/- Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------

# Logic of Predicates
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

/- # New tactics unveiled in this lesson:

-/

/- # Goals of this lecture:
1. Parsing quantifiers and reading their scope correctly.
2. Identify startegies for proving a quantified sentence in mathematics based on its logical structure.
3. Do the above using interactive Lean tactics.
-/

import ..prooflab
import .lec6_proposition
import ..homework.hw5

-- TODO: write properties of affine points like being in the upper half plane, etc
--import .logic_prop -- importing is transitive, hence we have already imported proofs1 and proofs0.

set_option pp.beta true
set_option pp.generalized_field_notation false
-- set_option pp.all true

namespace PROOFS

/-! ## Predicates
__Predicates__ are varying propositions, that is they are propositions which depend on varibale(s) (parameters) from a domain of discourse on which are they are defined. Another name for predicate is __relation__. Depending on the context, we might choose one or the other.

Suppose we want to express the idea of listing propositions
“2 is even”,
“4 is even”,
“6 is even”, etc.

This way, this is an impossible task to do in finite time. We cannot write infinite sentences in finite time/memory. Note that the information specified above is incomplete, nevertheless we got the idea since we understood the pattern: the next sentence in the list will be
“8 is even”.

Frege showed us how to do this:
let `P` be the predicate with the domain `ℕ` of natural numbers and let `P(n)` be the proposition “n is even”.

In Lean, we model predicates by functions into the type `Prop` of propositions. A __unary__ predicate `P` on a domain `X`, therefore, is a function `P : X → Prop` . Here `X` is said to be the __domain of discourse__ of `P` or simply the __domain__ of `P`. Note that `P`, upon taking a variables `x : X`, outputs a proposition `P(x)`.
-/

universe u

variables {X Y Z : Type}

variables A B : X → Prop -- two predictes A and B on X
-- We can think of A and B as a family of proposition in the sense that for each `x : X`, we get a proposition `A x`

section
variables x y : X
#check A x -- this is a proposition
#check A x → B y -- this is a proposition
end

section
variable n : ℕ
#check is_even -- a unary predicate on natural number
#check is_even n -- for each natual number we get a proposition
#check is_odd
end
/-
As before, the `variable` command does not create anything new. When we use variable `A` later in the file (say as part of an example), Lean creates a temporary variable of the type `A : X → Prop` (for that example).
-/

#check set
/-
A __binary predicate__/__relation__ has the type `X → X → Prop`.
-/

variable C : X → X → Prop

/-
Here `C`, upon taking a variables `x` and `y`, outputs proposition `C x y`. Binary predicates/relations provide us with means to talk about relationships between two things:
Here's An example of a binary relation
-/
section love
variable person : Type
variable loves : person → person → Prop
variable Romeo : person
variable Julliet : person
#check loves Romeo Julliet
end love

-- non-equality is a binary predicate
@[reducible]
def neq {X : Type} (x y : X) := ¬ (x = y)
-- infix ` ≠ `:60 := neq

#check neq
#check @neq
#check neq 2 3
#check 2 ≠ 3 -- syntactically the same as `neq 2 3`

lemma two_not_three :
  2 ≠ 3 :=
begin
  linarith,
end

#check two_not_three

-- sometimes having a lemma stating the definition `neq` as an iff statement is helpful in using `neq` with tactic `rw`
@[simp]
lemma neq.def {X : Type} (x y : X) : x ≠ y = ¬ (x = y) :=
begin
  refl,
end

namespace neq

lemma intro {x y : X}(h : x = y → false) :
  x ≠ y :=
begin
  exact h,
end

lemma elim {x y : X} (h : x ≠ y) :
  x = y → false :=
begin
  exact h,
end

-- irreflexivity of equality
lemma irfl {x : X} (h : x ≠ x) :
  false :=
begin
  apply h,
  refl,
end

lemma irfl_alt {x : X} (h : x ≠ x) :
  false :=
begin
  contradiction,
end

-- symmetry of inequality
lemma symm {x y : X} (h : x ≠ y) :
  y ≠ x :=
begin
  intro h₁,
  apply h,
  rw h₁,
end

end neq

#check @neq
#check @eq

#check @neq.irfl
#check @neq.symm
#check @neq.elim
#check irfl -- this does not work because the content of the namespace are only visible by calling the name of that namespace and non-accessible otherwise.

/-! ## Quantifiers
__Quantifiers__ turn unary predicates into propositions by quantifying over their domain. -/

/-! ### Universal Quantifier
What makes first-order predicate logic powerful is that it allows us to make assertions using __quantifiers__. Consider the following statements:

  -  Every natural number is even or odd, but not both.
  -  If some natural number is even, then so is its square.

The words "every" and "some" are encoded into the logic with the symbols `∀` and `∃`, respectively and they come with their own inference rules. The symbol `∀` followed by a variable `x` encodes the phrase "for every x". In other words, it asserts that every value of `x` has the property that follows it. A complete formalization of the first sentence above is given by the formal sentence

  `∀ n : ℕ, even(n) ∨ odd(n) ∧ ¬ (even(n) ∧ odd(n))`.

Similarly, a complete formal sentence of the second sentence above is given by

  `∀ n : ℕ, is_even (n) → is_even (n^2)`.

  Once we know `n : ℕ` the followins are propositions
  - is_even (n)
  - is_even (n^2)
  - is_even (n) → is_even (n^2)
  - ∀ n : ℕ, is_even (n) → is_even (n^2)

-/

#check is_even -- a predicate on natural numbers

#check is_even 3 -- the proposition `∃ k : ℕ, 3 = 2 * k`
#check is_even 4 -- the proposition `∃ k : ℕ, 4 = 2 * k`

#check ∀ x : ℝ, 0 ≤ x → abs x = x --∀

section parsing
variable P : Prop

#check (∀ x, A x) → P
#check ∀ x, (A x → P)
#check ∀ x, A x → P
--The last two are synonymous.

#check ∀ x, A x → B x
#check (∀ x, A x) → B -- this is wrong because the implication is only between propositions, and `B` is a predicate.
#check (∀ x, A x) → B x

#check ∃ x, (A x → P)
#check ∃ x, A x → P
--The last two are synonymous.

#check ∃ z, A z → B z
#check (∃ z, A z) → B z

--General rule: anything after "∃ x" or "∀ x" can use "x", unless the scope of ∃ or ∀ is restricted by parentheses.
end parsing

/-
The __introduction__ and __elimination__ rules of `∀` are similar to those of `→`.

We start with the __introduction__ rule: Suppose `A : X → Prop` is a predicate. To prove the proposition `∀ x, A x`, we need to prove that for any given `x : X`, the proposition `A x` holds. This means we first fix an arbitrary element `x` of `X` and then show that `A x` holds.
In Lean, we use the tactic __intro__ in order to do this. Here's a general pattern of construcing a proof of `∀ x, A x` where `sorry` has to be replaced by a correct proof term depending on `A`.
-/
example : ∀ x, A x :=
begin
  intro x, -- we fix an arbitrary element `x` here.
  show A x, from sorry,
end

example :
  ∀ x : X, x = x :=
begin
  intro x, -- we fix an arbitrary element `x` here.
  refl,
end

/-
The __elimination rule__ of `∀` says that given a predicate `P : X → Prop`, if we know that `∀ x, P x` (i.e. `P` holds for every term of `X`) holds then for any particular `t : X` we have that `P t` holds. In Lean, if we have a proof `h : ∀ x, P x` and a term `t : X` then we simply apply `h` to the term `t` to get a proof `h t : P t`.
-/

section forall_elim
variable h : ∀ x, A x
variable t : X -- `X` is the domain of discourse of `A : X → Prop`
-- specialize `h` to `t`
example : A t :=
-- we simply apply `h` to `a`
show A t, from h t
end forall_elim

-- an example of two eliminations and one introduction of ∀
example :
  (∀ x, A x) → (∀ x, B x) → (∀ x, A x ∧ B x) :=
begin
  intro hA,
  intro hB,
  intro x, -- intro for ∀
  split,
  {
    exact hA x, -- elim for ∀
  },
  {
    exact hB x, --elim for ∀
  },
end

theorem forall_impl :
  (∀ x, A x → B x) → (∀ x, A x) → (∀ x, B x) :=
begin
  intro hAB,
  intro hA,
  intro x,
  have h₁ : A x, from hA x,
  have h₂ : A x → B x, from hAB x,
  exact h₂ h₁,
end

theorem forall_imp_alt :
  (∀ x, A x → B x) → (∀ x, A x) → (∀ x, B x) :=
begin
  intro hAB,
  intro hA,
  intro x,
  apply hAB,
  sorry,
end

@[reducible]
def le_pred {X : Type} (A B : X → Prop) := ∀ x, A x → B x
local notation ` ≤ ` : 30 := λ A B, le_pred A B

#check A ≤ B

-- under the assumption `A ≤ B`, we can prove that if `A` is true everywhere, then `B` is true everywhere.
example (h : A ≤ B) :
  (∀ x, A x) → (∀ x, B x) :=
begin
  sorry,
end

/-
A __binary relation__ on a type `X` is a two-variable predicate `R : X → X → Prop`, that is, a true-false statement `R x y` attached to each pair of elements of `X`.

In mathematics, we often use __infix notation__, writing
`a R b` instead of `R a b`, e.g. `a = b`, `a ≤  b`, etc. Equality an inequality are relations.
-/

-- let X be a type, and let R be a binary relation on R.
variable {R : X → X → Prop}

/-
If `R` is reflexive, symmetric and transitive, we say it is an
__equivalence relation__. We will use the standard notation `x ≈ y` for `R x y` when `R` is an equivalence relation.

* __reflexivity__:
`R x x`, for every `x` of `X`.

* __transitivity__:
If `R x y` and `R y z`, then `R x z`, for every `x y z` of `X`.

* __symmetry__:
If `R x y` then `R y x`, for every `x y` of `X`.

In Lean:
`reflexive R := ∀ (x : X), R x x`
`symmetric R := ∀ ⦃x y : X⦄, R x y → R y x`
`transitive R := ∀ ⦃x y z : X⦄, R x y → R y z → R x z`
`equivalence R := reflexive R ∧ symmetric R ∧ transitive R`
-/

#reduce reflexive R -- ∀ (x : X), R x x
#reduce symmetric R -- ∀ ⦃x y : X⦄, R x y → R y x
#reduce transitive R -- ∀ ⦃x y z : X⦄, R x y → R y z → R x z

lemma equivalnce.defn :
  equivalence R ↔ reflexive R ∧ symmetric R ∧ transitive R :=
begin
  refl,
end

namespace equivalence

lemma refl_ext_left {ρ : reflexive R} (x y : X) (H : ∀ a : X,  R a x → R a y) :
  R x y :=
begin
  sorry,
end

lemma refl_ext {ρ : reflexive R} (x y : X) (H : ∀ a: X,  R x a ↔ R y a) :
  R x y :=
begin
  sorry,
end

lemma refl_symm_ext_left {ρ : reflexive R} {σ : symmetric R} (x y : X) (H : ∀ a : X,  R x a → R y a) :
  R x y :=
begin
  sorry,
end

theorem eqv_rel_ext {eqv : equivalence R} (x y : X) (H : ∀ a: X,  R x a → R y a) : R x y :=
begin
obtain ⟨ρ, σ, τ⟩ := eqv,
  sorry,
end

theorem trans_ext {tr : transitive R} (x y : X) (H : ∃ a : X, R x a ∧ R a y) : R x y :=
begin
sorry,
end

end equivalence -- end of namespace

/-! ### Examples of Universal Quantifiers in Mathematics-/

/-
In the examples below, we use the introduction rule of `∀` to prove statements of the form `∀ x, P x`.
-/

example :
  ∀ x : ℝ, (0 ≤ x) → abs x = x :=
begin
  intro t, -- since we are introducing any arbitrary element of `ℝ` it does not matter whether we name it `x` or `t` or whatever.
  intro h, -- application intro
  sorry,
end

section
variables a b : ℝ
#check (lt_rev_of_neg : a < b → -b < -a) -- this was proved in hw5
end

lemma is_pos_abs :
  ∀ x : ℝ, 0 ≤ abs x :=
begin
  intro x,
  cases le_or_gt 0 x,
  {
    have h₁ : abs x = x, from abs_of_nonneg h,
    rw h₁,
    exact h,
  },
  {
    have h₁ : abs x = - x, from abs_of_neg h,
    have h₂, from lt_rev_of_neg h,
    rw neg_zero at h₂,
    rw h₁,
    apply le_of_lt,
    exact h₂,
  },
end

/-
In the example below, we use the proof `is_pos_abs : ∀ x : ℝ, 0 ≤ abs x` from the above lemma to prove a new result accoring to the elimination rule of the universal quantifier. In the second branch of the prove below,
we have `x: ℝ` with a proof `h: 0 > x` (which show `x` is negative) as our context. Therefore, we can apply `is_pos_abs` to that `x`.
-/
-- leave
example :
  ∀  x : ℝ, x ≤ abs x :=
begin
  intro x,
  cases le_or_gt 0 x,
  {
    apply le_of_eq,
    apply eq.symm,
    apply abs_of_nonneg,
    apply h,
  },
  {
    apply le_of_lt,
    apply lt_of_lt_of_le,
    apply h,
    exact is_pos_abs x,
  },
end

/-
A function f : A → B is __injective__ (also called __one-to-one__) whenever the following sentence holds.
  ` ∀ a, b : A,  f(a) = f(b) → a = b `
An injective function is said to be an __injection__.
-/

@[simp] def is_injective {X Y : Type u} (f : X → Y) :=
∀ ⦃x₁ x₂⦄, f x₁ = f x₂ → x₁ = x₂

-- what is @[simp]?
-- what is {}?
-- what is ⦃ ⦄?

lemma injection_respect_distinction {X Y : Type} {f : X → Y} (inj : is_injective f) :
  ∀ ⦃x₁ x₂⦄, (x₁ ≠ x₂)  → (f x₁ ≠ f x₂) :=
begin
  sorry,
end

-- proof by contrapositive
example {X Y : Type} {f : X → Y} (inj : is_injective f) :
  ∀ ⦃x₁ x₂⦄, (x₁ ≠ x₂)  → (f x₁ ≠ f x₂) :=
begin
  sorry,
end

