import tactic.ring
import tactic.finish
import tactic.interactive
import tactic.find
import tactic.tidy
import tactic.well_founded_tactics
import lib.tactic.dmatch

open lean
open lean.parser

namespace tactic
namespace interactive
open interactive interactive.types expr

-- `let_eq h : x = v` is like `generalize h : v = x`, but without substitution
meta def let_eq (h : parse ident) (x : parse (tk ":" >> ident)) (v : parse (tk "=" *> texpr))
: tactic unit := do
  «have» (some h) (some ``(∃ x, x = %%v)) (some ``(Exists.intro %%v rfl)),
  hl ← get_local h,
  «destruct» ``(%%hl),
  «clear» [h],
  «intros» [x, h]

meta def cases_on : parse lean.parser.ident → tactic unit
| id := do
  «revert» [id],
  «intro» id,
  co <- resolve_name (id <.> "cases_on"),
  `[apply %%co; intros]

end interactive

open well_founded_tactics

meta def dec_tac_by (try : tactic unit) : tactic unit :=
  tactic.abstract (do
    clear_internals,
    unfold_wf_rel,
    process_lex (do
      unfold_sizeof,
      done <|> (cancel_nat_add_lt >> trivial_nat_lt) <|> try))

end tactic

namespace lib

meta def wf_tacs : well_founded_tactics := {dec_tac := tactic.dec_tac_by `[tidy]}
meta def wf_by (try : tactic unit) : well_founded_tactics := {dec_tac := tactic.dec_tac_by try}

end lib

example (a b : ℕ) : ∃ d, d = a - b := begin
  let_eq h : d = a - b,
  existsi d,
  exact h
end


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fintype.lattice
import data.list.min_max
import data.nat.order.lemmas
import logic.encodable.basic

/-!
# Denumerable types

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

This file defines denumerable (countably infinite) types as a typeclass extending `encodable`. This
is used to provide explicit encode/decode functions from and to `ℕ`, with the information that those
functions are inverses of each other.

## Implementation notes

This property already has a name, namely `α ≃ ℕ`, but here we are interested in using it as a
typeclass.
-/

variables {α β : Type*}

/-- A denumerable type is (constructively) bijective with `ℕ`. Typeclass equivalent of `α ≃ ℕ`. -/
class denumerable (α : Type*) extends encodable α :=
(decode_inv : ∀ n, ∃ a ∈ decode n, encode a = n)

open nat

namespace denumerable

section
variables [denumerable α] [denumerable β]
open encodable

theorem decode_is_some (α) [denumerable α] (n : ℕ) :
  (decode α n).is_some :=
option.is_some_iff_exists.2 $
(decode_inv n).imp $ λ a, Exists.fst

/-- Returns the `n`-th element of `α` indexed by the decoding. -/
def of_nat (α) [f : denumerable α] (n : ℕ) : α :=
option.get (decode_is_some α n)

@[simp, priority 900]
theorem decode_eq_of_nat (α) [denumerable α] (n : ℕ) :
  decode α n = some (of_nat α n) :=
option.eq_some_of_is_some _

@[simp] theorem of_nat_of_decode {n b}
  (h : decode α n = some b) : of_nat α n = b :=
option.some.inj $ (decode_eq_of_nat _ _).symm.trans h

@[simp] theorem encode_of_nat (n) : encode (of_nat α n) = n :=
let ⟨a, h, e⟩ := decode_inv n in
by rwa [of_nat_of_decode h]

@[simp] theorem of_nat_encode (a) : of_nat α (encode a) = a :=
of_nat_of_decode (encodek _)

/-- A denumerable type is equivalent to `ℕ`. -/
def eqv (α) [denumerable α] : α ≃ ℕ :=
⟨encode, of_nat α, of_nat_encode, encode_of_nat⟩

@[priority 100] -- See Note [lower instance priority]
instance : infinite α := infinite.of_surjective _ (eqv α).surjective

/-- A type equivalent to `ℕ` is denumerable. -/
def mk' {α} (e : α ≃ ℕ) : denumerable α :=
{ encode := e,
  decode := some ∘ e.symm,
  encodek := λ a, congr_arg some (e.symm_apply_apply _),
  decode_inv := λ n, ⟨_, rfl, e.apply_symm_apply _⟩ }

/-- Denumerability is conserved by equivalences. This is transitivity of equivalence the denumerable
way. -/
def of_equiv (α) {β} [denumerable α] (e : β ≃ α) : denumerable β :=
{ decode_inv := λ n, by simp,
  ..encodable.of_equiv _ e }

@[simp] theorem of_equiv_of_nat (α) {β} [denumerable α] (e : β ≃ α)
  (n) : @of_nat β (of_equiv _ e) n = e.symm (of_nat α n) :=
by apply of_nat_of_decode; show option.map _ _ = _; simp

/-- All denumerable types are equivalent. -/
def equiv₂ (α β) [denumerable α] [denumerable β] : α ≃ β := (eqv α).trans (eqv β).symm

instance nat : denumerable ℕ := ⟨λ n, ⟨_, rfl, rfl⟩⟩

@[simp] theorem of_nat_nat (n) : of_nat ℕ n = n := rfl

