import logic.relation

namespace hidden

/- Equality Propositions and Equality Relations

We will now shift focus to the specific binary
relation on any type, α, that we call equality.
Equality in Lean is polymorphic: Given any type
(in any type universe), we have a binary relation
on values of that type, of type α → α → Prop.
-/

-- Let's inspect the type of eq
#check @eq
-- eq : Π {α : Sort u_1}, α → α → Prop
-- infix ` = `:50 := eq

/-
In English, given any (Π) type, α, eq
takes two values of this type and reduces
to the proposition that these two values
are equal. So eq x y is the proposition,
x = y, and in fact Lean provides = as an
infix notation: the one you're accustomed
to from school days.
-/

-- These expressions mean the same thing
#check eq 0 0
#check 0 = 0

/- PROOFS

Up until now, all we've talked about is a mechanism,
eq, for generating propositions. What are the rules
for constructing and using proofs of equality?
-/

/- Inference rules

Equality has two inference rules: an introduction rule,
eq.refl, and an elimination rule, eq.subst. All other
properties of equality come from these two rules and
the meaning of "inductive definitions" in Lean (as we'll
see in a bit).
-/

/- Introduction rule: eq.refl

The introduction rule establishes the fact (constructs
proofs) that every object of any given type is equal to
itself.
-/

#check @eq.refl
-- ∀ {α : Sort u} (a : α), eq a a

#check eq.refl 0
-- eq 0 0, i.e., proof of 0 = 0

example : 0 = 0 := eq.refl 0

-- When Lean can infer "a" you can use rfl.
example : 0 = 0 := rfl

#check @rfl
-- ∀ {α : Sort u_1} {a : α}, a = a

/-
Note: in our logic you can't form a proposition that
two things of different types are equal. It's just a
type error, given the definition of eq.
-/

#check tt = "hi"    -- type error

/- Elimination rule: eq.subst

The second axiom of equality defines its elimination
rule: that is, how we can *use* a proof of an equality.
If you have a predicate, P : α → Prop, for some type,
α, and if you know P a, and you know a = b, then you
can deduce P b.

For example Tom is from New York (FromNY Tom), and
Bob = Tom, the by eq.subst you can deduce FromNY Bob.
Here's the rule formally.
-/

#check @eq.subst
/- eq.subst :
  ∀ {α : Sort u_1}
  {P : α → Prop}
  {a b : α},
  a = b →           -- if you know a = b
  P a →             -- and if you know P a
  P b               -- you can deduce P b
-- in reverse,
-- to show P b
-- suffices P a and a = b
-/

/-
What this rule really says is that if you
have a goal, P b, and you know a = b, you
can rewrite the goal as P a and the result
will be equivalent.

The following example sets up the use of
eq.subst. There are balls, balls can be
blue, a and b are balls, a is b, and a is
blue. The goal is to show that b is Blue.
That is done by applying eq.subst to the
proof of equality of a and b, and to the
proof that a is Blue.
-/

example
  (Ball : Type)
  (Blue : Ball → Prop)
  (a b : Ball)
  (eq_balls : a = b)
  (a_is_Blue : Blue a) :
  Blue b :=
eq.subst eq_balls a_is_Blue

/-
This next example show that applying
eq.subst to a proof of a = b reduces
the goal of showing Blue b to that of
showing Blue a. In a sense, applying
eq.subst to an equality proof effects
a *rewriting* of the current goal.
-/
example
  (Ball : Type)
  (Blue : Ball → Prop)
  (a b : Ball)
  (eq_balls : a = b)
  (a_is_Blue : Blue a) :
  Blue b :=
begin
  -- Study the sequents before and after this step
  apply eq.subst eq_balls,
  assumption,  -- now we can use *this* proof!
end

/-
Lean provides a useful tactic called
rewrite that automates application of
eq.subst to effect such rewritings. The
following two example illustate use of
two different forms of the tactic. In
short, given h : a = b, "rw h" changes
a's in the goal to b's and rw<-h changes
b's in the goal to a's.
-/

example
  (Ball : Type)
  (Blue : Ball → Prop)
  (a b : Ball)
  (eq_balls : a = b)
  (a_is_Blue : Blue a) :
  Blue b :=
begin
rw<-eq_balls, -- rewrite b to a (right to left)
assumption,
end

-- Exercise: complete the proof
example (α : Type) (a b : α) (P : α → Prop) : a = b → P b → P a :=
begin
intros ab Pb,
rw ab,
assumption,
end

/- Properties of The Equality Relation -/

/- Reflexivity

In English you can say a relation, r, is reflexive
if it relates *every* value, x in its "domain" to x
itself: that is ∀ x, r x x. Remember the relation r
is specified by a two-place predicate. So ∀ x, r x x
says that *every* value, x, is related to itself by r.
-/

#check @reflexive
/-
reflexive : Π {β : Sort v}, (β → β → Prop) → Prop

Π (capital Pi) means universal quantification. So,
what reflexive says is that "for any type, β (even
a propositional type), reflexive defines a property
of any binary relation on β.

Put another way, if you apply reflexive to any binary
relation on any type, β (inferred), you will get a
proposition: the one that precisely expresses what
it means for such a relation to be reflexive: that
every element of the domain is related to itself *in
that relation*.

For example, the reflexive predicate applied to the
equality relation yields the proposition that every
value of a given type is related to itself by equality
in this relation.
-/

#reduce reflexive (@eq nat)

/-
Of course, the introduction rule, refl, for equality
*makes* the equality relation reflexive. It's reflexive
by definition and so should be easy to prove.
-/

example : ∀ (X : Type), reflexive (@eq X) :=
begin
assume X,
unfold reflexive,
/- First axiom of equality:
   X : Type ⊢ ∀ (x : X), x = x
-/
assume x,
-- all the following are equivalent
-- exact @eq.refl X x,  -- no arguments inferred
-- exact eq.refl x,     -- one argument inferred
exact rfl,              -- both arguments inferred
end

/-
Congratulations, you have earned another sticker:
this one to recognize that you are now working with
properties of relations that in turn express
properties of sets of ordered pairs of values.
That's sorta cool!
-/

/- Symetric -/

/-
A relation is said to be symmetric if whenever
any object a is related to some object b, then b
is also related to a. The "friends" relation on
Facebook is symmetric in this sense.
-/

#check @symmetric
-- Π {β : Sort u_1}, (β → β → Prop) → Prop
#reduce @symmetric
-- ∀ ⦃x y : β⦄, x = y → y = x

/-
There's the generalized, formal definition: if x and
y are values (here of type nat), then if r x y then
r y x. If r is eq, then this says if x = y then y = x.
-/

#check @symmetric
#reduce @symmetric

/-
Exercise: prove that = is symmetric. And
answer the question, is ≤ symmetric, and
give a brief defense of your answer. If
your answer is no, provide a counter-example
to show that you are correct.
-/

example (α : Type): symmetric (@eq α) :=
begin
unfold symmetric,
assume x y e,
rw e,
end

example (α : Type) : transitive (@eq α) :=
begin
unfold transitive,
assume x y z xy yz,
rw <- yz,
assumption,
end

end hidden


import data.set.basic data.set.lattice data.nat.parity
import tactic.linarith

open set nat function

open_locale classical

variables {α : Type*} {β : Type*} {γ : Type*} {I : Type*}

/-!
## Set exercises

These are collected from *Mathematics in Lean*.

We will go over the examples together, and then let you
work on the exercises.

There is more material here than can fit in the sessions,
but we will pick and choose as we go.
-/

section set_variables

variable  x : α
variables s t u : set α

/-!
### Notation
-/

#check s ⊆ t        -- \sub
#check x ∈ s        -- \in or \mem
#check x ∉ s        -- \notin
#check s ∩ t        -- \i or \cap
#check s ∪ t        -- \un or \cup
#check (∅ : set α)  -- \empty

/-!
### Examples
-/

-- Three proofs of the same fact.
-- The first two expand definitions explicitly,
-- while the third forces Lean to do the unfolding.