-- Let's prove that the **identity function is injective**:
lemma injective_id : is_injective (id : X → X) :=
begin
   intros x₁ x₂, -- introduce variables for two inputs of x by the introduction rule of for all
  intro hid, -- introduce a proof of `id x₁ = id x₂` by the introduction rule of elimination
  exact hid, -- `id x₁` is definitionally identical to `x₁`, so `hid : id x₁ = id x₂` is identical to the goal `x₁ = x₂`
end

-- **Injections are closed under composition**, that is the composite of injective functions is injective. Here is a forward proof.
lemma injective_comp {X Y Z : Type} (f : X → Y) (g : Y → Z) (inj_f : is_injective f) (inj_g : is_injective g):
  is_injective (g ∘ f) :=
begin
  unfold is_injective,
  -- since we are proving a ∀ sentence we need to use `intros`
  intros x x' h,
  -- simplify the definition of composition in `h`
  dsimp at h,
  -- we deduce f x = f x' from g(f x) = g(f x') since g is injective.
  have h₂ : f x = f x', from inj_g h,
  -- we deduce x = x' from f x = f x' since f in injective.
  exact inj_f h₂,
end

#check injective_comp

-- Here is a backward proof using `apply` tactic.
example (f : X → Y) (g : Y → Z) (inj_f : is_injective f) (inj_g : is_injective g) :
  is_injective (g ∘ f) :=
begin
  unfold is_injective at *, -- `at *` tells to unfold everywhere
  intros a b he,
  apply inj_f,
  apply inj_g,
  exact he,
end

/-
Yet another proof: Lean's unifier figures out which variables you must mean.
-/
example (f : X → Y) (g : Y → Z) (inj_f : is_injective f) (inj_g : is_injective g) :
  is_injective (g ∘ f) :=
λ _ _, @@inj_f ∘ @@inj_g

/-
Let's prove that for every function `f : X → Y` and `g : Y → Z`, if the composition `g ∘ f : X → Z` is injective then `f` is injective.
-/

lemma inj_right_of_inj_comp (f : X → Y) (g : Y → Z) (h : is_injective (g ∘ f)) :
  is_injective f :=
begin
  intros x₁ x₂ h₁,
  have h₂ : (g ∘ f) x₁ = (g ∘ f) x₂, by
    {
      calc (g ∘ f) x₁   = (g ∘ f) x₂ : sorry,
    },
  sorry,
end

example :
  is_injective (swap_pair X Y) :=
begin
  sorry,
end

#check fst
#check snd
#check congr_arg

/-
Using the universal qunatifier `∀` we define the concepts of __upper bound__ and __lower bound__.
-/

def is_real_val_fun_ub {X : Type} (f : X → ℝ) (a : ℝ) :=
∀ x : X, f x ≤ a

def is_real_val_fun_lb {X : Type} (f : X → ℝ) (a : ℝ) :=
∀ x : X, a ≤ f x

variables f g : X → ℝ
variables a b : ℝ
#check is_real_val_fun_ub (f : X → ℝ) (a : ℝ)
-- we read `is_real_val_fun_ub (f : X → ℝ) (a : ℝ)` as " `a` is an upper bound for the real-valued function `f` ".
-- Similar `is_real_val_fun_lb {X : Type} (f : X → ℝ) (a : ℝ) ` is read as " `a` is a lower bound for the real-valued function `f` "

#check add_le_add

lemma lb_of_sum_of_sum_of_lb (h₁ : is_real_val_fun_lb f a) (h₂ : is_real_val_fun_lb g b) :
  is_real_val_fun_lb (λ x, f x + g x) (a + b) :=
begin
  sorry,
end

#check lb_of_sum_of_sum_of_lb
#check lb_of_sum_of_sum_of_lb f g a b

-- we could have ended the proof above more easily with `apply` rather than `exact`.
example (h₁ : is_real_val_fun_lb f a) (h₂ : is_real_val_fun_lb g b) :
  is_real_val_fun_lb (λ x, f x + g x) (a + b) :=
begin
  sorry,
end

/-
We read `nonneg_real_val_fun f` as "the real-valued function `f` has non-negative values."
-/
def nonneg_real_val_fun {X : Type} (f : X → ℝ) := is_real_val_fun_lb f 0

#check nonneg_real_val_fun
#check nonneg_real_val_fun f

-- what does the next lemma say?
lemma sum_nonneg_real_fun (nnf : nonneg_real_val_fun f) (nng : nonneg_real_val_fun g) :
  nonneg_real_val_fun (λ x, f x + g x) :=
begin
-- in order to prove a univerally quantified statement, we need
-- let `x` be an arbitrary element of `X`
 intro x,
-- to prove that `f x + g x` is nonnegative we need to prove that `f x` is nonnegative and `g x` is nonnegative
  apply add_nonneg,
-- `f x` is nonnegative because ...
  apply nnf,
-- `g x` is ...
-- therefore we are done
  sorry,
end

set_option trace.simp_lemmas true
--Alternatively, we could prove it using lemma `lb_of_sum_of_sum_of_lb`:
example (nnf : nonneg_real_val_fun f) (nng : nonneg_real_val_fun g) :
  nonneg_real_val_fun (λ x, f x + g x) :=
begin
  sorry,
end

-- what does the next lemma say?
lemma mul_nonneg_real_fun (nnf : nonneg_real_val_fun f) (nng : nonneg_real_val_fun g) :
  nonneg_real_val_fun (λ x, f x * g x) :=
begin
  sorry,
end

/-! ### Existential Quantifier

The __existential quantifier__ in logic encodes the phrase “there exists”. The formal expression `∃ x : ℕ, x ^ 2 = 9` says that there is a natural number whose square equals `9`.
-/

/- Some examples of unary predicates on `ℕ` built from `∃` -/

-- def is_even (n : ℕ) := ∃ k , n = 2 * k
-- def is_odd (n : ℕ ) := ∃ k , n = 2 * k + 1
def is_odd_alt (n : ℕ) := ¬ is_even n

/-
The canonical way to prove an existentially-quantified statement such as this one is to exhibit a natural number and show that it has the stated property. The number `3` has the required property, and the `refl` tactic can prove that it meets the stated property.

__How to prove an `∃`-statement__: In Lean, in order to prove a statement of the form `∃ x, P x`, we exhibit some `a` using the tactic `use a` and then prove `P a` by other means. Sometimes, this `a` can be an object from the local context or a more complicated expression built from the stuff of the context.

t : X   ht : P (t)
----------------- (intro rule for ∃)
∃ x, P(x)

-/

example :
  ∃ x : ℕ, x ^ 2 = 9 :=
begin
  use 3, -- we want to prove `∃ x : ℕ, x ^ 2 = 9`. So, we use the intro rule of `∃`. Our candidate is 3.
  refl,
end

example :
  ∃ x : ℚ, 2 < x ∧ x < 3 :=
begin
  use 7 / 3,
  norm_num, -- what does norm_num do?
end

-- term mode proof
example :
∃ x : ℚ , 2 < x ∧ x < 3 :=
⟨7 / 3, by norm_num⟩

example :
  is_even 10 :=
begin
  unfold is_even,
  use 5,
  refl,
end

example :
  ∃ n , is_even n :=
begin
  unfold is_even,
  use 4, -- picking `3` would be unwise, since `is_even 3` would be impossible to prove.
  use 2, -- This time we have no choice but to pick `2`.
  refl, -- refl is good enough for proving equalities in `ℕ`.
end

example {X Y : Type} (f : X → Y) (t : X):
  ∃ y : Y, ∃ x : X, f x = y :=
begin
  use f t, -- we ae trying to prove `∃ y : Y, ∃ x : X, f x = y`, and for this we use the intro rule of existential quantifier. Our candidate for the intro rule is `t`. We now have to prove the property `∃ x : X, f x = y`  about `y := f t`
  use t, -- we ae trying to prove `∃ (x : X), f x = f t` and for this we use the intro rule of existential quantifier. Our candidate for the intro rule is `t`.
  -- we need to prove f t = f t which is done by `refl`.
end

example :
∃ (f : X → Y) (g : Y → Z),  is_injective (g ∘ f) ∧  ¬ is_injective g :=
begin
  sorry,
end

/- we know how to prove an exists statement. But how do we use one?

               ---1
               P(t)
               ---
                .
                .
                .
               ---
∃ x, P(x)      R
---------------------- 1 , ∃-elim
          R

When __using__ a proof of a statement of the form `∃ x : X, P x`, we can assume having `t : X` such that `P t` is true. If from a general `t` and a proof of `P t` we can prove `R` then we can prove `R` from `∃ x, P x`.

The corresponding Lean tactic is `cases ... with ...`.
-/

#check (nat.succ_pos : ∀ (n : ℕ), 0 < nat.succ n)
#check (lt_irrefl)

example (x : ℕ) :
  (∃ y : ℕ, y + 1 = x) → (x ≠ 0) :=
begin
  sorry,
end

--Challenge: without linarith
example (x : ℕ) :
  (∃ y : ℕ, y + 1 = x) → (x ≠ 0) :=
begin
  intro h, -- intro rule for →
  cases h with y hy, -- the first use of `cases` for the elim rule of ∃
  intro hx,
  have hy₁, from (nat.succ_pos y),
  change 0 < y + 1 at hy₁,
  rw hy at hy₁,
  rw hx at hy₁,
  apply lt_irrefl 0,
  exact hy₁,
end

example :
  ¬ ∀ n , is_odd n :=
begin
  unfold is_odd,
  intro h,
  have h₁ : ∃ (k : ℕ), 0 = 2 * k + 1, from h 0,
  -- we need to use/eliminate `h₁`
  cases h₁ with n h₂,
  have h₃ : 0 < 2 * n + 1, from nat.succ_pos (2 * n),
  rw h₂ at h₃,
  apply lt_irrefl (2 * n + 1), -- `apply lt_irrefl` fails with the error ``invalid apply tactic, failed to synthesize type class instance for preorder ?m_1``
  exact h₃,
  -- alternatively, finish it off by `linarith` after `h₂` without any `rw` or `apply`.
end

/-
An example of binary predicates on `ℕ` built from `∃`
`divides m n` states that the natural number `m` divides natural number `n`. For instance
-/

@[simp]
def divides (m n : ℕ) := ∃ k : ℕ, n = m * k
#check divides

/-
Be careful: the divisibility symbol is not the ordinary bar on your keyboard. Rather, it is a unicode character obtained by typing `\|` in VS Code.
-/

-- by defn
example :
  ∀ n : ℕ, divides 2 n ↔ is_even n :=
begin
  intro n, -- we want to prove the ∀ statement `∀ n : ℕ, divides 2 n ↔ is_even n`
  split,
  {
    simp at *,
    intro k,
    intro h,
    unfold is_even,
    use k,
    exact h,
  },
  {
    sorry,
  },
end

lemma self_divide_self_sqr (x : ℕ)
  : divides x (x^2) :=
begin
 use x,
 -- refl,
 exact pow_two x,
end

lemma divides_trans (x y z : ℕ) (h₀ : divides x y) (h₁ : divides y z) :
  divides x z :=
begin
  unfold divides at *,
  cases h₀ with k₀ hk₀,
  cases h₁ with k₁ hk₁,
  use k₀ * k₁,
  rw [← mul_assoc, ← hk₀, hk₁],
end

example (a b : ℕ) :
  divides  (a + b) ((a + b)^2) :=
begin
  apply self_divide_self_sqr,
end

/-
__Combining ∀ and ∃__ to define prime numbers, surjective functions, etc:
-/

/-
 `prime n` means that `n` is a prime number, that is, a natural number at least 2 whose only divisors are `p` and `1`.
-/

def is_prime (p : ℕ) := (2 ≤ p) ∧ ∀ m : ℕ, divides m p → m = 1 ∨ m = p
#check is_prime

def is_prime_alt₁ (p : ℕ) := 2 ≤ p ∧ ∀ m < p, divides m p → m = 1

def is_prime_alt₂ {p : ℕ} := 2 ≤ p ∧ ∀ m, 2 ≤ m → m < p → ¬ divides m p

#check ne_of_lt

lemma is_prime_ne_one :
  ∀ p : ℕ,  is_prime p → p ≠ 1
  :=
begin
intro p,
intro hp,
cases hp,
intro h₁, -- alternatively with `linarith`
rw h₁ at hp_left,
cases lt_or_eq_of_le hp_left with ludicrous nonsense,
{
  have silly, from lt_trans (one_lt_two) ludicrous,
  apply lt_irrefl 1,
  exact silly,
},
{
  apply nat.add_self_ne_one 1,
  change 1 + 1 = 1 at nonsense, --rw does not work, see the lesson arithmetic with tactics.
  exact nonsense,
},
end

lemma nat_zero_or_atleast_one (k : ℕ) :
  (k = 0) ∨ (1 ≤ k) :=
begin
  exact eq_zero_or_pos, -- i found this with suggest, but library-search did not work!
end

lemma dvd_less (a b : ℕ) (h : divides a b) :
 (b ≠ 0) → a ≤ b :=
begin
  sorry,
end

#check (nat.dvd_prime _).mp
lemma seven_is_prime :
  is_prime 7 :=
begin
  split,
  linarith,
  intro n,
  intro hn,
  sorry,
end

-- but to show that `∀p prime₁ p  ↔ prime₂ p ` we need to know the rules of inference for quantifiers.

example :
  ∀ n : ℕ, is_prime n ↔ is_prime_alt₁ n :=
begin
  intro p,
  split,
    {
      intro h,
      unfold is_prime_alt₁,
      unfold is_prime at h,
      split,
        cases h,
        exact h_left,
        intro m,
        intro hm,
        intro hmp,
        cases h,
        have h', from h_right m hmp,
        cases h',
          exact h',
          exfalso,
          linarith,
    },
    {
      intro h,
      sorry,
    },
end

def is_surjective {X Y : Type} (f : X → Y) :=
∀ y : Y, ∃ x : X, f x = y

-- Surjections are closed under composition.
lemma surj_comp (f : X → Y) (g : Y → Z) (surj_f : is_surjective f) (surj_g : is_surjective g): is_surjective (g ∘ f) :=
begin
  intro z,
  have h₁, from surj_g z,
  cases h₁ with y h₂,
  have h₃, from surj_f y,
  cases h₃ with x h₄,
  have h₅: g y = g (f (x)), by rw h₄,
  have h₆ : z = g (f (x)), by rw [←h₂, h₅],
  existsi x,
  rw h₆,
end

-- The proof above can be made more compact: we can combine two of the `have` and `cases` into one cases hg a with b hb ...
-- also, much better rewrites.

