import data.set
import data.nat.sqrt

open set

namespace relation_2102_ns

/-
We're now going to formally explain
what a "section" is for in Lean. A
section allows you to specify in one
place a set of parameters that are then
assumed to be arguments to every other
definition in the section.  Here's a
very short little section to illustrate
the concept. Don't proceed until you
understand why the #check is reporting
the type of yo to be (ℕ → ℕ) → ℕ → ℕ,
even though it (looks like) it is
defined as yo (n : ℕ) := f n, with
just one argument.
-/

section demo
variable f : ℕ → ℕ
def yo (n : ℕ) := f n
#check yo
end demo

/-
The use of sections can make for
cleaner code, because you don't have
to repeat variable declarations in
each object you define within a
section. But if you don't understand
that every variable in a section is
an implicit parameter to every other
definition in the section, then you
will be mystified when it comes to
understanding those definitions.
-/

/-
Now we turn to the main content of
this unit: the theory of relations.
-/
section relation_2102_sec
/-
Here we use a section to define two
arguments that are assumed to be present
in each definition in the rest of this
file.

First, we let β be any type.
-/
variable {β : Type}

/-
Here's the key to this unit. We let
r represent a binary relation on values
of type β. Whereas we represent a set
of values of type β, or a property of
such values, as a predicate of type,
β → Prop, we represent in a binary
relation, or a set of pairs, of values
of type, β, as a predicate of type,
β → β → Prop.
-/
variable (r : β → β → Prop)

/-
So now, when you look at the definitions
in the rest of this file, you understand
that each one of them has two additional
arguments, namely β and r.
-/

/-
Applying r to two values, x and y, of
type, β, yields a proposition. You can
thus think of r as a property of pairs
of values. If the proposition is true,
then the ordered pair, (x, y), is in
the relation, otherwise it's not.
-/
variables x y : β
#check r x y

/-
In the preceding example, we wrote
the relation name before the arguments.
It's often more natural to write in in
between the arguments. We call such a
notation an infix notation. Lean gives
us a way to extend the syntax of Lean
by adding infix operators to reduce to
known prefix operators. Here we define
two infix versions of r, one called R,
and one called ≺. The number, 50, in the
following lines defines the precedence
of this operator, i.e., how tightly it
binds when appearing in an expression
with other operators.
-/

local infix `R`:50 := r
local infix `≺`:50 := r

/-
Now we can use either x R y or x ≺ y
to mean the same thing as r x y. We'll
use the x R y style in the file. Lean's
libraries happen to use x ≺ y, but they
mean the same thing, as we just said.
-/
#check x R y
#check x ≺ y

-- EXAMPLE: THE EQUALITY RELATION

/-
Let's look at equality as a binary
relation. The first thing to know is
that an expression, such as 1 = 1, is
a convenient way of writing "eq 1 1".
The = notation is defined as an infix
version of eq in just the same way
that we defined R and ≺ to be infix
versions of r. Check to see that the
following expressions mean the same
thing.
-/
#reduce 1 = 1
#reduce eq 1 1

/-
Let's look at the actual definition
of eq in Lean's libraries.
-/
#print eq
/-
Just look at the first line, skipping
the constructor for now. What is says
is that for any Type, α, eq is a binary
relation on values of that type. The "Pi"
symbol, Π,  is like ∀. ∀ is used when
working with propositions, but equality
is defined for any type, so we use Π
instead. You should read the definition as
saying that if you give eq any type, you
get back a binary relation on values of
that type: namely one for which the only
proofs that can be constructed are given
by eq.refl, which takes just one argument,
α, and returns a proof of α = α.

We thus expect the type of "eq ℕ" to be
a binary relation on ℕ values. We preface
eq in the following examples with @, which
tells Lean not to use implicit typing for
the type argument, α, to eq. We really do
have to give a type argument explicitly.
-/

#check @eq nat
#check @eq β

/-
We now see that for any type, α, such as
ℕ, or, in this file, β, eq α is a binary
relation on the set of values of type, α.
It is thus of type, α → α → Prop. That is
the signal that you're looking at a binary
relation in Lean.
-/

-- REFLEXIVE

/-
A relation is said to be reflexive if
every element in the domain of definition
of the relation (the set on which it is
defined) is related to itself.
-/

def reflexive := ∀ ⦃x⦄, x R x

#check reflexive
#reduce reflexive

#check reflexive (@eq β)
#reduce reflexive (@eq β)

/-
We know that eq β is a binary
relation defined on the set of
values of type, β. Let's assert
and prove it.
-/

lemma eq_refl : reflexive (@eq β) :=
begin
unfold reflexive,
intro, apply rfl,
end

/-
Let's take just a minute to unpack
the proposition, reflexive (@eq β).
You have to remember that at this
point in the file, we've already
defined β and r as implicit args to
all definitions, including that of
eq_refl.
-/

-- SYMMETRIC

/-
A relation is symmetric if, whenever
two values, and and y, are related,
y and x are related, in the opposite
order.
-/
def symmetric := ∀ ⦃x y⦄, x R y → y R x

/-
Let's prove that equality is symmetric.
Of course we're cheating a little here
by using a rule already in the libraries
that eq is symmetric: the rule, eq.symm.
-/
lemma eq_symm : symmetric (@eq β) :=
begin
unfold symmetric,
intros,
apply eq.symm,
assumption,
end

/-
EXERCISE: Is the real-world "likes"
relation, as in "has-a-crush-on", a
symmetric relation? How about Facebook's
"likes" relation?
-/

-- TRANSITIVE

/-
A binary relation on values of some
type, β, is said to be transitive if
whenever x and y are related, and y
and z are related, then x and z are
related.
-/
def transitive :=
    ∀ ⦃x y z⦄, x R y → y R z → x R z

/-
EXERCISE: Is equality transitive?
-/

lemma eq_trans : transitive (@eq β) :=
begin
unfold transitive,
intros x y z xy yz,
apply eq.trans xy yz,
end

/-
An equivalence relation is a binary
relation that is reflexive, symmetric,
and transitive.
-/
def equivalence := reflexive r ∧ symmetric r ∧ transitive r

/-
Is eq an equivalence relation? Sure.
-/

theorem eq_equiv : equivalence (@eq β) :=
begin
unfold equivalence,
split, exact eq_refl,
split, exact eq_symm, exact eq_trans,
end

/-
Let's discuss another equivalence
relation. Consider the set ℕ / 12,
the natural numbers modulo 12.

What is 2 mod 12? What is 14 mod 12?
What is 26 mod 12. All these numbers,
and indeed any natural number of the
form, 2 + k * 12 are congruent to 2
mod 12.
-/

#reduce 2 % 12
#reduce 14 % 12
#reduce 26 % 12

/-
This entire set of numbers mod 12
forms an equivalence class. Let's
formalize and prove this proposition.
-/

/-
First, the relation itself.
-/
def mod_12_equiv : ℕ → ℕ → Prop :=
    λ x y, x % 12 = y % 12

/-
Now a simple test case as a sanity
check.
-/
example : mod_12_equiv 2 14 :=
begin
unfold mod_12_equiv, apply rfl,
end

/-
Let's prove that the whole infinite
set of values of the form n + k * 12
is congruent.
-/
example :
    ∀ k : ℕ, ∀ n : ℕ,
    mod_12_equiv n (n + k * 12) :=
begin
intros,
unfold mod_12_equiv,
-- The simp tactic uses many rules to simplify expressions,
-- and can prove them true when trivial would do so
simp,
end

/-
Let's show that mod_12_equiv is an equivalence
-/

example : reflexive mod_12_equiv :=
begin
unfold mod_12_equiv,
unfold reflexive, -- EX: why just x here?
intro, apply rfl,
end

example : symmetric mod_12_equiv :=
begin
unfold symmetric,
intros x y,
unfold mod_12_equiv,
intro h,
-- New tactic: rewrite using an equality
rw h,
end

example : transitive mod_12_equiv :=
begin
unfold transitive,
intros x y z xy yz,
unfold mod_12_equiv at xy,
unfold mod_12_equiv at yz,
unfold mod_12_equiv,
rw xy, assumption,
end

/-
In the rest of this file, we transition
from x R y notation to x ≺ y. You will
find both used in mathematical writing.
Be careful not to read x ≺ y as saying
that x is less than y. The ≺ symbol in
this context can refer to any relation
whatsoever.
-/

/-
We now define additional properties of
binary relations on a set. For each of
them, come up with one or more familiar
relations having these, and not having
these, properties.
-/

variable {α : Type}

def empty_relation := λ a₁ a₂ : α, false

def irreflexive := ∀ x, ¬ x ≺ x

def anti_symmetric := ∀ ⦃x y⦄, x ≺ y → y ≺ x → x = y

def asymmetric := ∀ ⦃x y⦄, x ≺ y → ¬ y ≺ x

def subrelation (q r : β → β → Prop) := ∀ ⦃x y⦄, q x y → r x y

/- Closures of relations -/

def reflexive_closure /- of r -/ :=
  λ x y : β, (r x y) ∨ (x = y)

def symmetric_closure /- of r -/ :=
  λ x y : β, (r x y) ∨ (r y x)

/-
We're not yet ready for the following
formal definition of the transitive
closure of a relation, as we haven't
covered inductive definitions, but we
can introduce the idea informally.
Informally, it says that if there is
any path from x to y in R then (x, y)
is in the transitive closure of R.
-/

inductive tc {α : Type} (r : α → α → Prop) : α → α → Prop
| base  : ∀ a b, r a b → tc a b
| trans : ∀ a b c, tc a b → tc b c → tc a c

/-
EXAMPLE: What is the transitive closure
of the successor relation on the natural
numbers?
-/

/- *** FUNCTIONS AND THEIR PROPERTIES *** -/

/- The property of being single valued -/

/-
We define a critical property of every
function. Any function is single valued.
Given any argument, there is at most one
result. Another way to say this is that
if y = f x and z = f x, then it must be
the case that y = z, for otherwise there
would be two different results possible
for the value of f x.

EXERCISE: Name a familiar operation that
is not a function because it's not single
valued.
-/

def single_valued_fun
  (f : α → β) : Prop :=
    ∀ x : α, ∀ y z : β,
      y = f x → z = f x → y = z

/-
Let's look at the square function as
an example. We've seen it many times.
-/

def square (n :ℕ) := n * n

/-
We can easily prove that square is
single valued.
-/

lemma square_single_valued_fun :
  single_valued_fun square :=
begin
unfold single_valued_fun,
intros x y z,
assume ysqx zsqx,
rw ysqx, rw zsqx,
end

/-
Indeed, we can prove that any function
in Lean is single valued. And that is
not surprising, since the distinguishing
feature of a function is that it has this
property!
-/

theorem every_function_single_valued :
  ∀ f : α → β, single_valued_fun f :=
begin
  intro f,
  unfold single_valued_fun,
  intros x y z,
  assume yfx zfx,
  rw yfx, rw zfx,
end

/- A lambda represents a total function. -/

/-
A function is said to be total if it is
defined (which is to say it returns a
value) for every argument in its domain
of definition.

In Lean, the domain of definition of a
function is a type. We've already seen
that a function (value) of type α → β
defines a way to convert any value of
type α into some value of type β. To
"prove" the type α → β we assume that
we have some arbitary value, a : α,
and show that we can construct and
return a value of type β. Thus any
lambda abstraction in Lean represents
a *total* function: one that is defined
for *every* value of type α.
-/

/- *** Encoding Functions as Relations *** -/

/-
Given any function expressed as a lambda
abstraction, we can easily re-represent it
as a corresponding relation. Here's a one
line converter.
-/

def fun_to_rel (f : (β → β)): (β → β → Prop) :=
  -- the relation is the set of pairs (m, f m)
  λ m n, n = f m

/-
Here we convert the square functon to a
corresponding square relation.
-/

def square_rel := fun_to_rel square

/-
We can't "apply" a relation to an
argument to compute a result. That
is, we can't compute with relations.
-/

-- We can compute with functions
#reduce square 3

-- This doesn't work with relations
#reduce square_rel 3 -- not 9!

/-
But we can use logic prove that given
pairs of values are in a relation.
-/
example : square_rel 3 9 :=
begin
unfold square_rel,
unfold fun_to_rel,
apply rfl,
end

/- Representing Partial Funtions! -/

/-
A partial function is a function that
need not be defined for every value in
its domain of definition. An example
of a partial function is the square
root function where the domain of
definition is the whole set of real
numbers. The function is defined only
on the non-negative subset of this
domain of definition.
-/

/-
Why would we want to represent a
function as a relation? Giving up
the ability to compute seems like
(and is) a high cost. What do we
get for it? What we get for it is
the ability to represent partial
functions. A partial function is
a function that is not necessarily
defined for every value in its
domain of definition.
-/

/-
The square function, for example,
is defined for every value of type
ℕ. Suppose we wanted to represent
a partial function that is just
like the square function but that
is defined only for the values, 0,
1, 2, and 3. Here's how we can do
it.
-/

def square_partial : ℕ → ℕ → Prop :=
  λ m n,
    (m = 0 ∧ n = 0) ∨
    (m = 1 ∧ n = 1) ∨
    (m = 2 ∧ n = 4) ∨
    (m = 3 ∧ n = 9)