example (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
begin
  rw [subset_def, inter_def, inter_def],
  rw subset_def at h,
  dsimp,
  rintros x ⟨xs, xu⟩,
  exact ⟨h _ xs, xu⟩,
end

example (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
begin
  simp only [subset_def, mem_inter_iff] at *,
  rintros x ⟨xs, xu⟩,
  exact ⟨h _ xs, xu⟩,
end

example (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
begin
  intros x xsu,
  exact ⟨h xsu.1, xsu.2⟩
end

-- Use `cases` or `rcases` or `rintros` with union.
-- Two proofs of the same fact, one longer and one shorter.

example : s ∩ (t ∪ u) ⊆ (s ∩ t) ∪ (s ∩ u) :=
begin
  intros x hx,
  have xs : x ∈ s := hx.1,
  have xtu : x ∈ t ∪ u := hx.2,
  cases xtu with xt xu,
  { left,
    show x ∈ s ∩ t,
    exact ⟨xs, xt⟩ },
  right,
  show x ∈ s ∩ u,
  exact ⟨xs, xu⟩
end

example : s ∩ (t ∪ u) ⊆ (s ∩ t) ∪ (s ∩ u) :=
begin
  rintros x ⟨xs, xt | xu⟩,
  { left, exact ⟨xs, xt⟩ },
  right, exact ⟨xs, xu⟩
end

-- Two examples with set difference.
-- Type it as ``\\``.
-- ``x ∈ s \ t`` expands to ``x ∈ s ∧ x ∉ t``.

example : s \ t \ u ⊆ s \ (t ∪ u) :=
begin
  intros x xstu,
  have xs : x ∈ s := xstu.1.1,
  have xnt : x ∉ t := xstu.1.2,
  have xnu : x ∉ u := xstu.2,
  split,
  { exact xs }, dsimp,
  intro xtu, -- x ∈ t ∨ x ∈ u
  cases xtu with xt xu,
  { show false, from xnt xt },
  show false, from xnu xu
end

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

/-!
### Exercises
-/

example : (s ∩ t) ∪ (s ∩ u) ⊆ s ∩ (t ∪ u):=
sorry

example : s \ (t ∪ u) ⊆ s \ t \ u :=
sorry

/-!
### Proving two sets are equal
-/

-- the ext tactic

example : s ∩ t = t ∩ s :=
begin
  ext x,
  -- simp only [mem_inter_iff],  -- optional.
  split,
  { rintros ⟨xs, xt⟩, exact ⟨xt, xs⟩ },
  rintros ⟨xt, xs⟩, exact ⟨xs, xt⟩
end

example : s ∩ t = t ∩ s :=
by ext x; simp [and.comm]

/-!
### Exercises
-/

example : s ∩ (s ∪ t) = s :=
sorry

example : s ∪ (s ∩ t) = s :=
sorry

example : (s \ t) ∪ t = s ∪ t :=
sorry

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
sorry

/-!
### Set-builder notation
-/

def evens : set ℕ := {n | even n}
def odds :  set ℕ := {n | ¬ even n}

example : evens ∪ odds = univ :=
begin
  rw [evens, odds],
  ext n,
  simp,
  apply classical.em
end

example : s ∩ t = {x | x ∈ s ∧ x ∈ t} := rfl
example : s ∪ t = {x | x ∈ s ∨ x ∈ t} := rfl
example : (∅ : set α) = {x | false} := rfl
example : (univ : set α) = {x | true} := rfl

example (x : ℕ) (h : x ∈ (∅ : set ℕ)) : false :=
h

example (x : ℕ) : x ∈ (univ : set ℕ) :=
trivial

/-!
### Exercise
-/

-- Use `intro n` to unfold the definition of subset,
-- and use the simplifier to reduce the
-- set-theoretic constructions to logic.
-- We also recommend using the theorems
-- ``prime.eq_two_or_odd`` and ``even_iff``.

example : { n | nat.prime n } ∩ { n | n > 2} ⊆ { n | ¬ even n } :=
sorry

/-!
Indexed unions
-/

-- See *Mathematics in Lean* for a discussion of
-- bounded quantifiers, which we will skip here.

section

-- We can use any index type in place of ℕ
variables A B : ℕ → set α

example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
begin
  ext x,
  simp only [mem_inter_iff, mem_Union],
  split,
  { rintros ⟨xs, ⟨i, xAi⟩⟩,
    exact ⟨i, xAi, xs⟩ },
  rintros ⟨i, xAi, xs⟩,
  exact ⟨xs, ⟨i, xAi⟩⟩
end

example : (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i) :=
begin
  ext x,
  simp only [mem_inter_iff, mem_Inter],
  split,
  { intro h,
    split,
    { intro i,
      exact (h i).1 },
    intro i,
    exact (h i).2 },
  rintros ⟨h1, h2⟩ i,
  split,
  { exact h1 i },
  exact h2 i
end

end

/-!
### Exercise
-/

-- One direction requires classical logic!
-- We recommend using ``by_cases xs : x ∈ s``
-- at an appropriate point in the proof.

section

variables A B : ℕ → set α

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
sorry

end

/-
Mathlib also has bounded unions and intersections,
`⋃ x ∈ s, f x` and `⋂ x ∈ s, f x`,
and set unions and intersections, `⋃₀ s` and `⋂₀ s`,
where `s : set α`.

See *Mathematics in Lean* for details.
-/

end set_variables

/-!
### Functions
-/

section function_variables

variable  f : α → β
variables s t : set α
variables u v : set β
variable  A : I → set α
variable  B : I → set β

#check f '' s
#check image f s
#check f ⁻¹' u    -- type as \inv' and then hit space or tab
#check preimage f u

example : f '' s = {y | ∃ x, x ∈ s ∧ f x = y} := rfl
example : f ⁻¹' u = {x | f x ∈ u } := rfl

example : f ⁻¹' (u ∩ v) = f ⁻¹' u ∩ f ⁻¹' v :=
by { ext, refl }

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y, split,
  { rintros ⟨x, xs | xt, rfl⟩,
    { left, use [x, xs] },
    right, use [x, xt] },
  rintros (⟨x, xs, rfl⟩ | ⟨x, xt, rfl⟩),
  { use [x, or.inl xs] },
  use [x, or.inr xt]
end

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

/-!
### Exercises
-/

example : f '' s ⊆ u ↔ s ⊆ f ⁻¹' u :=
sorry

example (h : injective f) : f ⁻¹' (f '' s) ⊆ s :=
sorry

example : f '' (f⁻¹' u) ⊆ u :=
sorry

example (h : surjective f) : u ⊆ f '' (f⁻¹' u) :=
sorry

example (h : s ⊆ t) : f '' s ⊆ f '' t :=
sorry

example (h : u ⊆ v) : f ⁻¹' u ⊆ f ⁻¹' v :=
sorry

example : f ⁻¹' (u ∪ v) = f ⁻¹' u ∪ f ⁻¹' v :=
sorry

example : f '' (s ∩ t) ⊆ f '' s ∩ f '' t :=
sorry

example (h : injective f) : f '' s ∩ f '' t ⊆ f '' (s ∩ t) :=
sorry

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

example : f ⁻¹' u \ f ⁻¹' v ⊆ f ⁻¹' (u \ v) :=
sorry

example : f '' s ∩ v = f '' (s ∩ f ⁻¹' v) :=
sorry

example : f '' (s ∩ f ⁻¹' u) ⊆ f '' s ∪ u :=
sorry

example : s ∩ f ⁻¹' u ⊆ f ⁻¹' (f '' s ∩ u) :=
sorry

example : s ∪ f ⁻¹' u ⊆ f ⁻¹' (f '' s ∪ u) :=
sorry

example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
sorry

example : f '' (⋂ i, A i) ⊆ ⋂ i, f '' A i :=
sorry

example (i : I) (injf : injective f) : (⋂ i, f '' A i) ⊆ f '' (⋂ i, A i) :=
sorry

example : f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i) :=
sorry

example : f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i) :=
sorry

/-
There is a lot more in *Mathematics in Lean* that we will not have time for!
There is a discussion of injectivity, more exercises on images and ranges,
and a discussion of inverses.

But we will close with on last exercise. Remember that `surjective f`
says `∀ y, ∃ x, f x = y`.

See if you can understand the proof of Cantor's famous theorem that there is no
surjective function from its set to its powerset, and
fill in the two lines that are missing.
-/

theorem Cantor : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f surjf,
  let S := { i | i ∉ f i},
  rcases surjf S with ⟨j, h⟩,
  have h₁ : j ∉ f j,
  { intro h',
    have : j ∉ f j,
      { by rwa h at h' },
    contradiction },
  have h₂ : j ∈ S,
sorry
    ,
  have h₃ : j ∉ S,
sorry
    ,
  contradiction
end

end function_variables


/- LoVe Exercise 13: Rational and Real Numbers -/

import .love05_inductive_predicates_demo
import .love13_rational_and_real_numbers_demo

namespace LoVe

set_option pp.beta true

/- Question 1: Rationals -/

/- 1.1. Prove the following lemma.

Hint: The lemma `fraction.mk.inj_eq` might be useful. -/

#check fraction.mk.inj_eq

lemma fraction.ext (a b : fraction) (h : fraction.num a = fraction.num b)
    (h': fraction.denom a = fraction.denom b) :
  a = b :=
begin
  cases a,
  cases b,
  rw fraction.mk.inj_eq,
  exact and.intro h h'
end

/- 1.2. Extending the `fraction.has_mul` instance from the lecture, declare
`fraction` an instance of `semigroup`.

Hint: Use the lemma `fraction.ext` above, and possibly `fraction.mul_num`, and
`fraction.mul_denom`. -/

#check fraction.ext
#check fraction.mul_num
#check fraction.mul_denom

instance fraction.semigroup : semigroup fraction :=
{ mul_assoc :=
    begin
      intros,
      apply fraction.ext,
      repeat {
        simp [fraction.mul_num, fraction.mul_denom],
        ac_refl }
    end,
  ..fraction.has_mul }

/- 1.3. Extending the `myℚ.has_mul` instance from the lecture, declare `myℚ` an
instance of `semigroup`.

Hint: The lemma `quotient.induction_on₃` might be useful. -/

#check quotient.induction_on₃

instance myℚ.semigroup : semigroup myℚ :=
{ mul_assoc :=
    begin
      intros a b c,
      apply quotient.induction_on₃ a b c,
      intros x y z,
      apply quotient.sound,
      rw mul_assoc,
    end,
  ..myℚ.has_mul }

/- Question 2: Structural Induction on Paper -/

/- This and the next question will exercise your understanding of induction,
especially if you need to perform induction proofs on a whiteboard (or on paper
at the exam).

Guidelines for paper proofs:

We expect detailed, rigorous, mathematical proofs. You are welcome to use
standard mathematical notation or Lean structured commands (e.g., `assume`,
`have`, `show`, `calc`). You can also use tactical proofs (e.g., `intro`,
`apply`), but then please indicate some of the intermediate goals, so that we
can follow the chain of reasoning.

Major proof steps, including applications of induction and invocation of the
induction hypothesis, must be stated explicitly. For each case of a proof by
induction, you must list the inductive hypotheses assumed (if any) and the goal
to be proved. Minor proof steps corresponding to `refl`, `simp`, or `linarith`
need not be justified if you think they are obvious (to humans), but you should
say which key lemmas they follow from. You should be explicit whenever you use a
function definition or an introduction rule for an inductive predicate. -/

/- 2.1. Recall the following inductive datatype for binary trees from lecture 4:

    inductive btree (α : Type) : Type
    | empty {} : btree
    | node     : α → btree → btree → btree

We defined a function `mirror` on these binary trees as follows:

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

Prove the following lemma by structural induction, as a paper proof:

    lemma mirror_mirror {α : Type} :
      ∀t : btree α, mirror (mirror t) = t -/

/- We perform the proof by structural induction on `t`.

Case `empty`: The goal is `mirror (mirror empty) = empty`. This holds by the
definition of `mirror`.

Case `node a l r`: The induction hyptheses are `mirror (mirror l) = l` and
`mirror (mirror r) = r`. The goal is
`mirror (mirror (node a l r)) = node a l r`.

We have:

    mirror (mirror (node a l r))
    = mirror (node a (mirror r) (mirror l))           -- by definition of mirror
    = node a (mirror (mirror l)) (mirror (mirror r))) -- by definition of mirror
    = node a l r                                      -- by the IHs

QED -/

/- 2.2. Prove the same lemma in Lean and compare it with your paper proof. -/

lemma mirror_mirror₂ {α : Type} :
  ∀t : btree α, mirror (mirror t) = t :=
begin
  intro t,
  induction t with a l r ihl ihr,
  { rw mirror,
    rw mirror },
  { rw mirror,
    rw mirror,
    rw ihl,
    rw ihr }
end

/- Question 3: Rule Induction on Paper -/

/- 3.1. Recall the following inductive predicate from lecture 5:

    inductive even : ℕ → Prop
    | zero    : even 0
    | add_two : ∀n, even n → even (n + 2)

Prove the following lemma by rule induction, as a paper proof, following the
guidelines given at the beginning of question 2. This is a good exercise to
develop a deeper understanding of how rule induction works (and is good
practice for the final exam).

    lemma exists_of_even (n : ℕ) (h : even n) :
      ∃k : ℕ, n = 2 * k -/

/- We perform the proof by rule induction on `h`.

Case `zero`: The goal is `∃k : ℕ, 0 = 2 * k`. We use k = 0. The remaining goal
is `0 = 2 * 0`, which is obviously true.

Case `add_two`: The induction hypothesis is `∃k : ℕ, n = 2 * k`.  The goal is
`∃k : ℕ, n + 2 = 2 * k`.

The induction hypothesis gives us a number `k`, such that `n = 2 * k`. We use
`k + 1` to instantiate the existential quantifier in the goal. This yields the
goal `n + 2 = 2 * (k + 1)`.

Using the fact `n = 2 * k`, we can rewrite the goal into
`(2 * k) + 2 = 2 * (k + 1)`, which is obviously true. QED -/

/- 3.2. Prove the same lemma in Lean and compare it with your paper proof. -/

lemma exists_of_even (n : ℕ) (h : even n) :
  ∃k : ℕ, n = 2 * k :=
begin
  induction h with n h ih,
  { use 0,
    refl },
  { cases ih with k hk,
    use k + 1,
    rw hk,
    refl }
end

end LoVe


import combinatorics.simple_graph.basic
import combinatorics.simple_graph.subgraph
import simple_graph_aux
import finset_fintype_aux

namespace complete_graph

open simple_graph

universe u

variables {V : Type u} [fintype V] [decidable_eq V]
variable (G : simple_graph V)

lemma edge_to_finset_powerset_len_two_surj :
∀ s, ∃ e, ∃ e_in,
  (complete_graph V).edge_to_finset_powerset_len_two e e_in = s :=
begin
  rintro ⟨s, s_in⟩,
  rw finset.mem_powerset_len at s_in,
  cases s_in with s_subset card_s,
  rw finset.card_eq_two at card_s,
  rcases card_s with ⟨v₁, v₂, v₁_ne_v₂, hs⟩,
  use ⟦(v₁, v₂)⟧,
  simp only [mem_edge_set, complete_graph_eq_top, top_adj],
  use v₁_ne_v₂,
  unfold edge_to_finset_powerset_len_two,
  simp only [sym2.lift_mk, subtype.coe_mk, subtype.mk_eq_mk],
  exact hs.symm,
end

lemma card_edge_finset :
(complete_graph V).edge_finset.card = (fintype.card V).choose 2 :=
begin
  suffices : (complete_graph V).edge_finset.card =
    (finset.powerset_len 2 (finset.univ : finset V)).card,
  { rw this,
    exact finset.card_powerset_len _ _, },
  unfold simple_graph.edge_finset,
  refine finset.card_congr
    (λ e, λ e_in,
      ((complete_graph V).edge_to_finset_powerset_len_two
        e (by rwa ← set.mem_to_finset)).val) _ _ _,
  { simp only [subtype.val_eq_coe, finset.coe_mem, implies_true_iff], },
  { simp_rw set.mem_to_finset,
    simp_rw subtype.val_inj,
    exact (complete_graph V).edge_to_finset_powerset_len_two_inj, },
  { intros s s_in,
    have h_surj := edge_to_finset_powerset_len_two_surj ⟨s, s_in⟩,
    simp_rw ← subtype.val_inj at h_surj,
    simp_rw set.mem_to_finset,
    exact h_surj, },
end

theorem edge_set_nonempty (hV : fintype.card V ≥ 2) :
((complete_graph V).edge_set).nonempty :=
begin
  unfold set.nonempty,
  unfold simple_graph.edge_set,
  rcases fintype.ex_x_ne_y_of_card_ge_two hV with ⟨v₁, v₂, v₁_ne_v₂⟩,
  use ⟦(v₁, v₂)⟧,
  -- Lean infers that ⟦(x, y)⟧ is an edge using hxy and closes the goal early
end

theorem edge_finset_nonempty (hV : fintype.card V ≥ 2) :
((complete_graph V).edge_finset).nonempty :=
begin
  unfold edge_finset,
  rw ← finset.coe_nonempty,
  rw set.coe_to_finset,
  exact edge_set_nonempty hV,
end

end complete_graph


import game.sup_inf.infSumSets
namespace xena -- hide

/-
# Chapter 3 : Sup and Inf

## Level 7

Another level that showcases the infimum.
-/

def sum_set_const (A : set ℝ) (c : ℝ) := { x : ℝ | ∃ y ∈ A, x = y + c}

/- Lemma
If $A$ is a set of reals, then
$$ \textrm{inf} (c + A) = c + \textrm{inf} (A)$$
-/
lemma inf_sum_set_const (A : set ℝ) (h1A : A.nonempty)
  (h2A : bdd_below A) (a : ℝ) (c : ℝ):
  (is_glb A a) → is_glb (sum_set_const A c) (c + a) :=
begin
  intro h,
  cases h with hA hB,
  split,
  -- prove that (c+a) is a lower bound
  intros x h0,
  cases h0 with y h1,
  cases h1 with yA h2,
  { have h2 := hA yA, linarith, },
  -- prove that (c+a) is the GLB
  intros L hL,
  have h3 : L - c ∈ lower_bounds A,
    intros y hy,
    set x := y + c with hx,
    have h31 : x ∈ sum_set_const A c,
      unfold sum_set_const,
      split, swap, use y, split, exact hy, exact hx,
    have h32 := hL h31, rw hx at h32, linarith,
  have h4 := hB h3, linarith,
  done
end

end xena -- hide


/- Recursive functions -/

#print Nat -- Nat is an inductive datatype

def fib (n : Nat) : Nat :=
  match n with
  | 0 => 1
  | 1 => 1
  | n+2 => fib (n+1) + fib n

example : fib 5 = 8 := rfl

example : fib (n+2) = fib (n+1) + fib n := rfl

#print fib
/-
def fib : Nat → Nat :=
fun n =>
  Nat.brecOn n fun n f =>
    (match (motive := (n : Nat) → Nat.below n → Nat) n with
      | 0 => fun x => 1
      | 1 => fun x => 1
      | Nat.succ (Nat.succ n) => fun x => x.fst.fst + x.fst.snd.fst.fst)
      f
-/


import tutorial_world.incidenceplane --hide
open IncidencePlane --hide

/- Axiom :
incidence (P Q : Point) (ℓ : Line) : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through P Q
-/

/- Tactic : intro

## Summary:

`intro p` will turn a goal `⊢ P → Q` into a hypothesis `p : P`
and goal `⊢ Q`. If `P` and `Q` are sets `intro p` means "let $p$ be an arbitrary element of $P$".
If `P` and `Q` are propositions then `intro p` says "assume $P$ is true".

## Details

If your goal is a function or an implication `⊢ P → Q` then `intro`
will always make progress. `intro p` turns

`⊢ P → Q`

into

```
p : P
⊢ Q
```

The opposite tactic to intro is `revert`; given the situation
just above, `revert p` turns the goal back into `⊢ P → Q`.

**Variant:** Instead of calling `intro` multiple times, you can use
`intros`. That is, `intros h₁ h₂` is equivalent to `intro h₁, intro h₂`.

## Example

If your goal is an implication $P\implies Q$ then Lean writes
this as `⊢ P → Q`, and `intro p,` can be thought of as meaning
"let $p$ be a proof of $P$", or more informally "let's assume that
$P$ is true". The goal changes to `⊢ Q` and the hypothesis `p : P`
appears in the local context.

-/

/-
#Tutorial World

## Level 6: the `intro` tactic.

This level introduces the `intro` tactic. This allows you to create
a new hypothesis in the local context, just above the goal with the `⊢` symbol, whenever you see
the **`→`** symbol in the "goal" section. [**Remember:** the **`→`** symbol refers to the idea of
an **implication**. `P → Q` is read as "P implies Q" and interpreted as "If P happens, then Q also happens".]
In Lean, if we have the goal `⊢ IT RAINS → I GET WET`, by typing `intro h` we will get a new hypothesis in
the local context of the type `h : IT RAINS` and the goal will just change into  `⊢ I GET WET`.

To solve this level, you will need to use a new statement that has been added to the list of "Theorem statements":

* incidence (P Q : Point) (ℓ : Line) : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through P Q

Now, delete the `sorry` and note how the goal changes into a list of implications. [**Pro tip:** instead of writing
several lines of code with the `intro` tactic, try to use the `intros` tactic. This will make the computer understand
that you want to create more than one hypothesis at the same time.] For example, if you type `intros h1 h2 h3 h4,`, four
new hypotheses will be added to your local context. Once you've added all the possible hypotheses to it, try to compare
the goal with the `incidence` statement. Did you notice that we can `rewrite` that statement? Because we have the first
three **hypotheses** of the statement, we can change the line `r` into `line_through A B`! Type `rewrite h1 h2 h4,` and
see how the goal changes. To close the goal, try to apply the same argument to the line `s`.

Bewildered? Click on the box right below for a hint.

-/

/- Hint : Click here for a hint, in case you get stuck.
In case you wrote `intros h1 h2 h3 h4 h5,` in the first line, after typing `rewrite h1 h2 h4,`, click on enter and
write `rewrite h1 h3 h5,`. Now, the goal should change into `⊢ line_through A B = line_through A B`, but Lean finishes the
proof for us because it realises that automatically!
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B : Ω} {r s : Line Ω} -- hide

/- Lemma :
If two lines contain two distinct points, then they are the same line.
-/
lemma equal_lines_of_contain_two_points :
A ≠ B → A ∈ r → A ∈ s → B ∈ r → B ∈ s → r = s :=
begin

  intros h1 h2 h3 h4 h5,
  rewrite incidence h1 h2 h4,
  rewrite incidence h1 h3 h5,

end

/-
## Another proof for the same level

Mathematics is not "black or white". We can provide different proofs to solve the same lemma. In the explanation showed above,
we've seen how we the goal changes into `⊢ line_through A B = s` after writing `rewrite h1 h2 h4`. But, what would happen if we type
`rewrite h1 h3 h5` just before that line? If you try it, you will see that the goal changes into `⊢ r = line_through A B`. Make an
effort to understand why that happens so that you're ready to face the next level with ease!

-/


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar si a es el límite de s, entonces
--     ∃ N b, ∀ n, N ≤ n → abs (s n) < b :=
-- ----------------------------------------------------------------------

import .Definicion_de_convergencia

variables {s : ℕ → ℝ} {a : ℝ}

theorem exists_abs_le_of_converges_to
  (cs : converges_to s a)
  : ∃ N b, ∀ n, N ≤ n → abs (s n) < b :=
begin
  cases cs 1 zero_lt_one with N h,
  use [N, abs a + 1],
  intros n hn,
  specialize h n hn,
  calc abs (s n)
           = abs (s n - a + a)     : by ring
       ... ≤ abs (s n - a) + abs a : abs_add (s n - a) a
       ... < 1 + abs a             : by exact add_lt_add_right h (abs a)
       ... = abs a + 1             : by exact add_comm 1 (abs a),
end

-- Prueba
-- ======

/-
s : ℕ → ℝ,
a : ℝ,
cs : converges_to s a
⊢ ∃ (N : ℕ) (b : ℝ), ∀ (n : ℕ), N ≤ n → abs (s n) < b
  >> cases cs 1 zero_lt_one with N h,
N : ℕ,
h : ∀ (n : ℕ), n ≥ N → abs (s n - a) < 1
⊢ ∃ (N : ℕ) (b : ℝ), ∀ (n : ℕ), N ≤ n → abs (s n) < b
  >> use [N, abs a + 1],
⊢ ∀ (n : ℕ), N ≤ n → abs (s n) < abs a + 1
  >> intros n hn,
n : ℕ,
hn : N ≤ n
⊢ abs (s n) < abs a + 1
  >> specialize h n hn,
h : abs (s n - a) < 1
⊢ abs (s n) < abs a + 1
  >> calc abs (s n)
  >>          = abs (s n - a + a)     : by ring
  >>      ... ≤ abs (s n - a) + abs a : by apply abs_add_le_abs_add_abs
  >>      ... < 1 + abs a             : by exact add_lt_add_right h (abs a)
  >>      ... = abs a + 1             : by exact add_comm 1 (abs a),
no goals
-/

-- Comentario: Se usan los lemas
-- + zero_lt_one : 0 < 1
-- + abs_add_le_abs_add_abs a b : abs (a + b) ≤ abs a + abs b
-- + add_lt_add_right : a < b → ∀ (c : ℝ), a + c < b + c
-- + add_comm a b : a + b = b + a

-- Comprobación:
-- variable (b : ℝ)
-- #check @zero_lt_one _ _
-- #check @abs_add_le_abs_add_abs _ _ a b
-- #check @add_lt_add_right _ _ a b
-- #check @add_comm _ _ a b


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

/-!
# Locus of unequal values of finitely supported functions

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

Let `α N` be two Types, assume that `N` has a `0` and let `f g : α →₀ N` be finitely supported
functions.

## Main definition

* `finsupp.ne_locus f g : finset α`, the finite subset of `α` where `f` and `g` differ.

In the case in which `N` is an additive group, `finsupp.ne_locus f g` coincides with
`finsupp.support (f - g)`.
-/

variables {α M N P : Type*}

namespace finsupp
variable [decidable_eq α]

section N_has_zero
variables [decidable_eq N] [has_zero N] (f g : α →₀ N)

/--  Given two finitely supported functions `f g : α →₀ N`, `finsupp.ne_locus f g` is the `finset`
where `f` and `g` differ. This generalizes `(f - g).support` to situations without subtraction. -/
def ne_locus (f g : α →₀ N) : finset α :=
(f.support ∪ g.support).filter (λ x, f x ≠ g x)

@[simp] lemma mem_ne_locus {f g : α →₀ N} {a : α} : a ∈ f.ne_locus g ↔ f a ≠ g a :=
by simpa only [ne_locus, finset.mem_filter, finset.mem_union, mem_support_iff,
    and_iff_right_iff_imp] using ne.ne_or_ne _

lemma not_mem_ne_locus {f g : α →₀ N} {a : α} : a ∉ f.ne_locus g ↔ f a = g a :=
mem_ne_locus.not.trans not_ne_iff

@[simp] lemma coe_ne_locus : ↑(f.ne_locus g) = {x | f x ≠ g x} :=
by { ext, exact mem_ne_locus }

@[simp] lemma ne_locus_eq_empty {f g : α →₀ N} : f.ne_locus g = ∅ ↔ f = g :=
⟨λ h, ext (λ a, not_not.mp (mem_ne_locus.not.mp (finset.eq_empty_iff_forall_not_mem.mp h a))),
  λ h, h ▸ by simp only [ne_locus, ne.def, eq_self_iff_true, not_true, finset.filter_false]⟩

@[simp] lemma nonempty_ne_locus_iff {f g : α →₀ N} : (f.ne_locus g).nonempty ↔ f ≠ g :=
finset.nonempty_iff_ne_empty.trans ne_locus_eq_empty.not

lemma ne_locus_comm : f.ne_locus g = g.ne_locus f :=
by simp_rw [ne_locus, finset.union_comm, ne_comm]

@[simp]
lemma ne_locus_zero_right : f.ne_locus 0 = f.support :=
by { ext, rw [mem_ne_locus, mem_support_iff, coe_zero, pi.zero_apply] }

@[simp]
lemma ne_locus_zero_left : (0 : α →₀ N).ne_locus f = f.support :=
(ne_locus_comm _ _).trans (ne_locus_zero_right _)

end N_has_zero

section ne_locus_and_maps

lemma subset_map_range_ne_locus [decidable_eq N] [has_zero N] [decidable_eq M] [has_zero M]
  (f g : α →₀ N) {F : N → M} (F0 : F 0 = 0) :
  (f.map_range F F0).ne_locus (g.map_range F F0) ⊆ f.ne_locus g :=
λ x, by simpa only [mem_ne_locus, map_range_apply, not_imp_not] using congr_arg F

lemma zip_with_ne_locus_eq_left [decidable_eq N] [has_zero M] [decidable_eq P] [has_zero P]
  [has_zero N] {F : M → N → P} (F0 : F 0 0 = 0)
  (f : α →₀ M) (g₁ g₂ : α →₀ N) (hF : ∀ f, function.injective (λ g, F f g)) :
  (zip_with F F0 f g₁).ne_locus (zip_with F F0 f g₂) = g₁.ne_locus g₂ :=
by { ext, simpa only [mem_ne_locus] using (hF _).ne_iff }

lemma zip_with_ne_locus_eq_right [decidable_eq M] [has_zero M] [decidable_eq P] [has_zero P]
  [has_zero N] {F : M → N → P} (F0 : F 0 0 = 0)
  (f₁ f₂ : α →₀ M) (g : α →₀ N) (hF : ∀ g, function.injective (λ f, F f g)) :
  (zip_with F F0 f₁ g).ne_locus (zip_with F F0 f₂ g) = f₁.ne_locus f₂ :=
by { ext, simpa only [mem_ne_locus] using (hF _).ne_iff }

lemma map_range_ne_locus_eq [decidable_eq N] [decidable_eq M] [has_zero M] [has_zero N]
  (f g : α →₀ N) {F : N → M} (F0 : F 0 = 0) (hF : function.injective F) :
  (f.map_range F F0).ne_locus (g.map_range F F0) = f.ne_locus g :=
by { ext, simpa only [mem_ne_locus] using hF.ne_iff }

end ne_locus_and_maps

variables [decidable_eq N]

@[simp] lemma ne_locus_add_left [add_left_cancel_monoid N] (f g h : α →₀ N) :
  (f + g).ne_locus (f + h) = g.ne_locus h :=
zip_with_ne_locus_eq_left _ _ _ _ add_right_injective

@[simp] lemma ne_locus_add_right [add_right_cancel_monoid N] (f g h : α →₀ N) :
  (f + h).ne_locus (g + h) = f.ne_locus g :=
zip_with_ne_locus_eq_right _ _ _ _ add_left_injective

section add_group
variables [add_group N] (f f₁ f₂ g g₁ g₂ : α →₀ N)

@[simp] lemma ne_locus_neg_neg : ne_locus (-f) (-g) = f.ne_locus g :=
map_range_ne_locus_eq _ _ neg_zero neg_injective

lemma ne_locus_neg : ne_locus (-f) g = f.ne_locus (-g) := by rw [←ne_locus_neg_neg, neg_neg]

lemma ne_locus_eq_support_sub : f.ne_locus g = (f - g).support :=
by rw [←ne_locus_add_right _ _ (-g), add_right_neg, ne_locus_zero_right, sub_eq_add_neg]

@[simp] lemma ne_locus_sub_left : ne_locus (f - g₁) (f - g₂) = ne_locus g₁ g₂ :=
by simp only [sub_eq_add_neg, ne_locus_add_left, ne_locus_neg_neg]

@[simp] lemma ne_locus_sub_right : ne_locus (f₁ - g) (f₂ - g) = ne_locus f₁ f₂ :=
by simpa only [sub_eq_add_neg] using ne_locus_add_right _ _ _

@[simp] lemma ne_locus_self_add_right : ne_locus f (f + g) = g.support :=
by rw [←ne_locus_zero_left, ←ne_locus_add_left f 0 g, add_zero]

@[simp] lemma ne_locus_self_add_left : ne_locus (f + g) f = g.support :=
by rw [ne_locus_comm, ne_locus_self_add_right]

@[simp]

@[simp] lemma ne_locus_self_sub_left : ne_locus (f - g) f = g.support :=
by rw [ne_locus_comm, ne_locus_self_sub_right]

end add_group
end finsupp


/-
CS 2102 F19, Homework #8, Predicate Logic & Proofs.
-/

namespace hw8

/-
#1. Equality and proofs of equality.
-/

/-
A. [10 points] Fill in the blank.

When we say that the binary equality relation,
=, on objects of any type, α, is reflexive, we
mean that for any value, a, of type, α, _______.

ANSWER: a = a
-/

/-
B. [10 points]
Complete the following definition in Lean
to formalize the proposition that 1 equals
1.
-/

def one_eq_one : Prop :=
    -- ANSWER
    1 = 1

/-
C. [10 points]
Give an English language proof of the
proposition that 1 = 1 by completing the
following incomplete proof.

To obtain a proof of 1 = 1 we apply the ________
property of the ________ relation to the specific
value, _________.

ANSWER: reflexive, binary, 1
-/

/-
D. [10 points]
Give a formal proof of this proposition
by completing the following definition.
-/

def proof_that_one_eq_one : one_eq_one := eq.refl 1
    -- ANSWER

/- [10 points]
E. Complete the following test case to produce
an example that suggests (correctly) that Lean
will accept a proof that two *different terms* are
equal as long as they reduce to the same value.
-/

-- ANSWER: Give a proposition and proof in Lean

def two_plus_two_eq_four : 4 = 2 + 2 := eq.refl 4

-- ANSWER Does eq.refl work as suggested? Yes

/-
#2. Predicates and Properties

A predicate is a parameterized proposition. By
applying a predicate to different arguments, we get
different propositions. Such a propopsition can
be said to be "about" the argument to which it was
applied.

We interpret such a proposition as asserting that
its argument has a *property* of interest. If the
proposition has a proof (is true), the object does
have the asserted property, and if the proposition
is not true, the object doesn't have that property.

In the  following set of problems, we will take the
property of a natural number "being even" as a case
in point.

In natural language, we will say that a natural
number, n, is even if and only if (1) it is zero,
or, (2) it is two more than another even number.

Think about this inductive definition. Why does it
cover all possible cases -- an infinitude of cases?
(No need for an answer here.)
-/

/-

A. [10 points]

We have accepted as *axioms* in our definition
of evennness that zero is even and that any number
that is two more than another even number is even.
These are the only axioms you may use in giving a
proof that four is even. Give a natural language
proof now. Hint, start by saying the following:

Proof: To prove that four is even, *it will suffice*
to show that 2 is even, because if two is even then,
given that 4 is two more than two, if two is even
then so is four, by rule (2). Now all that remains
to be proved is that _______________.

Give the rest of your natural language proof here,
and be sure to indicate which of the two rules you
are applying at each step in your reasoning.

ANSWER:
• 2 is even
• To prove that two is even, *it will suffice* to show that 0 is even, because if 0 is even then, given that 2 is two more than 0, if 0 is even then so is 2 by rule (2). We can prove that 0 is even by applying rule (1).
-/

/-
B. [10 points]

We formalize a predicate, such as is_even, as a
family of "inductive propositions" given by a
function from argument values to propositions.
Such an inductive definition thus has the type,
α → Prop, where α is the type of argument to
which the predicate is applied.

Please see the first line of the definition of
is_even that follows for an example.

Having specified the *type* of a predicate, in
this case from ℕ → Prop, we then define the set
of constructors to define the logical rules that
can be used to construct proofs of any such
proposition.

These rules are the (formal) axioms that can be
used to construct proofs. The first one (below)
states that the term, pf_zero_is_even, is to be
accepted as a proof of is_even 0 (which is how
we write the application of a predicate to a value
to obtain a proposition, here that "0 is even").

The second constructor/axiom/rule provides a way
to build a proof of (is_even 2+n) by applying the
constructor to any n along with a proof that that
particular n is even. (Yes: the ∀ specifies the
first argument to pf_even_plus_two_is_even. This
is necessary to give the argument a name, here n,
so that that name can be used in defining the rest
of the constructor's type).
-/

inductive is_even : ℕ → Prop
| pf_zero_is_even : (is_even 0)
| pf_even_plus_two_is_even :
    ∀ (n : ℕ), is_even n → is_even (nat.succ (nat.succ n))

/-
Give formal proofs for each of the following
propositions. (Notice how we obtain different
propositions by applying the predicate, is_even,
to different argument values. This is what we
mean when we say that a predicate defines a
family of propositions.)
-/

open is_even

theorem zero_even   : is_even 0 :=
    -- ANSWER
    is_even.pf_zero_is_even

/-
In this case, give a proof term without using
a begin/end proof script.
-/
theorem two_even    : is_even 2 :=
    -- ANSWER
    is_even.pf_even_plus_two_is_even (0) pf_zero_is_even --wtf

/-
In this case, give a proof using a begin/end
proof script.
-/
theorem eight_even  : is_even 8 :=
begin
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    exact pf_zero_is_even,
      -- replace this with answer
end

/-
C. [10 points]

Formally specify a predicate, is_odd, on the
natural numbers.  You can reason about any
natural number being odd using two rules, just
as for being even. Once you've defined your
predicate (an inductive family of proposition,
just like is_even), formally state and prove
the following propositions (however you wish).

- 1 is odd
- 7 is odd

-/

-- ANSWER

inductive is_odd : ℕ → Prop
| pf_one_is_odd : (is_odd 1)
| pf_odd_plus_two_is_odd :
    ∀ (n : ℕ), is_odd n → is_odd (nat.succ (nat.succ n))

-- ANSWER

theorem one_odd : is_odd 1 := is_odd.pf_one_is_odd

-- ANSWER

/-
Introducing an important concept. In the preceding
problems, we've seen that we can think of a predicate
with one argument as defining a property objects, such
as the property of being even. Now we shift perspective
from the concept of a property, per se, to the concept
of "the set of objects that have a given property." The
set of objects that have the is_even property, for
example, could be written as

    evens = {0, 2, 4, 6, 8, 10, ...}

or more formally as

    evens = { n : ℕ | is_even n}

The elements of these sets are all, and only,
the values that "satisfy" the is_even predicate.
A value satisfies its predicate if, when plugged
in, the resulting proposition has a proof (and so
is true). The key conclusion is that a predicate
with a single argument defines a *set*, namely
the set of all and only those objects that have
that property.
-/

/-
#4. Predicates and binary relations

Mathematicians define *binary relations* as sets
of ordered pairs. For example, the equality relation
on natural numbers comprises the set of of all pairs
of natural numbers such that the first and second
elements are the same. We could write this set like
this:

    equals = { (0,0), (1,1), (2,2), ...},

or like this:

    equals = { (m : ℕ, n : ℕ) | m = n }

We formalize binary relations as predicates with
*two* arguments. The type of such a predicate in
Lean is thus α → β → Prop, where α and β are the
types of the arguments.

In our example, we have a two-place predicate that
defines the set of ordered pairs of natural numbers
where the two elements of each pair are co-equal.

Study and understand the following specification
of this binary relation. Look at the construtor,
mk, in particular: it says that you can construct
a proof that a pair of values, n and m, is in our
id_nat_relation if you have a proof of n = m. (In
other words, it suffices to show that n = m using
Lean's built in equality relation to construct a
proof that (n, m) is in our id_nat_relation.)
-/

inductive id_nat_relation : ℕ → ℕ → Prop
| mk : ∀ (n m : ℕ), n = m → id_nat_relation n m

/-
A. [10 points]

Give a formal proof that id_nat_relation contains
the pair, (3, 3). Do it by completing the following
proof. Think carefully about the third argument: you
need a *value* of what type here? What do we call a
value of a logical type?
-/

theorem three_three_in_id : id_nat_relation 3 3 :=
    -- ANSWER (apply a constructor, of course)
    id_nat_relation.mk 3 3 (eq.refl 3)

/-
B. [10 points]

Explain in just a few words why it is not
possible to prove that (3,5) is in this relation.

This is because there is no proof for 3 = 5.
-/

-- ANSWER

/-
EXTRA CREDIT.
-/

/-
Here's a definition of what it means for a
relation to be reflexive.
-/

def reflexive {α : Type} (r : α → α → Prop) :=
    ∀ (a : α), r a a

/-
A. Formally state and prove that id_nat_relation
is reflexive. Hint: use a script and start it
with "assume (a : ℕ)". Remember that to prove a ∀
proposition, we *assume* that we're given some
arbitrary but specific value of the given type,
then we prove the rest of the proposition about
it. But because we didn't say anything about
the element we picked, we can conclude that the
statement must be true of any element of the type.
-/

-- ANSWER

theorem id_nat_refl : reflexive id_nat_relation :=
begin
assume (a : ℕ),
sorry               -- replace this
end

/-
B. [Double extra credit.]

Formally define what we mean by a relation being
symmetric and transitive, in the style of the above
definition of reflexive, and formally state and show
that our id_nat_reflexive relation is also symmetric
and transitive.
-/

end hw8


-- 课程仓库
-- https://github.com/ImperialCollegeLondon/formalising-mathematics

-- 本答案
-- https://github.com/LeyangGuo/Formalizing_Mathmetics_zh

-- We import all of Lean's standard tactics
import tactic

/-!
# Logic

We will develop the basic theory of following five basic logical symbols

* `→` ("implies" -- type with `\l`)
* `¬` ("not" -- type with `\not` or `\n`)
* `∧` ("and" -- type with `\and` or `\an`)
* `↔` ("iff" -- type with `\iff` or `\lr`)
* `∨` ("or" -- type with `\or` or `\v`

# Tactics you will need to know

* `intro`
* `exact`
* `apply`
* `rw`
* `cases`
* `split`
* `left`
* `right`

See `README.md` in `src/week_1` for an explanation of what these
tactics do.

Note that there are plenty of other tactics, and indeed once you've
"got the hang of it" you might want to try tactics such as `cc`,
`tauto` and its variant `tauto!`, `finish`, and `library_search`.

# What to do

The `example`s are to demonstrate things to you. They sometimes
use tactics you don't know. You can look at them but you don't
need to touch them.

The `theorem`s and `lemma`s are things which have no proof. You need to change
the `sorry`s into proofs which Lean will accept.

This paragraph is a comment, by the way. One-line comments
are preceded with `--`.
-/

-- We work in a "namespace". All this means is that whenever it
-- looks like we've defined a new theorem called `id`, its full
-- name is `xena.id`. Which is good because `id` is already
-- defined in Lean.
namespace xena

-- Throughout this namespace, P Q and R will be arbitrary (variable)
-- true-false statements.
variables (P Q R : Prop)

/-!
## implies (→)

To prove the theorems in this section, you will need to know about
the tactics `intro`, `apply` and `exact`. You might also like
the `assumption` tactic.
-/

/-- Every proposition implies itself. -/
theorem id : P → P :=
begin
  -- Prove this using `intro` and `exact`
  intro h, exact h,
end

/-
Note that → isn't associative!
Try working out `false → (false → false) and (false → false) → false
-/

example : (false → (false → false)) ↔ true := by simp
example : ((false → false) → false) ↔ false := by simp

-- in Lean, `P → Q → R` is _defined_ to mean `P → (Q → R)`
-- Here's a proof of what I just said.
example : (P → Q → R) ↔ (P → (Q → R)) :=
begin
  -- look at the goal!
  refl -- true because ↔ is reflexive
end

theorem imp_intro : P → Q → P :=
begin
  -- remember that by definition the goal is P → (Q → P).
  -- Prove this proposition using `intro` and `exact`.
  -- Experiment. Can you prove it using `intros` and `assumption`?

  intro p, intro q,
  --exact p,
  assumption
end

/-- If we know `P`, and we also know `P → Q`, we can deduce `Q`. -/
lemma modus_ponens : P → (P → Q) → Q :=
begin
  -- You might find the `apply` tactic useful here.
  intro p, intro p_to_q,
  apply p_to_q,
  apply p
end

/-- implication is transitive -/
lemma imp_trans : (P → Q) → (Q → R) → (P → R) :=
begin
  -- The tactics you know should be enough
  intro p_q, intro q_r, intro p,
  apply q_r, apply p_q,
  exact p
end

-- This one is a "relative modus ponens" -- in the
-- presence of P, if Q -> R and Q then R.
lemma forall_imp : (P → Q → R) → (P → Q) → (P → R) :=
begin
  -- `intros hPQR hPQ hP,` would be a fast way to start.
  -- Make sure you understand what is going on there, if you use it.
  -- 用 introS 引入假设，去掉goal中的->
  intros p_q_r p_q p,

  --apply适用于多个推出且最后一个是目标命题的假设
  apply p_q_r,

  apply p,

  apply p_q,
  apply p,
end

/-

### not

`not P`, with notation `¬ P`, is *defined* to mean `P → false` in Lean,
i.e., the proposition that P implies false. You can easily check with
a truth table that P → false and ¬ P are equivalent.

We develop a basic interface for `¬`.
-/

-- I'll prove this one for you
theorem not_iff_imp_false : ¬ P ↔ (P → false) :=
begin
  -- true by definition
  refl
end

theorem not_not_intro : P → ¬ (¬ P) :=
begin
              -- 求证 P → ¬ ¬ P
              -- 思路 (P → ¬ ¬ P) ↔ P → ((P → false) → false)
intro hP,     -- 1 . P
intro h_not_P,-- 2 | .P → false
              -- 3 | | false     (1,2 → _)
apply h_not_P,-- 4 | (P → false) → false     (2,3 → _)
exact hP,     -- 5 P → ((P → false) → false)     (1,4 → _)
end           -- QED.

-- Here is a funny alternative proof! Can you work out how it works?
example : P → ¬ (¬ P) :=
begin
  apply modus_ponens,   -- 上面证明过
  -- 可以理解为在apply会自动进行多次intro直到后边的证明可以匹配
end

-- Here is a proof which does not use tactics at all, but uses lambda calculus.
-- It is called a "term mode" proof. We will not be discussing term mode
-- much in this course. It is a cool way to do basic logic proofs, but
-- it does not scale well in practice.
example : P → ¬ (¬ P) :=
-- 类型是 P → (P → false) → false
λ hP hnP, hnP hP

-- This is "modus tollens". Some mathematicians think of it as
-- "proof by contradiction".
theorem modus_tollens : (P → Q) → (¬ Q → ¬ P) :=
begin
  intro hPQ,  -- 1 .(P → Q)
  intro hnQ,  -- 2 |  .(Q → false)
  intro hP,   -- 3 |  |   . P
  apply hnQ,  -- 4 |  |   | Q         3,1 → _
  apply hPQ,  -- 5 |  |   | false     4,2 → _
  exact hP,   -- 6 |  | (P → false)   3,5 → _
              -- 7 |(P → Q) → (¬ Q → ¬ P)   1,2,6 → _

  -- 无需使用`by_contra`，因为目标是 ¬ P, 可以`intro hP`
end

-- This one cannot be proved using constructive mathematics!
-- You _have_ to use a tactic like `by_contra` (or, if you're happy
-- to cheat, the full "truth table" tactic `tauto!`.
-- Try it without using these, and you'll get stuck!
theorem double_negation_elimination : ¬ (¬ P) → P :=
begin
  -- tauto!,
  intro hnnP,
  by_contra hnP,
  apply hnnP,
  exact hnP,
end

/-!

### and

The hypothesis `hPaQ : P ∧ Q` in Lean, is equivalent to
hypotheses `hP : P` and `hQ : Q`.

If you have `hPaQ` as a hypothesis, and you want to get to
`hP` and `hQ`, you can use the `cases` tactic.

If you have `⊢ P ∧ Q` as a goal, and want to turn the goal
into two goals `⊢ P` and `⊢ Q`, then use the `split` tactic.

Note that after `split` it's good etiquette to use braces
e.g.

example (hP : P) (hQ : Q) : P ∧ Q :=
begin
  split,
  { exact hP },
  { exact hQ }
end

but for this sort of stuff I think principled indentation
is OK

```
example (hP : P) (hQ : Q) : P ∧ Q :=
begin
  split,
    exact hP,
  exact hQ
end
```

-/

theorem and.elim_left : P ∧ Q → P :=
begin
  -- I would recommend starting with
  -- `intro hPaQ,` and then `cases hPaQ with hP hQ`.
  intro hPQ,
  cases hPQ with hP hQ,
  exact hP
end

theorem and.elim_right : P ∧ Q → Q :=
begin
  intro hPQ,
  cases hPQ with hP hQ,
  exact hQ
end

-- fancy term mode proof
example : P ∧ Q → Q := λ hPaQ, hPaQ.2

theorem and.intro : P → Q → P ∧ Q :=
begin
  -- remember the `split` tactic.
  intros hP hQ,
  split,
  exact hP,
  exact hQ,
end

/-- the eliminator for `∧` -/
theorem and.elim : P ∧ Q → (P → Q → R) → R :=
begin
  intro hPaQ,
  intro hPQR,
  apply hPQR,

  cases hPaQ with hP hQ,
  exact hP,

  cases hPaQ with hP hQ,
  exact hQ,
end

/-- The recursor for `∧` -/
theorem and.rec : (P → Q → R) → P ∧ Q → R :=
begin
  intro hPQR,
  intro hPaQ,
  apply hPQR,

  cases hPaQ with hP hQ,
  exact hP,

  cases hPaQ with hP hQ,
  exact hQ,
end

/-- `∧` is symmetric -/
theorem and.symm : P ∧ Q → Q ∧ P :=
begin
  intro hPaQ,
  cases hPaQ with hP hQ,
  split,
  {exact hQ},
  {exact hP}
end

-- term mode proof
example : P ∧ Q → Q ∧ P :=
λ ⟨hP, hQ⟩, ⟨hQ, hP⟩

/-- `∧` is transitive -/
theorem and.trans : (P ∧ Q) → (Q ∧ R) → (P ∧ R) :=
begin
  -- The `rintro` tactic will do `intro` and `cases` all in one go.
  -- If you like, try starting this proof with `rintro ⟨hP, hQ⟩` if you want
  -- to experiment with it. Get the pointy brackets with `\<` and `\>`,
  -- or both at once with `\<>`.
  rintro ⟨ hP,hQ ⟩ ,
  rintro ⟨ hQ,hR ⟩ ,
  split,
  exact hP,
  exact hR
end

/-
Recall that the convention for the implies sign →
is that it is _right associative_, by which
I mean that `P → Q → R` means `P → (Q → R)` by definition.
Now note that if `P` implies `Q → R`
then this means that `P` and `Q` together, imply `R`,
so `P → Q → R` is logically equivalent to `(P ∧ Q) → R`.

We proved that `P → Q → R` implied `(P ∧ Q) → R`; this was `and.rec`.
Let's go the other way.
-/

lemma imp_imp_of_and_imp : ((P ∧ Q) → R) → (P → Q → R) :=
begin
  intro hPaQiR,
  intros hP hQ,
  apply hPaQiR,

  split,
  {exact hP},
  {exact hQ}
end

/-!

### iff

The basic theory of `iff`.

In Lean, to prove `P ∧ Q` you have to prove `P` and `Q`.
Similarly, to prove `P ↔ Q` in Lean, you have to prove `P → Q`
and `Q → P`. Just like `∧`, you can uses `cases h` if you have
a hypothesis `h : P ↔ Q`, and `split` if you have a goal `⊢ P ↔ Q`.
-/

/-- `P ↔ P` is true for all propositions `P`, i.e. `↔` is reflexive. -/
theorem iff.refl : P ↔ P :=
begin
  -- start with `split`
  split,
  -- P → P
  {intro hP,
    exact hP},
  -- P → P
  {intro hP,
    exact hP}
end

-- If you get stuck, there is always the "truth table" tactic `tauto!`
example : P ↔ P :=
begin
  tauto!, -- the "truth table" tactic.
end

-- refl tactic also works
example : P ↔ P :=
begin
  refl -- `refl` knows that `=` and `↔` are reflexive.
end

/-- `↔` is symmetric -/
theorem iff.symm : (P ↔ Q) → (Q ↔ P) :=
begin
  intro hPiffQ,
  split,
  -- Q → P
  {cases hPiffQ with hPiQ hQiP,
    exact hQiP},
  -- P → Q
  {cases hPiffQ with hPiQ hQiP,
    exact hPiQ}
end

-- NB there is quite a devious proof of this using `rw`.

-- show-off term mode proof
example : (P ↔ Q) → (Q ↔ P) :=
λ ⟨hPQ, hQP⟩, ⟨hQP, hPQ⟩

/-- `↔` is commutative -/
theorem iff.comm : (P ↔ Q) ↔ (Q ↔ P) :=
begin
  split,
  -- (P ↔ Q) → (Q ↔ P)
  apply iff.symm,
  -- (Q ↔ P) → (P ↔ Q)
  apply iff.symm,
end

-- without rw or cc this is painful!
/-- `↔` is transitive -/
theorem iff.trans :  (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  intro hPiffQ,
  intro hQiffR,
  split,
  -- P → R
  {rw hPiffQ, rw hQiffR,
  intro hR, exact hR},
  -- R → P
  {rw hPiffQ, rw hQiffR,
  intro hR, exact hR},
end

-- This can be done constructively, but it's hard. You'll need to know
-- about the `have` tactic to do it. Alternatively the truth table
-- tactic `tauto!` will do it.
theorem iff.boss : ¬ (P ↔ ¬ P) :=
begin
  intro h,
  cases h with hR hL,

  have sel_imp : P → P,{
    intro hP, exact hP,
    },

  have hnP : P → false, {
    intro hP,
    apply hR,
    exact hP,
    exact hP,
  },

  apply hR,
  apply hL,
  exact hnP,

  apply hL,
  exact hnP,
end

-- 上面的证明中用到如下引理
lemma not_imp_nSelf : (P → (P → false)) → (P → P) → (P → false) :=
begin
  -- `intros hPQR hPQ hP,` would be a fast way to start.
  -- Make sure you understand what is going on there, if you use it.
  -- 用 introS 引入假设，去掉goal中的->
  intros p_q_r p_q p,

  --apply适用于多个推出且最后一个是目标命题的假设
  apply p_q_r,

  apply p,

  apply p_q,
  apply p,
end

--
example : ¬ (P ↔ ¬ P) :=
begin
    by_cases h : P,
  -- P为真时
  {
    intro hPiffnP,
    cases hPiffnP with hPinP hnPiP,
    apply hPinP,
    exact h,
    exact h
    },
  -- P为假时
  {
  intro hPiffnP,
  cases hPiffnP with hPinP hnPiP,
  apply hPinP,
  apply hnPiP, exact h,
  apply hnPiP, exact h
  }
end

-- Now we have iff we can go back to and.

/-!
### ↔ and ∧
-/

-- 引理 and.comm 的证明，写在这里供参考
example : P ∧ Q → Q ∧ P :=
begin
  rintro ⟨ hP, hQ ⟩ ,
  split,
  exact hQ,
  exact hP,
end

/-- `∧` is commutative -/
theorem and.comm : P ∧ Q ↔ Q ∧ P :=
begin
  split,
  apply and.symm,
  apply and.symm,
end

-- fancy term-mode proof
example : P ∧ Q ↔ Q ∧ P :=
⟨and.symm _ _, and.symm _ _⟩

-- Note that ∧ is "right associative" in Lean, which means
-- that `P ∧ Q ∧ R` is _defined to mean_ `P ∧ (Q ∧ R)`.
-- Associativity can hence be written like this:
/-- `∧` is associative -/
theorem and_assoc : ((P ∧ Q) ∧ R) ↔ (P ∧ Q ∧ R) :=
begin
  split,
  -- (P ∧ Q) ∧ R → P ∧ (Q ∧ R)
  {
    rintro ⟨hPaQ,hR⟩ ,
    cases hPaQ with hP hQ,

    split,
      exact hP,
      split,
        exact hQ,
        exact hR,
  },
  -- P ∧ Q ∧ R → (P ∧ Q) ∧ R
  {
    rintro ⟨hP,hQaR⟩ ,
    cases hQaR with hQ hR,

    split,
      split,
        exact hP,
        exact hQ,
      exact hR,
    }
end

/-!

## Or

`P ∨ Q` is true when at least one of `P` and `Q` are true.
Here is how to work with `∨` in Lean.

If you have a hypothesis `hPoQ : P ∨ Q` then you
can break into the two cases `hP : P` and `hQ : Q` using
`cases hPoQ with hP hQ`

If you have a _goal_ of the form `⊢ P ∨ Q` then you
need to decide whether you're going to prove `P` or `Q`.
If you want to prove `P` then use the `left` tactic,
and if you want to prove `Q` then use the `right` tactic.

-/

-- recall that P, Q, R are Propositions. We'll need S for this one.
variable (S : Prop)

-- You will need to use the `left` tactic for this one.
theorem or.intro_left : P → P ∨ Q :=
begin
  intro hP,
  left,
  exact hP,
end

theorem or.intro_right : Q → P ∨ Q :=
begin
  intro hQ,
  right,
  exact hQ,
end

/-- the eliminator for `∨`. -/
theorem or.elim : P ∨ Q → (P → R) → (Q → R) → R :=
begin
  intros hPoQ hPR hQR,
  cases hPoQ with hP hQ,
  { -- P → R
    apply hPR,
    exact hP
  },
  { -- Q → R
    apply hQR,
    exact hQ,
  }
end

/-- `∨` is symmetric -/
theorem or.symm : P ∨ Q → Q ∨ P :=
begin
  intro hPoQ,
  cases hPoQ with hP hQ,
  -- P → Q ∨ P
  apply or.intro_right,
  exact hP,
  -- Q → Q ∨ P
  apply or.intro_left,
  exact hQ,
end

/-- `∨` is commutative -/
theorem or.comm : P ∨ Q ↔ Q ∨ P :=
begin
  split,
  { -- left imp right
    apply or.symm,
  },
  { -- right imp left
    apply or.symm,
  }
end

/-- `∨` is associative -/
theorem or.assoc : (P ∨ Q) ∨ R ↔ P ∨ Q ∨ R :=
begin
  split,
  { -- (P ∨ Q) ∨ R → P ∨ Q ∨ R
    intro hLeft,
    cases hLeft with hPoQ hR,
    cases hPoQ with hP hQ,
    -- known: P
    apply or.intro_left,
    exact hP,
    -- known: Q or R
      -- known Q
      apply or.intro_right,
      apply or.intro_left,
      exact hQ,
      -- known R
      apply or.intro_right,
      apply or.intro_right,
      exact hR,
  },
  {
    intro hRight,
    cases hRight with hP hQoR,
      { -- known P
        apply or.intro_left,
        apply or.intro_left,
        exact hP,
      },
    cases hQoR with hQ hR,
      { -- known Q,
        apply or.intro_left,
        apply or.intro_right,
        exact hQ,
      },
      { -- known R
        apply or.intro_right,
        exact hR,
      },
  },
end

/-!
### More about → and ∨
-/

theorem or.imp : (P → R) → (Q → S) → P ∨ Q → R ∨ S :=
begin
  intros hPR hQS hPoQ,
  cases hPoQ with hP hQ,
  { --known P,
    left,
    apply hPR,
    exact hP,
  },
  { -- known Q,
    right,
    apply hQS,
    exact hQ,
  }
end

theorem or.imp_left : (P → Q) → P ∨ R → Q ∨ R :=
begin
  intros hPQ hPoR,
  cases hPoR with hP hR,
  { -- known P
    left,
    apply hPQ,
    exact hP,
  },
  { -- known Q
    right,
    exact hR,
  }
end

theorem or.imp_right : (P → Q) → R ∨ P → R ∨ Q :=
begin
  intros hPQ hRoP,
  cases hRoP with hR hP,
  { --known R
    left,
    exact hR,
  },
  { --known P
    right,
    apply hPQ,
    exact hP,
  }
end

theorem or.left_comm : P ∨ Q ∨ R ↔ Q ∨ P ∨ R :=
begin
  -- Try rewriting `or.comm` and `or.assoc` to do this one quickly.
  -- https://stackoverflow.com/questions/69047508/rw-expression-in-expression
  -- 利用comm和assoc将 ↔ 左右化为相同，最后用refl
  rw ← or.assoc,
  nth_rewrite 1 or.comm,  -- rewrite 第二次匹配到的内容
  rw or.assoc,
end

example : P ∨ Q ∨ R ↔ Q ∨ P ∨ R :=
begin
  rw ← or.assoc,
  conv{
    to_lhs,
    congr,
    rw or.comm,
  },
  rw or.assoc,
end

/-- the recursor for `∨` -/
theorem or.rec : (P → R) → (Q → R) → P ∨ Q → R :=
begin
  intros hPR hQR hPoQ,
  cases hPoQ with hP hQ,
  -- known P
  apply hPR,
  exact hP,
  -- known Q
  apply hQR,
  exact hQ,
end

theorem or_congr : (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S) :=
begin
  intros hPR hQS,
  rw hPR,
  rw hQS,
  -- rw 会自动尝试refl
end

/-!

### true and false

`true` is a true-false statement, which can be proved with the `trivial` tactic.

`false` is a true-false statment which can only be proved if you manage
to find a contradiction within your assumptions.

If you manage to end up with a hypothesis `h : false` then there's quite
a funny way to proceed, which we now explain.

If you have `h : P ∧ Q` then you can uses `cases h with hP hQ` to split
into two cases.

If you have `h : false` then what do you think happens if we do `cases h`?
Hint: how many cases are there?
-/

/-- eliminator for `false` -/
theorem false.elim : false → P :=
begin
  intro hF,
  cases hF,
end

theorem and_true_iff : P ∧ true ↔ P :=
begin
  split,
  { -- P ∧ true → P
    intro hPaT,
    cases hPaT with hP hT,
    exact hP,
  },
  { -- P → P ∧ true
    intro hP,
    have hT : true,
      trivial,

    split,
    exact hP,
    exact hT,
  },
end

theorem or_false_iff : P ∨ false ↔ P :=
begin
  split,
  { -- ⊢ P ∨ false → P
    intro h,
    cases h with hP hF,
    exact hP,
    cases hF,
  },
  { -- ⊢ P → P ∨ false
    intro h,
    left,
    exact h,
  },
end

-- false.elim is handy for this one
theorem or.resolve_left : P ∨ Q → ¬P → Q :=
begin
  intros hPoQ hnP,

  have hPiffF : P ↔ false, {
    split,
    exact hnP,
    apply false.elim,
  },

  rw hPiffF at hPoQ,
  rw or.comm at hPoQ,
  rw or_false_iff at hPoQ,
  exact hPoQ,
end

-- this one you can't do constructively
theorem or_iff_not_imp_left : P ∨ Q ↔ ¬P → Q :=
begin
  split,
  { -- ⊢ P ∨ Q → ¬P → Q
    -- Done constructively
    apply or.resolve_left,
  },
  { -- ⊢ (¬P → Q) → P ∨ Q
    intro hnPQ,
    by_cases hP : P,
    { -- have P
      left,
      exact hP,
    },
    { -- have ¬ P
      right,
      apply hnPQ,
      exact hP,
    },
  },
end

end xena


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

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, sheet 1 : ∪ ∩ ⊆ and all that

Lean doesn't have "abstract" sets, it only has *subsets* of a type. If `X : Type` is a type
then the type of subsets of `X` is called `set X`. A term `A : set X`
can be thought of in three ways:

1) A set of elements of `X` (i.e. a set of elements all of which have type `X`);
2) A subset of `X`;
3) An element of the power set of `X`;
4) A function from `X` to `Prop` (sending the elements of `A` to `true` and the other ones to `false`)

So `set X` could have been called `subset X` or `powerset X`; I guess they chose `set X`
because it was the shortest.

Note that `X` is a type, but `A` is a term; the type of `A` is `set X`. This means
that `a : A` doesn't make sense. What we say instead is `a : X` and `a ∈ A`.
Of course `a ∈ A` is a true-false statement, so `a ∈ A : Prop`.

All the sets `A`, `B`, `C` etc we consider will be subsets of `X`.
If `x : X` then `x` may or may not be an element of `A`, `B`, `C`,
but it will always be a term of type `X`.

-/

-- set up variables
variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D : set X) -- A,B,C,D are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

/-

# subset (`⊆`), union (`∪`) and intersection (`∩`)

Here are some mathematical facts:

`A ⊆ B` is equivalent to `∀ x, x ∈ A → x ∈ B`;
`x ∈ A ∪ B` is equivalent to `x ∈ A ∨ x ∈ B`;
`x ∈ A ∩ B` is equivalent to `x ∈ A ∧ x ∈ B`.

All of these things are true *by definition* in Lean. Let's
check this.

-/

lemma subset_def : A ⊆ B ↔ ∀ x, x ∈ A → x ∈ B :=
begin
  -- ↔ is reflexive so `refl` works because LHS is defined to be equal to RHS
  refl
end

lemma mem_union_iff : x ∈ A ∪ B ↔ x ∈ A ∨ x ∈ B :=
begin
  refl
end

lemma mem_inter_iff : x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B :=
iff.rfl -- you don't even have to go into tactic mode to prove this stuff

/-

So now to change one side of these `↔`s to the other, you can
`rw` the appropriate lemma, or you can just use `change`. Or
you can ask yourself whether you need to do this at all.

Let's prove some theorems.

-/

example : A ⊆ A :=
begin
  sorry,
end

example : A ⊆ B → B ⊆ C → A ⊆ C :=
begin
  sorry,
end

example : A ⊆ A ∪ B :=
begin
  sorry,
end

example : A ∩ B ⊆ A :=
begin
  sorry,
end

example : A ⊆ B → A ⊆ C → A ⊆ (B ∩ C) :=
begin
  sorry,
end

example : B ⊆ A → C ⊆ A → B ∪ C ⊆ A :=
begin
  sorry,
end

example : A ⊆ B → C ⊆ D → A ∪ C ⊆ B ∪ D :=
begin
  sorry,
end

example : A ⊆ B → C ⊆ D → A ∩ C ⊆ B ∩ D :=
begin
  sorry,
end


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

/- UNIVERSAL QUANTIFICATION -/

-- We can leave off `: α` if Lean can infer it (here via `p`/`q`)
example : (∀ x, p x) → (∀ x, p x → q x) → (∀ x, q x) := _

-- The reverse direction of the slides example
example : (∀ x, p x ∧ q x) → (∀ x, p x) ∧ (∀ x, q x) := _

-- TODO: Prove the corresponding forward/reverse lemma(s) for `∨` (that hold)!
-- hint: input `∀` as `\all`

-- We can bind multiple variables in a single `∀`
example : (∀ x y, r x y) → (∀ y x, r x y) := _

/- EXISTENTIAL QUANTIFICATION -/

/-
Interestingly, in contrast to the universal quantifier, the existential quantifier is not primitive
but can be specified as an inductive type:
```
inductive Exists (p : α → Prop) : Prop where
  | intro (w : α) (h : p w) : Exists p
```
That is, `Exists.intro` takes/offers a "witness" and a proof that the predicate holds for the witness.
Instead of `Exists (fun x => p x)`, we can also write `∃ x, p x` (input `∃` as `\ex`).
-/

example : (∃ x, p x ∧ q x) → (∃ x, p x) ∧ (∃ x, q x) := _

example : ¬(∃ x, p x) → (∀ x, ¬ p x) := _

example : (∀ x, ¬ p x) → ¬(∃ x, p x) := _

example : (∃ x, ¬ p x) → ¬ (∀ x, p x) := _

section
open Classical
-- The following example can only be solved using the classical axioms
-- This one is pretty tricky again, don't feel bad about skipping it
-- hint: use the following helper theorem that can be derived from `em`:
#check byContradiction
-- hint: you may even need to use it more than once
example : ¬(∀ x, p x) → (∃ x, ¬ p x) := _
end

-- TODO: Decide for yourself what variables you need to model and prove the following
-- important real-world observation, which is sometimes called "drinker paradox":
--   "If there is at least one person in the pub, then there is someone in the pub such that,
--    if (s)he is drinking, then everyone in the pub is drinking."
-- hint: you can define "is in pub" either as a predicate variable on a "Person" type (`(Person : Type)`),
--   or, more simply, directly as a type "Occupant" since we are not interested in persons outside the pub
-- hint: you might need classical logic again
section Drinker

end Drinker

/- EQUALITY -/

example : ∀ a b c : α, a = b → b = c → a = c := _

example : ∀ a : α, ∃ b : α, b = a := _

-- "`Eq` is the least reflexive relation"
example : (∀ a, r a a) → (∀ a b, a = b → r a b) := _

end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import algebra.group.pi
import algebra.group.prod
import algebra.hom.iterate
import logic.equiv.set

/-!
# The group of permutations (self-equivalences) of a type `α`

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

This file defines the `group` structure on `equiv.perm α`.
-/
universes u v

namespace equiv

variables {α : Type u} {β : Type v}

namespace perm

instance perm_group : group (perm α) :=
{ mul := λ f g, equiv.trans g f,
  one := equiv.refl α,
  inv := equiv.symm,
  mul_assoc := λ f g h, (trans_assoc _ _ _).symm,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_left_inv := self_trans_symm }

@[simp] lemma default_eq : (default : perm α) = 1 := rfl

/-- The permutation of a type is equivalent to the units group of the endomorphisms monoid of this
type. -/
@[simps] def equiv_units_End : perm α ≃* units (function.End α) :=
{ to_fun := λ e, ⟨e, e.symm, e.self_comp_symm, e.symm_comp_self⟩,
  inv_fun := λ u, ⟨(u : function.End α), (↑u⁻¹ : function.End α), congr_fun u.inv_val,
    congr_fun u.val_inv⟩,
  left_inv := λ e, ext $ λ x, rfl,
  right_inv := λ u, units.ext rfl,
  map_mul' := λ e₁ e₂, rfl }

/-- Lift a monoid homomorphism `f : G →* function.End α` to a monoid homomorphism
`f : G →* equiv.perm α`. -/
@[simps] def _root_.monoid_hom.to_hom_perm {G : Type*} [group G] (f : G →* function.End α) :
  G →* perm α :=
equiv_units_End.symm.to_monoid_hom.comp f.to_hom_units

theorem mul_apply (f g : perm α) (x) : (f * g) x = f (g x) :=
equiv.trans_apply _ _ _

theorem one_apply (x) : (1 : perm α) x = x := rfl

@[simp] lemma inv_apply_self (f : perm α) (x) : f⁻¹ (f x) = x := f.symm_apply_apply x

@[simp] lemma apply_inv_self (f : perm α) (x) : f (f⁻¹ x) = x := f.apply_symm_apply x

lemma one_def : (1 : perm α) = equiv.refl α := rfl

lemma mul_def (f g : perm α) : f * g = g.trans f := rfl

lemma inv_def (f : perm α) : f⁻¹ = f.symm := rfl

@[simp, norm_cast] lemma coe_one : ⇑(1 : perm α) = id := rfl
@[simp, norm_cast] lemma coe_mul (f g : perm α) : ⇑(f * g) = f ∘ g := rfl
@[norm_cast] lemma coe_pow (f : perm α) (n : ℕ) : ⇑(f ^ n) = (f^[n]) :=
hom_coe_pow _ rfl (λ _ _, rfl) _ _
@[simp] lemma iterate_eq_pow (f : perm α) (n : ℕ) : (f^[n]) = ⇑(f ^ n) := (coe_pow _ _).symm

lemma eq_inv_iff_eq {f : perm α} {x y : α} : x = f⁻¹ y ↔ f x = y := f.eq_symm_apply

lemma inv_eq_iff_eq {f : perm α} {x y : α} : f⁻¹ x = y ↔ x = f y := f.symm_apply_eq

lemma zpow_apply_comm {α : Type*} (σ : perm α) (m n : ℤ) {x : α} :
  (σ ^ m) ((σ ^ n) x) = (σ ^ n) ((σ ^ m) x) :=
by rw [←equiv.perm.mul_apply, ←equiv.perm.mul_apply, zpow_mul_comm]

@[simp] lemma image_inv (f : perm α) (s : set α) : ⇑f⁻¹ '' s = f ⁻¹' s := f⁻¹.image_eq_preimage _
@[simp] lemma preimage_inv (f : perm α) (s : set α) : ⇑f⁻¹ ⁻¹' s = f '' s :=
(f.image_eq_preimage _).symm

/-! Lemmas about mixing `perm` with `equiv`. Because we have multiple ways to express
`equiv.refl`, `equiv.symm`, and `equiv.trans`, we want simp lemmas for every combination.
The assumption made here is that if you're using the group structure, you want to preserve it after
simp. -/

@[simp] lemma trans_one {α : Sort*} {β : Type*} (e : α ≃ β) : e.trans (1 : perm β) = e :=
equiv.trans_refl e

@[simp] lemma mul_refl (e : perm α) : e * equiv.refl α = e := equiv.trans_refl e

@[simp] lemma one_symm : (1 : perm α).symm = 1 := equiv.refl_symm

@[simp] lemma refl_inv : (equiv.refl α : perm α)⁻¹ = 1 := equiv.refl_symm

@[simp] lemma one_trans {α : Type*} {β : Sort*} (e : α ≃ β) : (1 : perm α).trans e = e :=
equiv.refl_trans e

@[simp] lemma refl_mul (e : perm α) : equiv.refl α * e = e := equiv.refl_trans e

@[simp] lemma inv_trans_self (e : perm α) : e⁻¹.trans e = 1 := equiv.symm_trans_self e

@[simp] lemma mul_symm (e : perm α) : e * e.symm = 1 := equiv.symm_trans_self e

@[simp] lemma self_trans_inv (e : perm α) : e.trans e⁻¹ = 1 := equiv.self_trans_symm e

@[simp] lemma symm_mul (e : perm α) : e.symm * e = 1 := equiv.self_trans_symm e

/-! Lemmas about `equiv.perm.sum_congr` re-expressed via the group structure. -/

@[simp] lemma sum_congr_mul {α β : Type*} (e : perm α) (f : perm β) (g : perm α) (h : perm β) :
  sum_congr e f * sum_congr g h = sum_congr (e * g) (f * h) :=
sum_congr_trans g h e f

@[simp] lemma sum_congr_inv {α β : Type*} (e : perm α) (f : perm β) :
  (sum_congr e f)⁻¹ = sum_congr e⁻¹ f⁻¹ :=
sum_congr_symm e f

@[simp] lemma sum_congr_one {α β : Type*} :
  sum_congr (1 : perm α) (1 : perm β) = 1 :=
sum_congr_refl

/-- `equiv.perm.sum_congr` as a `monoid_hom`, with its two arguments bundled into a single `prod`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between `α` and `β`. -/
@[simps]
def sum_congr_hom (α β : Type*) :
  perm α × perm β →* perm (α ⊕ β) :=
{ to_fun := λ a, sum_congr a.1 a.2,
  map_one' := sum_congr_one,
  map_mul' := λ a b, (sum_congr_mul _ _ _ _).symm}

lemma sum_congr_hom_injective {α β : Type*} :
  function.injective (sum_congr_hom α β) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split; ext i,
  { simpa using equiv.congr_fun h (sum.inl i), },
  { simpa using equiv.congr_fun h (sum.inr i), },
end

@[simp] lemma sum_congr_swap_one {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : α) :
  sum_congr (equiv.swap i j) (1 : perm β) = equiv.swap (sum.inl i) (sum.inl j) :=
sum_congr_swap_refl i j

@[simp] lemma sum_congr_one_swap {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : β) :
  sum_congr (1 : perm α) (equiv.swap i j) = equiv.swap (sum.inr i) (sum.inr j) :=
sum_congr_refl_swap i j

/-! Lemmas about `equiv.perm.sigma_congr_right` re-expressed via the group structure. -/

@[simp] lemma sigma_congr_right_mul {α : Type*} {β : α → Type*}
  (F : Π a, perm (β a)) (G : Π a, perm (β a)) :
  sigma_congr_right F * sigma_congr_right G = sigma_congr_right (F * G) :=
sigma_congr_right_trans G F

@[simp] lemma sigma_congr_right_inv {α : Type*} {β : α → Type*} (F : Π a, perm (β a)) :
  (sigma_congr_right F)⁻¹ = sigma_congr_right (λ a, (F a)⁻¹) :=
sigma_congr_right_symm F

@[simp] lemma sigma_congr_right_one {α : Type*} {β : α → Type*} :
  (sigma_congr_right (1 : Π a, equiv.perm $ β a)) = 1 :=
sigma_congr_right_refl

/-- `equiv.perm.sigma_congr_right` as a `monoid_hom`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between fibers. -/
@[simps]
def sigma_congr_right_hom {α : Type*} (β : α → Type*) :
  (Π a, perm (β a)) →* perm (Σ a, β a) :=
{ to_fun := sigma_congr_right,
  map_one' := sigma_congr_right_one,
  map_mul' := λ a b, (sigma_congr_right_mul _ _).symm }

lemma sigma_congr_right_hom_injective {α : Type*} {β : α → Type*} :
  function.injective (sigma_congr_right_hom β) :=
begin
  intros x y h,
  ext a b,
  simpa using equiv.congr_fun h ⟨a, b⟩,
end

/-- `equiv.perm.subtype_congr` as a `monoid_hom`. -/
@[simps] def subtype_congr_hom (p : α → Prop) [decidable_pred p] :
  (perm {a // p a}) × (perm {a // ¬ p a}) →* perm α :=
{ to_fun := λ pair, perm.subtype_congr pair.fst pair.snd,
  map_one' := perm.subtype_congr.refl,
  map_mul' := λ _ _, (perm.subtype_congr.trans _ _ _ _).symm }

lemma subtype_congr_hom_injective (p : α → Prop) [decidable_pred p] :
  function.injective (subtype_congr_hom p) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split;
  ext i;
  simpa using equiv.congr_fun h i
end

/-- If `e` is also a permutation, we can write `perm_congr`
completely in terms of the group structure. -/
@[simp] lemma perm_congr_eq_mul (e p : perm α) :
  e.perm_congr p = e * p * e⁻¹ := rfl

section extend_domain

/-! Lemmas about `equiv.perm.extend_domain` re-expressed via the group structure. -/

variables (e : perm α) {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p)

@[simp] lemma extend_domain_one : extend_domain 1 f = 1 :=
extend_domain_refl f

@[simp] lemma extend_domain_inv : (e.extend_domain f)⁻¹ = e⁻¹.extend_domain f := rfl

@[simp] lemma extend_domain_mul (e e' : perm α) :
  (e.extend_domain f) * (e'.extend_domain f) = (e * e').extend_domain f :=
extend_domain_trans _ _ _

/-- `extend_domain` as a group homomorphism -/
@[simps] def extend_domain_hom : perm α →* perm β :=
{ to_fun := λ e, extend_domain e f,
  map_one' := extend_domain_one f,
  map_mul' := λ e e', (extend_domain_mul f e e').symm }

lemma extend_domain_hom_injective : function.injective (extend_domain_hom f) :=
(injective_iff_map_eq_one (extend_domain_hom f)).mpr (λ e he, ext (λ x, f.injective (subtype.ext
  ((extend_domain_apply_image e f x).symm.trans (ext_iff.mp he (f x))))))

@[simp]

@[simp] lemma extend_domain_pow (n : ℕ) : (e ^ n).extend_domain f = e.extend_domain f ^ n :=
map_pow (extend_domain_hom f) _ _

@[simp] lemma extend_domain_zpow (n : ℤ) : (e ^ n).extend_domain f = e.extend_domain f ^ n :=
map_zpow (extend_domain_hom f) _ _

end extend_domain

section subtype
variables {p : α → Prop} {f : perm α}

/-- If the permutation `f` fixes the subtype `{x // p x}`, then this returns the permutation
  on `{x // p x}` induced by `f`. -/
def subtype_perm (f : perm α) (h : ∀ x, p x ↔ p (f x)) : perm {x // p x} :=
⟨λ x, ⟨f x, (h _).1 x.2⟩, λ x, ⟨f⁻¹ x, (h (f⁻¹ x)).2 $ by simpa using x.2⟩,
  λ _, by simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk],
  λ _, by simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk]⟩

@[simp] lemma subtype_perm_apply (f : perm α) (h : ∀ x, p x ↔ p (f x))
  (x : {x // p x}) : subtype_perm f h x = ⟨f x, (h _).1 x.2⟩ := rfl

@[simp] lemma subtype_perm_one (p : α → Prop) (h := λ _, iff.rfl) : @subtype_perm α p 1 h = 1 :=
equiv.ext $ λ ⟨_, _⟩, rfl

@[simp] lemma subtype_perm_mul (f g : perm α) (hf hg) :
  (f.subtype_perm hf * g.subtype_perm hg : perm {x // p x}) =
    (f * g).subtype_perm (λ x, (hg _).trans $ hf _) := rfl

private lemma inv_aux : (∀ x, p x ↔ p (f x)) ↔ ∀ x, p x ↔ p (f⁻¹ x) :=
f⁻¹.surjective.forall.trans $ by simp_rw [f.apply_inv_self, iff.comm]

/-- See `equiv.perm.inv_subtype_perm`-/
lemma subtype_perm_inv (f : perm α) (hf) :
  f⁻¹.subtype_perm hf = (f.subtype_perm $ inv_aux.2 hf : perm {x // p x})⁻¹ := rfl

/-- See `equiv.perm.subtype_perm_inv`-/
@[simp] lemma inv_subtype_perm (f : perm α) (hf) :
  (f.subtype_perm hf : perm {x // p x})⁻¹ = f⁻¹.subtype_perm (inv_aux.1 hf) := rfl

private lemma pow_aux (hf : ∀ x, p x ↔ p (f x)) : ∀ {n : ℕ} x, p x ↔ p ((f ^ n) x)
| 0 x := iff.rfl
| (n + 1) x := (pow_aux _).trans (hf _)

@[simp] lemma subtype_perm_pow (f : perm α) (n : ℕ) (hf) :
  (f.subtype_perm hf : perm {x // p x}) ^ n = (f ^ n).subtype_perm (pow_aux hf) :=
begin
  induction n with n ih,
  { simp },
  { simp_rw [pow_succ', ih, subtype_perm_mul] }
end

private lemma zpow_aux (hf : ∀ x, p x ↔ p (f x)) : ∀ {n : ℤ} x, p x ↔ p ((f ^ n) x)
| (int.of_nat n) := pow_aux hf
| (int.neg_succ_of_nat n) := by { rw zpow_neg_succ_of_nat, exact inv_aux.1 (pow_aux hf) }

@[simp] lemma subtype_perm_zpow (f : perm α) (n : ℤ) (hf) :
  (f.subtype_perm hf ^ n : perm {x // p x}) = (f ^ n).subtype_perm (zpow_aux hf) :=
begin
  induction n with n ih,
  { exact subtype_perm_pow _ _ _ },
  { simp only [zpow_neg_succ_of_nat, subtype_perm_pow, subtype_perm_inv] }
end

variables [decidable_pred p] {a : α}

/-- The inclusion map of permutations on a subtype of `α` into permutations of `α`,
  fixing the other points. -/
def of_subtype : perm (subtype p) →* perm α :=
{ to_fun := λ f, extend_domain f (equiv.refl (subtype p)),
  map_one' := equiv.perm.extend_domain_one _,
  map_mul' := λ f g, (equiv.perm.extend_domain_mul _ f g).symm, }

lemma of_subtype_subtype_perm {f : perm α} (h₁ : ∀ x, p x ↔ p (f x)) (h₂ : ∀ x, f x ≠ x → p x) :
  of_subtype (subtype_perm f h₁) = f :=
equiv.ext $ λ x, begin
  by_cases hx : p x,
  { exact (subtype_perm f h₁).extend_domain_apply_subtype _ hx, },
  { rw [of_subtype, monoid_hom.coe_mk, equiv.perm.extend_domain_apply_not_subtype],
    { exact not_not.mp (λ h, hx (h₂ x (ne.symm h))),  },
    { exact hx, }, }
end

lemma of_subtype_apply_of_mem (f : perm (subtype p)) (ha : p a) : of_subtype f a = f ⟨a, ha⟩ :=
extend_domain_apply_subtype _ _ _

@[simp] lemma of_subtype_apply_coe (f : perm (subtype p)) (x : subtype p) : of_subtype f x = f x :=
subtype.cases_on x $ λ _, of_subtype_apply_of_mem f

lemma of_subtype_apply_of_not_mem (f : perm (subtype p)) (ha : ¬ p a) : of_subtype f a = a :=
extend_domain_apply_not_subtype _ _ ha

lemma mem_iff_of_subtype_apply_mem (f : perm (subtype p)) (x : α) :
  p x ↔ p ((of_subtype f : α → α) x) :=
if h : p x then
by simpa only [h, true_iff, monoid_hom.coe_mk, of_subtype_apply_of_mem f h] using (f ⟨x, h⟩).2
else by simp [h, of_subtype_apply_of_not_mem f h]

@[simp] lemma subtype_perm_of_subtype (f : perm (subtype p)) :
  subtype_perm (of_subtype f) (mem_iff_of_subtype_apply_mem f) = f :=
equiv.ext $ λ x, subtype.coe_injective (of_subtype_apply_coe f x)

/-- Permutations on a subtype are equivalent to permutations on the original type that fix pointwise
the rest. -/
@[simps] protected def subtype_equiv_subtype_perm (p : α → Prop) [decidable_pred p] :
  perm (subtype p) ≃ {f : perm α // ∀ a, ¬p a → f a = a} :=
{ to_fun := λ f, ⟨f.of_subtype, λ a, f.of_subtype_apply_of_not_mem⟩,
  inv_fun := λ f, (f : perm α).subtype_perm
    (λ a, ⟨decidable.not_imp_not.1 $ λ hfa, (f.val.injective (f.prop _ hfa) ▸ hfa),
    decidable.not_imp_not.1 $ λ ha hfa, ha $ f.prop a ha ▸ hfa⟩),
  left_inv := equiv.perm.subtype_perm_of_subtype,
  right_inv := λ f,
    subtype.ext (equiv.perm.of_subtype_subtype_perm _ $ λ a, not.decidable_imp_symm $ f.prop a) }

lemma subtype_equiv_subtype_perm_apply_of_mem (f : perm (subtype p)) (h : p a) :
  perm.subtype_equiv_subtype_perm p f a = f ⟨a, h⟩ :=
f.of_subtype_apply_of_mem h

lemma subtype_equiv_subtype_perm_apply_of_not_mem (f : perm (subtype p)) (h : ¬ p a) :
  perm.subtype_equiv_subtype_perm p f a = a :=
f.of_subtype_apply_of_not_mem h

end subtype
end perm

section swap
variables [decidable_eq α]

@[simp] lemma swap_inv (x y : α) : (swap x y)⁻¹ = swap x y := rfl

@[simp] lemma swap_mul_self (i j : α) : swap i j * swap i j = 1 := swap_swap i j

lemma swap_mul_eq_mul_swap (f : perm α) (x y : α) : swap x y * f = f * swap (f⁻¹ x) (f⁻¹ y) :=
equiv.ext $ λ z, begin
  simp only [perm.mul_apply, swap_apply_def],
  split_ifs;
  simp only [perm.apply_inv_self, *, perm.eq_inv_iff_eq, eq_self_iff_true, not_true] at *
end

lemma mul_swap_eq_swap_mul (f : perm α) (x y : α) : f * swap x y = swap (f x) (f y) * f :=
by rw [swap_mul_eq_mul_swap, perm.inv_apply_self, perm.inv_apply_self]

lemma swap_apply_apply (f : perm α) (x y : α) : swap (f x) (f y) = f * swap x y * f⁻¹ :=
by rw [mul_swap_eq_swap_mul, mul_inv_cancel_right]

/-- Left-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma swap_mul_self_mul (i j : α) (σ : perm α) : equiv.swap i j * (equiv.swap i j * σ) = σ :=
by rw [←mul_assoc, swap_mul_self, one_mul]

/-- Right-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma mul_swap_mul_self (i j : α) (σ : perm α) : (σ * equiv.swap i j) * equiv.swap i j = σ :=
by rw [mul_assoc, swap_mul_self, mul_one]

/-- A stronger version of `mul_right_injective` -/
@[simp]
lemma swap_mul_involutive (i j : α) : function.involutive ((*) (equiv.swap i j)) :=
swap_mul_self_mul i j

/-- A stronger version of `mul_left_injective` -/
@[simp]
lemma mul_swap_involutive (i j : α) : function.involutive (* (equiv.swap i j)) :=
mul_swap_mul_self i j

@[simp] lemma swap_eq_one_iff {i j : α} : swap i j = (1 : perm α) ↔ i = j :=
swap_eq_refl_iff

lemma swap_mul_eq_iff {i j : α} {σ : perm α} : swap i j * σ = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_right_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, one_mul])⟩

lemma mul_swap_eq_iff {i j : α} {σ : perm α} : σ * swap i j = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_left_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, mul_one])⟩

lemma swap_mul_swap_mul_swap {x y z : α} (hwz: x ≠ y) (hxz : x ≠ z) :
  swap y z * swap x y * swap y z = swap z x :=
equiv.ext $ λ n, by { simp only [swap_apply_def, perm.mul_apply], split_ifs; cc }

end swap

section add_group
variables [add_group α] (a b : α)

@[simp] lemma add_left_zero : equiv.add_left (0 : α) = 1 := ext zero_add
@[simp] lemma add_right_zero : equiv.add_right (0 : α) = 1 := ext add_zero

@[simp] lemma add_left_add : equiv.add_left (a + b) = equiv.add_left a * equiv.add_left b :=
ext $ add_assoc _ _

@[simp] lemma add_right_add : equiv.add_right (a + b) = equiv.add_right b * equiv.add_right a :=
ext $ λ _, (add_assoc _ _ _).symm

@[simp] lemma inv_add_left : (equiv.add_left a)⁻¹ =  equiv.add_left (-a) := equiv.coe_inj.1 rfl
@[simp] lemma inv_add_right : (equiv.add_right a)⁻¹ =  equiv.add_right (-a) := equiv.coe_inj.1 rfl

@[simp] lemma pow_add_left (n : ℕ) : equiv.add_left a ^ n = equiv.add_left (n • a) :=
by { ext, simp [perm.coe_pow] }

@[simp] lemma pow_add_right (n : ℕ) : equiv.add_right a ^ n = equiv.add_right (n • a) :=
by { ext, simp [perm.coe_pow] }

@[simp] lemma zpow_add_left (n : ℤ) : equiv.add_left a ^ n = equiv.add_left (n • a) :=
(map_zsmul (⟨equiv.add_left, add_left_zero, add_left_add⟩ : α →+ additive (perm α)) _ _).symm

@[simp] lemma zpow_add_right (n : ℤ) : equiv.add_right a ^ n = equiv.add_right (n • a) :=
@zpow_add_left αᵃᵒᵖ _ _ _

end add_group

section group
variables [group α] (a b : α)

@[simp, to_additive] lemma mul_left_one : equiv.mul_left (1 : α) = 1 := ext one_mul
@[simp, to_additive] lemma mul_right_one : equiv.mul_right (1 : α) = 1 := ext mul_one

@[simp, to_additive]
lemma mul_left_mul : equiv.mul_left (a * b) = equiv.mul_left a * equiv.mul_left b :=
ext $ mul_assoc _ _

@[simp, to_additive]
lemma mul_right_mul : equiv.mul_right (a * b) = equiv.mul_right b * equiv.mul_right a :=
ext $ λ _, (mul_assoc _ _ _).symm

@[simp, to_additive inv_add_left]
lemma inv_mul_left : (equiv.mul_left a)⁻¹ = equiv.mul_left a⁻¹ := equiv.coe_inj.1 rfl
@[simp, to_additive inv_add_right]
lemma inv_mul_right : (equiv.mul_right a)⁻¹ = equiv.mul_right a⁻¹ := equiv.coe_inj.1 rfl

@[simp, to_additive pow_add_left]
lemma pow_mul_left (n : ℕ) : equiv.mul_left a ^ n = equiv.mul_left (a ^ n)  :=
by { ext, simp [perm.coe_pow] }

@[simp, to_additive pow_add_right]
lemma pow_mul_right (n : ℕ) : equiv.mul_right a ^ n = equiv.mul_right (a ^ n) :=
by { ext, simp [perm.coe_pow] }

@[simp, to_additive zpow_add_left]
lemma zpow_mul_left (n : ℤ) : equiv.mul_left a ^ n = equiv.mul_left (a ^ n) :=
(map_zpow (⟨equiv.mul_left, mul_left_one, mul_left_mul⟩ : α →* perm α) _ _).symm

@[simp, to_additive zpow_add_right]
lemma zpow_mul_right : ∀ n : ℤ, equiv.mul_right a ^ n = equiv.mul_right (a ^ n)
| (int.of_nat n) := by simp
| (int.neg_succ_of_nat n) := by simp

end group
end equiv

open equiv function

namespace set
variables {α : Type*} {f : perm α} {s t : set α}

@[simp] lemma bij_on_perm_inv : bij_on ⇑f⁻¹ t s ↔ bij_on f s t := equiv.bij_on_symm

alias bij_on_perm_inv ↔ bij_on.of_perm_inv bij_on.perm_inv

lemma maps_to.perm_pow : maps_to f s s → ∀ n : ℕ, maps_to ⇑(f ^ n) s s :=
by { simp_rw equiv.perm.coe_pow, exact maps_to.iterate }
lemma surj_on.perm_pow : surj_on f s s → ∀ n : ℕ, surj_on ⇑(f ^ n) s s :=
by { simp_rw equiv.perm.coe_pow, exact surj_on.iterate }
lemma bij_on.perm_pow : bij_on f s s → ∀ n : ℕ, bij_on ⇑(f ^ n) s s :=
by { simp_rw equiv.perm.coe_pow, exact bij_on.iterate }

lemma bij_on.perm_zpow (hf : bij_on f s s) : ∀ n : ℤ, bij_on ⇑(f ^ n) s s
| (int.of_nat n) := hf.perm_pow _
| (int.neg_succ_of_nat n) := by { rw zpow_neg_succ_of_nat, exact (hf.perm_pow _).perm_inv }

end set


import algebra.big_operators.ring algebra.big_operators.order tactic.ring

/-! # IMO 2010 A2 -/

namespace IMOSL
namespace IMO2010A2

open finset

section comm_ring_ineq

variables {R : Type*} [linear_ordered_comm_ring R]

private theorem special_identity (x : R) :
  4 * x ^ 3 - x ^ 4 = 6 * x ^ 2 - 4 * x + 1 - ((x - 1) ^ 2) ^ 2 :=
  by ring

variables {ι : Type*} [decidable_eq ι]

theorem sq_sum_le_sum_sq {s : finset ι} {x : ι → R} (h : ∀ i : ι, i ∈ s → 0 ≤ x i) :
  s.sum (λ i, x i ^ 2) ≤ s.sum x ^ 2 :=
begin
  induction s using finset.induction with j s s_ih1 s_ih2,
  rw [sum_empty, sum_empty, zero_pow two_pos],
  rw [sum_insert s_ih1, sum_insert s_ih1],
  replace h : 0 ≤ x j ∧ ∀ i : ι, i ∈ s → 0 ≤ x i :=
    ⟨h j (mem_insert_self j s), λ i h0, h i (mem_insert_of_mem h0)⟩,
  refine le_trans (add_le_add_left (s_ih2 h.2) _) _; clear s_ih1 s_ih2,
  rw [add_sq', le_add_iff_nonneg_right],
  exact mul_nonneg (mul_nonneg zero_le_two h.1) (sum_nonneg h.2)
end

theorem QM_AM (s : finset ι) (x : ι → R) : s.sum x ^ 2 ≤ s.card • s.sum (λ i, x i ^ 2) :=
begin
  induction s using finset.induction with j s s_ih1 s_ih2,
  rw [sum_empty, zero_pow two_pos, card_empty, zero_nsmul],
  rw [sum_insert s_ih1, sum_insert s_ih1, card_insert_of_not_mem s_ih1, succ_nsmul,
      add_sq, add_assoc, add_assoc, add_le_add_iff_left, nsmul_add, ← add_assoc,
      ← sum_const, ← sum_add_distrib, mul_sum],
  refine add_le_add (sum_le_sum (λ i _, _)) s_ih2,
  rw mul_right_comm; exact two_mul_le_add_sq (x i) (x j)
end

end comm_ring_ineq

variables {F : Type*} [linear_ordered_field F]

/-- An intermediate result that is more convenient to manipulate around than the main result -/
theorem final_solution_general' {ι : Type*} [decidable_eq ι] {s : finset ι} {a : ι → F}
    {σ₁ σ₂ B C S : F} (hσ₁ : s.sum a = σ₁) (hσ₂ : s.sum (λ i, a i ^ 2) = σ₂)
    (hB : 6 * σ₂ - 4 * σ₁ + s.card = B) (hC : (σ₂ - 2 * σ₁ + s.card) ^ 2 = C)
    (hS : 4 * s.sum (λ i, a i ^ 3) - s.sum (λ i, a i ^ 4) = S) :
  B - C ≤ S ∧ S ≤ B - C / s.card :=
begin
  ---- Some setups
  have X := λ (i : ι) (_ : i ∈ s), special_identity (a i),
  rw [mul_sum, ← sum_sub_distrib, sum_congr rfl X] at hS; clear X,
  rw [sum_sub_distrib, sum_add_distrib, sum_const, nsmul_one,
      sum_sub_distrib, ← mul_sum, hσ₂, ← mul_sum, hσ₁, hB] at hS,
  replace hC : s.sum (λ i, (a i - 1) ^ 2) ^ 2 = C :=
  begin
    conv_lhs {congr, congr, skip, funext, rw [sub_sq, one_pow, mul_one] },
    rw [sum_add_distrib, sum_const, nsmul_one, sum_sub_distrib, hσ₂, ← mul_sum, hσ₁, hC]
  end,

  ---- Now we are ready to finish proving both inequalities
  subst hS; subst hC; split; rw sub_le_sub_iff_left,
  exact sq_sum_le_sum_sq (λ i _, sq_nonneg (a i - 1)),
  rcases s.eq_empty_or_nonempty with rfl | h,
  rw [sum_empty, sum_empty, zero_pow two_pos, zero_div],
  replace h : 0 < (s.card : F) := by rwa [nat.cast_pos, card_pos],
  rw [div_le_iff' h, ← nsmul_eq_mul]; exact QM_AM s _
end

/-- Final solution, general version -/
theorem final_solution_general {ι : Type*} [decidable_eq ι] {s : finset ι} {a : ι → F}
    {σ₁ σ₂ : F} (h : s.sum a = σ₁) (h0 : s.sum (λ i, a i ^ 2) = σ₂) :
  let B := 6 * σ₂ - 4 * σ₁ + s.card, C := (σ₂ - 2 * σ₁ + s.card) ^ 2,
    S := 4 * s.sum (λ i, a i ^ 3) - s.sum (λ i, a i ^ 4) in
  B - C ≤ S ∧ S ≤ B - C / s.card :=
final_solution_general' h h0 rfl rfl rfl

/-- Final solution -/
theorem final_solution {a : fin 4 → F} (h : univ.sum a = 6) (h0 : univ.sum (λ i, a i ^ 2) = 12) :
  let S := 4 * univ.sum (λ i, a i ^ 3) - univ.sum (λ i, a i ^ 4) in 36 ≤ S ∧ S ≤ 48 :=
  by intros S; convert final_solution_general h h0; norm_num

end IMO2010A2
end IMOSL


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

! This file was ported from Lean 3 source module analysis.calculus.conformal.inner_product
! 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.Calculus.Conformal.NormedSpace
import Mathbin.Analysis.InnerProductSpace.ConformalLinearMap

/-!
# Conformal maps between inner product spaces

A function between inner product spaces is which has a derivative at `x`
is conformal at `x` iff the derivative preserves inner products up to a scalar multiple.
-/

noncomputable section

variable {E F : Type _}

variable [NormedAddCommGroup E] [NormedAddCommGroup F]

variable [InnerProductSpace ℝ E] [InnerProductSpace ℝ F]

open RealInnerProductSpace

/-- A real differentiable map `f` is conformal at point `x` if and only if its
    differential `fderiv ℝ f x` at that point scales every inner product by a positive scalar. -/
theorem conformalAt_iff' {f : E → F} {x : E} :
    ConformalAt f x ↔ ∃ c : ℝ, 0 < c ∧ ∀ u v : E, ⟪fderiv ℝ f x u, fderiv ℝ f x v⟫ = c * ⟪u, v⟫ :=
  by rw [conformalAt_iff_isConformalMap_fderiv, isConformalMap_iff]
#align conformal_at_iff' conformalAt_iff'

/-- A real differentiable map `f` is conformal at point `x` if and only if its
    differential `f'` at that point scales every inner product by a positive scalar. -/
theorem conformalAt_iff {f : E → F} {x : E} {f' : E →L[ℝ] F} (h : HasFderivAt f f' x) :
    ConformalAt f x ↔ ∃ c : ℝ, 0 < c ∧ ∀ u v : E, ⟪f' u, f' v⟫ = c * ⟪u, v⟫ := by
  simp only [conformalAt_iff', h.fderiv]
#align conformal_at_iff conformalAt_iff

/-- The conformal factor of a conformal map at some point `x`. Some authors refer to this function
    as the characteristic function of the conformal map. -/
def conformalFactorAt {f : E → F} {x : E} (h : ConformalAt f x) : ℝ :=
  Classical.choose (conformalAt_iff'.mp h)
#align conformal_factor_at conformalFactorAt

theorem conformalFactorAt_pos {f : E → F} {x : E} (h : ConformalAt f x) : 0 < conformalFactorAt h :=
  (Classical.choose_spec <| conformalAt_iff'.mp h).1
#align conformal_factor_at_pos conformalFactorAt_pos

theorem conformalFactorAt_inner_eq_mul_inner' {f : E → F} {x : E} (h : ConformalAt f x) (u v : E) :
    ⟪(fderiv ℝ f x) u, (fderiv ℝ f x) v⟫ = (conformalFactorAt h : ℝ) * ⟪u, v⟫ :=
  (Classical.choose_spec <| conformalAt_iff'.mp h).2 u v
#align conformal_factor_at_inner_eq_mul_inner' conformalFactorAt_inner_eq_mul_inner'

theorem conformalFactorAt_inner_eq_mul_inner {f : E → F} {x : E} {f' : E →L[ℝ] F}
    (h : HasFderivAt f f' x) (H : ConformalAt f x) (u v : E) :
    ⟪f' u, f' v⟫ = (conformalFactorAt H : ℝ) * ⟪u, v⟫ :=
  H.DifferentiableAt.HasFderivAt.unique h ▸ conformalFactorAt_inner_eq_mul_inner' H u v
#align conformal_factor_at_inner_eq_mul_inner conformalFactorAt_inner_eq_mul_inner