lemma surj_comp_alt (f : X → Y) (g : Y → Z)  (surj_f : is_surjective f) (surj_g : is_surjective g) : is_surjective (g ∘ f) :=
begin
  unfold is_surjective at *, -- We want to prove that `∀ (y : Z), ∃ (x : X), (g ∘ f) x = y`
  intro z, -- We use the introduction rule of ∀ to fix `z : Z` and try to prove  `∃ (x : X), (g ∘ f) x = y`
  have h₁, from surj_g z, -- by the elimination rule of ∀ we get a proof of `∃ (x : Y), g x = z` by applying `surj_g` to `z`.
  cases h₁ with y hy, -- we use the elim rule of ∃ to get a term `y : Y` with the property `g y = z`
  have h₂, from surj_f y, -- by the elimination rule of ∀ we get a proof of `∃ (x : X), f x = z` by applying `surj_f` to `y`.
  cases h₂ with x hx, -- we use the elim rule of ∃ to get a term `x : X` with the property `f x = y`
  rw ← hx at hy, -- we use the elim rule of ∃
  use x, -- we are trying to prove an ∃ statement
  exact hy,
end

-- We can shorten the proof above by omiting `have` statements.
example  (f : X → Y) (g : Y → Z)  (surj_f : is_surjective f) (surj_g : is_surjective g) : is_surjective (g ∘ f) :=
begin
  unfold is_surjective at *, -- We want to prove that `∀ (y : Z), ∃ (x : X), (g ∘ f) x = y`
  intro z, -- We use the introduction rule of ∀ to fix `z : Z` and try to prove  `∃ (x : X), (g ∘ f) x = y`
  cases surj_g z with y hy,
  cases surj_f y with x hx,
  rw ← hx at hy,
  use x, -- we are trying to prove an ∃ statement
  exact hy,
end

def has_real_val_fun_ub {X : Type} (f : X → ℝ) :=
∃ a : ℝ, is_real_val_fun_ub f a

def has_real_val_fun_lb {X : Type} (f : X → ℝ) :=
∃ a : ℝ, is_real_val_fun_lb f a

#check has_real_val_fun_ub

def up_boundless {X : Type} (f : X → ℝ) :=
¬ has_real_val_fun_ub f

-- The following example says that the identity function is __boundless__:

example : up_boundless (λ x : ℝ, x) :=
begin
  sorry,
end

-- Challenge
def down_boundless {X : Type} (f : X → ℝ) := ¬ has_real_val_fun_lb f

example :
down_boundless (λ x : ℝ, x) :=
begin
  sorry,
end

end PROOFS


/- LoVe Exercise 6: Monads -/

import .love06_monads_demo

namespace LoVe

/- Question 1: A State Monad with Failure -/

open LoVe.lawful_monad

/- We introduce a richer notion of lawful monad that provides an `orelse`
operator `<|>` satisfying some laws, given below. `emp` denotes failure.
`x <|> y` tries `x` first, falling back on `y` on failure. -/

class lawful_monad_with_orelse (m : Type → Type)
  extends lawful_monad m, has_orelse m :=
(emp {} {α} : m α)
(emp_orelse {α} (a : m α) :
  (emp <|> a) = a)
(orelse_emp {α} (a : m α) :
  (a <|> emp) = a)
(orelse_assoc {α} (a b c : m α) :
  ((a <|> b) <|> c) = (a <|> (b <|> c)))
(emp_bind {α β} (f : α → m β) :
  (emp >>= f) = emp)
(bind_emp {α β} (f : m α) :
  (f >>= (λa, emp : α → m β)) = emp)

open LoVe.lawful_monad_with_orelse

/- We register the laws as simplification rules: -/

attribute [simp]
  LoVe.lawful_monad_with_orelse.emp_orelse
  LoVe.lawful_monad_with_orelse.orelse_emp
  LoVe.lawful_monad_with_orelse.orelse_assoc
  LoVe.lawful_monad_with_orelse.emp_bind
  LoVe.lawful_monad_with_orelse.bind_emp

/- 1.1. We set up the `option` type constructor to be a
`lawful_monad_with_orelse`. Complete the proofs. -/

namespace option

/- The following line declares some variables as default arguments to
definitions that refer to them. -/

variables {α β γ : Type}

def orelse {α} : option α → option α → option α
| none     b := b
| (some a) _ := some a

instance lawful_monad_with_orelse_option : lawful_monad_with_orelse option :=
{ emp          := λα, none,
  orelse       := @option.orelse,
  emp_orelse   :=
    begin
      intros α a,
      refl
    end,
  orelse_emp   :=
    begin
      intros α a,
      cases a,
      { refl },
      { refl }
    end,
  orelse_assoc :=
    begin
      intros α a b c,
      cases a,
      { refl },
      { refl }
    end,
  emp_bind     :=
    begin
      intros α β f,
      refl
    end,
  bind_emp     :=
    begin
      intros α β g,
      cases g,
      { refl },
      { refl }
    end,
  .. LoVe.option.lawful_monad_option }

@[simp] lemma some_bind (a : α) (g : α → option β) :
  (some a >>= g) = g a :=
by refl

end option

/- Let us enable some convenient pattern matching syntax, by instantiating
Lean's `monad_fail` type class. (Do not worry if you do not understand what
we are referring to.) -/

instance {m : Type → Type} [lawful_monad_with_orelse m] : monad_fail m :=
⟨λα msg, emp⟩

/- Now we can write definitions such as the following: -/

def first_of_three {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  [n, _, _] ← c,  -- look ma, this list has three elements!
  pure n

#eval first_of_three (some [1])
#eval first_of_three (some [1, 2, 3])
#eval first_of_three (some [1, 2, 3, 4])

/- Using `lawful_monad_with_orelse` and the `monad_fail` syntax, we can give a
consise definition for the `sum_2_5_7` function seen in the lecture. -/

def sum_2_5_7₇ {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  (_ :: n2 :: _ :: _ :: n5 :: _ :: n7 :: _) ← c,
  pure (n2 + n5 + n7)

/- 1.2. Now we are ready to define `fstate σ`: a monad with an internal state of
type `σ` that can fail (unlike `state σ`).

We start with defining `fstate σ α`, where `σ` is the type of the internal
state, and `α` is the type of the value stored in the monad. We use `option` to
model failure. This means we can also use the monadic behvior of `option` when
defining the monadic opertions on `fstate`.

**Hint:** Remember that `fstate σ α` is an alias for a function type, so you can
use pattern matching and `λs, …` to define values of type `fstate σ α`.

**Hint:** `fstate` is very similar to `state` in the lecture demonstration. You
can look there for inspiration. -/

def fstate (σ : Type) (α : Type) :=
σ → option (α × σ)

/- 1.3. Define the `get` and `set` function for `fstate`, where `get` returns
the state passed along the state monad and `set s` changes the state to `s`. -/

def get {σ : Type} : fstate σ σ
| s := some (s, s)

def set {σ : Type} (s : σ) : fstate σ unit
| _ := some ((), s)

namespace fstate

/- The following line declares some variables as default arguments to
definitions that refer to them. -/

variables {σ α β γ : Type}

/- 1.4. Define the monadic operator `pure` for `fstate`, in such a way that it
will satisfy the monadic laws. -/

protected def bind (f : fstate σ α) (g : α → fstate σ β) : fstate σ β
| s := f s >>= function.uncurry g

#check function.uncurry

/- We set up the `>>=` syntax on `fstate`: -/

instance : has_bind (fstate σ) := ⟨@fstate.bind σ⟩

@[simp] lemma bind_apply (f : fstate σ α) (g : α → fstate σ β) (s : σ) :
  (f >>= g) s = f s >>= function.uncurry g :=
by refl

protected def pure (a : α) : fstate σ α
| s := some (a, s)

/- We set up the syntax for `pure` on `fstate`: -/

instance : has_pure (fstate σ) := ⟨@fstate.pure σ⟩

@[simp] lemma pure_apply (a : α) (s : σ) :
  (pure a : fstate σ α) s = some (a, s) :=
by refl

/- 1.3. Register `fstate` as a monad.

**Hint:** `pure` and `bind` are introduced using `protected`, so their names are
`fstate.pure` and `fstate.bind`.

**Hint**: The `funext` lemma is useful when you need to prove equality between
two functions.

**Hint**: Sometimes one invocation of `cases` is not enough. In particular,
`uncurry f p` requires that `p` is a pair of the form `(a, b)`.

**Hint**: `cases f s` only works when `f s` appears in your goal, so you may
need to unfold some constants before you can do a `cases`. -/

instance : lawful_monad (fstate σ) :=
{ pure_bind  :=
    begin
      intros α β a f,
      apply funext,
      intro s,
      refl
    end,
  bind_pure  :=
    begin
      intros α ma,
      apply funext,
      intro s,
      simp,
      cases ma s,
      { refl },
      { cases val,
        refl }
    end,
  bind_assoc :=
    begin
      intros α β γ f g ma,
      apply funext,
      intro s,
      simp,
      cases ma s,
      refl,
      cases val,
      refl
    end,
  .. fstate.has_bind, .. fstate.has_pure }

end fstate

/-  Question 2: Kleisli Operator

The kleisly operator `>=>` (not to be confused with `>>=`) is useful for
pipelining monadic operations. -/

open monad

/- The following two lines declare some variables as default arguments to
definitions that refer to them. -/

variables {m : Type → Type} [lawful_monad m] {α β γ δ : Type}
variables {f : α → m β} {g : β → m γ} {h : γ → m δ}

def kleisli (f : α → m β) (g : β → m γ) : (α → m γ) :=
λa, f a >>= g

infixr ` >=> `:90 := kleisli

/- 2.1. Prove that `pure` is a left and right unit for the Kleisli operator. -/

lemma pure_kleisli :
  pure >=> f = f :=
begin
  apply funext,
  intro a,
  exact pure_bind a f
end

lemma kleisli_pure :
  f >=> pure = f :=
begin
  apply funext,
  intro a,
  exact bind_pure (f a)
end

/- 2.2. Prove associativity of the Kleisli operator. -/

lemma kleisli_assoc :
  (f >=> g) >=> h = f >=> (g >=> h) :=
begin
  apply funext,
  intro a,
  apply bind_assoc g h (f a)
end

end LoVe


import tactic

@[derive decidable_rel]
def near_to (x y : ℕ) : Prop := (x - y) < 5 ∧ (y - x) < 5

local infix `∼`:50 := near_to

example : 5 ∼ 7 := by { split; norm_num }

example : reflexive near_to :=
by { intro x, split; { rw nat.sub_self, dec_trivial } }

example : symmetric near_to := λ x y ⟨hl, hr⟩, ⟨hr, hl⟩

example : ¬(transitive near_to) :=
begin
  intros h,
  apply (show ¬(20 ∼ 28), from dec_trivial),
  apply h (show 20 ∼ 24, from dec_trivial) (show 24 ∼ 28, from dec_trivial),
end


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.specific_limits
import Mathlib.analysis.asymptotics
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# The group of units of a complete normed ring

This file contains the basic theory for the group of units (invertible elements) of a complete
normed ring (Banach algebras being a notable special case).

## Main results

The constructions `one_sub`, `add` and `unit_of_nearby` state, in varying forms, that perturbations
of a unit are units.  The latter two are not stated in their optimal form; more precise versions
would use the spectral radius.

The first main result is `is_open`:  the group of units of a complete normed ring is an open subset
of the ring.

The function `inverse` (defined in `algebra.ring`), for a ring `R`, sends `a : R` to `a⁻¹` if `a` is
a unit and 0 if not.  The other major results of this file (notably `inverse_add`,
`inverse_add_norm` and `inverse_add_norm_diff_nth_order`) cover the asymptotic properties of
`inverse (x + t)` as `t → 0`.

-/

namespace units

/-- In a complete normed ring, a perturbation of `1` by an element `t` of distance less than `1`
from `1` is a unit.  Here we construct its `units` structure.  -/
def one_sub {R : Type u_1} [normed_ring R] [complete_space R] (t : R) (h : norm t < 1) : units R :=
  mk (1 - t) (tsum fun (n : ℕ) => t ^ n) (mul_neg_geom_series t h) (geom_series_mul_neg t h)

@[simp] theorem one_sub_coe {R : Type u_1} [normed_ring R] [complete_space R] (t : R)
    (h : norm t < 1) : ↑(one_sub t h) = 1 - t :=
  rfl

/-- In a complete normed ring, a perturbation of a unit `x` by an element `t` of distance less than
`∥x⁻¹∥⁻¹` from `x` is a unit.  Here we construct its `units` structure. -/
def add {R : Type u_1} [normed_ring R] [complete_space R] (x : units R) (t : R)
    (h : norm t < (norm ↑(x⁻¹)⁻¹)) : units R :=
  x * one_sub (-(↑(x⁻¹) * t)) sorry

@[simp] theorem add_coe {R : Type u_1} [normed_ring R] [complete_space R] (x : units R) (t : R)
    (h : norm t < (norm ↑(x⁻¹)⁻¹)) : ↑(add x t h) = ↑x + t :=
  sorry

/-- In a complete normed ring, an element `y` of distance less than `∥x⁻¹∥⁻¹` from `x` is a unit.
Here we construct its `units` structure. -/
def unit_of_nearby {R : Type u_1} [normed_ring R] [complete_space R] (x : units R) (y : R)
    (h : norm (y - ↑x) < (norm ↑(x⁻¹)⁻¹)) : units R :=
  add x (y - ↑x) h

@[simp] theorem unit_of_nearby_coe {R : Type u_1} [normed_ring R] [complete_space R] (x : units R)
    (y : R) (h : norm (y - ↑x) < (norm ↑(x⁻¹)⁻¹)) : ↑(unit_of_nearby x y h) = y :=
  sorry

/-- The group of units of a complete normed ring is an open subset of the ring. -/
theorem is_open {R : Type u_1} [normed_ring R] [complete_space R] :
    is_open (set_of fun (x : R) => is_unit x) :=
  sorry

theorem nhds {R : Type u_1} [normed_ring R] [complete_space R] (x : units R) :
    (set_of fun (x : R) => is_unit x) ∈ nhds ↑x :=
  mem_nhds_sets is_open
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑x ∈ set_of fun (x : R) => is_unit x)) set.mem_set_of_eq))
      (is_unit_unit x))

end units

namespace normed_ring

theorem inverse_one_sub {R : Type u_1} [normed_ring R] [complete_space R] (t : R) (h : norm t < 1) :
    ring.inverse (1 - t) = ↑(units.one_sub t h⁻¹) :=
  sorry