/- Single-valued *relations* -/

/-
To prove that the square_partial
relation represents a mathematical
function, we have to prove that
it's single valued. To this end,
we give a definition of what it
means for a relation to be single
valued in general. Remember that
this definition assumes that β is
a type, that x, y, and z are of
type β, and that ≺ is just infix
notation for a relation, r : β → β.
-/

def single_valued_rel :=
  ∀ x y z, (x ≺ y) → (x ≺ z) → (y = z)

/-
Let's assert and prove that our
partial square relation is actually
a function, i.e., is single valued.
It is a strictly partial function,
i.e., is a partial function and is
not a total function.

Note: some mathematicials consider
the total functions to be a subset
of the the partial functions (which
is what we do here). Others consider
these sets to be disjoint, i.e., that
if a function is partial if and only
if it is not total. We will use the
term "strictly partial" for that.
-/

lemma sv_square_rel :
  single_valued_rel square_partial :=
begin
  unfold single_valued_rel,
  unfold square_partial,
  intros x y z,
  assume h1 h2,

  cases h1 with x0y resty,
  cases h2 with x0z restz,

  cases x0y,
  cases x0z,
  rw x0y_right,
  rw x0z_right,

  cases x0y,
  cases restz with x1z rest,
  cases x1z,
  -- we can rewrite hypotheses, too!
  rw x0y_left at x1z_left,
  contradiction,

  -- the rest in the same tedious way
  sorry
end

/-
We can even prove that it's strictly
partial by showing that there actually
is a value on which it's not defined.
Such a value is 4.
-/

lemma square_rel_strictly_partial :
  ∃ m : ℕ, ¬ ∃ n : ℕ, square_partial m n :=
begin
apply exists.intro 4,
unfold square_partial,
assume h,
-- We use cases in several ways here
cases h with w rel,
cases rel, cases rel, contradiction,
cases rel, cases rel, cases rel_left,
cases rel, cases rel, cases rel_left,
cases rel, cases rel_left,
end

/-
*** Fundamental properties of functions ***
-/

/-
In this section, we introduce
several more crucial properties
of functions, beyond the essential
property of being single valued.
In particular, we introduce the
concepts of injective functions,
surjective functions, and bijective
functions, which are both injective
and surjective.
-/

/-
We now have two ways to represent
functions: as lambda abstractions
and as single-valued relations.
In this section, to define these
properties of functions in a way
that is applicable to both total
and partial functions, we formulate
them using our representation of
functions as single valued relations.
-/

/-
The property of being ***injective***.

A function is said to  be injective
if different arguments always give
different results. We express this
by saying if x R z and y R z then
x = y; otherwise different arguments
would yield the same result.
-/

def injective_rel :=
  single_valued_rel r →
    ∀ x y z, x R z → y R z → x = y

/-
Note that we make being single
valued a "pre-condition" for being
injective. The concept of being
injective only applies to relations
that are actually functions.
-/

/-
Mathematicians also use the phrase
"one-to-one" to mean injective. This
term is in contrast to a many-to-one
function, which can return the same
result for multiple argument values.

EXERCISE: Give examples of familiar
functions that are injective and that
are not injective.

Carefully compare and contrast the
concepts of being single-valued (which
makes a relation into a function) and
being injective (a property of some
but not all functions).
-/

/-
Extended Example: The square relation
represents an injective function. We
need a few building blocks to complete
the proof of this proposition.
-/

/-
First, we already proved that the square
function, expressed as a lambda abstraction,
is single-valued.
-/

#check square_single_valued_fun

/-
The proposition to be proved is that if
(x,z) and (y,z) are in the relation then
x = y. That is what it means for a function
to be injective. Now given that we are
talking about the square relation, what
it means for (x,z) and for (y,z) to be
in the relation is that (x, x * x) and
(y, y * y) are in the relation and that
x * x = y * y. Taking the square root of
both sides of this equation then leaves
us with the conclusion that x = y, which
is what was to be proved. QED.
-/

/-
We now formalize one of the key ideas
you've seen throughout your mathematical
career: given an equation, such as x = y,
we can "do the same thing to both sides"
and still have an equation.

We formalize this idea by showing that
if we have x = y, we can apply any
function, f, to each side, and we will
still have an equation: that f x = f y.

We prove this as a general principle. The
proof is by trivial rewriting.
-/

theorem f_equal :
  ∀ { α : Type },
  -- with x and y of some type, α
  ∀ { x y : α },
  -- given a function, f
  ∀ f: α → α,
  -- and an equality, x = y
  x = y →
  -- derive the equality, f x = f y
  f x = f y :=
begin
intros,
rw a,
end

/-
Now, the function that we're
going to want to apply to both
sides of an equation to prove
that our square relation is an
injective function is the square
root function for natural numbers.

The Lean library provides this
function as nat.sqrt. See the
includes at the top of this file
for inclusion of data.nat.sqrt.

To use proof assistants such as
Lean or Coq, in practice, at some
point it becomes necessary to learn
what's in tge libraries of already
defined data types, functions,
propositions, and proofs.

The key piece of knowledge you
need now is that the math library
provides a proof of the following:
For any n : ℕ, there is a proof
that nat.sqrt (n * n) = n. Here
is how it is declared. The point
is we can and will need to use
this already proven principle to
finish our proof of the injectivity
of the square relation.

sqrt_eq (n : ℕ) : sqrt (n * n) = n.

In particular, we can use f_equal
and nat.sqrt together to "apply the
square root function to each side
of the equation, x * x = y * y,"" to
deduce that x = y.
-/

/-
Here's a tiny example to illustrate the
basic idea. The statement of the theorem
and its proof then follow.
-/
-- introduce two variables to use
variables s t : ℕ
-- assume s squared equals t squared
variable s2t2 : s * s = t * t
-- apply square root to both sides
#check (f_equal nat.sqrt) s2t2

lemma square_injective :
  injective_rel square_rel :=
--  ∀ { x y : ℕ }, x * x = y * y → x = y :=
begin
unfold square_rel, unfold fun_to_rel,
unfold injective_rel, unfold single_valued_rel,
unfold square,
assume h,
intros x y z,
assume h1 h2,
rw h1 at h2,
-- apply nat.sqrt to both sides of h
have sqrt_both_sides := (f_equal nat.sqrt) h2,
-- use sqrt_eq to simplify sqrt (x * x) to x
rw nat.sqrt_eq at sqrt_both_sides,
-- and sqrt (y * y) to y
rw nat.sqrt_eq at sqrt_both_sides,
-- and that does it
assumption,
end

/-
The property of being surjective.

A function, f : α → β is said to be
surjective if it "covers" every value
in its co-domain, β. That is, it is
surjective if for any value of type
β there is some value of type α such
that f α = β.

We formalize the concept of being a
surjective function for a relational
formulation of functions, so that the
concept applies to partial functions
as well as total functions. We make
being single valued (being a function)
a pre-condition.
-/

def surjective_rel :=
  single_valued_rel r → ∀ y, ∃ x, x R y

/-
Exercise: Is the square function on
natural numbers, taking each natural
number to its square, surjective? How
would you prove that your answers is
correct?
-/

/-
Certainly the identity relation on the
natural numbers, id_nat := λ n : ℕ, n,
is surjective. To prove it, consider
an arbitrary y : ℕ and show that there
exists and x such that id_nat x = y.
The witness is just y itself.
-/

def id_nat := (λ n : ℕ, n)

def id_nat_rel := fun_to_rel id_nat

theorem id_nat_surj :
  surjective_rel (id_nat_rel) :=
begin
unfold surjective_rel,
unfold single_valued_rel,
unfold id_nat_rel,
assume fn,
intro y,
apply exists.intro y,
apply rfl,
end

/-
EXERCISE: Suppose that f is an encryption
function. When applied to a plaintext, t,
it yields a cyphertext, c. To decrypt the
cyphertext, to recover the plaintext, one
applies a decryption function, g, to c.
Should f injective? What if it weren't?
-/

/-
Finally a function is said to be
bijective if it is both injective
and surjective.
-/
def bijective_rel :=
  injective_rel r ∧ surjective_rel r

/-
We've already proved that the
identity function is surjective.
-/

/-
We need to prove it's injective.
-/

lemma id_nat_inj :
  injective_rel id_nat_rel :=
begin
  unfold id_nat_rel,
  unfold fun_to_rel,
  unfold injective_rel,
  unfold id_nat,
  assume h,
  intros x y z,
  assume zidx zidy,
  rw <-zidx,
  rw <-zidy,
end

theorem id_nat_bij :
  bijective_rel id_nat_rel :=
begin
exact ⟨id_nat_inj, id_nat_surj⟩
end

/-
Relations (& thus Function) as Sets of Pairs
-/

/-
We've already seen that we can represent
a total function, f : β → β, as a relation,
of type β → β → Prop.

We now show that if we're given a predicate
r : α → β → Prop, as a representation of a
function, f : α → β (thus also satisfying the
single-value predicate on relations), we can
convert it to an equivalent representation
of f as a set of pairs.
-/

/-
Let's recall what we know about pair types
and values and sets of pairs.

A pair is a value of a product type.
-/

def v := (1, 3)
#check v
def w := (1, tt)
#check w

/-
A set of pairs is thus a set of values of
a product type. In the example, w, above,
the type of w is ℕ × bool. In the example,
v, it's ℕ × ℕ.

The values of a product type, α × β, are
all of the possible pairs of values, p,
where p.fst is any value of type, α, and
p.snd is any value of type, β.

A product type contains *all* pairs of a
given type. Often we want to represent a
relation, or a function, in particular,
as a much smaller set of such pairs. An
example is our square_partial relation.
It can be represented as the set of four
pairs, { (0,0), (1,1), (2,4), (3,9) }.

The type of this set is set (ℕ × ℕ). We
can easily represent it in a line of code.
-/

def square_partial_as_set : set (ℕ × ℕ) :=
  { (0,0), (1,1), (2,4), (3, 9) }

/-
This is the kind of representation of a
function, or a relation more generally,
that's preferred in everyday mathematics.
In your future, such "set theoretic" ways
of representing things are preferred.
-/

/-
Now we see that square_partial_as_set
is just of the many possible values of
type set ℕ × ℕ. It's just one of many
subsets of the set of pairs of the
product type ℕ × ℕ. Indeed, any relation
is representable as some set of pairs! So
we represent a relation as a subset of
the set of values of some product type.
Finally, the set of all subsets of a
set of pairs ( values of some product
type) represents the set of all possible
relations between two types of values.
-/

def power_set_of_product_type
  { α β : Type }
  (s: set (α × β)):
  set (set (α × β)) :=
    { s : set (α × β) | true }

#check power_set_of_product_type square_partial_as_set

/-
Now we can think of, and represent, any
function, total or partial, as a set of
pairs, i.e., of values of product types.

The following function converts, r, the
relation shared throughout this file, to
a corresponding set of pairs.

This function is for the special cases
where α and β are the same type (here,
β).
-/

def relation_to_set_of_tuples: set (β × β) :=
    -- use set comprehension to define set
    { p : β × β | p.1 ≺ p.2 }

/-
We can also go back the other way,
converting a represetation of a
relation as a set of pairs, into
a representation of the relation
represeted as a predicate.
-/
def set_of_tuples_to_relation:
  set (β × β) → (β → β → Prop)
:=
begin
  assume s,
  exact (λ x y, (x, y) ∈ s),
end

/-
Indeed, these mappings are inverses.
What we mean by this is that if we
apply one function then the other we
get back to where we started. The
precise definition is given next.
Here we prove it in one direction.
-/

theorem set_to_relation_inverse :
∀ s : set (β × β),
  relation_to_set_of_tuples
    (set_of_tuples_to_relation s)
      = s
:=
begin
intro s,
unfold relation_to_set_of_tuples,
unfold set_of_tuples_to_relation,
/-
Looks complicated, and you could
use set extensionality to take a
next step, but it seems like this
is mostly simplifying expressions,
so let's ask Lean to try to help.
-/
simp,
/-
Nice! But now go back and make
sure you see exactly why it's
true. An English language proof
might say something like this.
The set of the left is just the
set of pairs of elements that are
in s, and that's just s, so the
equality holds, and we are done.
-/
end

/-
EXERCISE: Prove the theorem where
the functions are applied in the
other order.
-/

/- EXAMPLE: relation-set isomorphism -/

/-
We can represent a relation directly as
a set of pairs using set comprehension
notation. Here we define the set of pairs
of natural numbers where the first and
second elements of each pair are congurent
modulo 12.
-/
def mod_12_equiv': set (ℕ × ℕ) :=
  { p : (ℕ × ℕ) | p.1 % 12 = p.2 % 12 }

/-
Here we prove the equivalence of this new
representation with the representation of
this relation as a predicate, earlier in
this file. Given a set of pairs, you can
derive the relation; and given the latter,
you can derive the former. We now prove
formally that they're literally equivalent.
-/
example:
  ∀(n m: ℕ),
    mod_12_equiv n m ↔ (n, m) ∈ mod_12_equiv'