/-- If `α` is denumerable, then so is `option α`. -/
instance option : denumerable (option α) := ⟨λ n, begin
  cases n,
  { refine ⟨none, _, encode_none⟩,
    rw [decode_option_zero, option.mem_def] },
  refine ⟨some (of_nat α n), _, _⟩,
  { rw [decode_option_succ, decode_eq_of_nat, option.map_some', option.mem_def] },
  rw [encode_some, encode_of_nat],
end⟩

/-- If `α` and `β` are denumerable, then so is their sum. -/
instance sum : denumerable (α ⊕ β) :=
⟨λ n, begin
  suffices : ∃ a ∈ @decode_sum α β _ _ n,
    encode_sum a = bit (bodd n) (div2 n), {simpa [bit_decomp]},
  simp [decode_sum]; cases bodd n; simp [decode_sum, bit, encode_sum]
end⟩

section sigma
variables {γ : α → Type*} [∀ a, denumerable (γ a)]

/-- A denumerable collection of denumerable types is denumerable. -/
instance sigma : denumerable (sigma γ) :=
⟨λ n, by simp [decode_sigma]; exact ⟨_, _, ⟨rfl, heq.rfl⟩, by simp⟩⟩

@[simp] theorem sigma_of_nat_val (n : ℕ) :
  of_nat (sigma γ) n = ⟨of_nat α (unpair n).1, of_nat (γ _) (unpair n).2⟩ :=
option.some.inj $
by rw [← decode_eq_of_nat, decode_sigma_val]; simp; refl

end sigma

/-- If `α` and `β` are denumerable, then so is their product. -/
instance prod : denumerable (α × β) :=
of_equiv _ (equiv.sigma_equiv_prod α β).symm

@[simp] theorem prod_of_nat_val (n : ℕ) :
  of_nat (α × β) n = (of_nat α (unpair n).1, of_nat β (unpair n).2) :=
by simp; refl

@[simp] theorem prod_nat_of_nat : of_nat (ℕ × ℕ) = unpair :=
by funext; simp

instance int : denumerable ℤ := denumerable.mk' equiv.int_equiv_nat

instance pnat : denumerable ℕ+ := denumerable.mk' equiv.pnat_equiv_nat

/-- The lift of a denumerable type is denumerable. -/
instance ulift : denumerable (ulift α) := of_equiv _ equiv.ulift

/-- The lift of a denumerable type is denumerable. -/
instance plift : denumerable (plift α) := of_equiv _ equiv.plift

/-- If `α` is denumerable, then `α × α` and `α` are equivalent. -/
def pair : α × α ≃ α := equiv₂ _ _

end
end denumerable

namespace nat.subtype
open function encodable

/-! ### Subsets of `ℕ` -/

variables {s : set ℕ} [infinite s]

section classical
open_locale classical

end classical

variable [decidable_pred (∈ s)]

/-- Returns the next natural in a set, according to the usual ordering of `ℕ`. -/
def succ (x : s) : s :=
have h : ∃ m, ↑x + m + 1 ∈ s, from exists_succ x,
⟨↑x + nat.find h + 1, nat.find_spec h⟩

lemma succ_le_of_lt {x y : s} (h : y < x) : succ y ≤ x :=
have hx : ∃ m, ↑y + m + 1 ∈ s, from exists_succ _,
let ⟨k, hk⟩ := nat.exists_eq_add_of_lt h in
have nat.find hx ≤ k, from nat.find_min' _ (hk ▸ x.2),
show (y : ℕ) + nat.find hx + 1 ≤ x,
by rw hk; exact add_le_add_right (add_le_add_left this _) _

lemma le_succ_of_forall_lt_le {x y : s} (h : ∀ z < x, z ≤ y) : x ≤ succ y :=
have hx : ∃ m, ↑y + m + 1 ∈ s, from exists_succ _,
show ↑x ≤ ↑y + nat.find hx + 1,
from le_of_not_gt $ λ hxy,
(h ⟨_, nat.find_spec hx⟩ hxy).not_lt $
  calc ↑y ≤ ↑y + nat.find hx : le_add_of_nonneg_right (nat.zero_le _)
  ... < ↑y + nat.find hx + 1 : nat.lt_succ_self _

lemma lt_succ_self (x : s) : x < succ x :=
calc (x : ℕ) ≤ x + _ : le_self_add
... < succ x : nat.lt_succ_self (x + _)

lemma lt_succ_iff_le {x y : s} : x < succ y ↔ x ≤ y :=
⟨λ h, le_of_not_gt (λ h', not_le_of_gt h (succ_le_of_lt h')),
  λ h, lt_of_le_of_lt h (lt_succ_self _)⟩

/-- Returns the `n`-th element of a set, according to the usual ordering of `ℕ`. -/
def of_nat (s : set ℕ) [decidable_pred (∈ s)] [infinite s] : ℕ → s
| 0     := ⊥
| (n+1) := succ (of_nat n)

lemma of_nat_surjective_aux : ∀ {x : ℕ} (hx : x ∈ s), ∃ n, of_nat s n = ⟨x, hx⟩
| x := λ hx, let t : list s := ((list.range x).filter (λ y, y ∈ s)).pmap
  (λ (y : ℕ) (hy : y ∈ s), ⟨y, hy⟩) (by simp) in
have hmt : ∀ {y : s}, y ∈ t ↔ y < ⟨x, hx⟩,
  by simp [list.mem_filter, subtype.ext_iff_val, t]; intros; refl,
have wf : ∀ m : s, list.maximum t = m → ↑m < x,
  from λ m hmax, by simpa [hmt] using list.maximum_mem hmax,
begin
  cases hmax : list.maximum t with m,
  { exact ⟨0, le_antisymm bot_le
      (le_of_not_gt (λ h, list.not_mem_nil (⊥ : s) $
        by rw [← list.maximum_eq_none.1 hmax, hmt]; exact h))⟩ },
  cases of_nat_surjective_aux m.2 with a ha,
  exact ⟨a + 1, le_antisymm
    (by rw of_nat; exact succ_le_of_lt (by rw ha; exact wf _ hmax)) $
    by rw of_nat; exact le_succ_of_forall_lt_le
      (λ z hz, by rw ha; cases m; exact list.le_maximum_of_mem (hmt.2 hz) hmax)⟩
end
using_well_founded {dec_tac := `[tauto]}

lemma of_nat_surjective : surjective (of_nat s) :=
λ ⟨x, hx⟩, of_nat_surjective_aux hx

@[simp] lemma of_nat_range : set.range (of_nat s) = set.univ := of_nat_surjective.range_eq

@[simp] lemma coe_comp_of_nat_range : set.range (coe ∘ of_nat s : ℕ → ℕ) = s :=
by rw [set.range_comp coe, of_nat_range, set.image_univ, subtype.range_coe]

private def to_fun_aux (x : s) : ℕ :=
(list.range x).countp (∈ s)

private lemma to_fun_aux_eq (x : s) :
  to_fun_aux x = ((finset.range x).filter (∈ s)).card :=
by rw [to_fun_aux, list.countp_eq_length_filter]; refl

open finset

private lemma right_inverse_aux : ∀ n, to_fun_aux (of_nat s n) = n
| 0 := begin
  rw [to_fun_aux_eq, card_eq_zero, eq_empty_iff_forall_not_mem],
  rintro n hn,
  rw [mem_filter, of_nat, mem_range] at hn,
  exact bot_le.not_lt (show (⟨n, hn.2⟩ : s) < ⊥, from hn.1),
end
| (n+1) := have ih : to_fun_aux (of_nat s n) = n, from right_inverse_aux n,
have h₁ : (of_nat s n : ℕ) ∉ (range (of_nat s n)).filter (∈ s), by simp,
have h₂ : (range (succ (of_nat s n))).filter (∈ s) =
  insert (of_nat s n) ((range (of_nat s n)).filter (∈ s)),
  begin
    simp only [finset.ext_iff, mem_insert, mem_range, mem_filter],
    exact λ m, ⟨λ h, by simp only [h.2, and_true]; exact or.symm
        (lt_or_eq_of_le ((@lt_succ_iff_le _ _ _ ⟨m, h.2⟩ _).1 h.1)),
      λ h, h.elim (λ h, h.symm ▸ ⟨lt_succ_self _, (of_nat s n).prop⟩)
        (λ h, ⟨h.1.trans (lt_succ_self _), h.2⟩)⟩,
  end,
begin
  simp only [to_fun_aux_eq, of_nat, range_succ] at ⊢ ih,
  conv {to_rhs, rw [← ih, ← card_insert_of_not_mem h₁, ← h₂] },
end

/-- Any infinite set of naturals is denumerable. -/
def denumerable (s : set ℕ) [decidable_pred (∈ s)] [infinite s] : denumerable s :=
denumerable.of_equiv ℕ
{ to_fun := to_fun_aux,
  inv_fun := of_nat s,
  left_inv := left_inverse_of_surjective_of_right_inverse of_nat_surjective right_inverse_aux,
  right_inv := right_inverse_aux }

end nat.subtype

namespace denumerable
open encodable

/-- An infinite encodable type is denumerable. -/
def of_encodable_of_infinite (α : Type*) [encodable α] [infinite α] : denumerable α :=
begin
  letI := @decidable_range_encode α _;
  letI : infinite (set.range (@encode α _)) :=
    infinite.of_injective _ (equiv.of_injective _ encode_injective).injective,
  letI := nat.subtype.denumerable (set.range (@encode α _)),
  exact denumerable.of_equiv (set.range (@encode α _)) (equiv_range_encode α),
end

end denumerable

/-- See also `nonempty_encodable`, `nonempty_fintype`. -/
lemma nonempty_denumerable (α : Type*) [countable α] [infinite α] : nonempty (denumerable α) :=
(nonempty_encodable α).map $ λ h, by exactI denumerable.of_encodable_of_infinite _

instance nonempty_equiv_of_countable [countable α] [infinite α] [countable β] [infinite β] :
  nonempty (α ≃ β) :=
begin
  casesI nonempty_denumerable α,
  casesI nonempty_denumerable β,
  exact ⟨(denumerable.eqv _).trans (denumerable.eqv _).symm⟩,
end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Yury Kudryashov
-/
import algebra.algebra.basic
import linear_algebra.tensor_product
import algebra.iterate_hom

/-!
# Facts about algebras involving bilinear maps and tensor products

We move a few basic statements about algebras out of `algebra.algebra.basic`,
in order to avoid importing `linear_algebra.bilinear_map` and
`linear_algebra.tensor_product` unnecessarily.
-/

universes u v w

namespace algebra

open_locale tensor_product
open module

section

variables (R A : Type*) [comm_semiring R] [semiring A] [algebra R A]

/-- The multiplication in an algebra is a bilinear map.

A weaker version of this for semirings exists as `add_monoid_hom.mul`. -/
def lmul : A →ₐ[R] (End R A) :=
{ map_one' := by { ext a, exact one_mul a },
  map_mul' := by { intros a b, ext c, exact mul_assoc a b c },
  map_zero' := by { ext a, exact zero_mul a },
  commutes' := by { intro r, ext a, dsimp, rw [smul_def] },
  .. (show A →ₗ[R] A →ₗ[R] A, from linear_map.mk₂ R (*)
  (λ x y z, add_mul x y z)
  (λ c x y, by rw [smul_def, smul_def, mul_assoc _ x y])
  (λ x y z, mul_add x y z)
  (λ c x y, by rw [smul_def, smul_def, left_comm])) }

variables {R A}

@[simp] lemma lmul_apply (p q : A) : lmul R A p q = p * q := rfl

variables (R)

/-- The multiplication on the left in an algebra is a linear map. -/
def lmul_left (r : A) : A →ₗ[R] A :=
lmul R A r

/-- The multiplication on the right in an algebra is a linear map. -/
def lmul_right (r : A) : A →ₗ[R] A :=
(lmul R A).to_linear_map.flip r

/-- Simultaneous multiplication on the left and right is a linear map. -/
def lmul_left_right (vw: A × A) : A →ₗ[R] A :=
(lmul_right R vw.2).comp (lmul_left R vw.1)

lemma commute_lmul_left_right (a b : A) :
  commute (lmul_left R a) (lmul_right R b) :=
by { ext c, exact (mul_assoc a c b).symm, }

/-- The multiplication map on an algebra, as an `R`-linear map from `A ⊗[R] A` to `A`. -/
def lmul' : A ⊗[R] A →ₗ[R] A :=
tensor_product.lift (lmul R A).to_linear_map

variables {R A}

@[simp] lemma lmul'_apply {x y : A} : lmul' R (x ⊗ₜ y) = x * y :=
by simp only [algebra.lmul', tensor_product.lift.tmul, alg_hom.to_linear_map_apply, lmul_apply]

@[simp] lemma lmul_left_apply (p q : A) : lmul_left R p q = p * q := rfl
@[simp] lemma lmul_right_apply (p q : A) : lmul_right R p q = q * p := rfl
@[simp] lemma lmul_left_right_apply (vw : A × A) (p : A) :
  lmul_left_right R vw p = vw.1 * p * vw.2 := rfl

@[simp] lemma lmul_left_one : lmul_left R (1:A) = linear_map.id :=
by { ext, simp only [linear_map.id_coe, one_mul, id.def, lmul_left_apply] }

@[simp] lemma lmul_left_mul (a b : A) :
  lmul_left R (a * b) = (lmul_left R a).comp (lmul_left R b) :=
by { ext, simp only [lmul_left_apply, linear_map.comp_apply, mul_assoc] }

@[simp] lemma lmul_right_one : lmul_right R (1:A) = linear_map.id :=
by { ext, simp only [linear_map.id_coe, mul_one, id.def, lmul_right_apply] }

@[simp] lemma lmul_right_mul (a b : A) :
  lmul_right R (a * b) = (lmul_right R b).comp (lmul_right R a) :=
by { ext, simp only [lmul_right_apply, linear_map.comp_apply, mul_assoc] }

@[simp] lemma lmul_left_zero_eq_zero :
  lmul_left R (0 : A) = 0 :=
(lmul R A).map_zero

@[simp] lemma lmul_right_zero_eq_zero :
  lmul_right R (0 : A) = 0 :=
(lmul R A).to_linear_map.flip.map_zero

@[simp] lemma lmul_left_eq_zero_iff (a : A) :
  lmul_left R a = 0 ↔ a = 0 :=
begin
  split; intros h,
  { rw [← mul_one a, ← lmul_left_apply a 1, h, linear_map.zero_apply], },
  { rw h, exact lmul_left_zero_eq_zero, },
end

@[simp] lemma lmul_right_eq_zero_iff (a : A) :
  lmul_right R a = 0 ↔ a = 0 :=
begin
  split; intros h,
  { rw [← one_mul a, ← lmul_right_apply a 1, h, linear_map.zero_apply], },
  { rw h, exact lmul_right_zero_eq_zero, },
end

@[simp] lemma pow_lmul_left (a : A) (n : ℕ) :
  (lmul_left R a) ^ n = lmul_left R (a ^ n) :=
((lmul R A).map_pow a n).symm

@[simp] lemma pow_lmul_right (a : A) (n : ℕ) :
  (lmul_right R a) ^ n = lmul_right R (a ^ n) :=
linear_map.coe_injective $ ((lmul_right R a).coe_pow n).symm ▸ (mul_right_iterate a n)

end

section

variables {R A : Type*} [comm_semiring R] [ring A] [algebra R A]

lemma lmul_left_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
  function.injective (lmul_left R x) :=
by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
     exact mul_right_injective₀ hx }

lemma lmul_right_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
  function.injective (lmul_right R x) :=
by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
     exact mul_left_injective₀ hx }

lemma lmul_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
  function.injective (lmul R A x) :=
by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
     exact mul_right_injective₀ hx }

end

end algebra


-- Lógica de primer orden en Lean
-- ==============================

import tactic

variable  {U : Type}
variable  c : U
variables {P Q : U → Prop}
variable  {R : U -> U -> Prop}
variables (x y z : U)

-- * Reglas del cuantificador universal
-- ====================================

-- ** Regla de eliminación del cuantificador universal
-- ===================================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar
--    P(c), ∀x (P(x) → ¬Q(x)) ⊢ ¬Q(c)
-- ----------------------------------------------------

-- 1ª demostración
example
  (h1 : P c)
  (h2 : ∀x, P x → ¬Q x)
  : ¬Q c :=
have h3 : P c → ¬Q c, from h2 c,
show ¬Q c,            from h3 h1

-- 2ª demostración
example
  (h1 : P c)
  (h2 : ∀x, P x → ¬Q x)
  : ¬Q c :=
have h3 : P c → ¬Q c, from h2 c,
h3 h1

-- 3ª demostración
example
  (h1 : P c)
  (h2 : ∀x, P x → ¬Q x)
  : ¬Q c :=
(h2 c) h1

-- 4ª demostración
example
  (h1 : P c)
  (h2 : ∀x, P x → ¬Q x)
  : ¬Q c :=
-- by library_search
h2 c h1

-- 5ª demostración
example
  (h1 : P c)
  (h2 : ∀x, P x → ¬Q x)
  : ¬Q c :=
-- by hint
by tauto

-- 6ª demostración
example
  (h1 : P c)
  (h2 : ∀x, P x → ¬Q x)
  : ¬Q c :=
by finish

-- 7ª demostración
example
  (h1 : P c)
  (h2 : ∀x, P x → ¬Q x)
  : ¬Q c :=
begin
  apply h2,
  exact h1,
end

-- ** Regla de introducción del cuantificador universal
-- ====================================================

-- ----------------------------------------------------
-- Ej. 2. Demostrar
--    ∀x [P(x) → ¬Q(x)], ∀x P(x) ⊢ ∀x ¬Q(x)
-- ----------------------------------------------------

-- 1ª demostración
example
  (h1 : ∀x, P x → ¬Q x)
  (h2 : ∀x, P x)
  : ∀x, ¬Q x :=
assume x₀,
have h4 : P x₀ → ¬Q x₀, from h1 x₀,
have h5 : P x₀,         from h2 x₀,
show ¬Q x₀,             from h4 h5

-- 2ª demostración
example
  (h1 : ∀x, P x → ¬Q x)
  (h2 : ∀x, P x)
  : ∀x, ¬Q x :=
assume x₀, (h1 x₀) (h2 x₀)

-- 3ª demostración
example
  (h1 : ∀x, P x → ¬Q x)
  (h2 : ∀x, P x)
  : ∀x, ¬Q x :=
λ x₀, (h1 x₀) (h2 x₀)

-- 4ª demostración
example
  (h1 : ∀x, P x → ¬Q x)
  (h2 : ∀x, P x)
  : ∀x, ¬Q x :=
begin
  intro x₀,
  apply h1,
  apply h2,
end

-- 5ª demostración
example
  (h1 : ∀x, P x → ¬Q x)
  (h2 : ∀x, P x)
  : ∀x, ¬Q x :=
begin
  intro x₀,
  specialize h1 x₀,
  specialize h2 x₀,
  apply h1,
  exact h2,
end

-- 6ª demostración
example
  (h1 : ∀x, P x → ¬Q x)
  (h2 : ∀x, P x)
  : ∀x, ¬Q x :=
begin
  intro x₀,
  specialize h1 x₀,
  specialize h2 x₀,
  exact h1 h2,
end

-- 7ª demostración
example
  (h1 : ∀x, P x → ¬Q x)
  (h2 : ∀x, P x)
  : ∀x, ¬Q x :=
-- by hint
by tauto

-- 8ª demostración
example
  (h1 : ∀x, P x → ¬Q x)
  (h2 : ∀x, P x)
  : ∀x, ¬Q x :=
by finish

-- * Reglas del cuantificador existencial
-- ======================================

-- ** Regla de introducción del cuantificador existencial
-- ======================================================

-- ----------------------------------------------------
-- Ej. 3. Demostrar
--    ∀x P(x) ⊢ ∃x P(x)
-- ----------------------------------------------------

-- 1ª demostración
example
  (h1 : ∀x, P x)
  : ∃x, P x :=
have h2 : P c, from h1 c,
show ∃x, P x,  from exists.intro c h2

-- 2ª demostración
example
  (h1 : ∀x, P x)
  : ∃x, P x :=
show ∃x, P x,  from exists.intro c (h1 c)

-- 3ª demostración
example
  (h1 : ∀x, P x)
  : ∃x, P x :=
exists.intro c (h1 c)

-- 4ª demostración
example
  (h1 : ∀x, P x)
  : ∃x, P x :=
⟨c, h1 c⟩

-- 5ª demostración
example
  (a : U)
  (h1 : ∀x, P x)
  : ∃x, P x :=
begin
  use a,
  apply h1,
end

-- 6ª demostración
example
  (a : U)
  (h1 : ∀x, P x)
  : ∃x, P x :=
begin
  constructor,
  apply h1 a,
end

-- 7ª demostración
example
  [inhabited U]
  (h1 : ∀x, P x)
  : ∃x, P x :=
begin
  constructor,
  apply h1 (default U),
end

-- 8ª demostración
example
  (h : nonempty U)
  (h1 : ∀x, P x)
  : ∃x, P x :=
begin
  use (classical.choice h),
  apply h1,
end

-- ** Regla de eliminación del cuantificador existencial
-- =====================================================

-- ----------------------------------------------------
-- Ej. 4. Demostrar
--    ∀x [P(x) → Q(x)], ∃x P(x) ⊢ ∃x Q(x)
-- ----------------------------------------------------

-- 1ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
exists.elim h2
  ( assume x₀ (h3 : P x₀),
    have h4 : P x₀ → Q x₀, from h1 x₀,
    have h5 : Q x₀,        from h4 h3,
    show ∃x, Q x,          from exists.intro x₀ h5 )

-- 2ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
exists.elim h2
  ( assume x₀ (h3 : P x₀),
    have h4 : P x₀ → Q x₀, from h1 x₀,
    have h5 : Q x₀,        from h4 h3,
    show ∃x, Q x,          from ⟨x₀, h5⟩ )

-- 3ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
exists.elim h2
  ( assume x₀ (h3 : P x₀),
    have h4 : P x₀ → Q x₀, from h1 x₀,
    have h5 : Q x₀,        from h4 h3,
    ⟨x₀, h5⟩ )

-- 4ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
exists.elim h2
  ( assume x₀ (h3 : P x₀),
    have h4 : P x₀ → Q x₀, from h1 x₀,
    ⟨x₀, h4 h3⟩ )

-- 5ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
exists.elim h2
  ( assume x₀ (h3 : P x₀),
    ⟨x₀, h1 x₀ h3⟩ )

-- 6ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
exists.elim h2 (λ x₀ h3, ⟨x₀, h1 x₀ h3⟩)

-- 7ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
-- by library_search
Exists.imp h1 h2

-- 8ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
begin
  cases h2 with x₀ h3,
  use x₀,
  apply h1,
  exact h3,
end

-- 9ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
begin
  cases h2 with x₀ h3,
  use x₀,
  specialize h1 x₀,
  apply h1,
  exact h3,
end

-- 10ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
-- by hint
by tauto

-- 11ª demostración
-- ===============

example
  (h1 : ∀x, P x → Q x)
  (h2 : ∃x, P x)
  : ∃x, Q x :=
by finish

-- * Ejercicios sobre cuantificadores
-- ==================================

-- ------------------------------------------------------
-- Ej. 5. Demostrar que
--    ¬∀x P(x) ⊢ ∃x ¬P(x)
-- ------------------------------------------------------

-- 1ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume x₀,
        show P x₀, from
          by_contra
            ( assume h4 : ¬P x₀,
              have h5 : ∃x, ¬P x, from exists.intro x₀ h4,
              show false, from h2 h5 )),
    show false, from h1 h8)

-- 2ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume x₀,
        show P x₀, from
          by_contra
            ( assume h4 : ¬P x₀,
              have h5 : ∃x, ¬P x, from exists.intro x₀ h4,
              show false, from h2 h5 )),
    h1 h8)

-- 3ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume x₀,
        show P x₀, from
          by_contra
            ( assume h4 : ¬P x₀,
              have h5 : ∃x, ¬P x, from exists.intro x₀ h4,
              h2 h5 )),
    h1 h8)

-- 4ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume x₀,
        show P x₀, from
          by_contra
            ( assume h4 : ¬P x₀,
              have h5 : ∃x, ¬P x, from ⟨x₀, h4⟩,
              h2 h5 )),
    h1 h8)

-- 5ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume x₀,
        show P x₀, from
          by_contra
            ( assume h4 : ¬P x₀,
              h2 ⟨x₀, h4⟩ )),
    h1 h8)

-- 6ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume x₀,
        show P x₀, from
          by_contra (λ h4, h2 ⟨x₀, h4⟩)),
    h1 h8)

-- 7ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume x₀,
        by_contra (λ h4, h2 ⟨x₀, h4⟩)),
    h1 h8)

-- 8ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      (λ x₀, by_contra (λ h4, h2 ⟨x₀, h4⟩)),
    h1 h8)

-- 9ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    h1 (λ x₀, by_contra (λ h4, h2 ⟨x₀, h4⟩)))

-- 10ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra (λ h2, h1 (λ x₀, by_contra (λ h4, h2 ⟨x₀, h4⟩)))

-- 11ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
-- by library_search
not_forall.mp h1

-- 12ª demostración
lemma aux1
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
-- by hint
by finish

-- ------------------------------------------------------
-- Ej. 6. Demostrar que
--    ∃x ¬P(x) ⊢ ¬∀x P(x)
-- ------------------------------------------------------

-- 1ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
exists.elim h1
  ( assume x₀ (h3 : ¬P x₀),
    have h4 : P x₀, from h2 x₀,
    show false, from h3 h4)

-- 2ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
exists.elim h1
  ( assume x₀ (h3 : ¬P x₀),
    have h4 : P x₀, from h2 x₀,
    h3 h4)

-- 3ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
exists.elim h1
  ( assume x₀ (h3 : ¬P x₀),
    h3 (h2 x₀))

-- 4ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
exists.elim h1
  (λ x₀ h3, h3 (h2 x₀))

-- 5ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
λ h2, exists.elim h1 (λ x₀ h3, h3 (h2 x₀))

-- 6ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
-- by library_search
not_forall.mpr h1

-- 7ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
match h1 with ⟨x₀, (h3 : ¬P x₀)⟩ :=
  ( have h4 : P x₀, from h2 x₀,
    show false,     from h3 h4)
end

-- 8ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
begin
  intro h2,
  cases h1 with x₀ h3,
  apply h3,
  apply h2,
end

example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
begin
  intro h2,
  obtain ⟨x₀, h3⟩ := h1,
  apply h3,
  apply h2,
end

-- 9ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
-- by hint
by tauto

-- 10ª demostración
lemma aux2
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
by finish

-- ------------------------------------------------------
-- Ej. 7. Demostrar que
--    ¬∀x P(x) ↔ ∃x ¬P(x)
-- ------------------------------------------------------

-- 1ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
iff.intro
  ( assume h1 : ¬∀x, P x,
    show ∃x, ¬P x, from aux1 h1)
  ( assume h2 : ∃x, ¬P x,
    show ¬∀x, P x, from aux2 h2)

-- 2ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
iff.intro aux1 aux2

-- 3ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
-- by library_search
not_forall

-- 4ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
begin
  split,
  { exact aux1, },
  { exact aux2, },
end

-- 5ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
-- by hint
by finish

-- ------------------------------------------------------
-- Ej. 8. Demostrar
--    ∀x (P(x) ∧ Q(x)) ⊢ ∀x P(x) ∧ ∀x Q(x)
-- ------------------------------------------------------

-- 1ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
have h5 : ∀x, P x, from
    assume x₀,
    have h3 : P x₀ ∧ Q x₀,  from h1 x₀,
    show P x₀,              from and.elim_left h3,
have h9 : ∀x, Q x, from
    assume x₁,
    have h7 : P x₁ ∧ Q x₁,  from h1 x₁,
    show Q x₁,              from and.elim_right h7,
show (∀x, P x) ∧ (∀x, Q x), from and.intro h5 h9

-- 2ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
have h5 : ∀x, P x, from
    assume x₀,
    have h3 : P x₀ ∧ Q x₀,  from h1 x₀,
    show P x₀,              from h3.left,
have h9 : ∀x, Q x, from
    assume x₁,
    have h7 : P x₁ ∧ Q x₁,  from h1 x₁,
    show Q x₁,              from h7.right,
show (∀x, P x) ∧ (∀x, Q x), from ⟨h5, h9⟩

-- 3ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
have h5 : ∀x, P x, from
    assume x₀,
    have h3 : P x₀ ∧ Q x₀,  from h1 x₀,
    h3.left,
have h9 : ∀x, Q x, from
    assume x₁,
    have h7 : P x₁ ∧ Q x₁,  from h1 x₁,
    h7.right,
show (∀x, P x) ∧ (∀x, Q x), from ⟨h5, h9⟩

-- 4ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
have h5 : ∀x, P x, from
    assume x₀,
    (h1 x₀).left,
have h9 : ∀x, Q x, from
    assume x₁,
    (h1 x₁).right,
show (∀x, P x) ∧ (∀x, Q x), from ⟨h5, h9⟩

-- 5ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
have h5 : ∀x, P x, from
    λ x₀, (h1 x₀).left,
have h9 : ∀x, Q x, from
    λ x₁, (h1 x₁).right,
show (∀x, P x) ∧ (∀x, Q x), from ⟨h5, h9⟩

-- 6ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
have h5 : ∀x, P x, from
    λ x₀, (h1 x₀).left,
have h9 : ∀x, Q x, from
    λ x₁, (h1 x₁).right,
⟨h5, h9⟩

-- 7ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
⟨λ x₀, (h1 x₀).left, λ x₁, (h1 x₁).right⟩

-- 8ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
-- by library_search
forall_and_distrib.mp h1

-- 9ª demostración
example
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
begin
  split,
  { intro x₀,
    specialize h1 x₀,
    exact h1.left, },
  { intro x₁,
    specialize h1 x₁,
    exact h1.right, },
end

-- 9ª demostración
lemma aux3
  (h1 : ∀x, P x ∧ Q x)
  : (∀x, P x) ∧ (∀x, Q x) :=
-- by hint
by finish

-- ------------------------------------------------------
-- Ej. 9. Demostrar
--    ∀x P(x) ∧ ∀x Q(x) ⊢ ∀x (P(x) ∧ Q(x))
-- ------------------------------------------------------

-- 1ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
assume x₀,
have h3 : ∀x, P x, from and.elim_left h1,
have h4 : P x₀,    from h3 x₀,
have h5 : ∀x, Q x, from and.elim_right h1,
have h6 : Q x₀,    from h5 x₀,
show P x₀ ∧ Q x₀,  from and.intro h4 h6

-- 2ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
assume x₀,
have h3 : ∀x, P x, from h1.left,
have h4 : P x₀,    from h3 x₀,
have h5 : ∀x, Q x, from h1.right,
have h6 : Q x₀,    from h5 x₀,
show P x₀ ∧ Q x₀,  from ⟨h4, h6⟩

-- 3ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
assume x₀,
have h3 : ∀x, P x, from h1.left,
have h4 : P x₀,    from h3 x₀,
have h5 : ∀x, Q x, from h1.right,
have h6 : Q x₀,    from h5 x₀,
⟨h4, h6⟩

-- 4ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
assume x₀,
have h3 : ∀x, P x, from h1.left,
have h4 : P x₀,    from h3 x₀,
have h5 : ∀x, Q x, from h1.right,
⟨h4, h5 x₀⟩

-- 5ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
assume x₀,
have h3 : ∀x, P x, from h1.left,
have h4 : P x₀,    from h3 x₀,
⟨h4, h1.right x₀⟩

-- 6ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
assume x₀,
have h3 : ∀x, P x, from h1.left,
⟨h3 x₀, h1.right x₀⟩

-- 7ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
assume x₀,
⟨h1.left x₀, h1.right x₀⟩

-- 8ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
λ x₀, ⟨h1.left x₀, h1.right x₀⟩

-- 9ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
-- by library_search
forall_and_distrib.mpr h1

-- 10ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
begin
  cases h1 with h2 h3,
  intro x₀,
  split,
  { apply h2, },
  { apply h3, },
end

-- 11ª demostración
example
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
-- by hint
by tauto

-- 12ª demostración
lemma aux4
  (h1 : (∀x, P x) ∧ (∀x, Q x))
  : ∀x, P x ∧ Q x :=
by finish

-- ------------------------------------------------------
-- Ej. 10. Demostrar
--    ∀x (P(x) ∧ Q(x)) ↔ ∀x P(x) ∧ ∀x Q(x)
-- ------------------------------------------------------

-- 1ª demostración
example :
  (∀x, P x ∧ Q x) ↔ (∀x, P x) ∧ (∀x, Q x) :=
iff.intro aux3 aux4

-- 2ª demostración
example :
  (∀x, P x ∧ Q x) ↔ (∀x, P x) ∧ (∀x, Q x) :=
-- by library_search
forall_and_distrib

-- 3ª demostración
example :
  (∀x, P x ∧ Q x) ↔ (∀x, P x) ∧ (∀x, Q x) :=
-- by hint
by finish

-- -----------------------------------------------------
-- Ej. 11. Demostrar
--    ∃x (P(x) ∨ Q(x)) ⊢ ∃x P(x) ∨ ∃x Q(x)
-- -----------------------------------------------------

-- 1ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
exists.elim h1
  ( assume x₀ (h2 : P x₀ ∨ Q x₀),
    or.elim h2
    ( assume h3 : P x₀,
      have h4 : ∃x, P x,          from exists.intro x₀ h3,
      show (∃x, P x) ∨ (∃x, Q x), from or.inl h4 )
    ( assume h6 : Q x₀,
      have h7 : ∃x, Q x,          from exists.intro x₀ h6,
      show (∃x, P x) ∨ (∃x, Q x), from or.inr h7 ))

-- 2ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
exists.elim h1
  ( assume x₀ (h2 : P x₀ ∨ Q x₀),
    or.elim h2
    ( assume h3 : P x₀,
      have h4 : ∃x, P x,          from ⟨x₀, h3⟩,
      show (∃x, P x) ∨ (∃x, Q x), from or.inl h4 )
    ( assume h6 : Q x₀,
      have h7 : ∃x, Q x,          from ⟨x₀, h6⟩,
      show (∃x, P x) ∨ (∃x, Q x), from or.inr h7 ))

-- 3ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
exists.elim h1
  ( assume x₀ (h2 : P x₀ ∨ Q x₀),
    or.elim h2
    ( assume h3 : P x₀,
      have h4 : ∃x, P x,          from ⟨x₀, h3⟩,
      or.inl h4 )
    ( assume h6 : Q x₀,
      have h7 : ∃x, Q x,          from ⟨x₀, h6⟩,
      or.inr h7 ))

-- 4ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
exists.elim h1
  ( assume x₀ (h2 : P x₀ ∨ Q x₀),
    or.elim h2
    ( assume h3 : P x₀,
      or.inl ⟨x₀, h3⟩ )
    ( assume h6 : Q x₀,
      or.inr ⟨x₀, h6⟩ ))

-- 5ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
exists.elim h1
  ( assume x₀ (h2 : P x₀ ∨ Q x₀),
    or.elim h2
    ( λ h3, or.inl ⟨x₀, h3⟩ )
    ( λ h6, or.inr ⟨x₀, h6⟩ ))

-- 6ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
exists.elim h1
  (λ x₀ h2, h2.elim (λ h3, or.inl ⟨x₀, h3⟩)
                    (λ h6, or.inr ⟨x₀, h6⟩))

-- 7ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
-- by library_search
exists_or_distrib.mp h1

-- 8ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
match h1 with ⟨x₀, (h2 : P x₀ ∨ Q x₀)⟩ :=
  ( or.elim h2
    ( assume h3 : P x₀,
      have h4 : ∃x, P x,          from exists.intro x₀ h3,
      show (∃x, P x) ∨ (∃x, Q x), from or.inl h4 )
    ( assume h6 : Q x₀,
      have h7 : ∃x, Q x,          from exists.intro x₀ h6,
      show (∃x, P x) ∨ (∃x, Q x), from or.inr h7 ))
end

-- 9ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
begin
  cases h1 with x₀ h3,
  cases h3 with hp hq,
  { left,
    use x₀,
    exact hp, },
  { right,
    use x₀,
    exact hq, },
end

-- 10ª demostración
example
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
begin
  rcases h1 with ⟨x₀, hp | hq⟩,
  { left,
    use x₀,
    exact hp, },
  { right,
    use x₀,
    exact hq, },
end

-- 11ª demostración
lemma aux5
  (h1 : ∃x, P x  ∨ Q x)
  : (∃x, P x) ∨ (∃x, Q x) :=
-- by hint
by finish

-- -----------------------------------------------------
-- Ej. 12. Demostrar
--    ∃x P(x) ∨ ∃x Q(x) ⊢ ∃x (P(x) ∨ Q(x))
-- -----------------------------------------------------

-- 1ª demostración
example
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
or.elim h1
  ( assume h2 : ∃x, P x,
    exists.elim h2
      ( assume x₀ (h3 : P x₀),
        have h4 : P x₀ ∨ Q x₀, from or.inl h3,
        show ∃x, P x  ∨ Q x,   from exists.intro x₀ h4 ))
  ( assume h2 : ∃x, Q x,
    exists.elim h2
      ( assume x₀ (h3 : Q x₀),
        have h4 : P x₀ ∨ Q x₀, from or.inr h3,
        show ∃x, P x  ∨ Q x,   from exists.intro x₀ h4 ))

-- 2ª demostración
example
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
h1.elim
  ( assume ⟨x₀, (h3 : P x₀)⟩,
    have h4 : P x₀ ∨ Q x₀, from or.inl h3,
    show ∃x, P x  ∨ Q x,   from ⟨x₀, h4⟩ )
  ( assume ⟨x₀, (h3 : Q x₀)⟩,
    have h4 : P x₀ ∨ Q x₀, from or.inr h3,
    show ∃x, P x  ∨ Q x,   from ⟨x₀, h4⟩ )

-- 3ª demostración
example
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
h1.elim
  ( assume ⟨x₀, (h3 : P x₀)⟩,
    have h4 : P x₀ ∨ Q x₀, from or.inl h3,
    ⟨x₀, h4⟩ )
  ( assume ⟨x₀, (h3 : Q x₀)⟩,
    have h4 : P x₀ ∨ Q x₀, from or.inr h3,
    ⟨x₀, h4⟩ )

-- 4ª demostración
example
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
h1.elim
  ( assume ⟨x₀, (h3 : P x₀)⟩,
    ⟨x₀, or.inl h3⟩ )
  ( assume ⟨x₀, (h3 : Q x₀)⟩,
    ⟨x₀, or.inr h3⟩ )

-- 5ª demostración
example
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
h1.elim
  (λ ⟨x₀, h3⟩, ⟨x₀, or.inl h3⟩)
  (λ ⟨x₀, h3⟩, ⟨x₀, or.inr h3⟩)

-- 6ª demostración
example
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
-- by library_search
exists_or_distrib.mpr h1

-- 7ª demostración
example
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
begin
  cases h1 with hp hq,
  { cases hp with x₀ hx₀,
    use x₀,
    left,
    exact hx₀, },
  { cases hq with x₁ hx₁,
    use x₁,
    right,
    exact hx₁, },
end

-- 8ª demostración
example
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
begin
  rcases h1 with ⟨x₀, hx₀⟩ | ⟨x₁, hx₁⟩,
  { use x₀,
    left,
    exact hx₀, },
  { use x₁,
    right,
    exact hx₁, },
end

-- 9ª demostración
lemma aux6
  (h1 : (∃x, P x) ∨ (∃x, Q x))
  : ∃x, P x  ∨ Q x :=
-- by hint
by finish

-- -----------------------------------------------------
-- Ej. 13. Demostrar
--    ∃x (P(x) ∨ Q(x)) ↔ ∃x P(x) ∨ ∃x Q(x)
-- -----------------------------------------------------

-- 1ª demostración
example :
  (∃x, P x  ∨ Q x) ↔ (∃x, P x) ∨ (∃x, Q x) :=
iff.intro aux5 aux6

-- 2ª demostración
example :
  (∃x, P x  ∨ Q x) ↔ (∃x, P x) ∨ (∃x, Q x) :=
⟨aux5, aux6⟩

-- 3ª demostración
example :
  (∃x, P x  ∨ Q x) ↔ (∃x, P x) ∨ (∃x, Q x) :=
-- by library_search
exists_or_distrib

-- ------------------------------------------------------
-- Ej. 14. Demostrar que
--    ∃x∃yR(x,y) → ∃y∃xR(x,y)
-- ------------------------------------------------------

-- 1ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
assume h1 : ∃ x, ∃ y, R x y,
exists.elim h1
  ( assume x₀ (h2 : ∃ y, R x₀ y),
    exists.elim h2
      ( assume y₀ (h3 : R x₀ y₀),
        have h4 : ∃ x, R x y₀, from exists.intro x₀ h3,
        show ∃ y, ∃ x, R x y,  from exists.intro y₀ h4))

-- 2ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
assume ⟨x₀, y₀, (h1 : R x₀ y₀)⟩,
have h2 : ∃ x, R x y₀, from ⟨x₀, h1⟩,
show (∃ y, ∃ x, R x y), from ⟨y₀, h2⟩

-- 3ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
assume ⟨x₀, y₀, (h1 : R x₀ y₀)⟩,
show (∃ y, ∃ x, R x y), from ⟨y₀, ⟨x₀, h1⟩⟩

-- 4ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
assume ⟨x₀, y₀, (h1 : R x₀ y₀)⟩,
show (∃ y, ∃ x, R x y), from ⟨y₀, x₀, h1⟩

-- 5ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
assume ⟨x₀, y₀, (h1 : R x₀ y₀)⟩,
⟨y₀, x₀, h1⟩

-- 6ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
λ ⟨x₀, y₀, h1⟩, ⟨y₀, x₀, h1⟩

-- 7ª demostración
example :
  (∃ x y, R x y) → (∃ y x, R x y) :=
-- by library_search
exists_comm.mp

-- 8ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
begin
  intro h1,
  cases h1 with x₀ h2,
  cases h2 with y₀ h3,
  use y₀,
  use x₀,
  exact h3,
end

-- 9ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
begin
  intro h1,
  cases h1 with x₀ h2,
  cases h2 with y₀ h3,
  use [y₀, x₀],
  exact h3,
end

-- 10ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
begin
  intro h1,
  rcases h1 with ⟨x₀, y₀, h2⟩,
  use [y₀, x₀],
  exact h2,
end

-- 11ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
begin
  intro h1,
  rcases h1 with ⟨x₀, y₀, h2⟩,
  exact ⟨y₀, x₀, h2⟩,
end

-- 12ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
begin
  rintro ⟨x₀, y₀, h2⟩,
  exact ⟨y₀, x₀, h2⟩,
end

-- 13ª demostración
example :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
-- by hint
by tauto

-- 14ª demostración
lemma aux :
  (∃ x, ∃ y, R x y) → (∃ y, ∃ x, R x y) :=
by finish

-- ------------------------------------------------------
-- Ej. 15. Demostrar que
--    ∃x∃yR(x,y) ↔ ∃y∃xR(x,y)
-- ------------------------------------------------------

-- 1ª demostración
example :
  (∃ x y, R x y) ↔ (∃ y x, R x y) :=
iff.intro aux aux

-- 2ª demostración
example :
  (∃ x y, R x y) ↔ (∃ y x, R x y) :=
⟨aux, aux⟩

-- 3ª demostración
example :
  (∃ x y, R x y) ↔ (∃ y x, R x y) :=
-- by library_search
exists_comm

-- 4ª demostración
example :
  (∃ x y, R x y) ↔ (∃ y x, R x y) :=
-- by hint
by tauto

-- * Reglas de la igualdad
-- =======================

-- ** Regla de eliminación de la igualdad
-- ======================================

-- ----------------------------------------------------
-- Ej. 16. Demostrar que
--      x + 1 = 1 + x
--      x + 1 > 1 → x + 1 > 0
--      ⊢ 1 + x > 1 → 1 + x > 0
-- ----------------------------------------------------

variable [has_add U]
variable [has_one U]
variable [has_lt U]
variable [has_zero U]

-- 1ª demostración
example
  (h1 : x + 1 = 1 + x)
  (h2 : x + 1 > 1 → x + 1 > 0)
  : 1 + x > 1 → 1 + x > 0 :=
eq.subst h1 h2

-- 2ª demostración
example
  (h1 : x + 1 = 1 + x)
  (h2 : x + 1 > 1 → x + 1 > 0)
  : 1 + x > 1 → 1 + x > 0 :=
h1 ▸ h2

-- 3ª demostración
example
  (h1 : x + 1 = 1 + x)
  (h2 : x + 1 > 1 → x + 1 > 0)
  : 1 + x > 1 → 1 + x > 0 :=
begin
  rw h1 at h2,
  exact h2,
end

-- 4ª demostración
example
  (h1 : x + 1 = 1 + x)
  (h2 : x + 1 > 1 → x + 1 > 0)
  : 1 + x > 1 → 1 + x > 0 :=
begin
  rw ←h1,
  exact h2,
end

-- 5ª demostración
example
  (h1 : x + 1 = 1 + x)
  (h2 : x + 1 > 1 → x + 1 > 0)
  : 1 + x > 1 → 1 + x > 0 :=
-- by hint
by finish

-- ----------------------------------------------------
-- Ej. 17. Demostrar que
--    x = y, y = z ⊢ x = z
-- ----------------------------------------------------

-- 1ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
eq.subst h2 h1

-- 2ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
h2 ▸ h1

-- 3ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
eq.substr h1 h2

-- 4ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
eq.trans h1 h2

-- 5ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
begin
  rw h1,
  exact h2,
end

-- 6ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
begin
  rw h1,
  assumption,
end

-- 7ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
begin
  rwa h1,
end

-- 8ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
by rwa h1

-- 9ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
begin
  rwa ←h2,
end

-- 10ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
begin
  rwa h2 at h1,
end

-- 11ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
by simp *

-- 12ª demostración
example
  (h1 : x = y)
  (h2 : y = z)
  : x = z :=
-- by hint
by finish

-- ** Regla de introducción de la igualdad
-- =======================================

-- ----------------------------------------------------
-- Ej. 18. Demostrar
--    x = y ⊢ y = x
-- ----------------------------------------------------

-- 1ª demostración
example
  (h1 : x = y)
  : y = x :=
have h2 : x = x, from eq.refl x,
show y = x,      from eq.subst h1 h2

-- 2ª demostración
example
  (h1 : x = y)
  : y = x :=
have h2 : x = x, from eq.refl x,
show y = x,      from h1 ▸ h2

-- 3ª demostración
example
  (h1 : x = y)
  : y = x :=
have h2 : x = x, from eq.refl x,
h1 ▸ h2

-- 4ª demostración
example
  (h1 : x = y)
  : y = x :=
h1 ▸ eq.refl x

-- 5ª demostración
example
  (h1 : x = y)
  : y = x :=
h1 ▸ rfl

-- 6ª demostración
example
  (h1 : x = y)
  : y = x :=
-- by library_search
eq.symm h1

-- 7ª demostración
example
  (h1 : x = y)
  : y = x :=
begin
  rw h1,
end

-- 8ª demostración
example
  (h1 : x = y)
  : y = x :=
by rw h1

-- 9ª demostración
example
  (h1 : x = y)
  : y = x :=
by simp *

-- 10ª demostración
example
  (h1 : x = y)
  : y = x :=
-- by hint
by tauto

-- 11ª demostración
example
  (h1 : x = y)
  : y = x :=
by finish

-- 12ª demostración
example
  (h1 : x = y)
  : y = x :=
by solve_by_elim

-- ----------------------------------------------------
-- Ej. 19. Demostrar
--    y = x → y = z → x = z
-- ----------------------------------------------------

-- 1ª demostración
example : y = x → y = z → x = z :=
assume h1 : y = x,
assume h2 : y = z,
have h3 : x = y, from eq.symm h1,
show x = z,      from eq.trans h3 h2

-- 2ª demostración
example : y = x → y = z → x = z :=
assume h1 : y = x,
assume h2 : y = z,
have h3 : x = y, from eq.symm h1,
eq.trans h3 h2

-- 3ª demostración
example : y = x → y = z → x = z :=
assume h1 : y = x,
assume h2 : y = z,
eq.trans (eq.symm h1) h2

-- 4ª demostración
example : y = x → y = z → x = z :=
λ h1 h2, eq.trans (eq.symm h1) h2

-- 5ª demostración
example : y = x → y = z → x = z :=
λ h1 h2, eq.trans h1.symm h2

-- 6ª demostración
example : y = x → y = z → x = z :=
-- by library_search
λ h, h.congr_left.mp

-- 7ª demostración
example : y = x → y = z → x = z :=
begin
  intros h1 h2,
  rwa ←h1,
end

-- 8ª demostración
example : y = x → y = z → x = z :=
begin
  intros h1 h2,
  rw h1 at h2,
  assumption,
end

-- 9ª demostración
example : y = x → y = z → x = z :=
begin
  intros h1 h2,
  rwa h1 at h2,
end

-- 10ª demostración
example : y = x → y = z → x = z :=
begin
  intros h1 h2,
  calc x = y : h1.symm
     ... = z : h2,
end

-- 11ª demostración
example : y = x → y = z → x = z :=
-- by hint
by finish

-- 12ª demostración
example : y = x → y = z → x = z :=
assume h1 : y = x,
assume h2 : y = z,
show x = z,
  begin
    rw ←h1,
    rw h2
  end

-- 13ª demostración
example : y = x → y = z → x = z :=
assume h1 : y = x,
assume h2 : y = z,
show x = z,
  begin
    rw [←h1, h2]
  end

-- 14ª demostración
example : y = x → y = z → x = z :=
assume h1 : y = x,
assume h2 : y = z,
show x = z, by rw [←h1, h2]


import topology.metric_space.contracting

import picard_lindelof.definitions
import picard_lindelof.other.interval_integral
import picard_lindelof.other.mul_Inf

-- Following Imperial's MA2AA1 notes.

noncomputable theory
open metric set asymptotics filter real measure_theory
open interval_integral topological_space uniform_space
open picard_operator
open_locale topological_space classical filter uniformity

section picard_lindelof

local infix ` →ᵇ `:25 := bounded_continuous_function

-- NOTE: This is meant to be ℝ^n.
variables {E : Type*} [measurable_space E] [normed_group E] [borel_space E] [linear_order E]
                      [normed_space ℝ E] [complete_space E] [second_countable_topology E]

lemma dist_v_integrable (v : α → E → E) (I : IVP(v)) (x y : α →ᵇ E)
: integrable (λ t, dist (v t (x t)) (v t (y t))) :=
begin
  split,
  { exact measurable.dist (I.hintegrable' x).measurable (I.hintegrable' y).measurable, },
  { unfold has_finite_integral,
    simp only [dist_eq_norm, nnnorm_norm, ←nndist_eq_nnnorm, ←edist_nndist],
    simp only [edist_dist, dist_eq_norm],
    rcases (I.hbdd x) with ⟨Cx, hposCx, hboundCx⟩,
    rcases (I.hbdd y) with ⟨Cy, hposCy, hboundCy⟩,
    have h : ∀ a, ∥v a (x a) - v a (y a)∥ ≤ Cy + Cx,
    { intros a,
      have hd := norm_sub_le (v a (x a)) (v a (y a)),
      have hboundCxa := hboundCx a,
      have hboundCya := hboundCy a,
      linarith, },
    replace h := λ a, ennreal.of_real_le_of_real (h a),
    have hle1 : (∫⁻ (a : α), (ennreal.of_real ∥(v a (x a)) - (v a (y a))∥))
      ≤ (∫⁻ (a : α), (ennreal.of_real (Cy + Cx))),
    { apply lintegral_mono, exact h, },
    have hle2 : (∫⁻ (a : α), (ennreal.of_real (Cy + Cx))) < ⊤,
    { rw lintegral_const, apply ennreal.mul_lt_top,
      { exact ennreal.of_real_lt_top, },
      { have hfm : finite_measure (volume : measure α) := by apply_instance,
        refine hfm.measure_univ_lt_top, }, },
    exact lt_of_le_of_lt hle1 hle2, },
end

lemma dist_pointwise_integrable (v : α → E → E) (I : IVP(v)) (x y : α →ᵇ E)
: integrable (λ t, dist (x t) (y t)) :=
begin
  split,
  { exact measurable.dist x.2.1.measurable y.2.1.measurable, },
  { unfold has_finite_integral,
    simp only [dist_eq_norm, nnnorm_norm, ←nndist_eq_nnnorm, ←edist_nndist],
    simp only [edist_dist],
    rcases (@bounded_continuous_function.dist_set_exists _ _ _ _ x y) with ⟨C, hposC, hboundC⟩,
    replace hboundC := λ a, ennreal.of_real_le_of_real (hboundC a),
    have hle1 : (∫⁻ (a : α), (ennreal.of_real (dist (x a) (y a))))
      ≤ (∫⁻ (a : α), (ennreal.of_real C)),
    { apply lintegral_mono, exact hboundC, },
    have hle2 : (∫⁻ (a : α), (ennreal.of_real C)) < ⊤,
    { rw lintegral_const, apply ennreal.mul_lt_top,
      { exact ennreal.of_real_lt_top, },
      { have hfm : finite_measure (volume : measure α) := by apply_instance,
        refine hfm.measure_univ_lt_top, }, },
    exact lt_of_le_of_lt hle1 hle2, }
end

lemma K_dist_pointwise_integrable (v : α → E → E) (I : IVP(v)) (x y : α →ᵇ E)
: integrable (λ t, I.K.1 * dist (x t) (y t)) :=
integrable.const_mul (dist_pointwise_integrable v I x y) I.K.1

lemma P.lipschitz_at (x₀ : E) (v : α → E → E) (I : IVP(v)) (x y : α →ᵇ E) (t : α)
: dist (P x₀ v I x t) (P x₀ v I y t) ≤ I.K * dist x y :=
begin
    simp, rw dist_eq_norm,
    calc ∥(∫ s in 0..t, v s (x s)) - (∫ s in 0..t, v s (y s))∥
        = ∥∫ s in 0..t, (v s (x s)) - (v s (y s))∥
        : by rw interval_integral.integral_sub (I.hintegrable x t) (I.hintegrable y t)
    ... ≤ ∫ s in Ioc (min 0 t) (max 0 t), ∥(v s (x s)) - (v s (y s))∥
        : interval_integral.norm_integral_le_integral_norm_Ioc
    ... = ∫ s in Ioc (min 0 t) (max 0 t), (dist (v s (x s)) (v s (y s)))
        : by congr; ext; exact (dist_eq_norm _ _).symm
    ... ≤ ∫ s in Ioc (min 0 t) (max 0 t), I.K * dist (x s) (y s)
        : begin
            apply integral_mono,
            { have hd := dist_v_integrable v I x y,
              show integrable_on (λ t, dist (v t (x t)) (v t (y t))) _,
              exact integrable_on.mono_set (integrable_on_univ.2 hd) (λ s hs, trivial), },
            { have hd := K_dist_pointwise_integrable v I x y,
              show integrable_on (λ t, I.K.1 * dist (x t) (y t)) _,
              exact integrable_on.mono_set (integrable_on_univ.2 hd) (λ s hs, trivial), },
            intros t; dsimp,
            exact ((lipschitz_with_iff_dist_le_mul.1 (I.hlipschitz t)) (x t) (y t)),
        end
    ... ≤ ∫ s in Ioc (min 0 t) (max 0 t), I.K * dist x y
        : begin
            apply integral_mono,
            { have hd := K_dist_pointwise_integrable v I x y,
              show integrable_on (λ t, I.K.1 * dist (x t) (y t)) _,
              exact integrable_on.mono_set (integrable_on_univ.2 hd) (λ s hs, trivial), },
            { show integrable_on (λ t, I.K.1 * dist x y) (Ioc (min 0 t) (max 0 t)) volume,
               exact integrable_on.mono_set
                (integrable_on_univ.2 (integrable_const (I.K.1 * dist x y)))
                (λ s hs, trivial), },
            intros t; dsimp, mono,
            { apply le_cInf,
              { exact bounded_continuous_function.dist_set_exists, },
              { intros b hb, exact (hb.2 t), }, },
            { exact dist_nonneg, },
            { exact I.K.2, },
        end
    ... ≤ (abs t.1) * (I.K * dist x y)
        : begin
            rw [measure_theory.integral_const, measure.restrict_apply_univ],
            simp only [α.volume_Ioc, ennreal.to_real_of_real', ←neg_sub t.1],
            -- TODO: This should be simpler.
            by_cases h : 0 ≤ t,
            { erw [max_eq_right h, min_eq_left h, sub_zero t.val],
              replace h : 0 ≤ t.1 := h, rw [max_eq_left h],
              refine (mul_le_mul _ (le_refl _) _ _),
              { exact le_abs_self t.1, },
              { exact (mul_nonneg I.K.2 dist_nonneg), },
              { exact abs_nonneg t.1, }, },
            { replace h := le_of_not_le h,
              erw [max_eq_left h, min_eq_right h, zero_sub t.val],
              replace h : t.1 ≤ 0 := h,
              have h' := neg_le_neg h,
              rw neg_zero at h', rw [max_eq_left h'],
              refine (mul_le_mul _ (le_refl _) _ _),
              { rw [abs_of_nonpos h], },
              { exact (mul_nonneg I.K.2 dist_nonneg), },
              { exact abs_nonneg t.1, }, },
          end
    ... ≤ I.K * (dist x y)
        : begin
            have h := abs_le_abs t.2.2 (neg_le.1 t.2.1), rw abs_one at h,
            exact mul_le_of_le_one_left (mul_nonneg I.K.2 dist_nonneg) h,
          end
end

lemma P.lipschitz (x₀ : E) (v : α → E → E) (I : IVP(v))
: lipschitz_with I.K (P x₀ v I) :=
begin
  intros x y, cases I, cases I_K with K hnnK,
  unfold edist, rw metric_space.edist_dist, unfold dist,
  rw metric_space.edist_dist, unfold dist,
  rw ←ennreal.of_real_eq_coe_nnreal hnnK,
  rw ←ennreal.of_real_mul hnnK,
  apply ennreal.of_real_le_of_real,
  have h1 : ∃ (C : ℝ), 0 ≤ C ∧ ∀ (t : α), dist (x t) (y t) ≤ C :=
    bounded_continuous_function.dist_set_exists,
  have h2 : ∀ (t : α), dist (x t) (y t) ≤ Inf {C : ℝ | 0 ≤ C ∧ ∀ (s : α), dist (x s) (y s) ≤ C},
  { intros t, apply le_cInf,
    { use h1, },
    { intros b hb, exact (hb.2 t), }, },
  erw mul_Inf hnnK h1 h2, apply cInf_le_cInf,
  { use 0, intros b hb, exact hb.1, },
  { cases h1 with C hC, use [K * C, C, ⟨rfl, hC.1, hC.2⟩], },
  clear h1 h2,
  rintros C ⟨C', ⟨hC, hnnC', hC'⟩⟩, rw hC,
  refine ⟨mul_nonneg hnnK hnnC', _⟩, intros s,
  have hC's := hC' s,
  have hdxyle : dist x y ≤ C',
  { -- TODO: Factor this out.
    apply cInf_le,
    { use 0, intros b hb, exact hb.1, },
    { exact ⟨hnnC', hC'⟩, }, },
  -- TODO: This is not very nice and will need to change when we keep only one
  -- integrability condition.
  let I' : IVP(v) := ⟨⟨K, hnnK⟩, I_hK, I_hlipschitz, I_hbdd, I_hintegrable, I_hintegrable'⟩,
  have hPsle := P.lipschitz_at x₀ v I' x y s,
  have hKdxyle : K * dist x y ≤ K * C' := mul_le_mul (le_refl _) hdxyle dist_nonneg hnnK,
  exact le_trans hPsle hKdxyle,
end

def P.fixed_point (x₀ : E) (v : α → E → E) (I : IVP(v)) : α →ᵇ E :=
contracting_with.fixed_point (P x₀ v I) ⟨I.hK, P.lipschitz x₀ v I⟩

--------------- End ---------------

-- TODO: This is false. Maybe define α = [-2,2].
instance inst1 : nondiscrete_normed_field α := sorry

-- TODO: This is odd but should be provable.
instance inst2 : normed_space α E := sorry

lemma fixed_point_of_deriv (x₀ : E) (v : α → E → E) (I : IVP(v)) (f : α →ᵇ E)
(hderiv : ∀ t, has_deriv_within_at f (v t (f t)) (Icc 0 t) t) (h0 : f 0 = x₀)
: function.is_fixed_pt (P x₀ v I) f :=
begin
  unfold function.is_fixed_pt, ext t, simp,
  rw [add_comm, add_eq_of_eq_sub], erw ←h0,
  --have := integral_has_deriv_at_left (I.hintegrable f t),
  -- Apparently, we can't prove this because FTC-2 hasn't been proved!
  sorry,
end

-- Similar statement to the version using Gronwall's inequality.
theorem ODE_solution_unique
{x₀ : E} {v : α → E → E} (I : IVP(v)) {f g : α →ᵇ E}
(hf' : ∀ t, has_deriv_within_at f (v t (f t)) (Icc 0 t) t)
(hg' : ∀ t, has_deriv_within_at g (v t (g t)) (Icc 0 t) t)
(hf0 : f 0 = x₀) (hg0 : g 0 = x₀)
: f = g :=
begin
    have hfpf := fixed_point_of_deriv x₀ v I f hf' hf0,
    have hfpg := fixed_point_of_deriv x₀ v I g hg' hg0,
    exact contracting_with.fixed_point_unique' ⟨I.hK, P.lipschitz x₀ v I⟩ hfpf hfpg,
end

end picard_lindelof


import linear_algebra.dual
import linear_algebra.free_module.basic

import for_mathlib.nnrat

universe u
variables {Λ : Type u} [add_comm_group Λ]
variable {ι : Type*}

open_locale big_operators
open_locale nnrat

variable {α : Type*}

def nnrat_module {Λ : Type*} [add_comm_group Λ] [module ℚ Λ] : module (ℚ≥0) Λ :=
restrict_scalars.module (ℚ≥0) ℚ Λ

local attribute [instance] nnrat_module

instance nnrat_tower [module ℚ Λ] : is_scalar_tower (ℚ≥0) ℚ Λ :=
{ smul_assoc := λ x y z,
  begin
    rcases x with ⟨x, hx⟩,
    change (x • y) • z = x • _,
    simp [mul_smul],
  end }

variable [module ℚ Λ]
open module

def index_up_one (l : ι → Λ) : submodule (ℚ≥0) (dual ℚ Λ) :=
{ carrier := {x | ∀ i, 0 ≤ x (l i)},
  zero_mem' := λ i, le_rfl,
  add_mem' := λ x y hx hy i, by simpa only [linear_map.add_apply] using add_nonneg (hx _) (hy _),
  smul_mem' := λ c x hx i, mul_nonneg c.2 (hx i) }

@[simp] lemma mem_index_up_one (l : ι → Λ) (x : dual ℚ Λ) :
  x ∈ index_up_one l ↔ ∀ i, 0 ≤ x (l i) :=
iff.rfl

def set_up_one (s : set Λ) : submodule (ℚ≥0) (dual ℚ Λ) :=
index_up_one (coe : s → Λ)

lemma set_up_one_def (s : set Λ) : set_up_one s = index_up_one (coe : s → Λ) := rfl

lemma index_up_one_eq_set_up_one_range (l : ι → Λ) :
  index_up_one l = set_up_one (set.range l) :=
begin
  ext φ,
  split,
  { rintro hφ ⟨_, i, rfl⟩,
    apply hφ i },
  { rintro hφ i,
    apply hφ ⟨_, i, rfl⟩ },
end

@[simp] lemma mem_set_up_one (s : set Λ) (x : dual ℚ Λ) :
  x ∈ set_up_one s ↔ ∀ i ∈ s, 0 ≤ x i :=
begin
  change x ∈ index_up_one _ ↔ _,
  simp,
end

lemma set_up_one_antitone (s t : set Λ) :
  s ≤ t → set_up_one t ≤ set_up_one s :=
begin
  rintro h f hf ⟨i, hi⟩,
  apply hf ⟨_, h hi⟩,
end

/-- The submodule given by the intersection of the given functionals -/
def index_down_one (l : ι → Λ →ₗ[ℚ] ℚ) : submodule (ℚ≥0) Λ :=
{ carrier := {x | ∀ i, 0 ≤ l i x},
  zero_mem' := λ i, by simp only [linear_map.map_zero],
  add_mem' := λ x y hx hy i, by simpa only [linear_map.map_add] using add_nonneg (hx i) (hy i),
  smul_mem' := λ c x (hx : ∀ i, 0 ≤ l i x) i,
  begin
    rw linear_map.map_smul_of_tower,
    apply mul_nonneg c.2 (hx i),
  end }

@[simp] lemma mem_index_down_one (l : ι → dual ℚ Λ) (x : Λ) :
  x ∈ index_down_one l ↔ ∀ i, 0 ≤ l i x :=
iff.rfl

def set_down_one (s : set (dual ℚ Λ)) : submodule (ℚ≥0) Λ :=
index_down_one (coe : s → dual ℚ Λ)

lemma set_down_one_def (s : set (dual ℚ Λ)) :
  set_down_one s = index_down_one (coe : s → dual ℚ Λ) := rfl

lemma index_down_one_eq_set_down_one_range (l : ι → dual ℚ Λ) :
  index_down_one l = set_down_one (set.range l) :=
begin
  ext φ,
  split,
  { rintro hφ ⟨_, i, rfl⟩,
    apply hφ i },
  { rintro hφ i,
    apply hφ ⟨_, i, rfl⟩ },
end

@[simp] lemma mem_set_down_one (s : set (dual ℚ Λ)) (x : Λ) :
  x ∈ set_down_one s ↔ ∀ (i : dual ℚ Λ), i ∈ s → 0 ≤ i x :=
begin
  change x ∈ index_down_one _ ↔ _,
  simp,
end

lemma set_down_one_antitone (s t : set (dual ℚ Λ)) :
  s ≤ t → set_down_one t ≤ set_down_one s :=
begin
  rintro h f hf ⟨i, hi⟩,
  apply hf ⟨_, h hi⟩,
end

lemma set_up_one_span (s : set Λ) :
  set_up_one (submodule.span (ℚ≥0) s : set Λ) = set_up_one s :=
begin
  ext f,
  simp only [mem_set_up_one, set_like.mem_coe],
  split,
  { intros t y hy,
    apply t _ (submodule.subset_span hy) },
  { intros hf y hy,
    apply submodule.span_induction hy hf (by simp),
    { intros l₁ l₂ hl₁ hl₂,
      simp only [linear_map.map_add],
      apply add_nonneg hl₁ hl₂ },
    { intros q y hy,
      simp only [linear_map.map_smul_of_tower],
      apply mul_nonneg q.2 hy } }
end

lemma set_down_one_span (s : set (dual ℚ Λ)) :
  set_down_one (submodule.span (ℚ≥0) s : set (dual ℚ Λ)) = set_down_one s :=
begin
  ext x,
  simp only [mem_set_down_one, set_like.mem_coe],
  split,
  { intros t y hy,
    apply t _ (submodule.subset_span hy) },
  { intros hx y hy,
    apply submodule.span_induction hy hx (by simp),
    { intros l₁ l₂ hl₁ hl₂,
      apply add_nonneg hl₁ hl₂ },
    { intros q f hf,
      simp only [linear_map.smul_apply],
      apply mul_nonneg q.2 hf } }
end

lemma le_up_down (l : set (dual ℚ Λ)) : l ≤ set_up_one (set_down_one l : set Λ) :=
begin
  rintro x hx ⟨i, hi⟩,
  apply hi ⟨_, hx⟩,
end

lemma le_down_up (l : set Λ) : l ≤ set_down_one (set_up_one l : set (dual ℚ Λ)) :=
begin
  rintro x hx ⟨i, hi⟩,
  apply hi ⟨_, hx⟩,
end

noncomputable def down_two [finite_dimensional ℚ Λ] :
  submodule (ℚ≥0) (dual ℚ (dual ℚ Λ)) → submodule (ℚ≥0) Λ :=
submodule.comap (linear_equiv.restrict_scalars (ℚ≥0) (eval_equiv ℚ Λ) : Λ →ₗ[ℚ≥0] dual ℚ (dual ℚ Λ))

lemma down_two_def [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) (dual ℚ (dual ℚ Λ))) :
  down_two C =
  C.comap (linear_equiv.restrict_scalars (ℚ≥0) (eval_equiv ℚ Λ) : Λ →ₗ[ℚ≥0] dual ℚ (dual ℚ Λ)) :=
rfl

noncomputable def up_two [finite_dimensional ℚ Λ] :
  submodule (ℚ≥0) Λ → submodule (ℚ≥0) (dual ℚ (dual ℚ Λ)) :=
submodule.map (linear_equiv.restrict_scalars (ℚ≥0) (eval_equiv ℚ Λ) : Λ →ₗ[ℚ≥0] dual ℚ (dual ℚ Λ))

lemma down_two_up [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) Λ) :
  down_two (up_two C) = C :=
begin
  dunfold up_two down_two,
  rw linear_equiv.map_eq_comap,
  rw ←submodule.comap_comp,
  simp only [linear_equiv.refl_to_linear_map, linear_equiv.self_trans_symm, linear_equiv.comp_coe,
    submodule.comap_id],
end

lemma up_two_down [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) (dual ℚ (dual ℚ Λ))) :
  up_two (down_two C) = C :=
begin
  dunfold up_two down_two,
  rw linear_equiv.map_eq_comap,
  rw ←submodule.comap_comp,
  simp [submodule.comap_id],
end

lemma down_two_index_up_one [finite_dimensional ℚ Λ] (l : ι → dual ℚ Λ) :
  down_two (index_up_one l) = index_down_one l :=
begin
  ext x,
  simp only [down_two, submodule.mem_comap, linear_equiv.coe_coe,
    linear_equiv.restrict_scalars_apply, mem_index_up_one, mem_index_down_one],
  refl
end

lemma down_two_set_up_one [finite_dimensional ℚ Λ] (l : set (dual ℚ Λ)) :
  down_two (set_up_one l) = set_down_one l :=
down_two_index_up_one _

lemma up_two_index_down_one [finite_dimensional ℚ Λ] (l : ι → dual ℚ Λ) :
  up_two (index_down_one l) = index_up_one l :=
begin
  rw ←down_two_index_up_one,
  simp only [up_two_down],
end

lemma up_two_set_down_one [finite_dimensional ℚ Λ] (l : set (dual ℚ Λ)) :
  up_two (set_down_one l) = set_up_one l :=
up_two_index_down_one _

lemma down_up_down_eq (l : set (dual ℚ Λ)) :
  set_down_one (set_up_one (set_down_one l : set Λ) : set (dual ℚ Λ)) = set_down_one l :=
begin
  apply le_antisymm,
  { apply set_down_one_antitone,
    apply le_up_down },
  { apply le_down_up }
end

lemma up_down_up_eq (l : set Λ) :
  set_up_one (set_down_one (set_up_one l : set (dual ℚ Λ)) : set Λ) = set_up_one l :=
begin
  apply le_antisymm,
  { apply set_up_one_antitone,
    apply le_down_up },
  { apply le_up_down }
end

lemma down_two_up_one_up_one [finite_dimensional ℚ Λ]
  (C : submodule (ℚ≥0) Λ) (hC : ∃ (l : set (dual ℚ Λ)), C = set_down_one l) :
  down_two (set_up_one (set_up_one (C : set Λ) : set (dual ℚ Λ))) = C :=
begin
  rw down_two_set_up_one,
  rcases hC with ⟨l, rfl⟩,
  rw down_up_down_eq
end

lemma down_eval_eq [finite_dimensional ℚ Λ] (C : set Λ) :
  set_down_one (eval_equiv ℚ Λ '' C) = set_up_one C :=
begin
  ext x,
  simp only [and_imp, set.mem_image, mem_set_down_one, mem_set_up_one, forall_apply_eq_imp_iff₂,
    exists_imp_distrib],
  refl
end

lemma down_one_up_two [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) Λ) :
  set_down_one (up_two C : set (dual ℚ (dual ℚ Λ))) = set_up_one C :=
down_eval_eq _

lemma up_one_down_two [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) (dual ℚ (dual ℚ Λ))) :
  set_up_one (down_two C : set Λ) = set_down_one C :=
begin
  simp only [←down_one_up_two],
  simp only [up_two_down],
end

lemma up_one_down_one [finite_dimensional ℚ Λ] (C : set (dual ℚ Λ)) :
  set_up_one (set_down_one C : set Λ) = set_down_one (set_up_one C) :=
begin
  rw ←down_two_set_up_one,
  simp only [up_one_down_two],
end

/-- A submodule is polyhedral if it is the intersection of finitely many half spaces. -/
def is_polyhedral_cone (C : submodule (ℚ≥0) Λ) : Prop :=
  ∃ (ι : Type u) (_ : fintype ι) (l : ι → Λ →ₗ[ℚ] ℚ), C = index_down_one l

lemma is_polyhedral_cone_iff_finset (C : submodule (ℚ≥0) Λ) :
  is_polyhedral_cone C ↔ ∃ (s : finset (dual ℚ Λ)), C = set_down_one s :=
begin
  classical,
  split,
  { rintro ⟨ι, hι, l, rfl⟩,
    resetI,
    refine ⟨finset.univ.image l, _⟩,
    rw index_down_one_eq_set_down_one_range l,
    simp },
  { rintro ⟨s, rfl⟩,
    exact ⟨(s : set (dual ℚ Λ)), infer_instance, _, set_down_one_def _⟩ }
end

lemma down_two_up_one_up_one_cone [finite_dimensional ℚ Λ]
  (C : submodule (ℚ≥0) Λ) (hC : is_polyhedral_cone C) :
  down_two (set_up_one (set_up_one (C : set Λ) : set (dual ℚ Λ))) = C :=
begin
  apply down_two_up_one_up_one,
  rw is_polyhedral_cone_iff_finset at hC,
  rcases hC with ⟨_, rfl⟩,
  refine ⟨_, rfl⟩,
end

lemma is_polyhedral_cone_of_equiv {Λ' : Type u} [add_comm_group Λ'] [module ℚ Λ']
  (e : Λ ≃ₗ[ℚ] Λ') (C : submodule (ℚ≥0) Λ) (hC : is_polyhedral_cone C) :
  is_polyhedral_cone (submodule.map (e.to_linear_map.restrict_scalars (ℚ≥0)) C) :=
begin
  rcases hC with ⟨ι, hι, l, rfl⟩,
  refine ⟨ι, hι, λ i, _, _⟩,
  apply (l i).comp e.symm.to_linear_map,
  ext x,
  simp only [submodule.mem_map, function.comp_app, linear_map.coe_comp,
    mem_index_down_one, linear_equiv.coe_to_linear_map,
    linear_map.coe_restrict_scalars_eq_coe],
  split,
  { rintro ⟨y, hy, rfl⟩,
    simpa },
  { intro t,
    refine ⟨e.symm x, t, by simp⟩ }
end

lemma is_polyhedral_cone_bot_aux [fintype α] : is_polyhedral_cone (⊥ : submodule (ℚ≥0) (α → ℚ)) :=
⟨α ⊕ α, sum.fintype α α,
    sum.elim (λ i, ⟨λ f, f i, λ x y, rfl, λ _ _, rfl⟩)
             (λ i, -⟨λ f, f i, λ x y, rfl, λ _ _, rfl⟩),
begin
  ext,
  simp only [linear_map.coe_proj, sum.elim_inl, function.eval_apply, linear_map.neg_apply,
    sum.elim_inr, mem_index_down_one, sum.forall, submodule.mem_bot, neg_nonneg],
  split,
  { rintro rfl,
    simp only [linear_map.map_zero, and_self],
    intro a,
    apply le_rfl },
  { rintro ⟨h₁, h₂⟩,
    ext1 i,
    apply le_antisymm,
    { apply h₂ i },
    { apply h₁ i } }
end⟩

lemma is_polyhedral_cone_bot [finite_dimensional ℚ Λ] :
  is_polyhedral_cone (⊥ : submodule (ℚ≥0) Λ) :=
begin
  let l := (basis.of_vector_space ℚ Λ).equiv_fun,
  have := is_polyhedral_cone_of_equiv l.symm ⊥ is_polyhedral_cone_bot_aux,
  simpa using this,
end

lemma coe_min' (s : finset (ℚ≥0)) (hs : s.nonempty) :
  (coe (s.min' hs) : ℚ) = (s.image coe).min' (hs.image _) :=
begin
  induction s using finset.induction_on with x s hx ih t generalizing hs,
  { revert hs, simp only [finset.not_nonempty_empty, is_empty.forall_iff] },
  { rcases finset.eq_empty_or_nonempty s with (rfl | hs'),
    { simp only [insert_emptyc_eq, finset.min'_singleton, finset.image_singleton] },
    have aux := finset.min'_insert x s hs',
    apply_fun (coe : ℚ≥0 → ℚ) at aux,
    convert aux using 1, { congr },
    simp only [finset.image_insert, ih hs', nnrat.coe_min],
    simp only [← finset.min'_insert] }
end

def extended_half_spaces_index {ι : Type*} (s : ι → Λ →ₗ[ℚ] ℚ) (x : Λ) : Type* :=
{i : ι // 0 ≤ s i x} ⊕ ({i : ι // 0 < s i x} × {i : ι // s i x < 0})

instance {ι : Type*} [fintype ι] (s : ι → Λ →ₗ[ℚ] ℚ) (x : Λ) :
  fintype (extended_half_spaces_index s x) :=
begin
  rw extended_half_spaces_index,
  apply_instance
end

def extended_half_spaces {ι : Type*} (s : ι → Λ →ₗ[ℚ] ℚ) (x : Λ) :
  extended_half_spaces_index s x → Λ →ₗ[ℚ] ℚ :=
sum.elim (s ∘ coe) (λ ij, (s ij.1 x) • s ij.2 - (s ij.2 x) • s ij.1)

lemma span_le_extended [decidable_eq Λ] {ι : Type*} {s : ι → Λ →ₗ[ℚ] ℚ}
  {l : finset Λ} (hs : submodule.span ℚ≥0 (l : set Λ) = index_down_one s)
  {x : Λ} (hx : x ∉ l) :
  submodule.span ℚ≥0 ↑(insert x l) ≤ index_down_one (extended_half_spaces s x) :=
begin
  rw submodule.span_le,
  intros f hf,
  simp only [finset.coe_insert, set.mem_insert_iff, finset.mem_coe] at hf,
  simp only [set_like.mem_coe, mem_index_down_one, extended_half_spaces],
  rcases hf with (rfl | hf),
  { rintro (⟨i, hi⟩ | ⟨⟨i, hi⟩, j, hj⟩),
    { simpa },
    { simp [mul_comm] } },
  { have f_mem : f ∈ index_down_one s,
    { rw ←hs,
      exact submodule.subset_span hf },
    rintro (⟨i, hi⟩ | ⟨⟨i, hi⟩, j, hj⟩),
    { simpa using f_mem i },
    { have : 0 ≤ s i f, by apply f_mem,
      have : 0 ≤ s j f, by apply f_mem,
      simp only [algebra.id.smul_eq_mul, sub_nonneg, linear_map.smul_apply, sum.elim_inr,
        subtype.coe_mk, linear_map.sub_apply],
      nlinarith } },
end

lemma extended_le_span [decidable_eq Λ] {ι : Type*} [fintype ι] {s : ι → Λ →ₗ[ℚ] ℚ}
  {l : finset Λ} (hs : submodule.span ℚ≥0 (l : set Λ) = index_down_one s)
  {x : Λ} (hx : x ∉ l) :
  index_down_one (extended_half_spaces s x) ≤ submodule.span ℚ≥0 ↑(insert x l) :=
begin
  intros y hy,
  simp only [finset.coe_insert, submodule.mem_span_insert, exists_prop, hs],
  suffices : ∃ (t : ℚ≥0), y - t • x ∈ index_down_one s,
  { rcases this with ⟨a, ha⟩,
    refine ⟨a, _, ha, by simp⟩ },
  simp only [mem_index_down_one] at hy,
  have y_nonneg : ∀ i, 0 ≤ s i x → 0 ≤ s i y,
  { intros i hi,
    apply hy (sum.inl ⟨i, hi⟩) },
  have y_neg : ∀ i j, 0 < s i x → s j x < 0 → s j x * s i y ≤ s i x * s j y,
  { intros i j hi hj,
    simpa [extended_half_spaces] using hy (sum.inr ⟨⟨i, hi⟩, ⟨j, hj⟩⟩) },
  let a : {i // 0 < s i x} → ℚ≥0 := λ i, ⟨s i.1 y, y_nonneg _ i.2.le⟩ / ⟨s i.1 x, i.2.le⟩,
  let as : finset (ℚ≥0) := finset.univ.image a,
  let b : {i // s i x < 0} → ℚ := λ i, s i.1 y / s i.1 x,
  let bs : finset ℚ := finset.univ.image b,
  by_cases h : nonempty {i // 0 < s i x},
  { have : as.nonempty,
    { rwa [finset.nonempty.image_iff, finset.univ_nonempty_iff] },
    refine ⟨as.min' ‹as.nonempty›, _⟩,
    rw [mem_index_down_one],
    intros i,
    rw [linear_map.map_sub, sub_nonneg],
    simp only [linear_map.map_smul_of_tower, subtype.val_eq_coe],
    change (coe (_ : ℚ≥0)) * (s i x) ≤ s i y,
    rcases lt_trichotomy 0 (s i x) with (lt | eq | gt),
    { rw [coe_min', ←le_div_iff lt],
      apply finset.min'_le,
      simp only [finset.mem_univ, finset.mem_image, exists_prop],
      refine ⟨_, ⟨⟨i, lt⟩, ⟨⟩, rfl⟩, _⟩,
      simp },
    { rw [←eq, mul_zero],
      apply y_nonneg _ (eq.le) },
    { rw [coe_min', ←div_le_iff_of_neg gt],
      apply finset.le_min',
      simp only [and_imp, exists_prop, finset.mem_univ, bex_imp_distrib, finset.mem_image,
        exists_true_left, subtype.exists, exists_imp_distrib],
      rintro _ _ j hj ⟨⟨⟩, rfl⟩ rfl,
      simp only [nnrat.coe_div, subtype.coe_mk],
      have := y_neg _ _ hj gt,
      rwa [div_le_iff_of_neg gt, div_mul_eq_mul_div, mul_comm (s j y), div_le_iff' hj] } },
  by_cases h' : nonempty {i // s i x < 0},
  { have : bs.nonempty,
    { rwa [finset.nonempty.image_iff, finset.univ_nonempty_iff] },
    refine ⟨(bs.max' ‹bs.nonempty›).to_nnrat, λ i, _⟩,
    rw [linear_map.map_sub, sub_nonneg],
    simp only [linear_map.map_smul_of_tower, subtype.val_eq_coe],
    rcases lt_trichotomy 0 (s i x) with (lt | eq | gt),
    { exfalso,
      apply h,
      refine ⟨⟨_, lt⟩⟩ },
    { rw [←eq, smul_zero],
      apply y_nonneg,
      apply eq.le, },
    change max _ _ * _ ≤ _,
    rw ←div_le_iff_of_neg gt,
    rw le_max_iff,
    left,
    apply finset.le_max',
    simp only [finset.mem_univ, finset.mem_image, exists_true_left, subtype.exists],
    refine ⟨i, gt, rfl⟩ },
  refine ⟨0, _⟩,
  intros i,
  rw [linear_map.map_sub, sub_nonneg, zero_smul, linear_map.map_zero],
  simp only [linear_map.map_smul_of_tower, subtype.val_eq_coe],
  rcases le_or_lt 0 (s i x) with (lt | lt),
  { apply y_nonneg _ lt },
  { exfalso,
    apply h',
    refine ⟨⟨_, lt⟩⟩ },
end

lemma eliminate_inductive_step [decidable_eq Λ] (ι : Type u) [fintype ι] (s : ι → Λ →ₗ[ℚ] ℚ)
  {l : finset Λ} (hs : submodule.span ℚ≥0 (l : set Λ) = index_down_one s)
  (x : Λ) (hx : x ∉ l) :
  is_polyhedral_cone (submodule.span ℚ≥0 (coe (insert x l) : set Λ)) :=
begin
  refine ⟨extended_half_spaces_index s x, infer_instance, extended_half_spaces _ _, _⟩,
  apply le_antisymm,
  apply span_le_extended hs hx,
  apply extended_le_span hs hx,
end

lemma elimination_aux [finite_dimensional ℚ Λ] (l : finset Λ) :
  is_polyhedral_cone (submodule.span (ℚ≥0) (l : set Λ)) :=
begin
  classical,
  apply finset.induction_on l,
  { simp only [finset.coe_empty, submodule.span_empty],
    apply is_polyhedral_cone_bot },
  { clear l,
    rintro x l hx ⟨ι, hι, s, hs⟩,
    resetI,
    convert eliminate_inductive_step ι s hs x hx }
end

lemma is_polyhedral_cone_of_fg [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) Λ) (hC : C.fg) :
  is_polyhedral_cone C :=
begin
  rcases hC with ⟨l, rfl⟩,
  apply elimination_aux
end

lemma one_sixteen_c [finite_dimensional ℚ Λ] (ι : Type u) [fintype ι] (l : ι → Λ →ₗ[ℚ] ℚ) :
  set_up_one (index_down_one l : set Λ) =
    submodule.span (ℚ≥0) (set.range l) :=
begin
  set C : submodule (ℚ≥0) Λ := index_down_one l,
  set C_star := set_up_one (C : set Λ),
  set C' : submodule _ (dual ℚ Λ) := submodule.span (ℚ≥0) (set.range l),
  let C'_star := down_two (set_up_one (C' : set (dual ℚ Λ))),
  have C_eq : C = C'_star,
  { change C = down_two (set_up_one (C' : set (dual ℚ Λ))),
    rw down_two_set_up_one,
    rw set_down_one_span,
    apply index_down_one_eq_set_down_one_range },
  have C'pc : is_polyhedral_cone C',
  { apply is_polyhedral_cone_of_fg,
    classical,
    refine ⟨finset.univ.image l, _⟩,
    simp },
  change set_up_one (C : set Λ) = _,
  rw C_eq,
  change set_up_one (down_two (set_up_one (C' : set (dual ℚ Λ))) : set Λ) = _,
  rw down_two_set_up_one,
  rw is_polyhedral_cone_iff_finset at C'pc,
  clear_value C', clear' C C_star C'_star C_eq l,
  rcases C'pc with ⟨s, rfl⟩,
  simp_rw [up_one_down_one (set_down_one (s : set (dual ℚ (dual ℚ Λ))) : set (dual ℚ Λ))],
  rw down_up_down_eq,
end

lemma dual_fg_of_cone [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) Λ)
  (hC : is_polyhedral_cone C) :
  (set_up_one (C : set Λ) : submodule (ℚ≥0) (dual ℚ Λ)).fg :=
begin
  rcases hC with ⟨ι, hι, l, rfl⟩,
  resetI,
  simp only [one_sixteen_c],
  classical,
  refine ⟨finset.univ.image l, by simp⟩,
end

lemma fg_of_is_polyhedral_cone [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) Λ)
  (hC : is_polyhedral_cone C) :
  C.fg :=
begin
  have t := dual_fg_of_cone _ (is_polyhedral_cone_of_fg _ (dual_fg_of_cone _ hC)),
  have t2 : (submodule.map
      (((eval_equiv ℚ Λ).restrict_scalars (ℚ≥0)).symm : dual ℚ (dual ℚ Λ) →ₗ[ℚ≥0] Λ) _).fg,
  { refine submodule.fg.map _ t, },
  rwa [linear_equiv.map_eq_comap, linear_equiv.symm_symm, ← down_two_def,
    down_two_up_one_up_one_cone _ hC] at t2,
end

lemma fg_iff_is_polyhedral_cone [finite_dimensional ℚ Λ] (C : submodule (ℚ≥0) Λ) :
  is_polyhedral_cone C ↔ C.fg :=
⟨fg_of_is_polyhedral_cone C, is_polyhedral_cone_of_fg C⟩


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.uniform_space.cauchy
import topology.uniform_space.separation
import topology.dense_embedding

/-!
# Theory of complete separated uniform spaces.

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

This file is for elementary lemmas that depend on both Cauchy filters and separation.
-/

open filter
open_locale topology filter

variables {α : Type*}

/-In a separated space, a complete set is closed -/
lemma is_complete.is_closed  [uniform_space α] [separated_space α] {s : set α} (h : is_complete s) :
  is_closed s :=
is_closed_iff_cluster_pt.2 $ λ a ha, begin
  let f := 𝓝[s] a,
  have : cauchy f := cauchy_nhds.mono' ha inf_le_left,
  rcases h f this (inf_le_right) with ⟨y, ys, fy⟩,
  rwa (tendsto_nhds_unique' ha inf_le_left fy : a = y)
end

namespace dense_inducing
open filter
variables [topological_space α] {β : Type*} [topological_space β]
variables {γ : Type*} [uniform_space γ] [complete_space γ] [separated_space γ]

lemma continuous_extend_of_cauchy {e : α → β} {f : α → γ}
  (de : dense_inducing e) (h : ∀ b : β, cauchy (map f (comap e $ 𝓝 b))) :
  continuous (de.extend f) :=
de.continuous_extend $ λ b, complete_space.complete (h b)

end dense_inducing


lemma add_left_eq_zero {{a b : mynat}} (H : a + b = 0) : b = 0 :=
begin
cases b with d,
refl,
rw add_succ at H,
exfalso,
apply succ_ne_zero,
rw H,
refl,
end


/-
  The localization predicate (by Neil Strickland).

  This is Kenny's refactoring of the originial code taken from:
  https://github.com/kckennylau/Lean/blob/master/localization_alt.lean
-/

import algebra.ring
import group_theory.submonoid
import ring_theory.ideal_operations
import linear_algebra.basic

import to_mathlib.ring_hom

namespace localization_alt

universes u v w
variables {A : Type u} {B : Type v} {C : Type w}
variables [comm_ring A] [comm_ring B] [comm_ring C]
variables (S : set A) [is_submonoid S] (f : A → B) [is_ring_hom f]

-- This is essentially the same logic as units.ext, but in more convenient form.

lemma comm_monoid.inv_unique {M : Type*} [comm_monoid M]
  {a ai₁ ai₂ : M} (e₁ : a * ai₁ = 1) (e₂ : a * ai₂ = 1) : ai₁ = ai₂ :=
by rw [← mul_one ai₁, ← e₂, ← mul_assoc, mul_comm ai₁, e₁, one_mul]

-- Preserve definitional equality.

def inverts_data (S : set A) (f : A → B) : Type* :=
Π s : S, {si : B // (f s) * si = 1}

def inverts (S : set A) (f : A → B) : Prop :=
∀ s : S, ∃ si : B, (f s) * si = 1

lemma inverts_subsingleton (S : set A) (f : A → B) :
  subsingleton (inverts_data S f) :=
⟨λ fi1 fi2, funext $ λ s, subtype.eq $ comm_monoid.inv_unique (fi1 s).2 (fi2 s).2⟩

def inverts_of_data (h : inverts_data S f) : inverts S f :=
λ s, ⟨(h s).1,(h s).2⟩

noncomputable def inverts_some (h : inverts S f) : inverts_data S f :=
λ s, classical.indefinite_description _ (h s)

def has_denom_data (S : set A) (f : A → B) :=
Π b : B, {sa : S × A // (f sa.1) * b = f sa.2 }

def has_denom (S : set A) (f : A → B) : Prop :=
∀ b : B, ∃ (sa : S × A), (f sa.1) * b = (f sa.2)

def has_denom_of_data (h : has_denom_data S f) : has_denom S f :=
λ b, subtype.exists_of_subtype (h b)

noncomputable def has_denom_some (h : has_denom S f) : has_denom_data S f :=
λ b, classical.indefinite_description _ (h b)

def ann_aux (S : set A) [is_submonoid S] : Type* :=
{ as : A × S // as.1 * as.2 = 0 }

namespace ann_aux

def zero : ann_aux S := ⟨(0, 1), mul_one _⟩

def add (as bt : ann_aux S) : ann_aux S :=
⟨(as.1.1 + bt.1.1, as.1.2 * bt.1.2), show (as.1.1 + bt.1.1) * (as.1.2 * bt.1.2) = 0,
by rw [add_mul, ← mul_assoc, as.2, zero_mul, zero_add, mul_left_comm, bt.2, mul_zero]⟩

def smul (a : A) (bt : ann_aux S) : ann_aux S :=
⟨(a * bt.1.1, bt.1.2), show (a * bt.1.1) * bt.1.2 = 0, by rw [mul_assoc, bt.2, mul_zero]⟩

end ann_aux

def submonoid_ann (S : set A) [is_submonoid S] : ideal A :=
{ carrier := set.range (λ as : ann_aux S, as.1.1),
  zero := ⟨ann_aux.zero S, rfl⟩,
  add := λ _ _ ⟨as,has⟩ ⟨bt,hbt⟩, ⟨ann_aux.add S as bt, has ▸ hbt ▸ rfl⟩,
  smul := λ a _ ⟨bt,h⟩, ⟨ann_aux.smul S a bt, h ▸ rfl⟩ }

lemma inverts_ker (hf : inverts S f) : submonoid_ann S ≤ ker f :=
λ x ⟨⟨⟨a,s⟩,asz⟩,rfl⟩, let ⟨si,e1⟩ := hf s in show f x = 0,
by rw [← mul_one (f x), ← e1, ← mul_assoc, ← is_ring_hom.map_mul f, asz, is_ring_hom.map_zero f, zero_mul]

structure is_localization_data :=
(inverts : inverts_data S f)
(has_denom : has_denom_data S f)
(ker_le : ker f ≤ submonoid_ann S)

def is_localization : Prop :=
(inverts S f) ∧ (has_denom S f) ∧ (ker f = submonoid_ann S)

lemma localization_epi (hf : is_localization S f)
  (g₁ g₂ : B → C) [is_ring_hom g₁] [is_ring_hom g₂]
  (e : g₁ ∘ f = g₂ ∘ f) : g₁ = g₂ :=
begin
  have e' : ∀ x, g₁ (f x) = g₂ (f x) := λ x, by convert congr_fun e x,
  ext b,
  rcases hf.2.1 b with ⟨⟨s,a⟩,e1⟩,
  rcases hf.1 s with ⟨si,e2⟩,
  have e4 : g₁ (f s) * (g₁ si) = 1,
  { rw [← is_ring_hom.map_mul g₁, e2, is_ring_hom.map_one g₁] },
  have e5 : g₁ (f s) * (g₂ si) = 1,
  { rw [e', ← is_ring_hom.map_mul g₂, e2, is_ring_hom.map_one g₂] },
  rw [← mul_one b, ← e2, mul_left_comm, ← mul_assoc, e1],
  rw [is_ring_hom.map_mul g₁, is_ring_hom.map_mul g₂, e', comm_monoid.inv_unique e4 e5]
end

section localization_initial
variables (hf : is_localization_data S f) (g : A → C) [is_ring_hom g] (hg : inverts_data S g)

def is_localization_initial (hf : is_localization_data S f)
  (g : A → C) [is_ring_hom g] (hg : inverts_data S g) : B → C :=
λ b, g (hf.has_denom b).1.2 * hg (hf.has_denom b).1.1

lemma useful (hf : is_localization_data S f) (g : A → C) [is_ring_hom g] (hg : inverts_data S g)
  {a₁ a₂ : A} (H : f a₁ = f a₂) : g a₁ = g a₂ :=
begin
  rw [← sub_eq_zero, ← is_ring_hom.map_sub f] at H,
  rw [← sub_eq_zero, ← is_ring_hom.map_sub g],
  generalize_hyp : a₁ - a₂ = a at H ⊢,
  rcases hf.3 H with ⟨⟨as,h1⟩,h2⟩,
  rw [← h2],
  cases hg as.2 with c h3,
  rw [← mul_one (g as.1), ← h3, ← mul_assoc, ← is_ring_hom.map_mul g, h1, is_ring_hom.map_zero g, zero_mul]
end

lemma useful2 {x y z w : A} (h : x * y = 1) : z * x = w * x ↔ z = w :=
⟨λ H, have _ := congr_arg (* y) H, by rwa [mul_assoc, h, mul_one, mul_assoc, h, mul_one] at this,
λ H, by rw H⟩

instance (hf : is_localization_data S f) (g : A → C) [is_ring_hom g] (hg : inverts_data S g) :
  is_ring_hom (is_localization_initial S f hf g hg) :=
{ map_one := begin
    unfold is_localization_initial,
    rcases hf.has_denom 1 with ⟨⟨s,a⟩,h⟩,
    dsimp only at *,
    rw mul_one at h, replace h := useful S f hf g hg h,
    cases hg s with c hc,
    rw ← h, exact hc
  end,
  map_mul := λ x y, begin
    unfold is_localization_initial,
    rcases hf.has_denom x with ⟨⟨sx,ax⟩,h1⟩,
    rcases hf.has_denom y with ⟨⟨sy,ay⟩,h2⟩,
    rcases hf.has_denom (x*y) with ⟨⟨sxy,axy⟩,h3⟩,
    cases hg sx with sigx h4,
    cases hg sy with sigy h5,
    cases hg sxy with sigxy h6,
    cases hf.inverts sx with sifx h7,
    cases hf.inverts sy with sify h8,
    cases hf.inverts sxy with sifxy h9,
    dsimp only [subtype.coe_mk] at *,
    replace h1 : _ * _ = _ * _ := by convert congr_arg (* sifx) h1,
    rw [mul_right_comm, h7, one_mul] at h1,
    replace h2 : _ * _ = _ * _ := by convert congr_arg (* sify) h2,
    rw [mul_right_comm, h8, one_mul] at h2,
    rw [h1, h2] at h3,
    rw [← useful2 h4, ← useful2 h5, ← useful2 h6],
    have : g axy * sigxy * g ↑sx * g ↑sy * g ↑sxy = g axy * g ↑sx * g ↑sy * (g ↑sxy * sigxy),
    { simp only [mul_assoc, mul_comm, mul_left_comm] }, rw [this, h6, mul_one], clear this,
    have : g ax * sigx * (g ay * sigy) * g ↑sx * g ↑sy * g ↑sxy = g ax * g ay * g ↑sxy * (g ↑sx * sigx) * (g ↑sy * sigy),
    { simp only [mul_assoc, mul_comm, mul_left_comm] }, rw [this, h4, h5, mul_one, mul_one], clear this,
    iterate 4 { rw ← is_ring_hom.map_mul g }, apply useful S f hf g hg,
    iterate 4 { rw is_ring_hom.map_mul f }, rw ← h3,
    have : f ↑sxy * (f ax * sifx * (f ay * sify)) * f ↑sx * f ↑sy = f ax * f ay * f ↑sxy * (f ↑sx * sifx) * (f ↑sy * sify),
    { simp only [mul_assoc, mul_comm, mul_left_comm] }, rw [this, h7, h8, mul_one, mul_one]
  end,
  map_add := λ x y, begin
    unfold is_localization_initial,
    rcases hf.has_denom x with ⟨⟨sx,ax⟩,h1⟩,
    rcases hf.has_denom y with ⟨⟨sy,ay⟩,h2⟩,
    rcases hf.has_denom (x+y) with ⟨⟨sxy,axy⟩,h3⟩,
    cases hg sx with sigx h4,
    cases hg sy with sigy h5,
    cases hg sxy with sigxy h6,
    cases hf.inverts sx with sifx h7,
    cases hf.inverts sy with sify h8,
    cases hf.inverts sxy with sifxy h9,
    dsimp only [subtype.coe_mk] at *,
    replace h1 : _ * _ = _ * _ := by convert congr_arg (* sifx) h1,
    rw [mul_right_comm, h7, one_mul] at h1,
    replace h2 : _ * _ = _ * _ := by convert congr_arg (* sify) h2,
    rw [mul_right_comm, h8, one_mul] at h2,
    rw [h1, h2] at h3,
    rw [← useful2 h4, ← useful2 h5, ← useful2 h6],
    have : g axy * sigxy * g ↑sx * g ↑sy * g ↑sxy = g axy * g ↑sx * g ↑sy * (g ↑sxy * sigxy),
    { simp only [mul_assoc, mul_comm, mul_left_comm] }, rw [this, h6, mul_one], clear this,
    have : (g ax * sigx + g ay * sigy) * g ↑sx * g ↑sy * g ↑sxy =
      g ax * g ↑sy * g ↑sxy * (g ↑sx * sigx) + g ay * g ↑sx * g ↑sxy * (g ↑sy * sigy),
    { simp only [add_mul, mul_add, mul_assoc, mul_comm, mul_left_comm] }, rw [this, h4, h5, mul_one, mul_one], clear this,
    iterate 6 { rw ← is_ring_hom.map_mul g }, rw ← is_ring_hom.map_add g, apply useful S f hf g hg,
    rw is_ring_hom.map_add f, iterate 6 { rw is_ring_hom.map_mul f }, rw ← h3,
    have : f ↑sxy * (f ax * sifx + f ay * sify) * f ↑sx * f ↑sy =
      f ax * f ↑sy * f ↑sxy * (f ↑sx * sifx) + f ay * f ↑sx * f ↑sxy * (f ↑sy * sify),
    { simp only [add_mul, mul_add, mul_assoc, mul_comm, mul_left_comm] }, rw [this, h7, h8, mul_one, mul_one]
  end }

lemma is_localization_initial_comp (hf : is_localization_data S f)
  (g : A → C) [is_ring_hom g] (hg : inverts_data S g) (a : A) :
  is_localization_initial S f hf g hg (f a) = g a :=
begin
  unfold is_localization_initial,
  rcases hf.has_denom (f a) with ⟨⟨s,x⟩,h1⟩,
  cases hg s with si h2,
  dsimp only [subtype.coe_mk] at *,
  rw [← useful2 h2, mul_right_comm, mul_assoc, h2, mul_one, ← is_ring_hom.map_mul g],
  apply useful S f hf g hg,
  rw [← h1, is_ring_hom.map_mul f, mul_comm]
end

-- Uniqueness.

def inverts_data_aux (h : B → C) [is_ring_hom h] (hf : is_localization_data S f) :
  inverts_data S (h ∘ f) := λ s,
⟨h (hf.inverts s).val,
begin
  rw ←(is_ring_hom.map_mul h),
  rw (hf.inverts s).property,
  exact is_ring_hom.map_one h,
end⟩

theorem is_localization_unique (hf : is_localization_data S f) (h : B → C) [is_ring_hom h] (b : B) :
is_localization_initial S f hf (h ∘ f) (inverts_data_aux S f h hf) b = h b :=
begin
  unfold is_localization_initial,
  rcases hf.has_denom b with ⟨⟨s, a⟩, hb⟩,
  show h (f a) * h ((hf.inverts s).val) = h b,
  cases hf.inverts s with si hsi,
  rw ←is_ring_hom.map_mul h,
  congr,
  rw [←hb, mul_comm, ←mul_assoc, mul_comm si, hsi, one_mul]
end

-- The uniqueness lemma above is too strict to rewrite.

theorem is_localization_unique.of_eq
(hf : is_localization_data S f) (h : B → C) [is_ring_hom h] (b : B)
(t : A → C) [is_ring_hom t] (ht : inverts_data S t)
: t = h ∘ f
→ is_localization_initial S f hf t ht b = h b :=
begin
  intros Heq,
  unfold is_localization_initial,
  rcases hf.has_denom b with ⟨⟨s, a⟩, hb⟩,
  rcases (ht s) with ⟨w, Hw⟩,
  dsimp only [subtype.coe_mk] at *,
  rw Heq,
  rw Heq at Hw,
  dsimp only [function.comp] at *,
  rw [←hb, is_ring_hom.map_mul h, mul_comm (h (f s)), mul_assoc, Hw, mul_one],
end

end localization_initial

end localization_alt


/-
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.list.nodup
import data.multiset.bind
import data.multiset.range

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

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

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⟩

@[simp] 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,
  (@replicate_le_coe _ a 2 _).symm.not

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 count_eq_of_nodup [decidable_eq α] {a : α} {s : multiset α}
  (d : nodup s) : count a s = if a ∈ s then 1 else 0 :=
begin
  split_ifs with h,
  { exact count_eq_one_of_mem d h },
  { exact count_eq_zero_of_not_mem h },
end

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] 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 x.2),
  from (ht.ext $ (nodup_attach.2 hs).map $
      show injective (λ x : {x // x ∈ s}, i x x.2), from λ x y hxy,
        subtype.ext $ i_inj x y 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) : by rw [pmap_eq_map_attach]
... = t.map g : by rw [this, multiset.map_map]; exact map_congr rfl (λ x _, h _ _)

end multiset