/-- The formula `inverse (x + t) = inverse (1 + x⁻¹ * t) * x⁻¹` holds for `t` sufficiently small. -/
theorem inverse_add {R : Type u_1} [normed_ring R] [complete_space R] (x : units R) :
    filter.eventually
        (fun (t : R) => ring.inverse (↑x + t) = ring.inverse (1 + ↑(x⁻¹) * t) * ↑(x⁻¹)) (nhds 0) :=
  sorry

theorem inverse_one_sub_nth_order {R : Type u_1} [normed_ring R] [complete_space R] (n : ℕ) :
    filter.eventually
        (fun (t : R) =>
          ring.inverse (1 - t) =
            (finset.sum (finset.range n) fun (i : ℕ) => t ^ i) + t ^ n * ring


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.group_power.lemmas

/-!
# Powers of elements of groups with an adjoined zero element

In this file we define integer power functions for groups with an adjoined zero element.
This generalises the integer power function on a division ring.
-/

section zero
variables {M : Type*} [monoid_with_zero M]

@[simp] lemma zero_pow' : ∀ n : ℕ, n ≠ 0 → (0 : M) ^ n = 0
| 0     h := absurd rfl h
| (k+1) h := by { rw [pow_succ], exact zero_mul _ }

lemma ne_zero_pow {a : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≠ 0 → a ≠ 0 :=
by { contrapose!, rintro rfl, exact zero_pow' n hn }

@[simp] lemma zero_pow_eq_zero [nontrivial M] {n : ℕ} : (0 : M) ^ n = 0 ↔ 0 < n :=
begin
  split; intro h,
  { rw [pos_iff_ne_zero], rintro rfl, simpa using h },
  { exact zero_pow' n h.ne.symm }
end

lemma ring.inverse_pow (r : M) : ∀ (n : ℕ), ring.inverse r ^ n = ring.inverse (r ^ n)
| 0 := by rw [pow_zero, pow_zero, ring.inverse_one]
| (n + 1) := by rw [pow_succ, pow_succ', ring.mul_inverse_rev' ((commute.refl r).pow_left n),
                    ring.inverse_pow]

end zero

section group_with_zero
variables {G₀ : Type*} [group_with_zero G₀]

section nat_pow

@[simp, field_simps] theorem inv_pow₀ (a : G₀) (n : ℕ) : (a⁻¹) ^ n = (a ^ n)⁻¹ :=
begin
  induction n with n ih,
  { rw [pow_zero, pow_zero], exact inv_one.symm },
  { rw [pow_succ', pow_succ, ih, mul_inv_rev₀] }
end

theorem pow_sub₀ (a : G₀) {m n : ℕ} (ha : a ≠ 0) (h : n ≤ m) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ :=
have h1 : m - n + n = m, from tsub_add_cancel_of_le h,
have h2 : a ^ (m - n) * a ^ n = a ^ m, by rw [←pow_add, h1],
by simpa only [div_eq_mul_inv] using eq_div_of_mul_eq (pow_ne_zero _ ha) h2

theorem pow_inv_comm₀ (a : G₀) (m n : ℕ) : (a⁻¹) ^ m * a ^ n = a ^ n * (a⁻¹) ^ m :=
(commute.refl a).inv_left₀.pow_pow m n

end nat_pow

end group_with_zero

section zpow
open int
variables {G₀ : Type*} [group_with_zero G₀]

local attribute [ematch] le_of_lt

@[simp] theorem one_zpow₀ : ∀ (n : ℤ), (1 : G₀) ^ n = 1
| (n : ℕ) := by rw [zpow_coe_nat, one_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, inv_one]

lemma zero_zpow : ∀ z : ℤ, z ≠ 0 → (0 : G₀) ^ z = 0
| (n : ℕ) h := by { rw [zpow_coe_nat, zero_pow'], simpa using h }
| -[1+n]  h := by simp

lemma fzero_pow_eq (n : ℤ) : (0 : G₀) ^ n = if n = 0 then 1 else 0 :=
begin
  split_ifs with h,
  { rw [h, zpow_zero] },
  { rw [zero_zpow _ h] }
end

@[simp] theorem zpow_neg₀ (a : G₀) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := div_inv_monoid.zpow_neg' _ _
| 0       := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp }
| -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_inv₀, ← zpow_coe_nat], refl }

theorem zpow_neg_one₀ (x : G₀) : x ^ (-1:ℤ) = x⁻¹ :=
by { rw [← congr_arg has_inv.inv (pow_one x), zpow_neg₀, ← zpow_coe_nat], refl }

theorem inv_zpow₀ (a : G₀) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := by rw [zpow_coe_nat, zpow_coe_nat, inv_pow₀]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_pow₀]

lemma zpow_add_one₀ {a : G₀} (ha : a ≠ 0) : ∀ n : ℤ, a ^ (n + 1) = a ^ n * a
| (n : ℕ)    := by simp [← int.coe_nat_succ, pow_succ']
| -[1+0]     := by simp [int.neg_succ_of_nat_eq, ha]
| -[1+(n+1)] := by rw [int.neg_succ_of_nat_eq, zpow_neg₀, neg_add, neg_add_cancel_right, zpow_neg₀,
  ← int.coe_nat_succ, zpow_coe_nat, zpow_coe_nat, pow_succ _ (n + 1), mul_inv_rev₀, mul_assoc,
  inv_mul_cancel ha, mul_one]

lemma zpow_sub_one₀ {a : G₀} (ha : a ≠ 0) (n : ℤ) : a ^ (n - 1) = a ^ n * a⁻¹ :=
calc a ^ (n - 1) = a ^ (n - 1) * a * a⁻¹ : by rw [mul_assoc, mul_inv_cancel ha, mul_one]
             ... = a^n * a⁻¹             : by rw [← zpow_add_one₀ ha, sub_add_cancel]

lemma zpow_add₀ {a : G₀} (ha : a ≠ 0) (m n : ℤ) : a ^ (m + n) = a ^ m * a ^ n :=
begin
  induction n using int.induction_on with n ihn n ihn,
  case hz : { simp },
  { simp only [← add_assoc, zpow_add_one₀ ha, ihn, mul_assoc] },
  { rw [zpow_sub_one₀ ha, ← mul_assoc, ← ihn, ← zpow_sub_one₀ ha, add_sub_assoc] }
end

lemma zpow_add' {a : G₀} {m n : ℤ} (h : a ≠ 0 ∨ m + n ≠ 0 ∨ m = 0 ∧ n = 0) :
  a ^ (m + n) = a ^ m * a ^ n :=
begin
  by_cases hm : m = 0, { simp [hm] },
  by_cases hn : n = 0, { simp [hn] },
  by_cases ha : a = 0,
  { subst a,
    simp only [false_or, eq_self_iff_true, not_true, ne.def, hm, hn, false_and, or_false] at h,
    rw [zero_zpow _ h, zero_zpow _ hm, zero_mul] },
  { exact zpow_add₀ ha m n }
end

theorem zpow_one_add₀ {a : G₀} (h : a ≠ 0) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
by rw [zpow_add₀ h, zpow_one]

theorem semiconj_by.zpow_right₀ {a x y : G₀} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (x^m) (y^m)
| (n : ℕ) := by simp [h.pow_right n]
| -[1+n]  := by simp [(h.pow_right (n + 1)).inv_right₀]

theorem commute.zpow_right₀ {a b : G₀} (h : commute a b) : ∀ m : ℤ, commute a (b^m) :=
h.zpow_right₀

theorem commute.zpow_left₀ {a b : G₀} (h : commute a b) (m : ℤ) : commute (a^m) b :=
(h.symm.zpow_right₀ m).symm

theorem commute.zpow_zpow₀ {a b : G₀} (h : commute a b) (m n : ℤ) : commute (a^m) (b^n) :=
(h.zpow_left₀ m).zpow_right₀ n

theorem commute.zpow_self₀ (a : G₀) (n : ℤ) : commute (a^n) a := (commute.refl a).zpow_left₀ n

theorem commute.self_zpow₀ (a : G₀) (n : ℤ) : commute a (a^n) := (commute.refl a).zpow_right₀ n

theorem commute.zpow_zpow_self₀ (a : G₀) (m n : ℤ) : commute (a^m) (a^n) :=
(commute.refl a).zpow_zpow₀ m n

theorem zpow_bit0₀ (a : G₀) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n :=
begin
  apply zpow_add', right,
  by_cases hn : n = 0,
  { simp [hn] },
  { simp [← two_mul, hn, two_ne_zero] }
end

theorem zpow_bit1₀ (a : G₀) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a :=
begin
  rw [← zpow_bit0₀, bit1, zpow_add', zpow_one],
  right, left,
  apply bit1_ne_zero
end

theorem zpow_mul₀ (a : G₀) : ∀ m n : ℤ, a ^ (m * n) = (a ^ m) ^ n
| (m : ℕ) (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat, ← pow_mul, ← zpow_coe_nat], refl }
| (m : ℕ) -[1+ n] := by { rw [zpow_coe_nat, zpow_neg_succ_of_nat, ← pow_mul, coe_nat_mul_neg_succ,
    zpow_neg₀, inv_inj₀, ← zpow_coe_nat], refl }
| -[1+ m] (n : ℕ) := by { rw [zpow_coe_nat, zpow_neg_succ_of_nat, ← inv_pow₀, ← pow_mul,
    neg_succ_mul_coe_nat, zpow_neg₀, inv_pow₀, inv_inj₀, ← zpow_coe_nat], refl }
| -[1+ m] -[1+ n] := by { rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, neg_succ_mul_neg_succ,
    inv_pow₀, inv_inv₀, ← pow_mul, ← zpow_coe_nat], refl }

theorem zpow_mul₀' (a : G₀) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
by rw [mul_comm, zpow_mul₀]

@[simp, norm_cast] lemma units.coe_zpow₀ (u : units G₀) :
  ∀ (n : ℤ), ((u ^ n : units G₀) : G₀) = u ^ n
| (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat], exact u.coe_pow n }
| -[1+k] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, units.coe_inv', u.coe_pow]

lemma zpow_ne_zero_of_ne_zero {a : G₀} (ha : a ≠ 0) : ∀ (z : ℤ), a ^ z ≠ 0
| (n : ℕ) := by { rw zpow_coe_nat, exact pow_ne_zero _ ha }
| -[1+n]  := by { rw zpow_neg_succ_of_nat, exact inv_ne_zero (pow_ne_zero _ ha) }

lemma zpow_sub₀ {a : G₀} (ha : a ≠ 0) (z1 z2 : ℤ) : a ^ (z1 - z2) = a ^ z1 / a ^ z2 :=
by rw [sub_eq_add_neg, zpow_add₀ ha, zpow_neg₀, div_eq_mul_inv]

lemma commute.mul_zpow₀ {a b : G₀} (h : commute a b) :
  ∀ (i : ℤ), (a * b) ^ i = (a ^ i) * (b ^ i)
| (n : ℕ) := by simp [h.mul_pow n]
| -[1+n]  := by simp [h.mul_pow, (h.pow_pow _ _).eq, mul_inv_rev₀]

lemma mul_zpow₀ {G₀ : Type*} [comm_group_with_zero G₀] (a b : G₀) (m : ℤ):
  (a * b) ^ m = (a ^ m) * (b ^ m) :=
(commute.all a b).mul_zpow₀ m

theorem zpow_bit0' (a : G₀) (n : ℤ) : a ^ bit0 n = (a * a) ^ n :=
(zpow_bit0₀ a n).trans ((commute.refl a).mul_zpow₀ n).symm

theorem zpow_bit1' (a : G₀) (n : ℤ) : a ^ bit1 n = (a * a) ^ n * a :=
by rw [zpow_bit1₀, (commute.refl a).mul_zpow₀]

lemma zpow_eq_zero {x : G₀} {n : ℤ} (h : x ^ n = 0) : x = 0 :=
classical.by_contradiction $ λ hx, zpow_ne_zero_of_ne_zero hx n h

lemma zpow_ne_zero {x : G₀} (n : ℤ) : x ≠ 0 → x ^ n ≠ 0 :=
mt zpow_eq_zero

theorem zpow_neg_mul_zpow_self (n : ℤ) {x : G₀} (h : x ≠ 0) :
  x ^ (-n) * x ^ n = 1 :=
begin
  rw [zpow_neg₀],
  exact inv_mul_cancel (zpow_ne_zero n h)
end

theorem one_div_pow {a : G₀} (n : ℕ) :
  (1 / a) ^ n = 1 / a ^ n :=
by simp only [one_div, inv_pow₀]

theorem one_div_zpow {a : G₀} (n : ℤ) :
  (1 / a) ^ n = 1 / a ^ n :=
by simp only [one_div, inv_zpow₀]

@[simp] lemma inv_zpow' {a : G₀} (n : ℤ) :
  (a ⁻¹) ^ n = a ^ (-n) :=
by { rw [inv_zpow₀, ← zpow_neg_one₀, ← zpow_mul₀], simp }

end zpow

section
variables {G₀ : Type*} [comm_group_with_zero G₀]

@[simp] theorem div_pow (a b : G₀) (n : ℕ) :
  (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_pow, inv_pow₀]

@[simp] theorem div_zpow₀ (a : G₀) {b : G₀} (n : ℤ) :
  (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_zpow₀, inv_zpow₀]

lemma div_sq_cancel {a : G₀} (ha : a ≠ 0) (b : G₀) : a ^ 2 * b / a = a * b :=
by rw [sq, mul_assoc, mul_div_cancel_left _ ha]

end

/-- If a monoid homomorphism `f` between two `group_with_zero`s maps `0` to `0`, then it maps `x^n`,
`n : ℤ`, to `(f x)^n`. -/
lemma monoid_with_zero_hom.map_zpow {G₀ G₀' : Type*} [group_with_zero G₀] [group_with_zero G₀']
  (f : monoid_with_zero_hom G₀ G₀') (x : G₀) :
  ∀ n : ℤ, f (x ^ n) = f x ^ n
| (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat], exact f.to_monoid_hom.map_pow x n }
| -[1+n] := begin
    rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat],
    exact ((f.map_inv _).trans $ congr_arg _ $ f.to_monoid_hom.map_pow x _)
  end

-- I haven't been able to find a better home for this:
-- it belongs with other lemmas on `linear_ordered_field`, but
-- we need to wait until `zpow` has been defined in this file.
section
variables {R : Type*} [linear_ordered_field R] {a : R}

lemma pow_minus_two_nonneg : 0 ≤ a^(-2 : ℤ) :=
begin
  simp only [inv_nonneg, zpow_neg₀],
  change 0 ≤ a ^ ((2 : ℕ) : ℤ),
  rw zpow_coe_nat,
  apply sq_nonneg,
end

end


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import data.equiv.encodable.basic
import data.finset.basic
import data.set.disjointed
/-!
# Lattice operations on encodable types

Lemmas about lattice and set operations on encodable types

## Implementation Notes

This is a separate file, to avoid unnecessary imports in basic files.

Previously some of these results were in the `measure_theory` folder.
-/

open set

namespace encodable

variables {α : Type*} {β : Type*} [encodable β]

lemma supr_decode2 [complete_lattice α] (f : β → α) :
  (⨆ (i : ℕ) (b ∈ decode2 β i), f b) = (⨆ b, f b) :=
by { rw [supr_comm], simp [mem_decode2] }

lemma Union_decode2 (f : β → set α) : (⋃ (i : ℕ) (b ∈ decode2 β i), f b) = (⋃ b, f b) :=
supr_decode2 f

@[elab_as_eliminator] lemma Union_decode2_cases
  {f : β → set α} {C : set α → Prop}
  (H0 : C ∅) (H1 : ∀ b, C (f b)) {n} :
  C (⋃ b ∈ decode2 β n, f b) :=
match decode2 β n with
| none := by { simp, apply H0 }
| (some b) := by { convert H1 b, simp [ext_iff] }
end

theorem Union_decode2_disjoint_on {f : β → set α} (hd : pairwise (disjoint on f)) :
  pairwise (disjoint on λ i, ⋃ b ∈ decode2 β i, f b) :=
begin
  rintro i j ij x ⟨h₁, h₂⟩,
  revert h₁ h₂,
  simp, intros b₁ e₁ h₁ b₂ e₂ h₂,
  refine hd _ _ _ ⟨h₁, h₂⟩,
  cases encodable.mem_decode2.1 e₁,
  cases encodable.mem_decode2.1 e₂,
  exact mt (congr_arg _) ij
end

end encodable

namespace finset

lemma nonempty_encodable {α} (t : finset α) : nonempty $ encodable {i // i ∈ t} :=
begin
  classical, induction t using finset.induction with x t hx ih,
  { refine ⟨⟨λ _, 0, λ _, none, λ ⟨x,y⟩, y.rec _⟩⟩ },
  { cases ih with ih, exactI ⟨encodable.of_equiv _ (finset.subtype_insert_equiv_option hx)⟩ }
end

end finset


import tactic

lemma my_lemma: ∀ n : ℕ, n ≥ 0 :=
λ n, nat.zero_le n

lemma my_lemma2: ∀ n : ℕ, n ≥ 0 :=
begin
  intro n,
  apply nat.zero_le,
end

#print my_lemma2

-- Comentario: Al colocar el cursor sobre print se obtiene
--    theorem my_lemma2 : ∀ (n : ℕ), n ≥ 0 :=
--    λ (n : ℕ), n.zero_le

lemma my_lemma3: ∀ n : ℕ, n ≥ 0 :=
begin
  show_term {intro n, apply nat.zero_le},
end

-- Comentario: Al colocar el cursor sobre show_term se obtiene
--    λ n, n.zero_le

------------------------------------------------------------------------
-- § Referencia                                                       --
------------------------------------------------------------------------

-- Basado en el vídeo "Metaprogramming in Lean tutorial: video 1" de Rob
-- Lewis que se encuentra en https://youtu.be/o6oUjcE6Nz4


import positive_nat.lemmas
import tactic.well_founded_tactics

namespace positive_nat namespace natural

def mod : natural → natural → natural
| a b := if h : b < a then
have sub.total a b < a := sub_lt_of_lt h,
mod (sub.total a b) b else a
using_well_founded lib.wf_tacs

instance has_mod : has_mod natural := ⟨mod⟩

def mod_def {a b : natural} : a % b = if h : b < a then (sub a b) % b else a := mod.equations._eqn_1 a b

lemma mod_of_eq {a : natural} : a % a = a :=
begin
  rw mod_def,
  apply dif_neg,
  exact not_lt_of_eq
end

lemma mod_of_le {a b : natural} (h : a ≤ b) : a % b = a :=
begin
  cases h,
  { rw h, exact mod_of_eq },
  { rw mod_def,
    rw dif_neg,
    intro hh,
    exact not_lt_and_lt_symm ⟨h, hh⟩ }
end

lemma mod_step {a b : natural} (h : a > b) : a % b = (sub a b) % b :=
begin
  rw mod_def,
  rw dif_pos h
end

lemma one_mod {a : natural} : 1 % a = 1 :=
begin
  apply mod_of_le,
  exact one_le
end

lemma mod_le_right {a b : natural} : a % b ≤ b :=
begin
  induction a using positive_nat.natural.strong_induction with a ih,
  apply cases_le_or_gt a b; intro h,
  { rw mod_of_le; assumption },
  { rw mod_step,
    { apply ih, constructor, apply sub_add_eq },
    { assumption }}
end

lemma mod_le_left {n m : natural} : n % m ≤ n :=
begin
  suffices h : ∀ x, x ≤ n → (x % m) ≤ n,
  { apply h, exact or.inl rfl, },
  { intros x h,
    induction x using positive_nat.natural.strong_induction with x ih,
    rw mod_def, by_cases hh: m < x,
    { rw dif_pos, tactic.swap,
      { assumption, },
      { apply ih,
        { use m, rw sub_add_eq, },
        { cases h with y,
          { subst x, right, apply sub_lt_of_lt, },
          { cases h with y h, right, use m + y,
            rw ← add_assoc, rw sub_add_eq, assumption, }, }, }, },
    { rw dif_neg,
      { assumption, },
      { assumption, }, }, },
end

lemma mod_one {a : natural} : a % 1 = 1 :=
begin
  have h := @mod_le_right a 1,
  cases h,
  { assumption },
  { exfalso, exact not_lt_one h }
end

lemma mod_mul {a b : natural} (h : a > b) : ∃ x, b * x + (a % b) = a :=
begin
  revert b,
  apply positive_nat.natural.strong_induction a,
  intros c ih b h,
  replace ih := @ih (sub c b h) sub_lt_self b,
  rw mod_step, show c > b, assumption,
  by_cases h₁ : sub c b h > b,
  { specialize ih h₁,
    cases ih with y ih,
    use y + 1,
    rw [mul_succ, @add_comm b, add_assoc, @add_comm b, ← add_assoc, ih, sub_add_eq]
     },
  { use 1,
    rw mod_of_le,
    rw [mul_one, add_comm],
    rw sub_add_eq,
    cases le_or_gt _ _,
    assumption,
    exfalso,
    apply h₁,
    assumption }
end

lemma le_of_mod_eq {a b : natural} (h : a % b = a) : a ≤ b :=
begin
  cases le_or_gt a b with h₁ h₁,
  { assumption },
  { exfalso,
    rw mod_step h₁ at h,
    have h₂ := mod_le_left,
    rw h at h₂,
    exact not_le_sub h₂ }
end

lemma dvd_of_dvd_mod_of_dvd {a b c : natural} (h₁ : a ∣ b) (h₂ : a ∣ c % b) : a ∣ c :=
begin
  cases le_or_gt c b with h₃ h₄,
  { rw mod_of_le h₃ at h₂, assumption },
  { cases mod_mul h₄ with k h₅,
    cases h₁ with x h₁,
    cases h₂ with y h₂,
    use x * k + y,
    rw [← h₅, h₂, h₁, mul_add_dist, mul_assoc] }
end

end natural end positive_nat


import data.set.basic

import topology.basic
import algebra.module.basic
import algebra.module.submodule

import order.complete_lattice

import analysis.normed_space.basic

import linear_algebra.finite_dimensional

-- Soient E un espace vectoriel normé, F un sous-espace fermé de E et G un
-- sous-espace vectoriel de dimension finie de E. Montrer que F + G est fermé

theorem exo {R E: Type*} [normed_field R] [normed_group E] [normed_space R E] :
  forall (F G: submodule R E),
    (is_closed F.carrier) ->
    (finite_dimensional R G) ->

    (is_closed (F + G))
    -- cannot find F + G ... :(
:= sorry


/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.equiv.mul_add_aut
import logic.function.basic
import group_theory.subgroup

/-!
# Semidirect product

This file defines semidirect products of groups, and the canonical maps in and out of the
semidirect product. The semidirect product of `N` and `G` given a hom `φ` from
`φ` from `G` to the automorphism group of `N` is the product of sets with the group
`⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩`

## Key definitions

There are two homs into the semidirect product `inl : N →* N ⋊[φ] G` and
`inr : G →* N ⋊[φ] G`, and `lift` can be used to define maps `N ⋊[φ] G →* H`
out of the semidirect product given maps `f₁ : N →* H` and `f₂ : G →* H` that satisfy the
condition `∀ n g, f₁ (φ g n) = f₂ g * f₁ n * f₂ g⁻¹`

## Notation

This file introduces the global notation `N ⋊[φ] G` for `semidirect_product N G φ`

## Tags
group, semidirect product
-/
variables (N : Type*) (G : Type*) {H : Type*} [group N] [group G] [group H]

/-- The semidirect product of groups `N` and `G`, given a map `φ` from `G` to the automorphism
  group of `N`. It the product of sets with the group operation
  `⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩` -/
@[ext, derive decidable_eq]
structure semidirect_product (φ : G →* mul_aut N) :=
(left : N) (right : G)

attribute [pp_using_anonymous_constructor] semidirect_product

notation N` ⋊[`:35 φ:35`] `:0 G :35 := semidirect_product N G φ

namespace semidirect_product

variables {N G} {φ : G →* mul_aut N}

private def one_aux : N ⋊[φ] G := ⟨1, 1⟩
private def mul_aux (a b : N ⋊[φ] G) : N ⋊[φ] G := ⟨a.1 * φ a.2 b.1, a.right * b.right⟩
private def inv_aux (a : N ⋊[φ] G) : N ⋊[φ] G := let i := a.2⁻¹ in ⟨φ i a.1⁻¹, i⟩
private lemma mul_assoc_aux (a b c : N ⋊[φ] G) :
  mul_aux (mul_aux a b) c = mul_aux a (mul_aux b c) :=
by simp [mul_aux, mul_assoc, mul_equiv.map_mul]
private lemma mul_one_aux (a : N ⋊[φ] G) : mul_aux a one_aux = a :=
by cases a; simp [mul_aux, one_aux]
private lemma one_mul_aux (a : N ⋊[φ] G) : mul_aux one_aux a = a :=
by cases a; simp [mul_aux, one_aux]
private lemma mul_left_inv_aux (a : N ⋊[φ] G) : mul_aux (inv_aux a) a = one_aux :=
by simp only [mul_aux, inv_aux, one_aux, ← mul_equiv.map_mul, mul_left_inv]; simp

instance : group (N ⋊[φ] G) :=
{ one := one_aux,
  inv := inv_aux,
  mul := mul_aux,
  mul_assoc := mul_assoc_aux,
  one_mul := one_mul_aux,
  mul_one := mul_one_aux,
  mul_left_inv := mul_left_inv_aux }

instance : inhabited (N ⋊[φ] G) := ⟨1⟩

@[simp] lemma one_left : (1 : N ⋊[φ] G).left = 1 := rfl
@[simp] lemma one_right : (1 : N ⋊[φ] G).right = 1 := rfl
@[simp] lemma inv_left (a : N ⋊[φ] G) : (a⁻¹).left = φ a.right⁻¹ a.left⁻¹ := rfl
@[simp] lemma inv_right (a : N ⋊[φ] G) : (a⁻¹).right = a.right⁻¹ := rfl
@[simp] lemma mul_left (a b : N ⋊[φ] G) : (a * b).left = a.left * φ a.right b.left := rfl
@[simp] lemma mul_right (a b : N ⋊[φ] G) : (a * b).right = a.right * b.right := rfl

/-- The canonical map `N →* N ⋊[φ] G` sending `n` to `⟨n, 1⟩` -/
def inl : N →* N ⋊[φ] G :=
{ to_fun := λ n, ⟨n, 1⟩,
  map_one' := rfl,
  map_mul' := by intros; ext; simp }

@[simp] lemma left_inl (n : N) : (inl n : N ⋊[φ] G).left = n := rfl
@[simp] lemma right_inl (n : N) : (inl n : N ⋊[φ] G).right = 1 := rfl

lemma inl_injective : function.injective (inl : N → N ⋊[φ] G) :=
function.injective_iff_has_left_inverse.2 ⟨left, left_inl⟩

@[simp] lemma inl_inj {n₁ n₂ : N} : (inl n₁ : N ⋊[φ] G) = inl n₂ ↔ n₁ = n₂ :=
inl_injective.eq_iff

/-- The canonical map `G →* N ⋊[φ] G` sending `g` to `⟨1, g⟩` -/
def inr : G →* N ⋊[φ] G :=
{ to_fun := λ g, ⟨1, g⟩,
  map_one' := rfl,
  map_mul' := by intros; ext; simp }

@[simp] lemma left_inr (g : G) : (inr g : N ⋊[φ] G).left = 1 := rfl
@[simp] lemma right_inr (g : G) : (inr g : N ⋊[φ] G).right = g := rfl

lemma inr_injective : function.injective (inr : G → N ⋊[φ] G) :=
function.injective_iff_has_left_inverse.2 ⟨right, right_inr⟩

@[simp] lemma inr_inj {g₁ g₂ : G} : (inr g₁ : N ⋊[φ] G) = inr g₂ ↔ g₁ = g₂ :=
inr_injective.eq_iff

lemma inl_aut (g : G) (n : N) : (inl (φ g n) : N ⋊[φ] G) = inr g * inl n * inr g⁻¹ :=
by ext; simp

lemma inl_aut_inv (g : G) (n : N) : (inl ((φ g)⁻¹ n) : N ⋊[φ] G) = inr g⁻¹ * inl n * inr g :=
by rw [← monoid_hom.map_inv, inl_aut, inv_inv]

@[simp]

@[simp] lemma inl_left_mul_inr_right (x : N ⋊[φ] G) : inl x.left * inr x.right = x :=

by ext; simp

/-- The canonical projection map `N ⋊[φ] G →* G`, as a group hom. -/
def right_hom : N ⋊[φ] G →* G :=
{ to_fun := semidirect_product.right,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

@[simp] lemma right_hom_eq_right : (right_hom :  N ⋊[φ] G → G) = right := rfl

@[simp] lemma right_hom_comp_inl : (right_hom : N ⋊[φ] G →* G).comp inl = 1 :=
by ext; simp [right_hom]

@[simp] lemma right_hom_comp_inr : (right_hom : N ⋊[φ] G →* G).comp inr = monoid_hom.id _ :=
by ext; simp [right_hom]

@[simp] lemma right_hom_inl (n : N) : right_hom (inl n : N ⋊[φ] G) = 1 :=
by simp [right_hom]

@[simp] lemma right_hom_inr (g : G) : right_hom (inr g : N ⋊[φ] G) = g :=
by simp [right_hom]

lemma right_hom_surjective : function.surjective (right_hom : N ⋊[φ] G → G) :=
function.surjective_iff_has_right_inverse.2 ⟨inr, right_hom_inr⟩

lemma range_inl_eq_ker_right_hom : (inl : N →* N ⋊[φ] G).range = right_hom.ker :=
le_antisymm
  (λ _, by simp [monoid_hom.mem_ker, eq_comm] {contextual := tt})
  (λ x hx, ⟨x.left, by ext; simp [*, monoid_hom.mem_ker] at *⟩)

section lift
variables (f₁ : N →* H) (f₂ : G →* H)
  (h : ∀ g, f₁.comp (φ g).to_monoid_hom = (mul_aut.conj (f₂ g)).to_monoid_hom.comp f₁)

/-- Define a group hom `N ⋊[φ] G →* H`, by defining maps `N →* H` and `G →* H`  -/
def lift (f₁ : N →* H) (f₂ : G →* H)
  (h : ∀ g, f₁.comp (φ g).to_monoid_hom = (mul_aut.conj (f₂ g)).to_monoid_hom.comp f₁) :
  N ⋊[φ] G →* H :=
{ to_fun := λ a, f₁ a.1 * f₂ a.2,
  map_one' := by simp,
  map_mul' := λ a b, begin
    have := λ n g, monoid_hom.ext_iff.1 (h n) g,
    simp only [mul_aut.conj_apply, monoid_hom.comp_apply, mul_equiv.coe_to_monoid_hom] at this,
    simp [this, mul_assoc]
  end }

@[simp] lemma lift_inl (n : N) : lift f₁ f₂ h (inl n) = f₁ n := by simp [lift]
@[simp] lemma lift_comp_inl : (lift f₁ f₂ h).comp inl = f₁ := by ext; simp

@[simp] lemma lift_inr (g : G) : lift f₁ f₂ h (inr g) = f₂ g := by simp [lift]
@[simp] lemma lift_comp_inr : (lift f₁ f₂ h).comp inr = f₂ := by ext; simp

lemma lift_unique (F : N ⋊[φ] G →* H) :
  F = lift (F.comp inl) (F.comp inr) (λ _, by ext; simp [inl_aut]) :=
begin
  ext,
  simp only [lift, monoid_hom.comp_apply, monoid_hom.coe_mk],
  rw [← F.map_mul, inl_left_mul_inr_right],
end

/-- Two maps out of the semidirect product are equal if they're equal after composition
  with both `inl` and `inr` -/
lemma hom_ext {f g : (N ⋊[φ] G) →* H} (hl : f.comp inl = g.comp inl)
  (hr : f.comp inr = g.comp inr) : f = g :=
by { rw [lift_unique f, lift_unique g], simp only * }

end lift

section map

variables {N₁ : Type*} {G₁ : Type*} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁}

/-- Define a map from `N ⋊[φ] G` to `N₁ ⋊[φ₁] G₁` given maps `N →* N₁` and `G →* G₁` that
  satisfy a commutativity condition `∀ n g, f₁ (φ g n) = φ₁ (f₂ g) (f₁ n)`.  -/
def map (f₁ : N →* N₁) (f₂ : G →* G₁)
  (h : ∀ g : G, f₁.comp (φ g).to_monoid_hom = (φ₁ (f₂ g)).to_monoid_hom.comp f₁) :
  N ⋊[φ] G →* N₁ ⋊[φ₁] G₁ :=
{ to_fun := λ x, ⟨f₁ x.1, f₂ x.2⟩,
  map_one' := by simp,
  map_mul' := λ x y, begin
    replace h := monoid_hom.ext_iff.1 (h x.right) y.left,
    ext; simp * at *,
  end  }

variables (f₁ : N →* N₁) (f₂ : G →* G₁)
  (h : ∀ g : G, f₁.comp (φ g).to_monoid_hom = (φ₁ (f₂ g)).to_monoid_hom.comp f₁)

@[simp] lemma map_left (g : N ⋊[φ] G) : (map f₁ f₂ h g).left = f₁ g.left := rfl

@[simp] lemma map_right (g : N ⋊[φ] G) : (map f₁ f₂ h g).right = f₂ g.right := rfl

@[simp] lemma right_hom_comp_map : right_hom.comp (map f₁ f₂ h) = f₂.comp right_hom := rfl

@[simp] lemma map_inl (n : N) : map f₁ f₂ h (inl n) = inl (f₁ n) :=
by simp [map]

@[simp] lemma map_comp_inl : (map f₁ f₂ h).comp inl = inl.comp f₁ :=
by ext; simp

@[simp] lemma map_inr (g : G) : map f₁ f₂ h (inr g) = inr (f₂ g) :=
by simp [map]

@[simp] lemma map_comp_inr : (map f₁ f₂ h).comp inr = inr.comp f₂ :=
by ext; simp [map]

end map

end semidirect_product


universes u v

structure InjectiveFunction (α : Type u) (β : Type v) where
  fn  : α → β
  inj : ∀ a b, fn a = fn b → a = b

def add1 : InjectiveFunction Nat Nat where
  fn a      := a + 1
  inj a b h := by injection h; assumption

instance : CoeFun (InjectiveFunction α β) (fun _ => α → β) where
  coe s := s.fn

#eval add1 10

def mapAdd1 (xs : List Nat) : List Nat :=
  xs.map add1

#eval mapAdd1 [1, 2]

def foo : InjectiveFunction Bool (Nat → Nat) where
  fn
   | true,  a => a + 1
   | false, a => a
  inj a b h := by
    cases a
    cases b; rfl; injection (congrFun h 0)
    cases b; injection (congrFun h 0); rfl

theorem ex1 (x : Nat) : foo true x = x + 1 :=
  rfl

theorem ex2 (x : Nat) : foo false x = x :=
  rfl

#eval foo true 10
#eval foo false 20

#eval [1, 2, 3].map (foo true)


/-
Copyright (c) 2022 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez, Eric Wieser
-/
import data.list.chain

/-!
# Destuttering of Lists

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

This file proves theorems about `list.destutter` (in `data.list.defs`), which greedily removes all
non-related items that are adjacent in a list, e.g. `[2, 2, 3, 3, 2].destutter (≠) = [2, 3, 2]`.
Note that we make no guarantees of being the longest sublist with this property; e.g.,
`[123, 1, 2, 5, 543, 1000].destutter (<) = [123, 543, 1000]`, but a longer ascending chain could be
`[1, 2, 5, 543, 1000]`.

## Main statements

* `list.destutter_sublist`: `l.destutter` is a sublist of `l`.
* `list.destutter_is_chain'`: `l.destutter` satisfies `chain' R`.
* Analogies of these theorems for `list.destutter'`, which is the `destutter` equivalent of `chain`.

## Tags

adjacent, chain, duplicates, remove, list, stutter, destutter
-/

variables {α : Type*} (l : list α) (R : α → α → Prop) [decidable_rel R] {a b : α}

namespace list

@[simp] lemma destutter'_nil : destutter' R a [] = [a] := rfl

lemma destutter'_cons :
  (b :: l).destutter' R a = if R a b then a :: destutter' R b l else destutter' R a l := rfl

variables {R}

@[simp] lemma destutter'_cons_pos (h : R b a) :
  (a :: l).destutter' R b = b :: l.destutter' R a :=
by rw [destutter', if_pos h]

@[simp] lemma destutter'_cons_neg (h : ¬ R b a) :
  (a :: l).destutter' R b = l.destutter' R b :=
by rw [destutter', if_neg h]

variables (R)

@[simp] lemma destutter'_singleton : [b].destutter' R a = if R a b then [a, b] else [a] :=
by split_ifs; simp! [h]

lemma destutter'_sublist (a) : l.destutter' R a <+ a :: l :=
begin
  induction l with b l hl generalizing a,
  { simp },
  rw destutter',
  split_ifs,
  { exact sublist.cons2 _ _ _ (hl b) },
  { exact (hl a).trans ((l.sublist_cons b).cons_cons a) }
end

lemma mem_destutter' (a) : a ∈ l.destutter' R a :=
begin
  induction l with b l hl,
  { simp },
  rw destutter',
  split_ifs,
  { simp },
  { assumption }
end

lemma destutter'_is_chain : ∀ l : list α, ∀ {a b}, R a b → (l.destutter' R b).chain R a
| [] a b h := chain_singleton.mpr h
| (c :: l) a b h :=
begin
  rw destutter',
  split_ifs with hbc,
  { rw chain_cons,
    exact ⟨h, destutter'_is_chain l hbc⟩ },
  { exact destutter'_is_chain l h },
end

lemma destutter'_is_chain' (a) : (l.destutter' R a).chain' R :=
begin
  induction l with b l hl generalizing a,
  { simp },
  rw destutter',
  split_ifs,
  { exact destutter'_is_chain R l h },
  { exact hl a },
end

lemma destutter'_of_chain (h : l.chain R a) : l.destutter' R a = a :: l :=
begin
  induction l with b l hb generalizing a,
  { simp },
  obtain ⟨h, hc⟩ := chain_cons.mp h,
  rw [l.destutter'_cons_pos h, hb hc]
end

@[simp] lemma destutter'_eq_self_iff (a) : l.destutter' R a = a :: l ↔ l.chain R a :=
⟨λ h, by { rw [←chain', ←h], exact l.destutter'_is_chain' R a }, destutter'_of_chain _ _⟩

lemma destutter'_ne_nil : l.destutter' R a ≠ [] :=
ne_nil_of_mem $ l.mem_destutter' R a

@[simp] lemma destutter_nil : ([] : list α).destutter R = [] := rfl

lemma destutter_cons' : (a :: l).destutter R = destutter' R a l := rfl

lemma destutter_cons_cons : (a :: b :: l).destutter R =
  if R a b then a :: destutter' R b l else destutter' R a l := rfl

@[simp] lemma destutter_singleton : destutter R [a] = [a] := rfl

@[simp] lemma destutter_pair : destutter R [a, b] = if R a b then [a, b] else [a] :=
destutter_cons_cons _ R

lemma destutter_is_chain' : ∀ (l : list α), (l.destutter R).chain' R
| [] := list.chain'_nil
| (h :: l) := l.destutter'_is_chain' R h

lemma destutter_of_chain' : ∀ (l : list α), l.chain' R → l.destutter R = l
| [] h := rfl
| (a :: l) h := l.destutter'_of_chain _ h

@[simp] lemma destutter_eq_self_iff : ∀ (l : list α), l.destutter R = l ↔ l.chain' R
| [] := by simp
| (a :: l) := l.destutter'_eq_self_iff R a

lemma destutter_idem : (l.destutter R).destutter R = l.destutter R :=
destutter_of_chain' R _ $ l.destutter_is_chain' R

@[simp] lemma destutter_eq_nil : ∀ {l : list α}, destutter R l = [] ↔ l = []
| [] := iff.rfl
| (a :: l) := ⟨λ h, absurd h $ l.destutter'_ne_nil R, λ h, match h with end⟩

end list


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.bind
import data.multiset.powerset
import data.multiset.range

/-!
# The `nodup` predicate for multisets without duplicate elements.
-/

namespace multiset
open function list

variables {α β γ : Type*} {r : α → α → Prop} {s t : multiset α} {a : α}

/- nodup -/

/-- `nodup s` means that `s` has no duplicates, i.e. the multiplicity of
  any element is at most 1. -/
def nodup (s : multiset α) : Prop :=
quot.lift_on s nodup (λ s t p, propext p.nodup_iff)

@[simp] theorem coe_nodup {l : list α} : @nodup α l ↔ l.nodup := iff.rfl

@[simp] theorem nodup_zero : @nodup α 0 := pairwise.nil

@[simp] theorem nodup_cons {a : α} {s : multiset α} : nodup (a ::ₘ s) ↔ a ∉ s ∧ nodup s :=
quot.induction_on s $ λ l, nodup_cons

lemma nodup.cons (m : a ∉ s) (n : nodup s) : nodup (a ::ₘ s) := nodup_cons.2 ⟨m, n⟩

theorem nodup_singleton : ∀ a : α, nodup ({a} : multiset α) := nodup_singleton

lemma nodup.of_cons (h : nodup (a ::ₘ s)) : nodup s := (nodup_cons.1 h).2

theorem nodup.not_mem (h : nodup (a ::ₘ s)) : a ∉ s := (nodup_cons.1 h).1

theorem nodup_of_le {s t : multiset α} (h : s ≤ t) : nodup t → nodup s :=
le_induction_on h $ λ l₁ l₂, nodup.sublist

theorem not_nodup_pair : ∀ a : α, ¬ nodup (a ::ₘ a ::ₘ 0) := not_nodup_pair

theorem nodup_iff_le {s : multiset α} : nodup s ↔ ∀ a : α, ¬ a ::ₘ a ::ₘ 0 ≤ s :=
quot.induction_on s $ λ l, nodup_iff_sublist.trans $ forall_congr $ λ a,
not_congr (@repeat_le_coe _ a 2 _).symm

lemma nodup_iff_ne_cons_cons {s : multiset α} : s.nodup ↔ ∀ a t, s ≠ a ::ₘ a ::ₘ t :=
nodup_iff_le.trans
  ⟨λ h a t s_eq, h a (s_eq.symm ▸ cons_le_cons a (cons_le_cons a (zero_le _))),
   λ h a le, let ⟨t, s_eq⟩ := le_iff_exists_add.mp le in
     h a t (by rwa [cons_add, cons_add, zero_add] at s_eq )⟩

theorem nodup_iff_count_le_one [decidable_eq α] {s : multiset α} : nodup s ↔ ∀ a, count a s ≤ 1 :=
quot.induction_on s $ λ l, nodup_iff_count_le_one

@[simp] theorem count_eq_one_of_mem [decidable_eq α] {a : α} {s : multiset α}
  (d : nodup s) (h : a ∈ s) : count a s = 1 :=
le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h)

lemma nodup_iff_pairwise {α} {s : multiset α} : nodup s ↔ pairwise (≠) s :=
quotient.induction_on s $ λ l, (pairwise_coe_iff_pairwise (by exact λ a b, ne.symm)).symm

protected lemma nodup.pairwise : (∀ a ∈ s, ∀ b ∈ s, a ≠ b → r a b) → nodup s → pairwise r s :=
quotient.induction_on s $ assume l h hl, ⟨l, rfl, hl.imp_of_mem $ assume a b ha hb, h a ha b hb⟩

lemma pairwise.forall (H : symmetric r) (hs : pairwise r s) :
  ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → a ≠ b → r a b :=
let ⟨l, hl₁, hl₂⟩ := hs in hl₁.symm ▸ hl₂.forall H

theorem nodup_add {s t : multiset α} : nodup (s + t) ↔ nodup s ∧ nodup t ∧ disjoint s t :=
quotient.induction_on₂ s t $ λ l₁ l₂, nodup_append

theorem disjoint_of_nodup_add {s t : multiset α} (d : nodup (s + t)) : disjoint s t :=
(nodup_add.1 d).2.2

lemma nodup.add_iff (d₁ : nodup s) (d₂ : nodup t) : nodup (s + t) ↔ disjoint s t :=
by simp [nodup_add, d₁, d₂]

lemma nodup.of_map (f : α → β) : nodup (map f s) → nodup s :=
quot.induction_on s $ λ l, nodup.of_map f

lemma nodup.map_on {f : α → β} : (∀ x ∈ s, ∀ y ∈ s, f x = f y → x = y) →
  nodup s → nodup (map f s) :=
quot.induction_on s $ λ l, nodup.map_on

lemma nodup.map {f : α → β} {s : multiset α} (hf : injective f) : nodup s → nodup (map f s) :=
nodup.map_on (λ x _ y _ h, hf h)

theorem inj_on_of_nodup_map {f : α → β} {s : multiset α} :
  nodup (map f s) → ∀ (x ∈ s) (y ∈ s), f x = f y → x = y :=
quot.induction_on s $ λ l, inj_on_of_nodup_map

theorem nodup_map_iff_inj_on {f : α → β} {s : multiset α} (d : nodup s) :
  nodup (map f s) ↔ (∀ (x ∈ s) (y ∈ s), f x = f y → x = y) :=
⟨inj_on_of_nodup_map, λ h, d.map_on h⟩

lemma nodup.filter (p : α → Prop) [decidable_pred p] {s} : nodup s → nodup (filter p s) :=
quot.induction_on s $ λ l, nodup.filter p

@[simp] theorem nodup_attach {s : multiset α} : nodup (attach s) ↔ nodup s :=
quot.induction_on s $ λ l, nodup_attach

lemma nodup.pmap {p : α → Prop} {f : Π a, p a → β} {s : multiset α} {H}
  (hf : ∀ a ha b hb, f a ha = f b hb → a = b) : nodup s → nodup (pmap f s H) :=
quot.induction_on s (λ l H, nodup.pmap hf) H

instance nodup_decidable [decidable_eq α] (s : multiset α) : decidable (nodup s) :=
quotient.rec_on_subsingleton s $ λ l, l.nodup_decidable

lemma nodup.erase_eq_filter [decidable_eq α] (a : α) {s} : nodup s → s.erase a = filter (≠ a) s :=
quot.induction_on s $ λ l d, congr_arg coe $ d.erase_eq_filter a

lemma nodup.erase [decidable_eq α] (a : α) {l} : nodup l → nodup (l.erase a) :=
nodup_of_le (erase_le _ _)

lemma nodup.mem_erase_iff [decidable_eq α] {a b : α} {l} (d : nodup l) :
  a ∈ l.erase b ↔ a ≠ b ∧ a ∈ l :=
by rw [d.erase_eq_filter b, mem_filter, and_comm]

lemma nodup.not_mem_erase [decidable_eq α] {a : α} {s} (h : nodup s) : a ∉ s.erase a :=
λ ha, (h.mem_erase_iff.1 ha).1 rfl

protected lemma nodup.product {t : multiset β} : nodup s → nodup t → nodup (product s t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d₁ d₂, by simp [d₁.product d₂]

protected lemma nodup.sigma {σ : α → Type*} {t : Π a, multiset (σ a)} :
  nodup s → (∀ a, nodup (t a)) → nodup (s.sigma t) :=
quot.induction_on s $ assume l₁,
begin
  choose f hf using assume a, quotient.exists_rep (t a),
  rw show t = λ a, f a, from (eq.symm $ funext $ λ a, hf a),
  simpa using nodup.sigma
end

protected lemma nodup.filter_map (f : α → option β) (H : ∀ a a' b, b ∈ f a → b ∈ f a' → a = a') :
  nodup s → nodup (filter_map f s) :=
quot.induction_on s $ λ l, nodup.filter_map H

lemma nodup.inter_left [decidable_eq α] (t) : nodup s → nodup (s ∩ t) :=
nodup_of_le $ inter_le_left _ _

lemma nodup.inter_right [decidable_eq α] (s) : nodup t → nodup (s ∩ t) :=
nodup_of_le $ inter_le_right _ _

@[simp] theorem nodup_union [decidable_eq α] {s t : multiset α} :
  nodup (s ∪ t) ↔ nodup s ∧ nodup t :=
⟨λ h, ⟨nodup_of_le (le_union_left _ _) h, nodup_of_le (le_union_right _ _) h⟩,
 λ ⟨h₁, h₂⟩, nodup_iff_count_le_one.2 $ λ a, by rw [count_union]; exact
   max_le (nodup_iff_count_le_one.1 h₁ a) (nodup_iff_count_le_one.1 h₂ a)⟩

@[simp] theorem nodup_powerset {s : multiset α} : nodup (powerset s) ↔ nodup s :=
⟨λ h, (nodup_of_le (map_single_le_powerset _) h).of_map _,
  quotient.induction_on s $ λ l h,
  by simp; refine (nodup_sublists'.2 h).map_on _ ; exact
  λ x sx y sy e,
    (h.sublist_ext (mem_sublists'.1 sx) (mem_sublists'.1 sy)).1
      (quotient.exact e)⟩

alias nodup_powerset ↔ multiset.nodup.of_powerset multiset.nodup.powerset

protected lemma nodup.powerset_len {n : ℕ} (h : nodup s) : nodup (powerset_len n s) :=
nodup_of_le (powerset_len_le_powerset _ _) (nodup_powerset.2 h)

@[simp] lemma nodup_bind {s : multiset α} {t : α → multiset β} :
  nodup (bind s t) ↔ ((∀a∈s, nodup (t a)) ∧ (s.pairwise (λa b, disjoint (t a) (t b)))) :=
have h₁ : ∀a, ∃l:list β, t a = l, from
  assume a, quot.induction_on (t a) $ assume l, ⟨l, rfl⟩,
let ⟨t', h'⟩ := classical.axiom_of_choice h₁ in
have t = λa, t' a, from funext h',
have hd : symmetric (λa b, list.disjoint (t' a) (t' b)), from assume a b h, h.symm,
quot.induction_on s $ by simp [this, list.nodup_bind, pairwise_coe_iff_pairwise hd]

lemma nodup.ext {s t : multiset α} : nodup s → nodup t → (s = t ↔ ∀ a, a ∈ s ↔ a ∈ t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d₁ d₂, quotient.eq.trans $ perm_ext d₁ d₂

theorem le_iff_subset {s t : multiset α} : nodup s → (s ≤ t ↔ s ⊆ t) :=
quotient.induction_on₂ s t $ λ l₁ l₂ d, ⟨subset_of_le, d.subperm⟩

theorem range_le {m n : ℕ} : range m ≤ range n ↔ m ≤ n :=
(le_iff_subset (nodup_range _)).trans range_subset

theorem mem_sub_of_nodup [decidable_eq α] {a : α} {s t : multiset α} (d : nodup s) :
  a ∈ s - t ↔ a ∈ s ∧ a ∉ t :=
⟨λ h, ⟨mem_of_le tsub_le_self h, λ h',
  by refine count_eq_zero.1 _ h; rw [count_sub a s t, tsub_eq_zero_iff_le];
     exact le_trans (nodup_iff_count_le_one.1 d _) (count_pos.2 h')⟩,
 λ ⟨h₁, h₂⟩, or.resolve_right (mem_add.1 $ mem_of_le le_tsub_add h₁) h₂⟩

lemma map_eq_map_of_bij_of_nodup (f : α → γ) (g : β → γ) {s : multiset α} {t : multiset β}
  (hs : s.nodup) (ht : t.nodup) (i : Πa∈s, β)
  (hi : ∀a ha, i a ha ∈ t) (h : ∀a ha, f a = g (i a ha))
  (i_inj : ∀a₁ a₂ ha₁ ha₂, i a₁ ha₁ = i a₂ ha₂ → a₁ = a₂)
  (i_surj : ∀b∈t, ∃a ha, b = i a ha) :
  s.map f = t.map g :=
have t = s.attach.map (λ x, i x.1 x.2),
  from (ht.ext $ (nodup_attach.2 hs).map $
      show injective (λ x : {x // x ∈ s}, i x.1 x.2), from λ x y hxy,
        subtype.eq $ i_inj x.1 y.1 x.2 y.2 hxy).2
    (λ x, by simp only [mem_map, true_and, subtype.exists, eq_comm, mem_attach];
      exact ⟨i_surj _, λ ⟨y, hy⟩, hy.snd.symm ▸ hi _ _⟩),
calc s.map f = s.pmap  (λ x _, f x) (λ _, id) : by rw [pmap_eq_map]
... = s.attach.map (λ x, f x.1) : by rw [pmap_eq_map_attach]
... = t.map g : by rw [this, multiset.map_map]; exact map_congr rfl (λ x _, h _ _)

end multiset


import computability.language

universe u
variables {α β : Type*}

namespace language

lemma image_hom_mul_eq {f : list α → list β} {l l₁ : language α} (H : ∀ x y, f (x ++ y) = f x ++ f y):
f '' ((l * l₁ : language α)) = ((f '' l) * (f '' l₁) : language β) :=
begin
  ext,
  split,
  intro h,
  simp at *,
  rcases h with ⟨x', hl, hr⟩,
  rw mem_mul at *,
  rcases hl with ⟨a, b, h₁, h₂, h₃⟩,
  use f a,
  use f b,
  split,
  use a,
  exact ⟨h₁, rfl⟩,
  split,
  use b,
  exact ⟨h₂, rfl⟩,
  rw ← hr,
  subst_vars,
  exact (H a b).symm,
  intro h,
  simp at *,
  rw mem_mul at *,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  simp at *,
  rcases h₁ with ⟨x₁, h₄, h₅⟩,
  rcases h₂ with ⟨x₂, h₆, h₇⟩,
  use (x₁ ++ x₂),
  split,
  exact set.mem_image2_of_mem h₄ h₆,
  subst_vars,
  exact H x₁ x₂,
end

lemma mem_prod {L : list (language α)} {x : list α} :
x ∈ list.prod L ↔
∃ a b p s,
L = p ++ s ∧
a ∈ list.prod p ∧
b ∈ list.prod s ∧
x = a ++ b :=
begin
  induction L using list.reverse_rec_on,
  simp,
  {
    split,
    intro h,
    repeat {use ([])},
    simp,
    exact h,
    simp,
  },
  {
    simp at *,
    split,
    {
      intro h,
      rw mem_mul at h,
      rcases h with ⟨a, b, h₁, h₂, h₃⟩,
      use a,
      use b,
      use L_l,
      use ([L_a]),
      simp,
      split,
      exact h₁,
      split,
      exact h₂,
      exact h₃.symm,
    },
    {
      intro h,
      rcases h with ⟨a, b, p, s, h₁, h₂, h₃, h₄⟩,
      rw mem_mul,
      rw list.append_eq_append_iff at *,
    }
  }

end

end language


import tactic
import languages.basic
import languages.star
import regular.regex
import automata.dfa
import data.set.basic
import data.finset.basic
import data.finset.fold
import data.finset.lattice
import data.finset.order
import data.fintype.basic
import data.set.finite

open languages regex DFA finset list

namespace regex.from_dfa

variables {S Q : Type} [fintype S] [fintype Q] [decidable_eq S] [decidable_eq Q] {dfa : DFA S Q}

inductive go_restr (dfa : DFA S Q) (allowed : finset Q) : Q → list S → Q → Prop
| finish {q : Q}                    : go_restr q [] q
| last_step {ch : S} {q nxt : Q}    : dfa.next q ch = nxt → go_restr q [ch] nxt
| step {head : S} {tail : list S} {q nxt f : Q} :
    dfa.next q head = nxt → nxt ∈ allowed → go_restr nxt tail f → go_restr q (head::tail) f

lemma go_restr_univ {a b : Q} {w : list S}
    : go_restr dfa (fintype.elems Q) a w b ↔ go dfa a w = b :=
begin
    split, {
        intro go_re,
        induction go_re,
        case go_restr.finish {rw go_finish},
        case go_restr.last_step { simpa only },
        case go_restr.step : _ _ _ _ _ h_nxt h_allow go_prev {
            rwa [go_step, h_nxt],
        },
    }, {
        intro go_dfa,
        induction w generalizing a, {
            cases go_dfa, exact go_restr.finish,
        }, {
            cases go_dfa,
            refine go_restr.step rfl (mem_univ _) (@w_ih (dfa.next a w_hd) rfl),
        }
    }
end

lemma go_restr_insert {a b ins : Q} {w : list S} {allowed : finset Q} :
    go_restr dfa allowed a w b → go_restr dfa (insert ins allowed) a w b :=
begin
    rintro go_allowed,
    induction go_allowed,
    case go_restr.finish : { exact go_restr.finish },
    case go_restr.last_step : _ _ _ h_nxt { exact go_restr.last_step h_nxt, },
    case go_restr.step : _ _ _ _ _ h_nxt h_allow go_prev {
        refine go_restr.step h_nxt _ go_allowed_ih,
        simp only [h_allow, mem_insert, or_true, to_finset_cons],
    }
end

lemma go_restr_append {a b c : Q} {left right : list S} {allowed : finset Q} :
    b ∈ allowed → go_restr dfa allowed a left b → go_restr dfa allowed b right c →
    go_restr dfa allowed a (left ++ right) c :=
begin
    rintro b_allowed go_ab go_bc,
    induction go_ab,
    case go_restr.finish : { simp only [go_bc, nil_append] },
    case go_restr.last_step : _ _ _ h_nxt {
        exact go_restr.step h_nxt b_allowed go_bc,
    },
    case go_restr.step : _ _ _ _ _ h_nxt h_allow go_prev {
        replace go_bc := go_ab_ih b_allowed go_bc,
        refine go_restr.step h_nxt h_allow go_bc,
    }
end

lemma go_restr_list_join {a : Q} {l : list (list S)} {allowed : finset Q} :
    a ∈ allowed → (∀ x, x ∈ l → go_restr dfa allowed a x a) → go_restr dfa allowed a (join l) a :=
begin
    rintro a_allowed hl,
    induction l with head tail lst_ih, {
        simp [go_restr.finish],
    }, {
        refine go_restr_append a_allowed (hl head _) (lst_ih _),
        simp only [mem_cons_iff, true_or, eq_self_iff_true],
        rintro x xtail,
        refine hl x _,
        simp only [xtail, mem_cons_iff, or_true],
    }
end

def all_edges (dfa : DFA S Q) (a b : Q) : set (list S) :=
    (⋃ c : S, if dfa.next a c = b then {[c]} else ∅)

def FW (dfa : DFA S Q) : Q → Q → (list Q) → set (list S)
| a b []                := if a = b then all_edges dfa a b ∪ {[]} else all_edges dfa a b
| a b (head :: tail)    := (FW a b tail) ∪ (FW a head tail * kleene_star (FW head head tail) * FW head b tail)

lemma FW_to_go_restr {dfa : DFA S Q} {a b : Q} {allowed : list Q} {w : list S} :
    w ∈ FW dfa a b allowed → go_restr dfa allowed.to_finset a w b :=
begin
    induction allowed with head tail ih generalizing a b w, {
        intro hw,
        by_cases h : a = b, {
            simp [FW, all_edges, h] at hw,
            rcases hw with hw | ⟨ch, win⟩, {
                substs hw h,
                exact go_restr.finish,
            }, {
                split_ifs at win, {
                    simp only [set.mem_singleton_iff] at win,
                    substs h win,
                    refine go_restr.last_step h_1,
                }, {
                    simpa only [set.mem_empty_eq] using win,
                }
            }
        }, {
            simp [FW, all_edges, h] at hw,
            rcases hw with ⟨i, win⟩,
            split_ifs at win,
            { convert go_restr.last_step h_1 },
            { simpa only [set.mem_empty_eq] using win },
        },
    }, {
        intro hw,
        cases hw, {
            rw [to_finset_cons],
            exact go_restr_insert (ih hw),
        }, {
            rcases hw with ⟨_, right, ⟨left, mid, hleft, hmid, rfl⟩, hright, rfl⟩,
            rw to_finset_cons,
            replace hleft := ih hleft,
            replace hright := ih hright,
            rw [star_eq_list_join] at hmid,
            rcases hmid with ⟨l, hlist, rfl⟩,

            have h_head := finset.mem_insert_self head tail.to_finset,
            refine go_restr_append h_head _ _,
            refine go_restr_append h_head _ _,
            all_goals {try {apply go_restr_list_join}, try {apply go_restr_insert}, try {assumption}},

            rintro x xl,
            specialize ih (hlist x xl),
            exact go_restr_insert ih,
        }
    }
end

-- inductive go_restr (dfa : DFA S Q) (allow : finset Q) : Q → list S → Q → Prop
-- | finish {q : Q}                    : go_restr q [] q
-- | last_step {ch : S} {q nxt : Q}    : nxt = dfa.next q ch → go_restr q [ch] nxt
-- | step {head : S} {tail : list S} {q nxt f : Q} :
--     nxt = dfa.next q head → nxt ∈ allow → go_restr nxt tail f → go_restr q (head::tail) f

lemma go_restr_split {dfa : DFA S Q} {a b s : Q} {allowed : finset Q} {w : list S} :
    go_restr dfa (insert s allowed) a w b →
    (go_restr dfa allowed a w b) ∨
    (∃ pref (inf : list (list S)) suf,
        go_restr dfa allowed a pref s ∧
        (∀ x, x ∈ inf → go_restr dfa allowed s x s) ∧
        go_restr dfa allowed s suf b ∧
        pref ++ inf.join ++ suf = w) :=
begin
    intro go_ab,
    induction go_ab,
    case finish {
        left, exact go_restr.finish,
    },
    case last_step : ch q nxt h_nxt {
        left, exact go_restr.last_step h_nxt,
    },
    case step : head tail q nxt f h_nxt h_allow go_tail ih {
        by_cases nxt = s, {
            subst h,
            right,
            cases ih, {
                use [[head], [], tail],
                use [go_restr.last_step h_nxt, forall_mem_nil _, ih],
                simp only [join, eq_self_iff_true, and_self, singleton_append],
            }, {
                rcases ih with ⟨pref, inf, suf, go_pref, go_inf, go_suf, rfl⟩,
                use [[head], pref :: inf, suf],
                use [go_restr.last_step h_nxt],
                split, {
                    rintro x hx,
                    cases hx, {
                        rw ← hx at go_pref,
                        exact go_pref,
                    }, {
                        exact go_inf x hx,
                    }
                }, {
                    use go_suf,
                    simp only [join, cons_append, eq_self_iff_true, list.append_assoc, and_self, singleton_append],
                }
            }
        }, {
            simp only [h, mem_insert, false_or, to_finset_cons] at h_allow,
            cases ih, {
                left,
                refine go_restr.step h_nxt h_allow ih,
            }, {
                right,
                rcases ih with ⟨pref, inf, suf, go_pref, go_inf, go_suf, rfl⟩,
                use [head :: pref, inf, suf],
                use [go_restr.step h_nxt h_allow go_pref],
                use [go_inf, go_suf],
                simp only [cons_append, eq_self_iff_true, and_self],
            }
        }
    }
end

lemma FW_from_go_restr {dfa : DFA S Q} {a b : Q} {allow_list : list Q} {w : list S} :
    go_restr dfa allow_list.to_finset a w b → w ∈ FW dfa a b allow_list :=
begin
    intro go_ab,
    induction allow_list with head tail ih generalizing a b w, {
        dsimp [FW, all_edges],
        cases go_ab,
        case go_restr.finish : {
            simp,
        },
        case go_restr.last_step : _ _ _ go_ab_nxt {
            split_ifs; {
                simp [mem_sup],
                use [go_ab_ch],
                simp [go_ab_nxt],
            },
        },
        case go_restr.step : _ _ _ _ _ go_ab_nxt go_ab_allow go_ab_prev {
            simpa only [to_finset_nil, not_mem_empty] using go_ab_allow,
        }
    }, {
        dsimp [FW, all_edges],
        rw [to_finset_cons] at go_ab,
        replace go_ab := go_restr_split go_ab,
        rcases go_ab with _ | ⟨pref, inf, suf, go_pref, go_inf, go_suf, rfl⟩, {
            left,
            exact ih go_ab,
        }, {
            right,
            use [pref ++ inf.join, suf, pref, inf.join],
            refine ⟨ih go_pref, _, rfl⟩,
            apply star_eq_list_join.2 ⟨inf, λ x hx, ih (go_inf x hx), rfl⟩,
            use ih go_suf,
        }
    }
end

lemma FW_is_regex {dfa : DFA S Q} (a b : Q) {allowed : list Q} :
    regex_lang (FW dfa a b allowed) :=
begin
    induction allowed with head tail ih generalizing a b, {
        rw FW,
        split_ifs,
        all_goals {try {apply union_is_regex _ eps_is_regex}, clear h},
        all_goals {
            simp [all_edges],
            rw [←set.bUnion_univ],
            lift (set.univ : set S) to finset S using set.finite.of_fintype (set.univ : set S),
            apply finset_bUnion_is_regex,
            intros c cx,
            split_ifs with hnext,
            { exact one_is_regex, },
            { exact empty_is_regex, },
        },
    }, {
        rw FW,
        have rAB := ih a b,
        have rAH := ih a head,
        have rHH := ih head head,
        have rHB := ih head b,
        apply union_is_regex rAB,
        apply append_is_regex (append_is_regex rAH (star_is_regex rHH)) rHB,
    }
end

lemma FW_is_DFA {dfa : DFA S Q} {allowed : list Q} (hQ : allowed.to_finset = fintype.elems Q) :
   (⋃ c ∈ dfa.term, FW dfa dfa.start c allowed) = lang_of_dfa dfa :=
begin
    apply set.subset.antisymm, {
        apply set.bUnion_subset,
        rintro x x_term w w_fw,
        replace w_fw := FW_to_go_restr w_fw,
        rw [hQ, go_restr_univ] at w_fw,
        subst w_fw,
        exact x_term,
    }, {
        rintro w hw,
        refine set.mem_bUnion hw _,
        apply FW_from_go_restr,
        rw [hQ, go_restr_univ],
    }
end

theorem dfa_to_regex {L : set (list S)} : dfa_lang L → regex_lang L :=
begin
    rintro ⟨Q, fQ, dQ, dfa, rfl⟩,
    resetI,
    letI := fQ,
    rcases to_finset_surjective (fintype.elems Q) with ⟨Qlist, hQ⟩,
    rw ← FW_is_DFA hQ,

    apply finset_bUnion_is_regex,
    rintro c cx,
    exact FW_is_regex dfa.start c,
end

end regex.from_dfa


/-
Copyright (c) 2020 Paul van Wamelen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Paul van Wamelen.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.number_theory.pythagorean_triples
import Mathlib.ring_theory.coprime
import Mathlib.PostPort

namespace Mathlib

/-!
# Fermat's Last Theorem for the case n = 4
There are no non-zero integers `a`, `b` and `c` such that `a ^ 4 + b ^ 4 = c ^ 4`.
-/

/-- Shorthand for three non-zero integers `a`, `b`, and `c` satisfying `a ^ 4 + b ^ 4 = c ^ 2`.
We will show that no integers satisfy this equation. Clearly Fermat's Last theorem for n = 4
follows. -/
def fermat_42 (a : ℤ) (b : ℤ) (c : ℤ) :=
  a ≠ 0 ∧ b ≠ 0 ∧ a ^ bit0 (bit0 1) + b ^ bit0 (bit0 1) = c ^ bit0 1

namespace fermat_42

theorem comm {a : ℤ} {b : ℤ} {c : ℤ} : fermat_42 a b c ↔ fermat_42 b a c := sorry

theorem mul {a : ℤ} {b : ℤ} {c : ℤ} {k : ℤ} (hk0 : k ≠ 0) : fermat_42 a b c ↔ fermat_42 (k * a) (k * b) (k ^ bit0 1 * c) := sorry

theorem ne_zero {a : ℤ} {b : ℤ} {c : ℤ} (h : fermat_42 a b c) : c ≠ 0 := sorry

/-- We say a solution to `a ^ 4 + b ^ 4 = c ^ 2` is minimal if there is no other solution with
a smaller `c` (in absolute value). -/
def minimal (a : ℤ) (b : ℤ) (c : ℤ) :=
  fermat_42 a b c ∧ ∀ (a1 b1 c1 : ℤ), fermat_42 a1 b1 c1 → int.nat_abs c ≤ int.nat_abs c1

/-- if we have a solution to `a ^ 4 + b ^ 4 = c ^ 2` then there must be a minimal one. -/
theorem exists_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : fermat_42 a b c) : ∃ (a0 : ℤ), ∃ (b0 : ℤ), ∃ (c0 : ℤ), minimal a0 b0 c0 := sorry

/-- a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` must have `a` and `b` coprime. -/
theorem coprime_of_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : minimal a b c) : is_coprime a b := sorry

/-- We can swap `a` and `b` in a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2`. -/
theorem minimal_comm {a : ℤ} {b : ℤ} {c : ℤ} : minimal a b c → minimal b a c := sorry

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has positive `c`. -/
theorem neg_of_minimal {a : ℤ} {b : ℤ} {c : ℤ} : minimal a b c → minimal a b (-c) := sorry

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has `a` odd. -/
theorem exists_odd_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : fermat_42 a b c) : ∃ (a0 : ℤ), ∃ (b0 : ℤ), ∃ (c0 : ℤ), minimal a0 b0 c0 ∧ a0 % bit0 1 = 1 := sorry

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has
`a` odd and `c` positive. -/
theorem exists_pos_odd_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : fermat_42 a b c) : ∃ (a0 : ℤ), ∃ (b0 : ℤ), ∃ (c0 : ℤ), minimal a0 b0 c0 ∧ a0 % bit0 1 = 1 ∧ 0 < c0 := sorry

end fermat_42

theorem int.coprime_of_sqr_sum {r : ℤ} {s : ℤ} (h2 : is_coprime s r) : is_coprime (r ^ bit0 1 + s ^ bit0 1) r :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (r ^ bit0 1 + s ^ bit0 1) r)) (pow_two r)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (r * r + s ^ bit0 1) r)) (pow_two s)))
      (is_coprime.mul_add_left_left (is_coprime.mul_left h2 h2) r))

theorem int.coprime_of_sqr_sum' {r : ℤ} {s : ℤ} (h : is_coprime r s) : is_coprime (r ^ bit0 1 + s ^ bit0 1) (r * s) :=
  is_coprime.mul_right (int.coprime_of_sqr_sum (iff.mp is_coprime_comm h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (r ^ bit0 1 + s ^ bit0 1) s)) (add_comm (r ^ bit0 1) (s ^ bit0 1))))
      (int.coprime_of_sqr_sum h))

namespace fermat_42

-- If we have a solution to a ^ 4 + b ^ 4 = c ^ 2, we can construct a smaller one. This

-- implies there can't be a smallest solution.

theorem not_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : minimal a b c) (ha2 : a % bit0 1 = 1) (hc : 0 < c) : False := sorry

end fermat_42

theorem not_fermat_42 {a : ℤ} {b : ℤ} {c : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) : a ^ bit0 (bit0 1) + b ^ bit0 (bit0 1) ≠ c ^ bit0 1 := sorry

theorem not_fermat_4 {a : ℤ} {b : ℤ} {c : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) : a ^ bit0 (bit0 1) + b ^ bit0 (bit0 1) ≠ c ^ bit0 (bit0 1) := sorry