:=
begin
  assume n m,
  apply iff.intro,

    -- forward
    unfold mod_12_equiv,
    assume pf_mod_12_equiv,
    unfold mod_12_equiv',
    change n % 12 = m % 12,
    assumption,

    -- backward
    unfold mod_12_equiv',
    assume pf_mod_12_equiv',
    unfold mod_12_equiv,
    change n % 12 = m % 12 at pf_mod_12_equiv',
    assumption,
end

/-

CONCLUSION

So there you have it. We have three ways to
represent functions: as lambda abstractions,
predicates, and sets. Lambda abstractions are
used to represent total functions. Predicates
and sets can represent both partial and total
functions. We can convert between equivalent
representations. Everyday mathematics prefers
the set style representation (being rooted in
set theory rather than type theory, in Lean)

We've also studied properties of relations.
These include the reflexive, symmetric, and
transitive properties and the property of
being an equivalence relation. We saw that
an equivalene relation partitions a set into
a set of disjoint subsets, the equivalence
classes of the equivalence relation.

We then looked at the property of being
single valued, which is what is required
for a relation also to be a function.

We then studied a number of properties of
functions, in particular: being injective,
surjective, and bijective (both injective
and surjective).

Finally, we spent time on the importance
of being able to represent and reason about
partial functions in CS. We can't directly
represent them as lambda abstractions, so
we represent them as "relations", by which
in this context we mean predicates. We can
also represent them as equivalent sets of
pairs, but in Lean, we will prefer to stick
with predicate representations of relations.

The fundamental tradeoff is this: you can
compute with lambda abstractions, but you
are limited to total functions; whereas,
with relations, you can represent partial
functions, but you can't compute with a
relation. Instead, you have to use logic
to state and prove propositions about them.
-/

/- EXTRA MATERIAL -/

/-
Another view of transitive closure:
Covered in Prof. Hocking's section,
but not in Sullivan's.
-/

/-
Let us define a relation R as R1
For example imagine the relation
“is one or two less than” as
defined over the naturals. It
contains the 2-tuples {(0, 1),
(0, 2), (1, 2), (1, 3), (2, 3),
(2, 4), (3, 4), (3, 5), etc.}

Now let us define R2 (or R ◦ R)
as the relation having left-hand
elements equal to the left-hand
elements of the tuples in R1, and
right-hand elements equal to the
corresponding right-hand elements
of the right-hand elements in R1
E.g., from above this would be
“is two, three, or four less than”
It contains the 2-tuples {(0, 2),
(0, 3), (0, 4), (1, 3), (1, 4),
(1, 5), etc.)

R3 (or R ◦ R2) is the relation
having left-hand elements having
left-hand elements equal to the
left-hand elements of the tuples
in R1, and right-hand elements
equal to the corresponding
right-hand elements of the
right-hand elements in R2 E.g.,
from the above this would be
“is three, four, or five less than”
-/

def successor:
  (β → β → Prop) → (β → β → Prop) :=
begin
  assume r,
  exact λ (x y: β),
    ∃(b: β), (x ≺ b) ∧ (b ≺ y)
end

/-
The following is a definition for composition of two
arbitrary relations R1 and R2.
-/

def composition{α: Type}
  (R1: (α → α → Prop)) (R2: (α → α → Prop)): (α → α → Prop) :=
    λ(x y: α), ∃(b: α), (R1 x b) ∧ (R2 b y)

/-
Let's now define the composition operator for relations: ◦
-/

local infix `◦`:50 := composition

/-
The transitive closure of a relation, R,
can now also be understood as the union
of R and all of its successor relations.
-/

end relation_2102_sec

end relation_2102_ns

#print nat.less_than_or_equal


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

! This file was ported from Lean 3 source module topology.algebra.order.t5
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Order.Basic
import Mathlib.Data.Set.Intervals.OrdConnectedComponent

/-!
# Linear order is a completely normal Hausdorff topological space

In this file we prove that a linear order with order topology is a completely normal Hausdorff
topological space.
-/

open Filter Set Function OrderDual Topology Interval

variable {X : Type _} [LinearOrder X] [TopologicalSpace X] [OrderTopology X] {a b c : X}
  {s t : Set X}

namespace Set

@[simp]

theorem compl_section_ordSeparatingSet_mem_nhdsWithin_Ici (hd : Disjoint s (closure t))
    (ha : a ∈ s) : (ordConnectedSection (ordSeparatingSet s t))ᶜ ∈ 𝓝[≥] a := by
  have hmem : tᶜ ∈ 𝓝[≥] a := by
    refine' mem_nhdsWithin_of_mem_nhds _
    rw [← mem_interior_iff_mem_nhds, interior_compl]
    exact disjoint_left.1 hd ha
  rcases exists_Icc_mem_subset_of_mem_nhdsWithin_Ici hmem with ⟨b, hab, hmem', hsub⟩
  by_cases H : Disjoint (Icc a b) (ordConnectedSection <| ordSeparatingSet s t)
  · exact mem_of_superset hmem' (disjoint_left.1 H)
  · simp only [Set.disjoint_left, not_forall, Classical.not_not] at H
    rcases H with ⟨c, ⟨hac, hcb⟩, hc⟩
    have hsub' : Icc a b ⊆ ordConnectedComponent (tᶜ) a :=
      subset_ordConnectedComponent (left_mem_Icc.2 hab) hsub
    have hd : Disjoint s (ordConnectedSection (ordSeparatingSet s t)) :=
      disjoint_left_ordSeparatingSet.mono_right ordConnectedSection_subset
    replace hac : a < c := hac.lt_of_ne <| Ne.symm <| ne_of_mem_of_not_mem hc <|
      disjoint_left.1 hd ha
    refine' mem_of_superset (Ico_mem_nhdsWithin_Ici (left_mem_Ico.2 hac)) fun x hx hx' => _
    refine' hx.2.ne (eq_of_mem_ordConnectedSection_of_uIcc_subset hx' hc _)
    refine' subset_inter (subset_unionᵢ₂_of_subset a ha _) _
    · exact OrdConnected.uIcc_subset inferInstance (hsub' ⟨hx.1, hx.2.le.trans hcb⟩)
        (hsub' ⟨hac.le, hcb⟩)
    · rcases mem_unionᵢ₂.1 (ordConnectedSection_subset hx').2 with ⟨y, hyt, hxy⟩
      refine' subset_unionᵢ₂_of_subset y hyt (OrdConnected.uIcc_subset inferInstance hxy _)
      refine' subset_ordConnectedComponent left_mem_uIcc hxy _
      suffices c < y by
        rw [uIcc_of_ge (hx.2.trans this).le]
        exact ⟨hx.2.le, this.le⟩
      refine' lt_of_not_le fun hyc => _
      have hya : y < a := not_le.1 fun hay => hsub ⟨hay, hyc.trans hcb⟩ hyt
      exact hxy (Icc_subset_uIcc ⟨hya.le, hx.1⟩) ha
#align set.compl_section_ord_separating_set_mem_nhds_within_Ici Set.compl_section_ordSeparatingSet_mem_nhdsWithin_Ici

theorem compl_section_ordSeparatingSet_mem_nhdsWithin_Iic (hd : Disjoint s (closure t))
    (ha : a ∈ s) : (ordConnectedSection <| ordSeparatingSet s t)ᶜ ∈ 𝓝[≤] a := by
  have hd' : Disjoint (ofDual ⁻¹' s) (closure <| ofDual ⁻¹' t) := hd
  have ha' : toDual a ∈ ofDual ⁻¹' s := ha
  simpa only [dual_ordSeparatingSet, dual_ordConnectedSection] using
    compl_section_ordSeparatingSet_mem_nhdsWithin_Ici hd' ha'
#align set.compl_section_ord_separating_set_mem_nhds_within_Iic Set.compl_section_ordSeparatingSet_mem_nhdsWithin_Iic

theorem compl_section_ordSeparatingSet_mem_nhds (hd : Disjoint s (closure t)) (ha : a ∈ s) :
    (ordConnectedSection <| ordSeparatingSet s t)ᶜ ∈ 𝓝 a := by
  rw [← nhds_left_sup_nhds_right, mem_sup]
  exact
    ⟨compl_section_ordSeparatingSet_mem_nhdsWithin_Iic hd ha,
      compl_section_ordSeparatingSet_mem_nhdsWithin_Ici hd ha⟩
#align set.compl_section_ord_separating_set_mem_nhds Set.compl_section_ordSeparatingSet_mem_nhds

theorem ordT5Nhd_mem_nhdsSet (hd : Disjoint s (closure t)) : ordT5Nhd s t ∈ 𝓝ˢ s :=
  bUnion_mem_nhdsSet fun x hx => ordConnectedComponent_mem_nhds.2 <| inter_mem
    (by
      rw [← mem_interior_iff_mem_nhds, interior_compl]
      exact disjoint_left.1 hd hx)
    (compl_section_ordSeparatingSet_mem_nhds hd hx)
#align set.ord_t5_nhd_mem_nhds_set Set.ordT5Nhd_mem_nhdsSet

end Set

open Set

/-- A linear order with order topology is a completely normal Hausdorff topological space. -/
instance (priority := 100) OrderTopology.t5Space : T5Space X :=
  ⟨fun s t h₁ h₂ => Filter.disjoint_iff.2
    ⟨ordT5Nhd s t, ordT5Nhd_mem_nhdsSet h₂, ordT5Nhd t s, ordT5Nhd_mem_nhdsSet h₁.symm,
      disjoint_ordT5Nhd⟩⟩
#align order_topology.t5_space OrderTopology.t5Space


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.order.absolute_value
import algebra.euclidean_domain

/-!
# Euclidean absolute values

This file defines a predicate `absolute_value.is_euclidean abv` stating the
absolute value is compatible with the Euclidean domain structure on its domain.

## Main definitions

 * `absolute_value.is_euclidean abv` is a predicate on absolute values on `R` mapping to `S`
    that preserve the order on `R` arising from the Euclidean domain structure.
 * `absolute_value.abs_is_euclidean` shows the "standard" absolute value on `ℤ`,
   mapping negative `x` to `-x`, is euclidean.
-/
local infix ` ≺ `:50 := euclidean_domain.r

namespace absolute_value

section ordered_semiring

variables {R S : Type*} [euclidean_domain R] [ordered_semiring S]
variables (abv : absolute_value R S)

/-- An absolute value `abv : R → S` is Euclidean if it is compatible with the
`euclidean_domain` structure on `R`, namely `abv` is strictly monotone with respect to the well
founded relation `≺` on `R`. -/
structure is_euclidean : Prop :=
(map_lt_map_iff' : ∀ {x y}, abv x < abv y ↔ x ≺ y)

namespace is_euclidean

variables {abv}

-- Rearrange the parameters to `map_lt_map_iff'` so it elaborates better.
lemma map_lt_map_iff {x y : R} (h : abv.is_euclidean) : abv x < abv y ↔ x ≺ y :=
map_lt_map_iff' h

attribute [simp] map_lt_map_iff

lemma sub_mod_lt (h : abv.is_euclidean) (a : R) {b : R} (hb : b ≠ 0) :
  abv (a % b) < abv b :=
h.map_lt_map_iff.mpr (euclidean_domain.mod_lt a hb)

end is_euclidean

end ordered_semiring

section int

open int

-- TODO: generalize to `linear_ordered_euclidean_domain`s if we ever get a definition of those
/-- `abs : ℤ → ℤ` is a Euclidean absolute value -/
protected lemma abs_is_euclidean : is_euclidean (absolute_value.abs : absolute_value ℤ ℤ) :=
{ map_lt_map_iff' := λ x y, show abs x < abs y ↔ nat_abs x < nat_abs y,
    by rw [abs_eq_nat_abs, abs_eq_nat_abs, coe_nat_lt] }

end int

end absolute_value


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

open_locale classical
noncomputable theory

universes u v w

namespace my

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

section

def _root_.set.least_elements [has_le α] (S : set α) : set α :=
{ x ∈ S | ∀ y ∈ S, x ≤ y }

lemma _root_.set.mem_least_elements [has_le α] (S : set α) (x : α) : x ∈ S.least_elements ↔ x ∈ S ∧ ∀ y ∈ S, x ≤ y :=
by simp [set.least_elements]

class well_order (α : Type u) extends linear_order α :=
(exists_min : ∀ (S : set α), S.nonempty → ∃ x ∈ S, ∀ y ∈ S, x ≤ y)

end

def artinian (α : Type u) [has_lt α] : Prop :=
¬∃ f : ℕ → α, ∀ n, f (n + 1) < f n

lemma exists_min [well_order α] (S : set α) : S.nonempty → ∃ x ∈ S, ∀ y ∈ S, x ≤ y :=
well_order.exists_min _

lemma nonempty_least_elements [well_order α] (S : set α) (hS : S.nonempty) : S.least_elements.nonempty :=
let ⟨x, hx, hx'⟩ := exists_min S hS in ⟨x, hx, hx'⟩

lemma subsingleton_least_elements [linear_order α] (S : set α) {x y : α} (hx : x ∈ S.least_elements) (hy : y ∈ S.least_elements) : x = y :=
le_antisymm (hx.2 _ hy.1) (hy.2 _ hx.1)

section
variables [has_lt α] (S : set α) (hS : ∀ x : S, ∃ y : S, (y : α) < x) (s : α) (hs : s ∈ S)

noncomputable def descending_chain : ℕ → S
| 0 := ⟨s, hs⟩
| (n+1) := classical.some $ hS $ descending_chain n

lemma descending_chain_property : ∀ n, (descending_chain S hS s hs (n + 1) : α) < descending_chain S hS s hs n
| 0 := classical.some_spec $ hS $ descending_chain S hS s hs 0
| (n+1) := classical.some_spec $ hS $ descending_chain S hS s hs (n+1)

end

def well_order_of_is_artinian [linear_order α] (h : artinian α) : well_order α :=
{ exists_min := λ S ⟨s, hs⟩,
  begin
    rw artinian at h,
    contrapose! h,
    suffices hS : ∀ x : S, ∃ y : S, (y : α) < x,
    { exact ⟨λ n, descending_chain S hS s hs n, descending_chain_property S hS s hs⟩ },
    rintro ⟨x, hx⟩,
    obtain ⟨y, hy, hy'⟩ := h x hx,
    exact ⟨⟨y, hy⟩, hy'⟩
  end,
  ..(infer_instance : linear_order α) }

lemma is_artinian [well_order α] : artinian α :=
begin
  rintro ⟨f, hf⟩,
  obtain ⟨x, ⟨n, rfl⟩, hx'⟩ := exists_min (set.range f) (set.range_nonempty f),
  exact lt_irrefl _ ((hx' (f (n + 1)) (set.mem_range_self _)).trans_lt (hf n))
end

theorem well_ordered_induction [well_order α] (P : α → Prop) (hP : ∀ x, (∀ y, y < x → P y) → P x) : ∀ x, P x :=
begin
  by_contradiction,
  push_neg at h,
  rcases h with ⟨x, hx⟩,
  obtain ⟨y, hy, hy'⟩ := exists_min { z | ¬P z } ⟨x, hx⟩,
  refine hy (hP _ (λ z hz, _)),
  contrapose! hy',
  exact ⟨z, hy', hz⟩
end

def I [has_lt α] (x : α) : set α := { y | y < x }
def J [has_le α] (x : α) : set α := { y | y ≤ x }

@[simp] lemma mem_I [has_lt α] (x y : α) : x ∈ I y ↔ x < y := iff.rfl
@[simp] lemma mem_J [has_le α] (x y : α) : x ∈ J y ↔ x ≤ y := iff.rfl

lemma I_ne_univ [preorder α] (x : α) : I x ≠ set.univ :=
λ h, lt_irrefl x (h.symm ▸ set.mem_univ x : x ∈ I x)

lemma mem_J_iff [linear_order α] (x y : α) : x ∈ J y ↔ x = y ∨ x ∈ I y :=
le_iff_eq_or_lt

lemma iso_apply_least_element [linear_order α] [linear_order β] (f : α ≃o β) (x : α) : f x ∈ (f '' I x)ᶜ.least_elements :=
begin
  refine ⟨by simp, λ y hy, _⟩,
  simp only [not_exists, set.mem_image, not_and, mem_I, set.mem_compl_eq] at hy,
  have := hy (f.symm y),
  contrapose! this,
  simpa only [order_iso.symm_apply_apply, and_true, order_iso.apply_symm_apply, eq_self_iff_true] using f.symm.lt_iff_lt.mpr this
end

instance subsingleton_order_iso [well_order α] [well_order β] : subsingleton (α ≃o β) :=
⟨λ f g, rel_iso.ext $ well_ordered_induction _
  (λ x hx, subsingleton_least_elements (f '' I x)ᶜ
    (iso_apply_least_element _ _)
    ((set.image_congr hx).symm ▸ iso_apply_least_element _ _))⟩

def initial_segment [linear_order α] (Y : set α) : Prop :=
∀ x ∈ Y, ∀ y < x, y ∈ Y

lemma I_subset_initial_segment [linear_order α] {Y : set α} (hY : initial_segment Y) : ∀ x ∈ Y, I x ⊆ Y :=
λ x hx y hy, hY _ hx _ hy

lemma initial_segment_I [linear_order α] (x : α) : initial_segment (I x) :=
λ y hy z hz, hz.trans hy

lemma initial_segment_J [linear_order α] (x : α) : initial_segment (J x) :=
λ y hy z hz, le_of_lt $ hz.trans_le hy

lemma initial_segment_univ [linear_order α] : initial_segment (set.univ : set α) :=
by tidy

lemma initial_segment_def [linear_order α] {Y : set α} (hY : initial_segment Y) {x y : α} (hx : x ∈ Y) (hy : y ≤ x) : y ∈ Y :=
by { rcases eq_or_lt_of_le hy with (h|h), exacts [h.symm ▸ hx, hY _ hx _ h] }

lemma initial_segment_of_image [linear_order α] [linear_order β] (S : set α) (f : α → β) (hf : strict_mono f)
  (hfS : initial_segment (f '' S)) : initial_segment S :=
begin
  intros x hx y hxy,
  obtain ⟨z, ⟨hz, hz'⟩⟩ := hfS (f x) ⟨x, hx, rfl⟩ (f y) (hf.lt_iff_lt.2 hxy),
  obtain rfl := hf.injective hz',
  exact hz
end

lemma initial_segment_of_order_iso [linear_order α] [linear_order β] (S : set α) (f : α ≃o β) :
  initial_segment (f '' S) ↔ initial_segment S :=
begin
  refine ⟨initial_segment_of_image _ _ f.strict_mono, _⟩,
  convert initial_segment_of_image (f '' S) _ f.symm.strict_mono,
  rw order_iso.symm_image_image
end

lemma initial_segment_eq [well_order α] {S : set α} (hS : initial_segment S) : S = set.univ ∨ ∃ x, S = I x :=
begin
  refine or_iff_not_imp_left.2 (λ h, _),
  obtain ⟨x', hx'⟩ := (set.ne_univ_iff_exists_not_mem _).1 h,
  obtain ⟨x, hx₁, hx₂⟩ := exists_min Sᶜ ⟨x', hx'⟩,
  refine ⟨x, set.ext (λ y, ⟨λ hy, _, λ hy, _⟩)⟩,
  { contrapose! hx₁,
    exact not_not.2 (initial_segment_def hS hy (not_lt.1 hx₁)) },
  { contrapose! hx₂,
    exact ⟨y, hx₂, hy⟩ }
end

section recursion
variables [well_order α] {G : Π (x : α), (I x → β) → β}

section
variables (G)

structure attempt :=
(definition_set : set α)
(initial_definition_set : initial_segment definition_set)
(to_fun : α → β)
(hh : ∀ x ∈ definition_set, to_fun x = G _ (set.restrict to_fun (I x)))

end

instance : has_coe_to_fun (attempt G) (λ _, α → β) := ⟨attempt.to_fun⟩

namespace attempt

lemma initial_segment_definition_set (h : attempt G) : initial_segment h.definition_set :=
attempt.initial_definition_set _

def defined_at (h : attempt G) (x : α) : Prop :=
x ∈ h.definition_set

lemma defined_at_iff (h : attempt G) {x : α} : h.defined_at x ↔ x ∈ h.definition_set :=
iff.rfl

lemma attempt_eq (h : attempt G) {x : α} : h.defined_at x → h x = G _ (set.restrict h (I x)) :=
attempt.hh _ _

lemma attempt_well_defined (h h' : attempt G) : ∀ (x : α) (hx : h.defined_at x) (hx' : h'.defined_at x), h x = h' x :=
begin
  refine well_ordered_induction _ (λ x hx hx₁ hx₂, _),
  rw [attempt_eq _ hx₁, attempt_eq _ hx₂],
  congr' 1,
  exact funext (λ y, hx _ y.2 (h.initial_segment_definition_set _ hx₁ _ y.2) (h'.initial_segment_definition_set _ hx₂ _ y.2))
end

section
variables (G)
include G

def attempt_defined_at (x : α) :=
{ h : attempt G // h.defined_at x }

lemma nonempty_β (x : α) : nonempty β :=
begin
  obtain ⟨m, hm, hm'⟩ := exists_min set.univ ⟨x, trivial⟩,
  refine ⟨G m _⟩,
  rintro ⟨y, hy⟩,
  exact false.elim (lt_irrefl m ((hm' y trivial).trans_lt hy))
end

def any (x : α) : β :=
classical.choice $ nonempty_β G x

lemma exists_assemble (S : set α) (hS : initial_segment S) (hS' : ∀ x ∈ S, nonempty (attempt_defined_at G x)) :
  ∃ h : attempt G, h.definition_set = S :=
begin
  have : ∀ x : S, ∃ h : attempt G, h.defined_at x,
  { rintro ⟨x, hx⟩,
    obtain ⟨h, hh⟩ := hS' x hx,
    exact ⟨h, hh⟩ },
  choose h hh using this,
  refine ⟨⟨_, hS, λ x, if hx : x ∈ S then h ⟨x, hx⟩ x else any G x, λ x hx, _⟩, rfl⟩,
  rw [dif_pos hx, attempt_eq (h ⟨x, hx⟩) _],
  { congr' 1,
    ext y,
    have : (y : α) ∈ S := hS _ hx _ y.2,
    simp only [this, dif_pos, set.restrict_apply],
    exact attempt_well_defined _ _ _ (initial_segment_definition_set _ _ (hh _) _ y.2) (hh _) },
  { exact hh _ }
end

lemma exists_extend (x : α) (h : ∃ h' : attempt G, h'.definition_set = I x) : ∃ h : attempt G, h.definition_set = J x :=
begin
  rcases h with ⟨h, hh⟩,
  refine ⟨⟨_, initial_segment_J x, function.update h x (G _ (set.restrict h (I x))), _⟩, rfl⟩,
  simp only [mem_J_iff, forall_eq_or_imp, function.update_same],
  refine ⟨_, _⟩,
  { congr' 1,
    ext y,
    rw [set.restrict_apply, set.restrict_apply, function.update_noteq (show (y : α) ≠ x, from ne_of_lt y.2)] },
  { intros y hy,
    rw [function.update_noteq (show (y : α) ≠ x, from ne_of_lt hy),
      h.attempt_eq (h.defined_at_iff.2 (hh.symm ▸ hy : y ∈ h.definition_set))],
    congr' 1,
    ext z,
    rw [set.restrict_apply, set.restrict_apply, function.update_noteq (show (z : α) ≠ x, from ne_of_lt (lt_trans z.2 hy))] }
end

lemma exists_attempt : ∀ x, nonempty (attempt_defined_at G x) :=
begin
  refine well_ordered_induction _ (λ x hx, _),
  obtain ⟨h, hh⟩ := exists_extend G x (exists_assemble G (I x) (initial_segment_I x) (λ y hy, hx _ hy)),
  exact ⟨⟨h, h.defined_at_iff.2 (hh.symm ▸ (le_refl _ : x ∈ J x))⟩⟩
end

end

end attempt

variables (G)

theorem recursion : ∃! f : α → β, ∀ x, f x = G x (set.restrict f _) :=
begin
  obtain ⟨f, hf⟩ := attempt.exists_assemble G set.univ initial_segment_univ (λ x hx, attempt.exists_attempt G x),
  have hf : ∀ x, f x = G x (set.restrict f _) := λ x, f.attempt_eq (f.defined_at_iff.2 (hf.symm ▸ set.mem_univ x)),
  refine ⟨f, ⟨hf, λ g hg, funext (well_ordered_induction _ (λ x hx, _))⟩⟩,
  rw [hf x, hg x],
  exact congr_arg _ (funext (λ y, hx _ y.2))
end

end recursion

section subset_collapse

instance well_order_set [well_order α] (S : set α) : well_order S :=
{ exists_min :=
   begin
     rintros T ⟨t, ht⟩,
     let T' := { x | ∃ (h : x ∈ S), (⟨x, h⟩ : S) ∈ T },
     have hT' : T'.nonempty := ⟨t, ⟨t.2, _⟩⟩,
     { obtain ⟨x, ⟨hx, hx'⟩, hx''⟩ := exists_min T' hT',
       refine ⟨⟨x, hx⟩, hx', λ y hy, hx'' _ ⟨y.2, _⟩⟩,
       simpa only [subtype.coe_eta, subtype.val_eq_coe] using hy },
     { simpa only [subtype.coe_eta] using ht }
   end,
  ..(infer_instance : linear_order S)}

section
variables (α β)

def isomorphic_to_initial_segment [well_order α] [well_order β] : Prop :=
∃ (S : set β), initial_segment S ∧ nonempty (α ≃o S)

end

notation a ` ≺ `:70 b:70 := isomorphic_to_initial_segment a b

lemma iis_iff_exists_strict_mono [well_order α] [well_order β] :
  α ≺ β ↔ ∃ (f : α → β), strict_mono f ∧ initial_segment (set.range f) :=
begin
  refine ⟨_, _⟩,
  { rintro ⟨S, hS, ⟨f⟩⟩,
    refine ⟨subtype.val ∘ f, strict_mono.comp (λ x y, id) f.strict_mono, _⟩,
    { simpa only [f.surjective.range_comp, subtype.range_val] using hS } },
  { rintro ⟨f, hf, hf'⟩,
    exact ⟨set.range f, hf', ⟨hf.order_iso _⟩⟩ }
end

lemma mem_least_elements [well_order α] [well_order β] {S : set β} (hS : initial_segment S) (f : α ≃o S) (x : α) :
  (f x : β) ∈ ((subtype.val ∘ f) '' I x)ᶜ.least_elements :=
begin
  refine ⟨_, _⟩,
  { rintro ⟨z, ⟨hz, hz'⟩⟩,
    obtain rfl := (order_iso.apply_eq_iff_eq _).1 (subtype.ext hz'),
    exact lt_irrefl _ hz },
  { rintros y hy,
    contrapose! hy,
    simp only [set.mem_image, not_not, function.comp_app, mem_I, set.mem_compl_eq, subtype.val_eq_coe],
    obtain ⟨z, hz⟩ := f.surjective ⟨y, hS _ (f x).2 _ hy⟩,
    obtain rfl : (f z : β) = y := congr_arg subtype.val hz,
    exact ⟨z, ⟨f.lt_iff_lt.1 hy, rfl⟩⟩ }
end

theorem subset_collapse_uniqueness [well_order α] [well_order β] (h : α ≺ β) :
  ∃! (S : set β), initial_segment S ∧ nonempty (α ≃o S) :=
begin
  rcases h with ⟨S, ⟨hS, ⟨f⟩⟩⟩,
  refine ⟨S, ⟨hS, ⟨f⟩⟩, _⟩,
  rintro T ⟨hT, ⟨g⟩⟩,
  suffices : ∀ x, (f x : β) = g x,
  { have : subtype.val ∘ f = subtype.val ∘ g,
    { ext, simp only [this, function.comp_app, subtype.val_eq_coe] },
    rw [←@subtype.range_val _ T, ←g.surjective.range_comp, ←this, f.surjective.range_comp, subtype.range_val] },
  refine well_ordered_induction _ (λ x hx, _),
  have := mem_least_elements hS f x,
  rw [(set.image_congr (λ y hy, hx _ hy) : (subtype.val ∘ f) '' I x = (subtype.val ∘ g) '' I x)] at this,
  exact subsingleton_least_elements _ this (mem_least_elements hT g x)
end

lemma isomorphic_to_initial_of_range_nonempty [well_order α] [well_order β]
  (h : ∀ (x : α) (f : I x → β) (hf : strict_mono f ∧ initial_segment (set.range f)), (set.range f)ᶜ.nonempty) : α ≺ β :=
begin
  suffices : ∃ f : α → β, ∀ (x : α), f x ∈ (f '' I x)ᶜ.least_elements,
  { rcases this with ⟨f, hf⟩,
    have hfi : function.injective f,
    { intros x y hxy,
      rcases @trichotomous _ (<) _ x y with (h|rfl|h),
      { exact false.elim ((hf y).1 ⟨x, ⟨h, hxy⟩⟩) },
      { refl },
      { exact false.elim ((hf x).1 ⟨y, ⟨h, hxy.symm⟩⟩) } },
    refine ⟨set.range f, ⟨_, _⟩⟩,
    { rintro x ⟨y, rfl⟩ z hz,
      have := (hf y).2 z,
      contrapose! this,
      exact ⟨λ h, this (set.mem_range_of_mem_image _ _ h), hz⟩ },
    { refine ⟨strict_mono.order_iso f (monotone.strict_mono_of_injective (λ x y hxy, (hf x).2 (f y) _) hfi)⟩,
      rintro ⟨z, ⟨hz, hz'⟩⟩,
      exact lt_irrefl x (((hfi hz').symm ▸ hxy : x ≤ z).trans_lt hz) } },
  by_cases hβ : nonempty β,
  { have : ∀ (x : α) (f : I x → β) (h : strict_mono f ∧ initial_segment (set.range f)), (set.range f)ᶜ.least_elements.nonempty,
    { exact λ x f hf, nonempty_least_elements _ (h x f hf) },
    choose! G hG using this,
    obtain ⟨f, ⟨hf, -⟩⟩ := recursion G,
    have hf' : ∀ x, strict_mono (set.restrict f (I x)) ∧ initial_segment (set.range (set.restrict f (I x))),
    { refine well_ordered_induction _ (λ z hz, _),
      have hf' : initial_segment (set.range (set.restrict f (I z))),
      { simp only [set.range_restrict],
        rintro x ⟨y, ⟨hy, rfl⟩⟩ w hw,
        obtain ⟨h₁, h₂⟩ := hG _ _ (hz _ hy),
        rw ←hf at h₁ h₂,
        have := not_imp_not.2 (h₂ w) (not_le.2 hw),
        simp only [not_exists, exists_prop, set.mem_image, set_coe.exists, not_and, not_not, set.range_restrict, mem_I,
          set.mem_compl_eq, not_forall] at this,
        rcases this with ⟨q, hq, rfl⟩,
        refine ⟨q, ⟨hq.trans hy, rfl⟩⟩ },
      refine ⟨λ x y hxy, _, hf'⟩,
      simp only [set.restrict_apply],
      obtain ⟨h₁, h₂⟩ := hG _ _ (hz _ x.2),
      obtain ⟨h₃, h₄⟩ := hG _ _ (hz _ y.2),
      rw ←hf at h₁ h₂ h₃ h₄,
      rcases @trichotomous _ (<) _ (f x) (f y) with (h|h|h),
      { exact h },
      { refine false.elim (h₃ _),
        simp only [set.mem_image, set.range_restrict, mem_I, subtype.val_eq_coe],
        exact ⟨x, hxy, h⟩ },
      { have := not_imp_not.2 (h₂ _) (not_le.2 h),
        simp only [not_exists, exists_prop, set.mem_image, not_and, not_not, set.range_restrict, mem_I, set.mem_compl_eq,
          not_forall, subtype.val_eq_coe] at this,
        rcases this with ⟨q, hq, hq'⟩,
        refine false.elim (h₃ _),
        simp only [set.mem_image, set.range_restrict, mem_I, subtype.val_eq_coe],
        refine ⟨q, hq.trans hxy, hq'⟩ } },
    refine ⟨f, λ x, _⟩,
    rw hf,
    convert hG x (set.restrict f (I x)) (hf' _),
    simp only [set.range_restrict] },
  { simp only [not_nonempty_iff] at hβ,
    resetI,
    have : is_empty α,
    { refine ⟨λ a', _⟩,
      obtain ⟨a, -, ha⟩ := exists_min set.univ ⟨a', trivial⟩,
      have := h a,
      rw [(set.ext (λ x, ⟨λ hx, lt_irrefl a ((ha x trivial).trans_lt hx), false.elim⟩) : I a = ∅)] at this,
      obtain ⟨b, -⟩ := this (λ x, false.elim x.2) ⟨λ x, false.elim x.2, λ b, false.elim (is_empty.false b)⟩,
      exact is_empty.false b },
    exactI ⟨λ x, false.elim (is_empty.false x), λ x, false.elim (is_empty.false x)⟩ }
end

theorem subset_collapse [well_order α] (Y : set α) : Y ≺ α :=
begin
  apply isomorphic_to_initial_of_range_nonempty,
  rintros x f ⟨hf, hf'⟩,
  suffices : ∀ z, f z ≤ z,
  { refine ⟨x, _⟩,
    rintro ⟨y, hy⟩,
    exact ne_of_lt ((this _).trans_lt y.2) hy },
  refine well_ordered_induction _ (λ z hz, _),
  contrapose! hz,
  obtain ⟨w, hw⟩ := hf' _ (set.mem_range_self _) _ hz,
  refine ⟨w, hf.lt_iff_lt.1 (hw.symm ▸ hz), _⟩,
  rw hw,
  exact hf.lt_iff_lt.1 (hw.symm ▸ hz)
end

theorem well_order_total [well_order α] [well_order β] : α ≺ β ∨ β ≺ α :=
begin
  by_cases h : ∀ (x : α) (f : I x → β) (hf : strict_mono f ∧ initial_segment (set.range f)), (set.range f)ᶜ.nonempty,
  { exact or.inl (isomorphic_to_initial_of_range_nonempty h) },
  { simp only [and_imp, exists_prop, not_forall, set.not_nonempty_iff_eq_empty, set.compl_empty_iff, set.range_iff_surjective] at h,
    rcases h with ⟨x, f, hf₁, -, hf₃⟩,
    exact or.inr ⟨I x, initial_segment_I _, ⟨(hf₁.order_iso_of_surjective _ hf₃).symm⟩⟩ }
end

lemma iis_self [well_order α] (S : set α) (hS : initial_segment S) : nonempty (α ≃o S) → S = set.univ :=
begin
  rintro ⟨f⟩,
  obtain ⟨T, -, hT⟩ := subset_collapse_uniqueness (subset_collapse (set.univ : set α)),
  obtain rfl : set.univ = T := hT _ ⟨initial_segment_univ, ⟨order_iso.refl _⟩⟩,
  exact hT _ ⟨hS, ⟨order_iso.set.univ.trans f⟩⟩
end

lemma surjective_of_initial_segment_range [well_order α] (f : α → α) (hf : strict_mono f) (hf' : initial_segment (set.range f)) :
  function.surjective f :=
begin
  obtain ⟨S, -, hS⟩ := subset_collapse_uniqueness (subset_collapse (set.univ : set α)),
  obtain rfl : set.univ = S := hS _ ⟨initial_segment_univ, ⟨order_iso.refl _⟩⟩,
  exact set.range_iff_surjective.1 (hS _ ⟨hf', ⟨order_iso.set.univ.trans (hf.order_iso _)⟩⟩)
end

theorem well_order_trans [well_order α] [well_order β] [well_order γ] (hαβ : α ≺ β) (hβγ : β ≺ γ) : α ≺ γ :=
begin
  simp only [iis_iff_exists_strict_mono] at *,
  rcases hαβ with ⟨f, hf₁, hf₂⟩,
  rcases hβγ with ⟨g, hg₁, hg₂⟩,
  refine ⟨g ∘ f, hg₁.comp hf₁, _⟩,
  rw set.range_comp,
  rintro z ⟨y, ⟨⟨x, rfl⟩, rfl⟩⟩ y hy,
  obtain ⟨z, rfl⟩ := hg₂ _ ⟨f x, rfl⟩ _ hy,
  exact ⟨z, hf₂ _ ⟨x, rfl⟩ _ (hg₁.lt_iff_lt.1 hy), rfl⟩
end

theorem well_order_antisymm [well_order α] [well_order β] (hαβ : α ≺ β) (hβα : β ≺ α) : nonempty (α ≃o β) :=
begin
  obtain ⟨f, hf₁, hf₂⟩ := iis_iff_exists_strict_mono.1 hαβ,
  obtain ⟨g, hg₁, hg₂⟩ := iis_iff_exists_strict_mono.1 hβα,
  refine ⟨hf₁.order_iso_of_surjective _ (function.surjective.of_comp (surjective_of_initial_segment_range _ (hf₁.comp hg₁) _))⟩,
  rw set.range_comp,
  rintro z ⟨y, ⟨⟨x, rfl⟩, rfl⟩⟩ y hy,
  obtain ⟨z, rfl⟩ := hf₂ _ ⟨g x, rfl⟩ _ hy,
  exact ⟨z, hg₂ _ ⟨x, rfl⟩ _ (hf₁.lt_iff_lt.1 hy), rfl⟩
end

theorem well_order_refl [well_order α] : α ≺ α :=
⟨set.univ, initial_segment_univ, ⟨order_iso.set.univ.symm⟩⟩

end subset_collapse

end my


/-
Copyright (c) 2020 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo
-/
import dynamics.flow

/-!
# ω-limits

For a function `ϕ : τ → α → β` where `β` is a topological space, we
define the ω-limit under `ϕ` of a set `s` in `α` with respect to
filter `f` on `τ`: an element `y : β` is in the ω-limit of `s` if the
forward images of `s` intersect arbitrarily small neighbourhoods of
`y` frequently "in the direction of `f`".

In practice `ϕ` is often a continuous monoid-act, but the definition
requires only that `ϕ` has a coercion to the appropriate function
type. In the case where `τ` is `ℕ` or `ℝ` and `f` is `at_top`, we
recover the usual definition of the ω-limit set as the set of all `y`
such that there exist sequences `(tₙ)`, `(xₙ)` such that `ϕ tₙ xₙ ⟶ y`
as `n ⟶ ∞`.

## Notations

The `omega_limit` locale provides the localised notation `ω` for
`omega_limit`, as well as `ω⁺` and `ω⁻` for `omega_limit at_top` and
`omega_limit at_bot` respectively for when the acting monoid is
endowed with an order.
-/

open set function filter
open_locale topological_space

/-!
### Definition and notation
-/

section omega_limit

variables {τ : Type*} {α : Type*} {β : Type*} {ι : Type*}

/-- The ω-limit of a set `s` under `ϕ` with respect to a filter `f` is
    ⋂ u ∈ f, cl (ϕ u s). -/
def omega_limit [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) : set β :=
⋂ u ∈ f, closure (image2 ϕ u s)

localized "notation `ω` := omega_limit" in omega_limit

localized "notation `ω⁺` := omega_limit at_top" in omega_limit
localized "notation `ω⁻` := omega_limit at_bot" in omega_limit

variables [topological_space β]
variables (f : filter τ) (ϕ : τ → α → β) (s s₁ s₂: set α)

/-!
### Elementary properties
-/

lemma omega_limit_def : ω f ϕ s = ⋂ u ∈ f, closure (image2 ϕ u s) := rfl

lemma omega_limit_subset_of_tendsto {m : τ → τ} {f₁ f₂ : filter τ} (hf : tendsto m f₁ f₂) :
  ω f₁ (λ t x, ϕ (m t) x) s ⊆ ω f₂ ϕ s :=
begin
  apply Inter_subset_Inter2, intro u,  use m ⁻¹' u,
  apply Inter_subset_Inter2, intro hu, use tendsto_def.mp hf _ hu,
  rw ←image2_image_left,
  exact closure_mono (image2_subset (image_preimage_subset _ _) subset.rfl),
end

lemma omega_limit_mono_left {f₁ f₂ : filter τ} (hf : f₁ ≤ f₂) : ω f₁ ϕ s ⊆ ω f₂ ϕ s :=
omega_limit_subset_of_tendsto ϕ s (tendsto_id' hf)

lemma omega_limit_mono_right {s₁ s₂ : set α} (hs : s₁ ⊆ s₂) : ω f ϕ s₁ ⊆ ω f ϕ s₂ :=
bInter_subset_bInter_right $ λ u hu, closure_mono (image2_subset subset.rfl hs)

lemma is_closed_omega_limit : is_closed (ω f ϕ s) :=
is_closed_Inter $ λ u, is_closed_Inter $ λ hu, is_closed_closure

lemma maps_to_omega_limit' {α' β' : Type*} [topological_space β'] {f : filter τ} {ϕ : τ → α → β}
  {ϕ' : τ → α' → β'} {ga : α → α'} {s' : set α'} (hs : maps_to ga s s')
  {gb : β → β'} (hg : ∀ᶠ t in f, eq_on (gb ∘ (ϕ t)) (ϕ' t ∘ ga) s)
  (hgc : continuous gb) :
  maps_to gb (ω f ϕ s) (ω f ϕ' s') :=
begin
  simp only [omega_limit_def, mem_Inter, maps_to],
  intros y hy u hu,
  refine map_mem_closure hgc (hy _ (inter_mem_sets hu hg)) (forall_image2_iff.2 $ λ t ht x hx, _),
  calc gb (ϕ t x) = ϕ' t (ga x) : ht.2 hx
  ... ∈ image2 ϕ' u s' : mem_image2_of_mem ht.1 (hs hx)
end

lemma maps_to_omega_limit {α' β' : Type*} [topological_space β'] {f : filter τ} {ϕ : τ → α → β}
  {ϕ' : τ → α' → β'} {ga : α → α'} {s' : set α'} (hs : maps_to ga s s')
  {gb : β → β'} (hg : ∀ t x, gb (ϕ t x) = ϕ' t (ga x))
  (hgc : continuous gb) :
  maps_to gb (ω f ϕ s) (ω f ϕ' s') :=
maps_to_omega_limit' _ hs (eventually_of_forall $ λ t x hx, hg t x) hgc

lemma omega_limit_image_eq {α' : Type*} (ϕ : τ → α' → β) (f : filter τ) (g : α → α') :
  ω f ϕ (g '' s) = ω f (λ t x, ϕ t (g x)) s :=
by simp only [omega_limit, image2_image_right]

lemma omega_limit_preimage_subset {α' : Type*} (ϕ : τ → α' → β) (s : set α') (f : filter τ)
  (g : α → α') :
  ω f (λ t x, ϕ t (g x)) (g ⁻¹' s) ⊆ ω f ϕ s :=
maps_to_omega_limit _ (maps_to_preimage _ _) (λ t x, rfl) continuous_id

/-!
### Equivalent definitions of the omega limit

The next few lemmas are various versions of the property
characterising ω-limits:
-/

/-- An element `y` is in the ω-limit set of `s` w.r.t. `f` if the
    preimages of an arbitrary neighbourhood of `y` frequently
    (w.r.t. `f`) intersects of `s`. -/
lemma mem_omega_limit_iff_frequently (y : β) : y ∈ ω f ϕ s ↔
  ∀ n ∈ 𝓝 y, ∃ᶠ t in f, (s ∩ ϕ t ⁻¹' n).nonempty :=
begin
  simp_rw [frequently_iff, omega_limit_def, mem_Inter, mem_closure_iff_nhds],
  split,
  { intros h _ hn _ hu,
    rcases h _ hu _ hn with ⟨_, _, _, _, ht, hx, hϕtx⟩,
    exact ⟨_, ht, _, hx, by rwa [mem_preimage, hϕtx]⟩,
  },
  { intros h _ hu _ hn,
    rcases h _ hn hu with ⟨_, ht, _, hx, hϕtx⟩,
    exact  ⟨_, hϕtx, _, _, ht, hx, rfl⟩ }
end

/-- An element `y` is in the ω-limit set of `s` w.r.t. `f` if the
    forward images of `s` frequently (w.r.t. `f`) intersect arbitrary
    neighbourhoods of `y`. -/
lemma mem_omega_limit_iff_frequently₂ (y : β) : y ∈ ω f ϕ s ↔
  ∀ n ∈ 𝓝 y, ∃ᶠ t in f, (ϕ t '' s ∩ n).nonempty :=
by simp_rw [mem_omega_limit_iff_frequently, image_inter_nonempty_iff]

/-- An element `y` is in the ω-limit of `x` w.r.t. `f` if the forward
    images of `x` frequently (w.r.t. `f`) falls within an arbitrary
    neighbourhood of `y`. -/
lemma mem_omega_limit_singleton_iff_map_cluster_point (x : α) (y : β) :
  y ∈ ω f ϕ {x} ↔ map_cluster_pt y f (λ t, ϕ t x) :=
by simp_rw [mem_omega_limit_iff_frequently, map_cluster_pt_iff, singleton_inter_nonempty,
  mem_preimage]

/-!
### Set operations and omega limits
-/

lemma omega_limit_inter : ω f ϕ (s₁ ∩ s₂) ⊆ ω f ϕ s₁ ∩ ω f ϕ s₂ :=
subset_inter (omega_limit_mono_right _ _ (inter_subset_left _ _))
  (omega_limit_mono_right _ _(inter_subset_right _ _))

lemma omega_limit_Inter (p : ι → set α) : ω f ϕ (⋂ i, p i) ⊆ ⋂ i, ω f ϕ (p i) :=
subset_Inter $ λ i, omega_limit_mono_right _ _ (Inter_subset _ _)

lemma omega_limit_union : ω f ϕ (s₁ ∪ s₂) = ω f ϕ s₁ ∪ ω f ϕ s₂ :=
begin
  ext y, split,
  { simp only [mem_union, mem_omega_limit_iff_frequently, union_inter_distrib_right,
      union_nonempty, frequently_or_distrib],
    contrapose!,
    simp only [not_frequently, not_nonempty_iff_eq_empty, ← subset_empty_iff],
    rintro ⟨⟨n₁, hn₁, h₁⟩, ⟨n₂, hn₂, h₂⟩⟩,
    refine ⟨n₁ ∩ n₂, inter_mem_sets hn₁ hn₂, h₁.mono $ λ t, _, h₂.mono $ λ t, _⟩,
    exacts [subset.trans $ inter_subset_inter_right _ $ preimage_mono $ inter_subset_left _ _,
      subset.trans $ inter_subset_inter_right _ $ preimage_mono $ inter_subset_right _ _] },
  { rintros (hy|hy),
    exacts [omega_limit_mono_right _ _ (subset_union_left  _ _) hy,
      omega_limit_mono_right _ _ (subset_union_right _ _) hy] },
end

lemma omega_limit_Union (p : ι → set α) : (⋃ i, ω f ϕ (p i)) ⊆ ω f ϕ ⋃ i, p i :=
by { rw Union_subset_iff,
     exact λ i, omega_limit_mono_right _ _ (subset_Union _ _)}

/-!
Different expressions for omega limits, useful for rewrites. In
particular, one may restrict the intersection to sets in `f` which are
subsets of some set `v` also in `f`.
-/

lemma omega_limit_eq_Inter : ω f ϕ s = ⋂ u : ↥f.sets, closure (image2 ϕ u s) :=
bInter_eq_Inter _ _

lemma omega_limit_eq_bInter_inter {v : set τ} (hv : v ∈ f) :
  ω f ϕ s = ⋂ u ∈ f, closure (image2 ϕ (u ∩ v) s) :=
subset.antisymm
  (Inter_subset_Inter2 (λ u, ⟨u ∩ v,
   Inter_subset_Inter2 (λ hu, ⟨inter_mem_sets hu hv, subset.rfl⟩)⟩))
  (Inter_subset_Inter (λ u,
   Inter_subset_Inter (λ hu, closure_mono
     (image2_subset (inter_subset_left _ _) subset.rfl))))

lemma omega_limit_eq_Inter_inter {v : set τ} (hv : v ∈ f) :
  ω f ϕ s = ⋂ (u : ↥f.sets), closure (image2 ϕ (u ∩ v) s) :=
by { rw omega_limit_eq_bInter_inter _ _ _ hv, apply bInter_eq_Inter }

lemma omega_limit_subset_closure_fw_image {u : set τ} (hu : u ∈ f) :
  ω f ϕ s ⊆ closure (image2 ϕ u s) :=
begin
  rw omega_limit_eq_Inter,
  intros _ hx,
  rw mem_Inter at hx,
  exact hx ⟨u, hu⟩,
end

/-!
### `ω-limits and compactness
-/

/-- A set is eventually carried into any open neighbourhood of its ω-limit:
if `c` is a compact set such that `closure {ϕ t x | t ∈ v, x ∈ s} ⊆ c` for some `v ∈ f`
and `n` is an open neighbourhood of `ω f ϕ s`, then for some `u ∈ f` we have
`closure {ϕ t x | t ∈ u, x ∈ s} ⊆ n`. -/
lemma eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset'
  {c : set β} (hc₁ : is_compact c) (hc₂ : ∃ v ∈ f, closure (image2 ϕ v s) ⊆ c)
  {n : set β} (hn₁ : is_open n) (hn₂ : ω f ϕ s ⊆ n) :
  ∃ u ∈ f, closure (image2 ϕ u s) ⊆ n :=
begin
  rcases hc₂ with ⟨v, hv₁, hv₂⟩,
  let k := closure (image2 ϕ v s),
  have hk : is_compact (k \ n) :=
    compact_diff (compact_of_is_closed_subset hc₁ is_closed_closure hv₂) hn₁,
  let j := λ u, (closure (image2 ϕ (u ∩ v) s))ᶜ,
  have hj₁ : ∀ u ∈ f, is_open (j u), from
    λ _ _, (is_open_compl_iff.mpr is_closed_closure),
  have hj₂ : k \ n ⊆ ⋃ u ∈ f, j u, begin
    have : (⋃ u ∈ f, j u) = ⋃ (u : ↥f.sets), j u, from bUnion_eq_Union _ _,
    rw [this, diff_subset_comm, diff_Union],
    rw omega_limit_eq_Inter_inter _ _ _ hv₁ at hn₂,
    simp_rw diff_compl,
    rw ←inter_Inter,
    exact subset.trans (inter_subset_right _ _) hn₂,
  end,
  rcases hk.elim_finite_subcover_image hj₁ hj₂ with ⟨g, hg₁ : ∀ u ∈ g, u ∈ f, hg₂, hg₃⟩,
  let w := (⋂ u ∈ g, u) ∩ v,
  have hw₂ : w ∈ f, by simpa *,
  have hw₃ : k \ n ⊆ (closure (image2 ϕ w s))ᶜ, from
    calc k \ n ⊆ ⋃ u ∈ g, j u : hg₃
    ... ⊆ (closure (image2 ϕ w s))ᶜ :
    begin
      simp only [Union_subset_iff, compl_subset_compl],
      intros u hu,
      mono* using [w],
      exact Inter_subset_of_subset u (Inter_subset_of_subset hu subset.rfl),
    end,
  have hw₄ : kᶜ ⊆ (closure (image2 ϕ w s))ᶜ, begin
    rw compl_subset_compl,
    calc closure (image2 ϕ w s)
        ⊆ _ : closure_mono (image2_subset (inter_subset_right _ _) subset.rfl)
  end,
  have hnc : nᶜ ⊆ (k \ n) ∪ kᶜ, by rw [union_comm, ←inter_subset, diff_eq, inter_comm],
  have hw : closure (image2 ϕ w s) ⊆ n, from
    compl_subset_compl.mp (subset.trans hnc (union_subset hw₃ hw₄)),
  exact ⟨_, hw₂, hw⟩
end

/-- A set is eventually carried into any open neighbourhood of its ω-limit:
if `c` is a compact set such that `closure {ϕ t x | t ∈ v, x ∈ s} ⊆ c` for some `v ∈ f`
and `n` is an open neighbourhood of `ω f ϕ s`, then for some `u ∈ f` we have
`closure {ϕ t x | t ∈ u, x ∈ s} ⊆ n`. -/
lemma eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset
  [t2_space β] {c : set β} (hc₁ : is_compact c) (hc₂ : ∀ᶠ t in f, maps_to (ϕ t) s c)
  {n : set β} (hn₁ : is_open n) (hn₂ : ω f ϕ s ⊆ n) :
  ∃ u ∈ f, closure (image2 ϕ u s) ⊆ n :=
eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset'
  f ϕ _ hc₁ ⟨_, hc₂, closure_minimal (image2_subset_iff.2 (λ t, id)) hc₁.is_closed⟩ hn₁ hn₂

lemma eventually_maps_to_of_is_compact_absorbing_of_is_open_of_omega_limit_subset
  [t2_space β] {c : set β} (hc₁ : is_compact c) (hc₂ : ∀ᶠ t in f, maps_to (ϕ t) s c)
  {n : set β} (hn₁ : is_open n) (hn₂ : ω f ϕ s ⊆ n) :
  ∀ᶠ t in f, maps_to (ϕ t) s n :=
begin
  rcases eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset
    f ϕ s hc₁ hc₂ hn₁ hn₂ with ⟨u, hu_mem, hu⟩,
  refine mem_sets_of_superset hu_mem (λ t ht x hx, _),
  exact hu (subset_closure $ mem_image2_of_mem ht hx)
end

lemma eventually_closure_subset_of_is_open_of_omega_limit_subset [compact_space β]
  {v : set β} (hv₁ : is_open v) (hv₂ : ω f ϕ s ⊆ v) :
  ∃ u ∈ f, closure (image2 ϕ u s) ⊆ v :=
eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset'
  _ _ _ compact_univ ⟨univ, univ_mem_sets, subset_univ _⟩ hv₁ hv₂

lemma eventually_maps_to_of_is_open_of_omega_limit_subset [compact_space β]
  {v : set β} (hv₁ : is_open v) (hv₂ : ω f ϕ s ⊆ v) :
  ∀ᶠ t in f, maps_to (ϕ t) s v :=
begin
  rcases eventually_closure_subset_of_is_open_of_omega_limit_subset f ϕ s hv₁ hv₂
    with ⟨u, hu_mem, hu⟩,
  refine mem_sets_of_superset hu_mem (λ t ht x hx, _),
  exact hu (subset_closure $ mem_image2_of_mem ht hx)
end

/-- The ω-limit of a nonempty set w.r.t. a nontrivial filter is nonempty. -/
lemma nonempty_omega_limit_of_is_compact_absorbing [ne_bot f] {c : set β} (hc₁ : is_compact c)
  (hc₂ : ∃ v ∈ f, closure (image2 ϕ v s) ⊆ c) (hs : s.nonempty) :
  (ω f ϕ s).nonempty :=
begin
  rcases hc₂ with ⟨v, hv₁, hv₂⟩,
  rw omega_limit_eq_Inter_inter _ _ _ hv₁,
  apply is_compact.nonempty_Inter_of_directed_nonempty_compact_closed,
  { rintro ⟨u₁, hu₁⟩ ⟨u₂, hu₂⟩,
    use ⟨u₁ ∩ u₂, inter_mem_sets hu₁ hu₂⟩, split,
   all_goals { exact closure_mono (image2_subset
        (inter_subset_inter_left _ (by simp)) subset.rfl) }},
  { intro u,
    have hn : (image2 ϕ (u ∩ v) s).nonempty, from
      nonempty.image2 (nonempty_of_mem_sets (inter_mem_sets u.prop hv₁)) hs,
    exact hn.mono subset_closure },
  { intro _,
    apply compact_of_is_closed_subset hc₁ is_closed_closure,
    calc _ ⊆ closure (image2 ϕ v s) : closure_mono (image2_subset
                                        (inter_subset_right _ _) subset.rfl)
    ...    ⊆ c : hv₂ },
  { exact λ _, is_closed_closure },
end

lemma nonempty_omega_limit [compact_space β] [ne_bot f] (hs : s.nonempty) :
  (ω f ϕ s).nonempty :=
nonempty_omega_limit_of_is_compact_absorbing _ _ _
  compact_univ ⟨univ, univ_mem_sets, subset_univ _⟩ hs

end omega_limit

/-!
### ω-limits of Flows by a Monoid
-/

namespace flow

variables
{τ : Type*} [topological_space τ] [add_monoid τ] [has_continuous_add τ]
{α : Type*} [topological_space α]
(f : filter τ) (ϕ : flow τ α) (s : set α)

open_locale omega_limit

lemma is_invariant_omega_limit (hf : ∀ t, tendsto ((+) t) f f) :
  is_invariant ϕ (ω f ϕ s) :=
λ t, maps_to.mono (subset.refl _) (omega_limit_subset_of_tendsto ϕ s (hf t)) $
  maps_to_omega_limit _ (maps_to_id _) (λ t' x, (ϕ.map_add _ _ _).symm)
    (continuous_const.flow ϕ continuous_id)

lemma omega_limit_image_subset (t : τ) (ht : tendsto (+ t) f f) :
  ω f ϕ (ϕ t '' s) ⊆ ω f ϕ s :=
begin
  simp only [omega_limit_image_eq, ← map_add],
  exact omega_limit_subset_of_tendsto ϕ s ht
end

end flow

/-!
### ω-limits of Flows by a Group
-/

namespace flow

variables
{τ : Type*} [topological_space τ] [add_comm_group τ] [topological_add_group τ]
{α : Type*} [topological_space α]
(f : filter τ) (ϕ : flow τ α) (s : set α)

open_locale omega_limit

/-- the ω-limit of a forward image of `s` is the same as the ω-limit of `s`. -/
@[simp] lemma omega_limit_image_eq (hf : ∀ t, tendsto (+ t) f f) (t : τ) :
  ω f ϕ (ϕ t '' s) = ω f ϕ s :=
subset.antisymm (omega_limit_image_subset _ _ _ _ (hf t)) $
calc ω f ϕ s = ω f ϕ (ϕ (-t) '' (ϕ t '' s)) : by simp [image_image, ← map_add]
... ⊆ ω f ϕ (ϕ t '' s) : omega_limit_image_subset _ _ _ _ (hf _)

lemma omega_limit_omega_limit (hf : ∀ t, tendsto ((+) t) f f) :
  ω f ϕ (ω f ϕ s) ⊆ ω f ϕ s :=
begin
  simp only [subset_def, mem_omega_limit_iff_frequently₂, frequently_iff],
  intros _ h,
  rintro n hn u hu,
  rcases mem_nhds_sets_iff.mp hn with ⟨o, ho₁, ho₂, ho₃⟩,
  rcases h o (mem_nhds_sets ho₂ ho₃) hu with ⟨t, ht₁, ht₂⟩,
  have l₁ : (ω f ϕ s ∩ o).nonempty, from
    ht₂.mono (inter_subset_inter_left _
      ((is_invariant_iff_image _ _).mp (is_invariant_omega_limit _ _ _ hf) _)),
  have l₂ : ((closure (image2 ϕ u s)) ∩ o).nonempty :=
    l₁.mono (λ b hb, ⟨omega_limit_subset_closure_fw_image _ _ _ hu hb.1, hb.2⟩),
  have l₃ : (o ∩ image2 ϕ u s).nonempty,
  begin
    rcases l₂ with ⟨b, hb₁, hb₂⟩,
    exact mem_closure_iff_nhds.mp hb₁ o (mem_nhds_sets ho₂ hb₂)
  end,
  rcases l₃ with ⟨ϕra, ho, ⟨_, _, hr, ha, hϕra⟩⟩,
  exact ⟨_, hr, ϕra, ⟨_, ha, hϕra⟩, ho₁ ho⟩,
end

end flow


theorem exo (a b c: nat):
  a > 0 -> b > 0 -> c > 0
  -> a^2 + b^2 = c^2
  -> ((c/a + c/b)^2 > 8) /\ (forall n, (c/a + c/b)^2 = n -> false)


import tactic
import structures2
import utils
import data.real.basic
import compute

/- dEAduction
Title
    Ensembles et applications
Institution
    Université du monde
AvailableProof
    proof_methods new_object apply
AvailableMagic
    assumption
AvailableExercises
  UNTIL_NOW -image_directe_et_inclusion_II -image_reciproque_et_inclusion_II -image_directe_et_intersection_II
-/

local attribute [instance] classical.prop_decidable
---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course

------------------
-- COURSE TITLE --
------------------
namespace maths_approfondies
/- dEAduction
PrettyName
    1M003 : mathématiques approfondies
-/

def limite (u:ℕ → ℝ ) (l: ℝ) :=
∀ ε > 0, ∃ N >0, ∀ n ≥ N, |u n - l| < ε

lemma definition.limite {u: ℕ → ℝ} (l: ℝ):
limite u l ↔  ∀ ε > 0, ∃ n_0 >0, ∀ n ≥ n_0, |u n - l| < ε
:=
/- dEAduction
ImplicitUse
    True
DummyVarsNames
    FromLean
-/
begin
    refl,
end

lemma exercise.essai_suites1 :
limite (λ n, 1/(n+1)) 0 :=
begin
    -- rw limite,
    sorry
end

end maths_approfondies

end course


import Mathlib.Tactic.Basic
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Int.Basic
/-!
## Forward Reasoning about Connectives and Quantifiers

Reasoning about the logical connectives and quantifiers in a forward fashion uses
the same introduction and elimination rules as in [tactic mode](../BackwardProofs/ConnectivesAndQuantifiers.lean.md).
A few examples will show the flavor. Let us start with conjunction:
-/
lemma and_swap (a b : Prop) :
  a ∧ b → b ∧ a :=
λ hab : a ∧ b =>
  have ha : a := And.left hab
  have hb : b := And.right hab
  show b ∧ a from And.intro hb ha
/-!
Even readers who do not know what `And.left` etc. means can understand that we extract `a` and `b` from
`a ∧ b` and put them back together as `b ∧ a`. Mathematicians would probably have an easier time making
sense of this proof than of its tactical counterpart:

-/
lemma and_swap₂ (a b : Prop) :
  a ∧ b → b ∧ a := by
  intro hab
  apply And.intro
  apply And.right
  exact hab
  apply And.left
  exact hab

/-!
On the other hand, the tactical proof is easier to derive mindlessly.

In general, backward proofs are easier to find, and most of the automation provided by proof
assistants works backwards. The reason is simple: Pretend that you are Miss Marple or Hercule Poirot
on a murder investigation. A backward investigation would start from the crime scene and try to
extract clues that potentially connect a handful of suspects to the crime. In contrast, a forward
investigation might start by questioning as many as seven billion people to determine whether they
have an alibi. Which approach is more likely to succeed?

Our next examples concern _one-point rules_. These are lemmas that can be used to eliminate a
quantifier when the bound variable can effectively take only one value. For example, the proposition
`∀ n, n = 666 → beast ≥ n` can be simplified to `beast ≥ 666`. The following lemma justifies this
simplification:

-/
lemma forall.one_point {α : Type} (t : α) (p : α → Prop) :
  (∀x, x = t → p x) ↔ p t :=
Iff.intro (
  λ (hall : ∀ (x : α), x = t → p x) =>
    show p t by
      apply hall t
      rfl
) (
  λ (hp : p t) (x : α) =>
    show x = t → p x by
      intro heq
      rw [heq]
      exact hp
)

/-!
The proof may look intimidating, but it was not hard to develop. The key was to
proceed one step at a time. At first, we observed that the goal is an equivalence,
so we wrote
```
Iff.intro (_) (_)
```
The two placeholders are important to make this proof well formed. We already
put parentheses because we strongly suspect that these will be nontrivial proofs.
Because proofs are basically terms, which are basically programs, the advice we
gave in Section 1.1.4 applies here as well:

> The key idea is that the [proof] should be syntactically correct at all times. The only red
underlining we should see in Visual Studio Code should appear under the placeholders. In general, a
good principle for software development is to start with a program that compiles, perform the smallest
change possible to obtain a new compiling program, and repeat until the program is complete.

Hovering over the first placeholder makes the corresponding subgoal appear. We
can see that Lean expects a proof of `⊢ (∀ (x : α), x = t → p x) → p t`, so we provide
a suitable skeleton. Remember that an implication is the same as a function, so
a structured proof of an implication consists of a lambda that introduces the
assumption followed by a show:
```lean
Iff.intro
  (λ hall : ∀ (x : α), x = t → p x =>
  show p t by
  _)
  (_)
```
What we need to show now is the simpler term `p t` which can by done using the `apply` tactic
using the `hall` hypothesis. The result of this is the goal `t = t` which can be easily
solved using `rfl` or `exact` in this case would also work.

The second part of the `Iff.intro` has to prove the inverse implication, namely,
that `p t → ∀ (x : α), x = t → p x`.  For this proof we need to fix the variable `x`
in that ∀ quantificaiton. We can do that simply by adding it as a parameter in our lambda
function, so we can create the hypothesis `hp` and fix the value of `x` with `λ (hp : p t) (x : α)`.
This leaves us with having to prove the subgoal `x = t → p x`.  Using `intro heq` takes off
the first part of this implication `x = t` and makes it a hypothesis, which leaves us with
the goal `p x`.  The `rw` tactic can use the fact that `x = t` to rewrite this goal as `p t`
and the `exact` tactic can match this exactly with the hypothesis `hp`.

Notice that each of placeholders we started with can be filled in with a structured proof or by a
tactical proof. To fill these placeholders, interpreted each implication as the function arrow
using a λ to introduce the hypothesis and variables that are bound by a quantifier.

Let us check that the rule actually works on our motivating example:
-/
lemma beast_666 (beast : ℕ) :
  (∀ n : ℕ, n = 666 → beast ≥ n) ↔ beast ≥ 666 :=
  forall.one_point _ _
/-!
It works (we know because there are no red squiggles!). Matching `forall.one_point t p` against the
statement of `beast_666` yields the instantiation `t := 666` and `p := (λ m => beast = m)`. Indeed, if we
substitute these values in `forall.one_point` and β-reduce, we get the statement of `beast_666`.

Finally, the one-point rule for ∃ demonstrates how to use the introduction and
elimination rules for ∃ in a structured proof:
-/
lemma exists.one_point {α : Type} (t : α) (p : α → Prop) :
  (∃x : α, x = t ∧ p x) ↔ p t :=
Iff.intro
  (λ hex : ∃x, x = t ∧ p x =>
    Exists.elim hex
    (λ (x : α) (hand : x = t ∧ p x) =>
      show p t by
      cc))
  (λ hp : p t =>
    show ∃ x : α, x = t ∧ p x from
    Exists.intro t
    (show t = t ∧ p t by
      cc))

-- BUGBUG: cc is missing.
/-!
Notice how we use `Exists.elim hex` to obtain an `x` such that `x = t ∧ p x`. This
admittedly is a bit cumbersome
-/


/-
# Example: Graph Search

This example looks at searching for paths through a graph.
-/
import LeanSpec.lib.Util

/-
## Non-Empty Lists

Before we get on to graphs, sometimes it is useful to know when working with lists
that a list is guaranteed to be non-empty. A possible model of such lists is:
-/
structure List₁ (α : Type) where
  list : List α
  inv  : list ≠ []

/-
An element of `List₁` is a structure containing a core Lean list (which may be empty),
and a proof the list is non-empty.

This example shows how Lean `structure`s are more powerful than records of traditional languages.
The second element `inv : list ≠ []` is not data, but rather a constraint on the first element.
The empty list is not a member of the type because we can never prove `[] ≠ []`.

If a type is an instance of the `HasSubset` class, we can use `⊆` notation.
-/
instance : HasSubset (List₁ α) where
  Subset l₁ l₂ := l₁.list ⊆ l₂.list

/-
The definition simply delegates to the underlying `List`, which is already an instance of `HasSubset`.

Since the list is guaranteed non-empty, functions that extract the first and last element are
total.
-/
def first : List₁ α → α
  | ⟨a::_, _⟩ => a

def last : List₁ α → α
  | ⟨[a], _⟩      => a
  | ⟨_::a::as, _⟩ => last ⟨a::as, by simp⟩

/-
## Graphs

All we need for a node in the graph is to be able to distinguish it from other nodes,
so `String` is adequate for our needs.
-/
abbrev Node := String

example : Node := "N1"

/-
An edge has a start and an end node, hence is directed, and a cost to traverse from
the start to the end.
-/
structure Edge where
  starts : Node
  ends   : Node
  cost   : Nat

example : Edge := {
  starts := "N1"
  ends   := "N2"
  cost   := 4
}

/-
A graph is simply a non-empty list of edges. We don't consider empty graphs here.
-/
abbrev Graph := List₁ Edge

def exampleGraph : Graph := ⟨[⟨"N1","N2",4⟩, ⟨"N1","N3",7⟩, ⟨"N2","N3",2⟩], by simp⟩

/-
With the above definitions we can define a path over a graph.
-/
structure Path (g : Graph) where
  path : List₁ Edge
  inv  : path ⊆ g ∧ path.list.Chain' (·.ends = ·.starts)

/-
`Path` is dependent on `Graph`, so given `g : Graph`, `Path g` is the type of paths
over the graph `g`. The elements are:
- `path` is the ordered list of edges that constitute the path;
- `inv.left` states every edge in the path is also in the graph; and
- `inv.right` states that given two consecutive edges, the end node of the first is the start node
of the second. (Refer to propostion `List.Chain'` defined in [std4](https://github.com/leanprover/std4).)

Notes:
- Fields named `inv` specify invariants. That is, they
specify the constraints any instance of the type must satisfy. The `inv` fields
themselves contain no data or computational content, they serve to restrict the
values allowed in the other fields.
- In subsequent definitions, the convention adopted is that fields named `inv`
always capture constraints on the type.
- Where there are multiple constraints, there is a single `inv` field that is the conjunction
of the constraints.

Let's define a couple of convenience functions to identify the nodes at the start and end
of a path.
-/
def pathStart (p : Path g) : Node :=
  (first p.path).starts

def pathEnd (p : Path g) : Node :=
  (last p.path).ends

/-
An example of a path, with respect to graph `exampleGraph` defined earlier, is:
-/
example : Path exampleGraph := {
  path := ⟨[⟨"N1","N2",4⟩, ⟨"N2","N3",4⟩], by simp⟩,
  inv  := sorry
}

/-
As noted in [Introduction](../Introduction.md), a program derived directly from a specification
contains the non-computational content that is evidence of the correctness of the program, but which
is of no interest when the program is run. In the case of data definitions, the non-computational content
is the evidence the data satisfies the structure constraints (`by simp` and `sorry` above).
If we are only interested in the data, the non-computational content starts to become intrusive,
especially when we have many, nested subtypes. However, that is only because we are
constructing example data, it has minimal impact on the specification itself.

## Graph Search

We can now specify a function that finds a path through a graph. A first attempt
might be:
-/
def FindPath₁ (g : Graph) (s e : Node) :=
  { p : Path g // pathStart p = s ∧ pathEnd p = e }

/-
Given a graph `g` and a pair of nodes `s` and `e`, find a path over `g` whose start is `s` and end is `e`.
Seems reasonable, but a program meeting this specification cannot be derived. The goal is to find a path
but there is no guarantee such a path exists. The are two possible reasons:

- the specification does not require `s` or `e` to be in the graph;
- even if `s` and `e` are in the graph, there is no guarantee a path between them exists.

What about:
-/
def FindPath₂ (g : Graph) (s e : Node) :=
  Option { p : Path g // pathStart p = s ∧ pathEnd p = e }

/-
This at least accommodates the failure cases described above, but it has a trivial implementation that
is not what is intended:
-/
def findPath (g : Graph) (s e : Node) :
  Option { p : Path g // pathStart p = s ∧ pathEnd p = e } := none

/-
If we always choose the `none` option the specification is satisfied.

Going back to the first attempt, `FindPath₁`, let's give it a more meaningful name since it doesn't
guarantee a solution exists:
-/
def IsPath (g : Graph) (s e : Node) := { p : Path g // pathStart p = s ∧ pathEnd p = e }

/-
In the case a path exists we want to create an element of `IsPath g s e` (the type of paths from
`s` to `e` over `g`). If no path exists, we need to provide evidence for said fact. At the
propositional level this would be `¬ P`, which is definitionally equal to `P → False`, and when
working at the type level this becomes `T → Empty`. Consequently, we are led to the definition:
-/
def FindPath₃ (g : Graph) (s e : Node) :=
  IsPath g s e ⊕ (IsPath g s e → Empty)

/-
`⊕` is the disjoint/discriminated union type, also called `Sum`.

`FindPath₃` returns a disjoint sum. If a path exists it is returned as the left injection.
If no path exists, evidence is returned as the right injection.

## Shortest Path

The cost of a path is the sum of the cost of the edges in the path.
-/
def pathCost (p : Path g) : Nat :=
  (p.path.list.map (·.cost)).add 0

/-
Finding the shortest path through a graph is an optimisation problem so we have
the same pattern as `Knapsack`:
-/
def ShortestPath (g : Graph) (s e : Node) (_ : IsPath g s e) :=
  { p : IsPath g s e // ∀ q : IsPath g s e, pathCost p.val ≤ pathCost q.val }

/-
The solution is a path over `g` from `s` to `e` with the constraint that any other path
costs at least as much as the solution.

One difference here is the precondition `(_ : IsPath g s e)`. We have avoided the disjoint
sum in the specification of `ShortestPath` by requiring there is at least one path.

## Exercises

- Modify the specification of `ShortestPath` such that it does not assume the existence of a path.

- Specify the property that a graph has no edges with identical start and end nodes.

- Specify the property that a graph is acyclic.

- Define non-empty lists as a subtype instead of a structure, and modify the remainder of the
specification as necessary.
-/


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import data.fintype.card
import algebra.group.prod
import algebra.big_operators.basic
import algebra.ring.pi

/-!
# Big operators for Pi Types

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

This file contains theorems relevant to big operators in binary and arbitrary product
of monoids and groups
-/

open_locale big_operators

namespace pi

@[to_additive]
lemma list_prod_apply {α : Type*} {β : α → Type*} [Πa, monoid (β a)] (a : α) (l : list (Πa, β a)) :
  l.prod a = (l.map (λf:Πa, β a, f a)).prod :=
(eval_monoid_hom β a).map_list_prod _

@[to_additive]
lemma multiset_prod_apply {α : Type*} {β : α → Type*} [∀a, comm_monoid (β a)] (a : α)
  (s : multiset (Πa, β a)) : s.prod a = (s.map (λf:Πa, β a, f a)).prod :=
(eval_monoid_hom β a).map_multiset_prod _

end pi

@[simp, to_additive]
lemma finset.prod_apply {α : Type*} {β : α → Type*} {γ} [∀a, comm_monoid (β a)] (a : α)
  (s : finset γ) (g : γ → Πa, β a) : (∏ c in s, g c) a = ∏ c in s, g c a :=
(pi.eval_monoid_hom β a).map_prod _ _

/-- An 'unapplied' analogue of `finset.prod_apply`. -/
@[to_additive "An 'unapplied' analogue of `finset.sum_apply`."]
lemma finset.prod_fn {α : Type*} {β : α → Type*} {γ} [∀a, comm_monoid (β a)]
  (s : finset γ) (g : γ → Πa, β a) : (∏ c in s, g c) = (λ a, ∏ c in s, g c a) :=
funext (λ a, finset.prod_apply _ _ _)

@[simp, to_additive]
lemma fintype.prod_apply {α : Type*} {β : α → Type*} {γ : Type*} [fintype γ]
  [∀a, comm_monoid (β a)] (a : α) (g : γ → Πa, β a) : (∏ c, g c) a = ∏ c, g c a :=
finset.prod_apply a finset.univ g

@[to_additive prod_mk_sum]
lemma prod_mk_prod {α β γ : Type*} [comm_monoid α] [comm_monoid β] (s : finset γ)
  (f : γ → α) (g : γ → β) : (∏ x in s, f x, ∏ x in s, g x) = ∏ x in s, (f x, g x) :=
by haveI := classical.dec_eq γ; exact
finset.induction_on s rfl (by simp [prod.ext_iff] {contextual := tt})

section single
variables {I : Type*} [decidable_eq I] {Z : I → Type*}
variables [Π i, add_comm_monoid (Z i)]

-- As we only defined `single` into `add_monoid`, we only prove the `finset.sum` version here.
lemma finset.univ_sum_single [fintype I] (f : Π i, Z i) :
  ∑ i, pi.single i (f i) = f :=
by { ext a, simp }

lemma add_monoid_hom.functions_ext [finite I] (G : Type*) [add_comm_monoid G]
  (g h : (Π i, Z i) →+ G) (H : ∀ i x, g (pi.single i x) = h (pi.single i x)) : g = h :=
begin
  casesI nonempty_fintype I,
  ext k,
  rw [← finset.univ_sum_single k, g.map_sum, h.map_sum],
  simp only [H]
end

/-- This is used as the ext lemma instead of `add_monoid_hom.functions_ext` for reasons explained in
note [partially-applied ext lemmas]. -/
@[ext]
lemma add_monoid_hom.functions_ext' [finite I] (M : Type*) [add_comm_monoid M]
  (g h : (Π i, Z i) →+ M)
  (H : ∀ i, g.comp (add_monoid_hom.single Z i) = h.comp (add_monoid_hom.single Z i)) :
  g = h :=
have _ := λ i, add_monoid_hom.congr_fun (H i), -- elab without an expected type
g.functions_ext M h this

end single

section ring_hom
open pi
variables {I : Type*} [decidable_eq I] {f : I → Type*}
variables [Π i, non_assoc_semiring (f i)]

@[ext] lemma ring_hom.functions_ext [finite I] (G : Type*) [non_assoc_semiring G]
  (g h : (Π i, f i) →+* G) (H : ∀ (i : I) (x : f i), g (single i x) = h (single i x)) : g = h :=
ring_hom.coe_add_monoid_hom_injective $
  @add_monoid_hom.functions_ext I _ f _ _ G _ (g : (Π i, f i) →+ G) h H

end ring_hom

namespace prod

variables {α β γ : Type*} [comm_monoid α] [comm_monoid β] {s : finset γ} {f : γ → α × β}

@[to_additive]
lemma fst_prod : (∏ c in s, f c).1 = ∏ c in s, (f c).1 :=
(monoid_hom.fst α β).map_prod f s

@[to_additive]
lemma snd_prod  : (∏ c in s, f c).2 = ∏ c in s, (f c).2 :=
(monoid_hom.snd α β).map_prod f s

end prod