/-
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.finset.sort
import logic.denumerable

/-!
# Equivalences involving `list`-like types

This file defines some additional constructive equivalences using `encodable` and the pairing
function on `ℕ`.
-/

open nat list

namespace encodable
variables {α : Type*}

section list
variable [encodable α]

/-- Explicit encoding function for `list α` -/
def encode_list : list α → ℕ
| []     := 0
| (a::l) := succ (mkpair (encode a) (encode_list l))

/-- Explicit decoding function for `list α` -/
def decode_list : ℕ → option (list α)
| 0        := some []
| (succ v) := match unpair v, unpair_right_le v with
  | (v₁, v₂), h :=
    have v₂ < succ v, from lt_succ_of_le h,
    (::) <$> decode α v₁ <*> decode_list v₂
  end

/-- If `α` is encodable, then so is `list α`. This uses the `mkpair` and `unpair` functions from
`data.nat.pairing`. -/
instance list : encodable (list α) :=
⟨encode_list, decode_list, λ l,
  by induction l with a l IH; simp [encode_list, decode_list, unpair_mkpair, encodek, *]⟩

@[simp] theorem encode_list_nil : encode (@nil α) = 0 := rfl
@[simp] theorem encode_list_cons (a : α) (l : list α) :
  encode (a :: l) = succ (mkpair (encode a) (encode l)) := rfl

@[simp] theorem decode_list_zero : decode (list α) 0 = some [] :=
show decode_list 0 = some [], by rw decode_list

@[simp] theorem decode_list_succ (v : ℕ) :
  decode (list α) (succ v) =
  (::) <$> decode α v.unpair.1 <*> decode (list α) v.unpair.2 :=
show decode_list (succ v) = _, begin
  cases e : unpair v with v₁ v₂,
  simp [decode_list, e], refl
end

theorem length_le_encode : ∀ (l : list α), length l ≤ encode l
| [] := _root_.zero_le _
| (a :: l) := succ_le_succ $ (length_le_encode l).trans (right_le_mkpair _ _)

end list

section finset
variables [encodable α]

private def enle : α → α → Prop := encode ⁻¹'o (≤)

private lemma enle.is_linear_order : is_linear_order α enle :=
(rel_embedding.preimage ⟨encode, encode_injective⟩ (≤)).is_linear_order

private def decidable_enle (a b : α) : decidable (enle a b) :=
by unfold enle order.preimage; apply_instance

local attribute [instance] enle.is_linear_order decidable_enle

/-- Explicit encoding function for `multiset α` -/
def encode_multiset (s : multiset α) : ℕ :=
encode (s.sort enle)

/-- Explicit decoding function for `multiset α` -/
def decode_multiset (n : ℕ) : option (multiset α) :=
coe <$> decode (list α) n

/-- If `α` is encodable, then so is `multiset α`. -/
instance multiset : encodable (multiset α) :=
⟨encode_multiset, decode_multiset,
 λ s, by simp [encode_multiset, decode_multiset, encodek]⟩

end finset

/-- A listable type with decidable equality is encodable. -/
def encodable_of_list [decidable_eq α] (l : list α) (H : ∀ x, x ∈ l) : encodable α :=
⟨λ a, index_of a l, l.nth, λ a, index_of_nth (H _)⟩

def trunc_encodable_of_fintype (α : Type*) [decidable_eq α] [fintype α] : trunc (encodable α) :=
@@quot.rec_on_subsingleton _
  (λ s : multiset α, (∀ x:α, x ∈ s) → trunc (encodable α)) _
  finset.univ.1
  (λ l H, trunc.mk $ encodable_of_list l H)
  finset.mem_univ

/-- A noncomputable way to arbitrarily choose an ordering on a finite type.
  It is not made into a global instance, since it involves an arbitrary choice.
  This can be locally made into an instance with `local attribute [instance] fintype.encodable`. -/
noncomputable def _root_.fintype.encodable (α : Type*) [fintype α] : encodable α :=
by { classical, exact (encodable.trunc_encodable_of_fintype α).out }

/-- If `α` is encodable, then so is `vector α n`. -/
instance vector [encodable α] {n} : encodable (vector α n) :=
encodable.subtype

/-- If `α` is encodable, then so is `fin n → α`. -/
instance fin_arrow [encodable α] {n} : encodable (fin n → α) :=
of_equiv _ (equiv.vector_equiv_fin _ _).symm

instance fin_pi (n) (π : fin n → Type*) [∀ i, encodable (π i)] : encodable (Π i, π i) :=
of_equiv _ (equiv.pi_equiv_subtype_sigma (fin n) π)

/-- If `α` is encodable, then so is `array n α`. -/
instance array [encodable α] {n} : encodable (array n α) :=
of_equiv _ (equiv.array_equiv_fin _ _)

/-- If `α` is encodable, then so is `finset α`. -/
instance finset [encodable α] : encodable (finset α) :=
by haveI := decidable_eq_of_encodable α; exact
 of_equiv {s : multiset α // s.nodup}
  ⟨λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩

def fintype_arrow (α : Type*) (β : Type*) [decidable_eq α] [fintype α] [encodable β] :
  trunc (encodable (α → β)) :=
(fintype.trunc_equiv_fin α).map $
  λ f, encodable.of_equiv (fin (fintype.card α) → β) $
  equiv.arrow_congr f (equiv.refl _)

def fintype_pi (α : Type*) (π : α → Type*) [decidable_eq α] [fintype α] [∀ a, encodable (π a)] :
  trunc (encodable (Π a, π a)) :=
(encodable.trunc_encodable_of_fintype α).bind $ λ a,
  (@fintype_arrow α (Σa, π a) _ _ (@encodable.sigma _ _ a _)).bind $ λ f,
  trunc.mk $ @encodable.of_equiv _ _ (@encodable.subtype _ _ f _) (equiv.pi_equiv_subtype_sigma α π)

/-- The elements of a `fintype` as a sorted list. -/
def sorted_univ (α) [fintype α] [encodable α] : list α :=
finset.univ.sort (encodable.encode' α ⁻¹'o (≤))

@[simp] theorem mem_sorted_univ {α} [fintype α] [encodable α] (x : α) : x ∈ sorted_univ α :=
(finset.mem_sort _).2 (finset.mem_univ _)

@[simp] theorem length_sorted_univ (α) [fintype α] [encodable α] :
  (sorted_univ α).length = fintype.card α :=
finset.length_sort _

@[simp]

@[simp] theorem sorted_univ_to_finset (α) [fintype α] [encodable α] [decidable_eq α] :
  (sorted_univ α).to_finset = finset.univ :=
finset.sort_to_finset _ _

/-- An encodable `fintype` is equivalent to the same size `fin`. -/
def fintype_equiv_fin {α} [fintype α] [encodable α] :
  α ≃ fin (fintype.card α) :=
begin
  haveI : decidable_eq α := encodable.decidable_eq_of_encodable _,
  transitivity,
  { exact ((sorted_univ_nodup α).nth_le_equiv_of_forall_mem_list _ mem_sorted_univ).symm },
  exact equiv.cast (congr_arg _ (length_sorted_univ α))
end

/-- If `α` and `β` are encodable and `α` is a fintype, then `α → β` is encodable as well. -/
instance fintype_arrow_of_encodable {α β : Type*} [encodable α] [fintype α] [encodable β] :
  encodable (α → β) :=
of_equiv (fin (fintype.card α) → β) $ equiv.arrow_congr fintype_equiv_fin (equiv.refl _)

end encodable

namespace denumerable
variables {α : Type*} {β : Type*} [denumerable α] [denumerable β]
open encodable

section list

theorem denumerable_list_aux : ∀ n : ℕ,
  ∃ a ∈ @decode_list α _ n, encode_list a = n
| 0        := by rw decode_list; exact ⟨_, rfl, rfl⟩
| (succ v) := begin
  cases e : unpair v with v₁ v₂,
  have h := unpair_right_le v,
  rw e at h,
  rcases have v₂ < succ v, from lt_succ_of_le h,
    denumerable_list_aux v₂ with ⟨a, h₁, h₂⟩,
  rw option.mem_def at h₁,
  use of_nat α v₁ :: a,
  simp [decode_list, e, h₂, h₁, encode_list, mkpair_unpair' e],
end

/-- If `α` is denumerable, then so is `list α`. -/
instance denumerable_list : denumerable (list α) := ⟨denumerable_list_aux⟩

@[simp] theorem list_of_nat_zero : of_nat (list α) 0 = [] :=
by rw [← @encode_list_nil α, of_nat_encode]

@[simp] theorem list_of_nat_succ (v : ℕ) :
  of_nat (list α) (succ v) =
  of_nat α v.unpair.1 :: of_nat (list α) v.unpair.2 :=
of_nat_of_decode $ show decode_list (succ v) = _,
begin
  cases e : unpair v with v₁ v₂,
  simp [decode_list, e],
  rw [show decode_list v₂ = decode (list α) v₂,
      from rfl, decode_eq_of_nat]; refl
end

end list

section multiset

/-- Outputs the list of differences of the input list, that is
`lower [a₁, a₂, ...] n = [a₁ - n, a₂ - a₁, ...]` -/
def lower : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m - n) :: lower l m

/-- Outputs the list of partial sums of the input list, that is
`raise [a₁, a₂, ...] n = [n + a₁, n + a₁ + a₂, ...]` -/
def raise : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m + n) :: raise l (m + n)

lemma lower_raise : ∀ l n, lower (raise l n) n = l
| []       n := rfl
| (m :: l) n := by rw [raise, lower, add_tsub_cancel_right, lower_raise]

lemma raise_lower : ∀ {l n}, list.sorted (≤) (n :: l) → raise (lower l n) n = l
| []       n h := rfl
| (m :: l) n h :=
  have n ≤ m, from list.rel_of_sorted_cons h _ (l.mem_cons_self _),
  by simp [raise, lower, tsub_add_cancel_of_le this, raise_lower h.of_cons]

lemma raise_chain : ∀ l n, list.chain (≤) n (raise l n)
| []       n := list.chain.nil
| (m :: l) n := list.chain.cons (nat.le_add_left _ _) (raise_chain _ _)

/-- `raise l n` is an non-decreasing sequence. -/
lemma raise_sorted : ∀ l n, list.sorted (≤) (raise l n)
| []       n := list.sorted_nil
| (m :: l) n := (list.chain_iff_pairwise (@le_trans _ _)).1 (raise_chain _ _)

/-- If `α` is denumerable, then so is `multiset α`. Warning: this is *not* the same encoding as used
in `encodable.multiset`. -/
instance multiset : denumerable (multiset α) := mk' ⟨
  λ s : multiset α, encode $ lower ((s.map encode).sort (≤)) 0,
  λ n, multiset.map (of_nat α) (raise (of_nat (list ℕ) n) 0),
  λ s, by have := raise_lower
      (list.sorted_cons.2 ⟨λ n _, zero_le n, (s.map encode).sort_sorted _⟩);
    simp [-multiset.coe_map, this],
  λ n, by simp [-multiset.coe_map, list.merge_sort_eq_self _ (raise_sorted _ _), lower_raise]⟩

end multiset

section finset

/-- Outputs the list of differences minus one of the input list, that is
`lower' [a₁, a₂, a₃, ...] n = [a₁ - n, a₂ - a₁ - 1, a₃ - a₂ - 1, ...]`. -/
def lower' : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m - n) :: lower' l (m + 1)

/-- Outputs the list of partial sums plus one of the input list, that is
`raise [a₁, a₂, a₃, ...] n = [n + a₁, n + a₁ + a₂ + 1, n + a₁ + a₂ + a₃ + 2, ...]`. Adding one each
time ensures the elements are distinct. -/
def raise' : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m + n) :: raise' l (m + n + 1)

lemma lower_raise' : ∀ l n, lower' (raise' l n) n = l
| []       n := rfl
| (m :: l) n := by simp [raise', lower', add_tsub_cancel_right, lower_raise']

lemma raise_lower' : ∀ {l n}, (∀ m ∈ l, n ≤ m) → list.sorted (<) l → raise' (lower' l n) n = l
| []       n h₁ h₂ := rfl
| (m :: l) n h₁ h₂ :=
  have n ≤ m, from h₁ _ (l.mem_cons_self _),
  by simp [raise', lower', tsub_add_cancel_of_le this, raise_lower'
    (list.rel_of_sorted_cons h₂ : ∀ a ∈ l, m < a) h₂.of_cons]

lemma raise'_chain : ∀ l {m n}, m < n → list.chain (<) m (raise' l n)
| []       m n h := list.chain.nil
| (a :: l) m n h := list.chain.cons
  (lt_of_lt_of_le h (nat.le_add_left _ _)) (raise'_chain _ (lt_succ_self _))

/-- `raise' l n` is a strictly increasing sequence. -/
lemma raise'_sorted : ∀ l n, list.sorted (<) (raise' l n)
| []       n := list.sorted_nil
| (m :: l) n := (list.chain_iff_pairwise (@lt_trans _ _)).1
  (raise'_chain _ (lt_succ_self _))

/-- Makes `raise' l n` into a finset. Elements are distinct thanks to `raise'_sorted`. -/
def raise'_finset (l : list ℕ) (n : ℕ) : finset ℕ :=
⟨raise' l n, (raise'_sorted _ _).imp (@ne_of_lt _ _)⟩

/-- If `α` is denumerable, then so is `finset α`. Warning: this is *not* the same encoding as used
in `encodable.finset`. -/
instance finset : denumerable (finset α) := mk' ⟨
  λ s : finset α, encode $ lower' ((s.map (eqv α).to_embedding).sort (≤)) 0,
  λ n, finset.map (eqv α).symm.to_embedding (raise'_finset (of_nat (list ℕ) n) 0),
  λ s, finset.eq_of_veq $ by simp [-multiset.coe_map, raise'_finset,
    raise_lower' (λ n _, zero_le n) (finset.sort_sorted_lt _)],
  λ n, by simp [-multiset.coe_map, finset.map, raise'_finset, finset.sort,
    list.merge_sort_eq_self (≤) ((raise'_sorted _ _).imp (@le_of_lt _ _)),
    lower_raise']⟩

end finset

end denumerable

namespace equiv

/-- The type lists on unit is canonically equivalent to the natural numbers. -/
def list_unit_equiv : list unit ≃ ℕ :=
{ to_fun := list.length,
  inv_fun := list.repeat (),
  left_inv := λ u, list.length_injective (by simp),
  right_inv := λ n, list.length_repeat () n }

/-- `list ℕ` is equivalent to `ℕ`. -/
def list_nat_equiv_nat : list ℕ ≃ ℕ := denumerable.eqv _

/-- If `α` is equivalent to `ℕ`, then `list α` is equivalent to `α`. -/
def list_equiv_self_of_equiv_nat {α : Type} (e : α ≃ ℕ) : list α ≃ α :=
calc list α ≃ list ℕ : list_equiv_of_equiv e
        ... ≃ ℕ      : list_nat_equiv_nat
        ... ≃ α      : e.symm

end equiv


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module order.filter.lift
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Filter.Bases
import Mathlib.Order.ConditionallyCompleteLattice.Basic

/-!
# Lift filters along filter and set functions
-/

open Set Classical Filter Function

namespace Filter

variable {α β γ : Type _} {ι : Sort _}

section lift

/-- A variant on `bind` using a function `g` taking a set instead of a member of `α`.
This is essentially a push-forward along a function mapping each set to a filter. -/
protected def lift (f : Filter α) (g : Set α → Filter β) :=
  ⨅ s ∈ f, g s
#align filter.lift Filter.lift

variable {f f₁ f₂ : Filter α} {g g₁ g₂ : Set α → Filter β}

@[simp]
theorem lift_top (g : Set α → Filter β) : (⊤ : Filter α).lift g = g univ := by simp [Filter.lift]
#align filter.lift_top Filter.lift_top

-- porting note: use `∃ i, p i ∧ _` instead of `∃ i (hi : p i), _`
/-- If `(p : ι → Prop, s : ι → Set α)` is a basis of a filter `f`, `g` is a monotone function
`Set α → Filter γ`, and for each `i`, `(pg : β i → Prop, sg : β i → Set α)` is a basis
of the filter `g (s i)`, then `(λ (i : ι) (x : β i), p i ∧ pg i x, λ (i : ι) (x : β i), sg i x)`
is a basis of the filter `f.lift g`.

This basis is parametrized by `i : ι` and `x : β i`, so in order to formulate this fact using
`Filter.HasBasis` one has to use `Σ i, β i` as the index type, see `Filter.HasBasis.lift`.
This lemma states the corresponding `mem_iff` statement without using a sigma type. -/
theorem HasBasis.mem_lift_iff {ι} {p : ι → Prop} {s : ι → Set α} {f : Filter α}
    (hf : f.HasBasis p s) {β : ι → Type _} {pg : ∀ i, β i → Prop} {sg : ∀ i, β i → Set γ}
    {g : Set α → Filter γ} (hg : ∀ i, (g <| s i).HasBasis (pg i) (sg i)) (gm : Monotone g)
    {s : Set γ} : s ∈ f.lift g ↔ ∃ i, p i ∧ ∃ x, pg i x ∧ sg i x ⊆ s := by
  refine' (mem_binfᵢ_of_directed _ ⟨univ, univ_sets _⟩).trans _
  · intro t₁ ht₁ t₂ ht₂
    exact ⟨t₁ ∩ t₂, inter_mem ht₁ ht₂, gm <| inter_subset_left _ _, gm <| inter_subset_right _ _⟩
  · simp only [← (hg _).mem_iff]
    exact hf.exists_iff fun t₁ t₂ ht H => gm ht H
#align filter.has_basis.mem_lift_iff Filter.HasBasis.mem_lift_iffₓ

/-- If `(p : ι → Prop, s : ι → Set α)` is a basis of a filter `f`, `g` is a monotone function
`Set α → Filter γ`, and for each `i`, `(pg : β i → Prop, sg : β i → Set α)` is a basis
of the filter `g (s i)`, then `(λ (i : ι) (x : β i), p i ∧ pg i x, λ (i : ι) (x : β i), sg i x)`
is a basis of the filter `f.lift g`.

This basis is parametrized by `i : ι` and `x : β i`, so in order to formulate this fact using
`has_basis` one has to use `Σ i, β i` as the index type. See also `Filter.HasBasis.mem_lift_iff`
for the corresponding `mem_iff` statement formulated without using a sigma type. -/
theorem HasBasis.lift {ι} {p : ι → Prop} {s : ι → Set α} {f : Filter α} (hf : f.HasBasis p s)
    {β : ι → Type _} {pg : ∀ i, β i → Prop} {sg : ∀ i, β i → Set γ} {g : Set α → Filter γ}
    (hg : ∀ i, (g (s i)).HasBasis (pg i) (sg i)) (gm : Monotone g) :
    (f.lift g).HasBasis (fun i : Σi, β i => p i.1 ∧ pg i.1 i.2) fun i : Σi, β i => sg i.1 i.2 := by
  refine' ⟨fun t => (hf.mem_lift_iff hg gm).trans _⟩
  simp [Sigma.exists, and_assoc, exists_and_left]
#align filter.has_basis.lift Filter.HasBasis.lift

theorem mem_lift_sets (hg : Monotone g) {s : Set β} : s ∈ f.lift g ↔ ∃ t ∈ f, s ∈ g t :=
  (f.basis_sets.mem_lift_iff (fun s => (g s).basis_sets) hg).trans <| by
    simp only [id, exists_mem_subset_iff]
#align filter.mem_lift_sets Filter.mem_lift_sets

theorem interₛ_lift_sets (hg : Monotone g) :
    ⋂₀ { s | s ∈ f.lift g } = ⋂ s ∈ f, ⋂₀ { t | t ∈ g s } := by
  simp only [interₛ_eq_binterᵢ, mem_setOf_eq, Filter.mem_sets, mem_lift_sets hg, interᵢ_exists,
    interᵢ_and, @interᵢ_comm _ (Set β)]
#align filter.sInter_lift_sets Filter.interₛ_lift_sets

theorem mem_lift {s : Set β} {t : Set α} (ht : t ∈ f) (hs : s ∈ g t) : s ∈ f.lift g :=
  le_principal_iff.mp <|
    show f.lift g ≤ 𝓟 s from infᵢ_le_of_le t <| infᵢ_le_of_le ht <| le_principal_iff.mpr hs
#align filter.mem_lift Filter.mem_lift

theorem lift_le {f : Filter α} {g : Set α → Filter β} {h : Filter β} {s : Set α} (hs : s ∈ f)
    (hg : g s ≤ h) : f.lift g ≤ h :=
  infᵢ₂_le_of_le s hs hg
#align filter.lift_le Filter.lift_le

theorem le_lift {f : Filter α} {g : Set α → Filter β} {h : Filter β} :
    h ≤ f.lift g ↔ ∀ s ∈ f, h ≤ g s :=
  le_infᵢ₂_iff
#align filter.le_lift Filter.le_lift

theorem lift_mono (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) : f₁.lift g₁ ≤ f₂.lift g₂ :=
  infᵢ_mono fun s => infᵢ_mono' fun hs => ⟨hf hs, hg s⟩
#align filter.lift_mono Filter.lift_mono

theorem lift_mono' (hg : ∀ s ∈ f, g₁ s ≤ g₂ s) : f.lift g₁ ≤ f.lift g₂ := infᵢ₂_mono hg
#align filter.lift_mono' Filter.lift_mono'

theorem tendsto_lift {m : γ → β} {l : Filter γ} :
    Tendsto m l (f.lift g) ↔ ∀ s ∈ f, Tendsto m l (g s) := by
  simp only [Filter.lift, tendsto_infᵢ]
#align filter.tendsto_lift Filter.tendsto_lift

theorem map_lift_eq {m : β → γ} (hg : Monotone g) : map m (f.lift g) = f.lift (map m ∘ g) :=
  have : Monotone (map m ∘ g) := map_mono.comp hg
  Filter.ext fun s => by
    simp only [mem_lift_sets hg, mem_lift_sets this, exists_prop, mem_map, Function.comp_apply]
#align filter.map_lift_eq Filter.map_lift_eq

theorem comap_lift_eq {m : γ → β} : comap m (f.lift g) = f.lift (comap m ∘ g) := by
  simp only [Filter.lift, comap_infᵢ]; rfl
#align filter.comap_lift_eq Filter.comap_lift_eq

theorem comap_lift_eq2 {m : β → α} {g : Set β → Filter γ} (hg : Monotone g) :
    (comap m f).lift g = f.lift (g ∘ preimage m) :=
  le_antisymm (le_infᵢ₂ fun s hs => infᵢ₂_le (m ⁻¹' s) ⟨s, hs, Subset.rfl⟩)
    (le_infᵢ₂ fun _s ⟨s', hs', h_sub⟩ => infᵢ₂_le_of_le s' hs' <| hg h_sub)
#align filter.comap_lift_eq2 Filter.comap_lift_eq2

theorem lift_map_le {g : Set β → Filter γ} {m : α → β} : (map m f).lift g ≤ f.lift (g ∘ image m) :=
  le_lift.2 fun _s hs => lift_le (image_mem_map hs) le_rfl
#align filter.lift_map_le Filter.lift_map_le

theorem map_lift_eq2 {g : Set β → Filter γ} {m : α → β} (hg : Monotone g) :
    (map m f).lift g = f.lift (g ∘ image m) :=
  lift_map_le.antisymm <| le_lift.2 fun _s hs => lift_le hs <| hg <| image_preimage_subset _ _
#align filter.map_lift_eq2 Filter.map_lift_eq2

theorem lift_comm {g : Filter β} {h : Set α → Set β → Filter γ} :
    (f.lift fun s => g.lift (h s)) = g.lift fun t => f.lift fun s => h s t :=
  le_antisymm
    (le_infᵢ fun i => le_infᵢ fun hi => le_infᵢ fun j => le_infᵢ fun hj =>
      infᵢ_le_of_le j <| infᵢ_le_of_le hj <| infᵢ_le_of_le i <| infᵢ_le _ hi)
    (le_infᵢ fun i => le_infᵢ fun hi => le_infᵢ fun j => le_infᵢ fun hj =>
      infᵢ_le_of_le j <| infᵢ_le_of_le hj <| infᵢ_le_of_le i <| infᵢ_le _ hi)
#align filter.lift_comm Filter.lift_comm

theorem lift_assoc {h : Set β → Filter γ} (hg : Monotone g) :
    (f.lift g).lift h = f.lift fun s => (g s).lift h :=
  le_antisymm
    (le_infᵢ₂ fun _s hs => le_infᵢ₂ fun t ht =>
      infᵢ_le_of_le t <| infᵢ_le _ <| (mem_lift_sets hg).mpr ⟨_, hs, ht⟩)
    (le_infᵢ₂ fun t ht =>
      let ⟨s, hs, h'⟩ := (mem_lift_sets hg).mp ht
      infᵢ_le_of_le s <| infᵢ_le_of_le hs <| infᵢ_le_of_le t <| infᵢ_le _ h')
#align filter.lift_assoc Filter.lift_assoc

theorem lift_lift_same_le_lift {g : Set α → Set α → Filter β} :
    (f.lift fun s => f.lift (g s)) ≤ f.lift fun s => g s s :=
  le_lift.2 fun _s hs => lift_le hs <| lift_le hs le_rfl
#align filter.lift_lift_same_le_lift Filter.lift_lift_same_le_lift

theorem lift_lift_same_eq_lift {g : Set α → Set α → Filter β} (hg₁ : ∀ s, Monotone fun t => g s t)
    (hg₂ : ∀ t, Monotone fun s => g s t) : (f.lift fun s => f.lift (g s)) = f.lift fun s => g s s :=
  lift_lift_same_le_lift.antisymm <|
    le_lift.2 fun s hs => le_lift.2 fun t ht => lift_le (inter_mem hs ht) <|
      calc
        g (s ∩ t) (s ∩ t) ≤ g s (s ∩ t) := hg₂ (s ∩ t) (inter_subset_left _ _)
        _ ≤ g s t := hg₁ s (inter_subset_right _ _)

#align filter.lift_lift_same_eq_lift Filter.lift_lift_same_eq_lift

theorem lift_principal {s : Set α} (hg : Monotone g) : (𝓟 s).lift g = g s :=
  (lift_le (mem_principal_self _) le_rfl).antisymm (le_lift.2 fun _t ht => hg ht)
#align filter.lift_principal Filter.lift_principal

theorem monotone_lift [Preorder γ] {f : γ → Filter α} {g : γ → Set α → Filter β} (hf : Monotone f)
    (hg : Monotone g) : Monotone fun c => (f c).lift (g c) := fun _ _ h => lift_mono (hf h) (hg h)
#align filter.monotone_lift Filter.monotone_lift

theorem lift_neBot_iff (hm : Monotone g) : (NeBot (f.lift g)) ↔ ∀ s ∈ f, NeBot (g s) := by
  simp only [neBot_iff, Ne.def, ← empty_mem_iff_bot, mem_lift_sets hm, not_exists, not_and]
#align filter.lift_ne_bot_iff Filter.lift_neBot_iff

@[simp]
theorem lift_const {f : Filter α} {g : Filter β} : (f.lift fun _ => g) = g :=
  infᵢ_subtype'.trans infᵢ_const
#align filter.lift_const Filter.lift_const

@[simp]
theorem lift_inf {f : Filter α} {g h : Set α → Filter β} :
    (f.lift fun x => g x ⊓ h x) = f.lift g ⊓ f.lift h := by simp only [Filter.lift, infᵢ_inf_eq]
#align filter.lift_inf Filter.lift_inf

@[simp]
theorem lift_principal2 {f : Filter α} : f.lift 𝓟 = f :=
  le_antisymm (fun s hs => mem_lift hs (mem_principal_self s))
    (le_infᵢ fun s => le_infᵢ fun hs => by simp only [hs, le_principal_iff])
#align filter.lift_principal2 Filter.lift_principal2

theorem lift_infᵢ_le {f : ι → Filter α} {g : Set α → Filter β} :
    (infᵢ f).lift g ≤ ⨅ i, (f i).lift g :=
  le_infᵢ fun _ => lift_mono (infᵢ_le _ _) le_rfl
#align filter.lift_infi_le Filter.lift_infᵢ_le

theorem lift_infᵢ [Nonempty ι] {f : ι → Filter α} {g : Set α → Filter β}
    (hg : ∀ s t, g (s ∩ t) = g s ⊓ g t) : (infᵢ f).lift g = ⨅ i, (f i).lift g := by
  refine' lift_infᵢ_le.antisymm fun s => _
  have H : ∀ t ∈ infᵢ f, (⨅ i, (f i).lift g) ≤ g t :=
    by
    intro t ht
    refine' infᵢ_sets_induct ht _ fun hs ht => _
    · inhabit ι
      exact infᵢ₂_le_of_le default univ (infᵢ_le _ univ_mem)
    · rw [hg]
      exact le_inf (infᵢ₂_le_of_le _ _ <| infᵢ_le _ hs) ht
  simp only [mem_lift_sets (Monotone.of_map_inf hg), exists_imp, and_imp]
  exact fun t ht hs => H t ht hs
#align filter.lift_infi Filter.lift_infᵢ

theorem lift_infᵢ_of_directed [Nonempty ι] {f : ι → Filter α} {g : Set α → Filter β}
    (hf : Directed (· ≥ ·) f) (hg : Monotone g) : (infᵢ f).lift g = ⨅ i, (f i).lift g :=
  lift_infᵢ_le.antisymm fun s =>
    by
    simp only [mem_lift_sets hg, exists_imp, and_imp, mem_infᵢ_of_directed hf]
    exact fun t i ht hs => mem_infᵢ_of_mem i <| mem_lift ht hs
#align filter.lift_infi_of_directed Filter.lift_infᵢ_of_directed

theorem lift_infᵢ_of_map_univ {f : ι → Filter α} {g : Set α → Filter β}
    (hg : ∀ s t, g (s ∩ t) = g s ⊓ g t) (hg' : g univ = ⊤) :
    (infᵢ f).lift g = ⨅ i, (f i).lift g := by
  cases isEmpty_or_nonempty ι
  · simp [infᵢ_of_empty, hg']
  · exact lift_infᵢ hg
#align filter.lift_infi_of_map_univ Filter.lift_infᵢ_of_map_univ

end lift

section Lift'

/-- Specialize `lift` to functions `Set α → Set β`. This can be viewed as a generalization of `map`.
This is essentially a push-forward along a function mapping each set to a set. -/
protected def lift' (f : Filter α) (h : Set α → Set β) :=
  f.lift (𝓟 ∘ h)
#align filter.lift' Filter.lift'

variable {f f₁ f₂ : Filter α} {h h₁ h₂ : Set α → Set β}

@[simp]
theorem lift'_top (h : Set α → Set β) : (⊤ : Filter α).lift' h = 𝓟 (h univ) :=
  lift_top _
#align filter.lift'_top Filter.lift'_top

theorem mem_lift' {t : Set α} (ht : t ∈ f) : h t ∈ f.lift' h :=
  le_principal_iff.mp <| show f.lift' h ≤ 𝓟 (h t) from infᵢ_le_of_le t <| infᵢ_le_of_le ht <| le_rfl
#align filter.mem_lift' Filter.mem_lift'

theorem tendsto_lift' {m : γ → β} {l : Filter γ} :
    Tendsto m l (f.lift' h) ↔ ∀ s ∈ f, ∀ᶠ a in l, m a ∈ h s := by
  simp only [Filter.lift', tendsto_lift, tendsto_principal, comp]
#align filter.tendsto_lift' Filter.tendsto_lift'

theorem HasBasis.lift' {ι} {p : ι → Prop} {s} (hf : f.HasBasis p s) (hh : Monotone h) :
    (f.lift' h).HasBasis p (h ∘ s) :=
  ⟨fun t => (hf.mem_lift_iff (fun i => hasBasis_principal (h (s i)))
    (monotone_principal.comp hh)).trans <| by simp only [exists_const, true_and, comp]⟩
#align filter.has_basis.lift' Filter.HasBasis.lift'

theorem mem_lift'_sets (hh : Monotone h) {s : Set β} : s ∈ f.lift' h ↔ ∃ t ∈ f, h t ⊆ s :=
  mem_lift_sets <| monotone_principal.comp hh
#align filter.mem_lift'_sets Filter.mem_lift'_sets

theorem eventually_lift'_iff (hh : Monotone h) {p : β → Prop} :
    (∀ᶠ y in f.lift' h, p y) ↔ ∃ t ∈ f, ∀ y ∈ h t, p y :=
  mem_lift'_sets hh
#align filter.eventually_lift'_iff Filter.eventually_lift'_iff

theorem interₛ_lift'_sets (hh : Monotone h) : ⋂₀ { s | s ∈ f.lift' h } = ⋂ s ∈ f, h s :=
  (interₛ_lift_sets (monotone_principal.comp hh)).trans <| interᵢ₂_congr fun _ _ => cinfₛ_Ici
#align filter.sInter_lift'_sets Filter.interₛ_lift'_sets

theorem lift'_le {f : Filter α} {g : Set α → Set β} {h : Filter β} {s : Set α} (hs : s ∈ f)
    (hg : 𝓟 (g s) ≤ h) : f.lift' g ≤ h :=
  lift_le hs hg
#align filter.lift'_le Filter.lift'_le

theorem lift'_mono (hf : f₁ ≤ f₂) (hh : h₁ ≤ h₂) : f₁.lift' h₁ ≤ f₂.lift' h₂ :=
  lift_mono hf fun s => principal_mono.mpr <| hh s
#align filter.lift'_mono Filter.lift'_mono

theorem lift'_mono' (hh : ∀ s ∈ f, h₁ s ⊆ h₂ s) : f.lift' h₁ ≤ f.lift' h₂ :=
  infᵢ₂_mono fun s hs => principal_mono.mpr <| hh s hs
#align filter.lift'_mono' Filter.lift'_mono'

theorem lift'_cong (hh : ∀ s ∈ f, h₁ s = h₂ s) : f.lift' h₁ = f.lift' h₂ :=
  le_antisymm (lift'_mono' fun s hs => le_of_eq <| hh s hs)
    (lift'_mono' fun s hs => le_of_eq <| (hh s hs).symm)
#align filter.lift'_cong Filter.lift'_cong

theorem map_lift'_eq {m : β → γ} (hh : Monotone h) : map m (f.lift' h) = f.lift' (image m ∘ h) :=
  calc
    map m (f.lift' h) = f.lift (map m ∘ 𝓟 ∘ h) := map_lift_eq <| monotone_principal.comp hh
    _ = f.lift' (image m ∘ h) := by simp only [comp, Filter.lift', map_principal]

#align filter.map_lift'_eq Filter.map_lift'_eq

theorem lift'_map_le {g : Set β → Set γ} {m : α → β} : (map m f).lift' g ≤ f.lift' (g ∘ image m) :=
  lift_map_le
#align filter.lift'_map_le Filter.lift'_map_le

theorem map_lift'_eq2 {g : Set β → Set γ} {m : α → β} (hg : Monotone g) :
    (map m f).lift' g = f.lift' (g ∘ image m) :=
  map_lift_eq2 <| monotone_principal.comp hg
#align filter.map_lift'_eq2 Filter.map_lift'_eq2

theorem comap_lift'_eq {m : γ → β} : comap m (f.lift' h) = f.lift' (preimage m ∘ h) := by
  simp only [Filter.lift', comap_lift_eq, (· ∘ ·), comap_principal]
#align filter.comap_lift'_eq Filter.comap_lift'_eq

theorem comap_lift'_eq2 {m : β → α} {g : Set β → Set γ} (hg : Monotone g) :
    (comap m f).lift' g = f.lift' (g ∘ preimage m) :=
  comap_lift_eq2 <| monotone_principal.comp hg
#align filter.comap_lift'_eq2 Filter.comap_lift'_eq2

theorem lift'_principal {s : Set α} (hh : Monotone h) : (𝓟 s).lift' h = 𝓟 (h s) :=
  lift_principal <| monotone_principal.comp hh
#align filter.lift'_principal Filter.lift'_principal

theorem lift'_pure {a : α} (hh : Monotone h) : (pure a : Filter α).lift' h = 𝓟 (h {a}) := by
  rw [← principal_singleton, lift'_principal hh]
#align filter.lift'_pure Filter.lift'_pure

theorem lift'_bot (hh : Monotone h) : (⊥ : Filter α).lift' h = 𝓟 (h ∅) := by
  rw [← principal_empty, lift'_principal hh]
#align filter.lift'_bot Filter.lift'_bot

theorem le_lift' {f : Filter α} {h : Set α → Set β} {g : Filter β} :
    g ≤ f.lift' h ↔ ∀ s ∈ f, h s ∈ g :=
  le_lift.trans <| forall₂_congr fun _ _ => le_principal_iff
#align filter.le_lift' Filter.le_lift'

theorem principal_le_lift' {t : Set β} : 𝓟 t ≤ f.lift' h ↔ ∀ s ∈ f, t ⊆ h s :=
  le_lift'
#align filter.principal_le_lift' Filter.principal_le_lift'

theorem monotone_lift' [Preorder γ] {f : γ → Filter α} {g : γ → Set α → Set β} (hf : Monotone f)
    (hg : Monotone g) : Monotone fun c => (f c).lift' (g c) := fun _ _ h => lift'_mono (hf h) (hg h)
#align filter.monotone_lift' Filter.monotone_lift'

theorem lift_lift'_assoc {g : Set α → Set β} {h : Set β → Filter γ} (hg : Monotone g)
    (hh : Monotone h) : (f.lift' g).lift h = f.lift fun s => h (g s) :=
  calc
    (f.lift' g).lift h = f.lift fun s => (𝓟 (g s)).lift h := lift_assoc (monotone_principal.comp hg)
    _ = f.lift fun s => h (g s) := by simp only [lift_principal, hh, eq_self_iff_true]

#align filter.lift_lift'_assoc Filter.lift_lift'_assoc

theorem lift'_lift_assoc {g : Set α → Filter β} {h : Set β → Set γ} (hg : Monotone g) :
    (f.lift g).lift' h = f.lift fun s => (g s).lift' h :=
  lift_assoc hg
#align filter.lift'_lift_assoc Filter.lift'_lift_assoc

theorem lift_lift'_same_le_lift' {g : Set α → Set α → Set β} :
    (f.lift fun s => f.lift' (g s)) ≤ f.lift' fun s => g s s :=
  lift_lift_same_le_lift
#align filter.lift_lift'_same_le_lift' Filter.lift_lift'_same_le_lift'

theorem lift_lift'_same_eq_lift' {g : Set α → Set α → Set β} (hg₁ : ∀ s, Monotone fun t => g s t)
    (hg₂ : ∀ t, Monotone fun s => g s t) :
    (f.lift fun s => f.lift' (g s)) = f.lift' fun s => g s s :=
  lift_lift_same_eq_lift (fun s => monotone_principal.comp (hg₁ s)) fun t =>
    monotone_principal.comp (hg₂ t)
#align filter.lift_lift'_same_eq_lift' Filter.lift_lift'_same_eq_lift'

theorem lift'_inf_principal_eq {h : Set α → Set β} {s : Set β} :
    f.lift' h ⊓ 𝓟 s = f.lift' fun t => h t ∩ s := by
  simp only [Filter.lift', Filter.lift, (· ∘ ·), ← inf_principal, infᵢ_subtype', ← infᵢ_inf]
#align filter.lift'_inf_principal_eq Filter.lift'_inf_principal_eq

theorem lift'_neBot_iff (hh : Monotone h) : NeBot (f.lift' h) ↔ ∀ s ∈ f, (h s).Nonempty :=
  calc
    NeBot (f.lift' h) ↔ ∀ s ∈ f, NeBot (𝓟 (h s)) := lift_neBot_iff (monotone_principal.comp hh)
    _ ↔ ∀ s ∈ f, (h s).Nonempty := by simp only [principal_neBot_iff]
#align filter.lift'_ne_bot_iff Filter.lift'_neBot_iff

@[simp]
theorem lift'_id {f : Filter α} : f.lift' id = f :=
  lift_principal2
#align filter.lift'_id Filter.lift'_id

theorem lift'_infᵢ [Nonempty ι] {f : ι → Filter α} {g : Set α → Set β}
    (hg : ∀ s t, g (s ∩ t) = g s ∩ g t) : (infᵢ f).lift' g = ⨅ i, (f i).lift' g :=
  lift_infᵢ fun s t => by simp only [inf_principal, comp, hg]
#align filter.lift'_infi Filter.lift'_infᵢ

theorem lift'_infᵢ_of_map_univ {f : ι → Filter α} {g : Set α → Set β}
    (hg : ∀ {s t}, g (s ∩ t) = g s ∩ g t) (hg' : g univ = univ) :
    (infᵢ f).lift' g = ⨅ i, (f i).lift' g :=
  lift_infᵢ_of_map_univ (fun s t => by simp only [inf_principal, comp, hg])
    (by rw [Function.comp_apply, hg', principal_univ])
#align filter.lift'_infi_of_map_univ Filter.lift'_infᵢ_of_map_univ

theorem lift'_inf (f g : Filter α) {s : Set α → Set β} (hs : ∀ t₁ t₂, s (t₁ ∩ t₂) = s t₁ ∩ s t₂) :
    (f ⊓ g).lift' s = f.lift' s ⊓ g.lift' s := by
  rw [inf_eq_infᵢ, inf_eq_infᵢ, lift'_infᵢ hs]
  refine infᵢ_congr ?_
  rintro (_|_) <;> rfl
#align filter.lift'_inf Filter.lift'_inf

theorem lift'_inf_le (f g : Filter α) (s : Set α → Set β) :
    (f ⊓ g).lift' s ≤ f.lift' s ⊓ g.lift' s :=
  le_inf (lift'_mono inf_le_left le_rfl) (lift'_mono inf_le_right le_rfl)
#align filter.lift'_inf_le Filter.lift'_inf_le

theorem comap_eq_lift' {f : Filter β} {m : α → β} : comap m f = f.lift' (preimage m) :=
  Filter.ext fun _ => (mem_lift'_sets monotone_preimage).symm
#align filter.comap_eq_lift' Filter.comap_eq_lift'

end Lift'

section Prod

variable {f : Filter α}

theorem prod_def {f : Filter α} {g : Filter β} :
    f ×ᶠ g = f.lift fun s => g.lift' fun t => s ×ˢ t := by
  simpa only [Filter.lift', Filter.lift, (f.basis_sets.prod g.basis_sets).eq_binfᵢ,
    infᵢ_prod, infᵢ_and] using infᵢ_congr fun i => infᵢ_comm
#align filter.prod_def Filter.prod_def

alias mem_prod_self_iff ← mem_prod_same_iff
#align filter.mem_prod_same_iff Filter.mem_prod_same_iff

theorem prod_same_eq : f ×ᶠ f = f.lift' fun t : Set α => t ×ˢ t :=
  f.basis_sets.prod_self.eq_binfᵢ
#align filter.prod_same_eq Filter.prod_same_eq

theorem tendsto_prod_self_iff {f : α × α → β} {x : Filter α} {y : Filter β} :
    Filter.Tendsto f (x ×ᶠ x) y ↔ ∀ W ∈ y, ∃ U ∈ x, ∀ x x' : α, x ∈ U → x' ∈ U → f (x, x') ∈ W := by
  simp only [tendsto_def, mem_prod_same_iff, prod_sub_preimage_iff, exists_prop, iff_self_iff]
#align filter.tendsto_prod_self_iff Filter.tendsto_prod_self_iff

variable {α₁ : Type _} {α₂ : Type _} {β₁ : Type _} {β₂ : Type _}

theorem prod_lift_lift {f₁ : Filter α₁} {f₂ : Filter α₂} {g₁ : Set α₁ → Filter β₁}
    {g₂ : Set α₂ → Filter β₂} (hg₁ : Monotone g₁) (hg₂ : Monotone g₂) :
    f₁.lift g₁ ×ᶠ f₂.lift g₂ = f₁.lift fun s => f₂.lift fun t => g₁ s ×ᶠ g₂ t := by
  simp only [prod_def, lift_assoc hg₁]
  apply congr_arg; funext x
  rw [lift_comm]
  apply congr_arg; funext y
  apply lift'_lift_assoc hg₂
#align filter.prod_lift_lift Filter.prod_lift_lift

theorem prod_lift'_lift' {f₁ : Filter α₁} {f₂ : Filter α₂} {g₁ : Set α₁ → Set β₁}
    {g₂ : Set α₂ → Set β₂} (hg₁ : Monotone g₁) (hg₂ : Monotone g₂) :
    f₁.lift' g₁ ×ᶠ f₂.lift' g₂ = f₁.lift fun s => f₂.lift' fun t => g₁ s ×ˢ g₂ t :=
  calc
    f₁.lift' g₁ ×ᶠ f₂.lift' g₂ = f₁.lift fun s => f₂.lift fun t => 𝓟 (g₁ s) ×ᶠ 𝓟 (g₂ t) :=
      prod_lift_lift (monotone_principal.comp hg₁) (monotone_principal.comp hg₂)
    _ = f₁.lift fun s => f₂.lift fun t => 𝓟 (g₁ s ×ˢ g₂ t) := by
      { simp only [prod_principal_principal] }
#align filter.prod_lift'_lift' Filter.prod_lift'_lift'

end Prod

end Filter


/-
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 analysis.convex.basic
import analysis.specific_limits

/-!
# Tangent cone

In this file, we define two predicates `unique_diff_within_at 𝕜 s x` and `unique_diff_on 𝕜 s`
ensuring that, if a function has two derivatives, then they have to coincide. As a direct
definition of this fact (quantifying on all target types and all functions) would depend on
universes, we use a more intrinsic definition: if all the possible tangent directions to the set
`s` at the point `x` span a dense subset of the whole subset, it is easy to check that the
derivative has to be unique.

Therefore, we introduce the set of all tangent directions, named `tangent_cone_at`,
and express `unique_diff_within_at` and `unique_diff_on` in terms of it.
One should however think of this definition as an implementation detail: the only reason to
introduce the predicates `unique_diff_within_at` and `unique_diff_on` is to ensure the uniqueness
of the derivative. This is why their names reflect their uses, and not how they are defined.

## Implementation details

Note that this file is imported by `fderiv.lean`. Hence, derivatives are not defined yet. The
property of uniqueness of the derivative is therefore proved in `fderiv.lean`, but based on the
properties of the tangent cone we prove here.
-/

variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜]

open filter set
open_locale topological_space

section tangent_cone

variables {E : Type*} [add_comm_monoid E] [module 𝕜 E] [topological_space E]

/-- The set of all tangent directions to the set `s` at the point `x`. -/
def tangent_cone_at (s : set E) (x : E) : set E :=
{y : E | ∃(c : ℕ → 𝕜) (d : ℕ → E), (∀ᶠ n in at_top, x + d n ∈ s) ∧
  (tendsto (λn, ∥c n∥) at_top at_top) ∧ (tendsto (λn, c n • d n) at_top (𝓝 y))}

/-- A property ensuring that the tangent cone to `s` at `x` spans a dense subset of the whole space.
The main role of this property is to ensure that the differential within `s` at `x` is unique,
hence this name. The uniqueness it asserts is proved in `unique_diff_within_at.eq` in `fderiv.lean`.
To avoid pathologies in dimension 0, we also require that `x` belongs to the closure of `s` (which
is automatic when `E` is not `0`-dimensional).
 -/
@[mk_iff] structure unique_diff_within_at (s : set E) (x : E) : Prop :=
(dense_tangent_cone : dense ((submodule.span 𝕜 (tangent_cone_at 𝕜 s x)) : set E))
(mem_closure : x ∈ closure s)

/-- A property ensuring that the tangent cone to `s` at any of its points spans a dense subset of
the whole space.  The main role of this property is to ensure that the differential along `s` is
unique, hence this name. The uniqueness it asserts is proved in `unique_diff_on.eq` in
`fderiv.lean`. -/
def unique_diff_on (s : set E) : Prop :=
∀x ∈ s, unique_diff_within_at 𝕜 s x

end tangent_cone

variables {E : Type*} [normed_group E] [normed_space 𝕜 E]
variables {F : Type*} [normed_group F] [normed_space 𝕜 F]
variables {G : Type*} [normed_group G] [normed_space ℝ G]
variables {𝕜} {x y : E} {s t : set E}

section tangent_cone
/- This section is devoted to the properties of the tangent cone. -/

open normed_field

lemma tangent_cone_univ : tangent_cone_at 𝕜 univ x = univ :=
begin
  refine univ_subset_iff.1 (λy hy, _),
  rcases exists_one_lt_norm 𝕜 with ⟨w, hw⟩,
  refine ⟨λn, w^n, λn, (w^n)⁻¹ • y, univ_mem' (λn, mem_univ _),  _, _⟩,
  { simp only [norm_pow],
    exact tendsto_pow_at_top_at_top_of_one_lt hw },
  { convert tendsto_const_nhds,
    ext n,
    have : w ^ n * (w ^ n)⁻¹ = 1,
    { apply mul_inv_cancel,
      apply pow_ne_zero,
      simpa [norm_eq_zero] using (ne_of_lt (lt_trans zero_lt_one hw)).symm },
    rw [smul_smul, this, one_smul] }
end

lemma tangent_cone_mono (h : s ⊆ t) :
  tangent_cone_at 𝕜 s x ⊆ tangent_cone_at 𝕜 t x :=
begin
  rintros y ⟨c, d, ds, ctop, clim⟩,
  exact ⟨c, d, mem_of_superset ds (λn hn, h hn), ctop, clim⟩
end

/-- Auxiliary lemma ensuring that, under the assumptions defining the tangent cone,
the sequence `d` tends to 0 at infinity. -/
lemma tangent_cone_at.lim_zero {α : Type*} (l : filter α) {c : α → 𝕜} {d : α → E}
  (hc : tendsto (λn, ∥c n∥) l at_top) (hd : tendsto (λn, c n • d n) l (𝓝 y)) :
  tendsto d l (𝓝 0) :=
begin
  have A : tendsto (λn, ∥c n∥⁻¹) l (𝓝 0) := tendsto_inv_at_top_zero.comp hc,
  have B : tendsto (λn, ∥c n • d n∥) l (𝓝 ∥y∥) :=
    (continuous_norm.tendsto _).comp hd,
  have C : tendsto (λn, ∥c n∥⁻¹ * ∥c n • d n∥) l (𝓝 (0 * ∥y∥)) := A.mul B,
  rw zero_mul at C,
  have : ∀ᶠ n in l, ∥c n∥⁻¹ * ∥c n • d n∥ = ∥d n∥,
  { apply (eventually_ne_of_tendsto_norm_at_top hc 0).mono (λn hn, _),
    rw [norm_smul, ← mul_assoc, inv_mul_cancel, one_mul],
    rwa [ne.def, norm_eq_zero] },
  have D : tendsto (λ n, ∥d n∥) l (𝓝 0) :=
    tendsto.congr' this C,
  rw tendsto_zero_iff_norm_tendsto_zero,
  exact D
end

lemma tangent_cone_mono_nhds (h : 𝓝[s] x ≤ 𝓝[t] x) :
  tangent_cone_at 𝕜 s x ⊆ tangent_cone_at 𝕜 t x :=
begin
  rintros y ⟨c, d, ds, ctop, clim⟩,
  refine ⟨c, d, _, ctop, clim⟩,
  suffices : tendsto (λ n, x + d n) at_top (𝓝[t] x),
    from tendsto_principal.1 (tendsto_inf.1 this).2,
  refine (tendsto_inf.2 ⟨_, tendsto_principal.2 ds⟩).mono_right h,
  simpa only [add_zero] using tendsto_const_nhds.add (tangent_cone_at.lim_zero at_top ctop clim)
end

/-- Tangent cone of `s` at `x` depends only on `𝓝[s] x`. -/
lemma tangent_cone_congr (h : 𝓝[s] x = 𝓝[t] x) :
  tangent_cone_at 𝕜 s x = tangent_cone_at 𝕜 t x :=
subset.antisymm
  (tangent_cone_mono_nhds $ le_of_eq h)
  (tangent_cone_mono_nhds $ le_of_eq h.symm)

/-- Intersecting with a neighborhood of the point does not change the tangent cone. -/
lemma tangent_cone_inter_nhds (ht : t ∈ 𝓝 x) :
  tangent_cone_at 𝕜 (s ∩ t) x = tangent_cone_at 𝕜 s x :=
tangent_cone_congr (nhds_within_restrict' _ ht).symm

/-- The tangent cone of a product contains the tangent cone of its left factor. -/
lemma subset_tangent_cone_prod_left {t : set F} {y : F} (ht : y ∈ closure t) :
  linear_map.inl 𝕜 E F '' (tangent_cone_at 𝕜 s x) ⊆ tangent_cone_at 𝕜 (set.prod s t) (x, y) :=
begin
  rintros _ ⟨v, ⟨c, d, hd, hc, hy⟩, rfl⟩,
  have : ∀n, ∃d', y + d' ∈ t ∧ ∥c n • d'∥ < ((1:ℝ)/2)^n,
  { assume n,
    rcases mem_closure_iff_nhds.1 ht _ (eventually_nhds_norm_smul_sub_lt (c n) y
      (pow_pos one_half_pos n)) with ⟨z, hz, hzt⟩,
    exact ⟨z - y, by simpa using hzt, by simpa using hz⟩ },
  choose d' hd' using this,
  refine ⟨c, λn, (d n, d' n), _, hc, _⟩,
  show ∀ᶠ n in at_top, (x, y) + (d n, d' n) ∈ set.prod s t,
  { filter_upwards [hd],
    assume n hn,
    simp [hn, (hd' n).1] },
  { apply tendsto.prod_mk_nhds hy _,
    refine squeeze_zero_norm (λn, (hd' n).2.le) _,
    exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one }
end

/-- The tangent cone of a product contains the tangent cone of its right factor. -/
lemma subset_tangent_cone_prod_right {t : set F} {y : F}
  (hs : x ∈ closure s) :
  linear_map.inr 𝕜 E F '' (tangent_cone_at 𝕜 t y) ⊆ tangent_cone_at 𝕜 (set.prod s t) (x, y) :=
begin
  rintros _ ⟨w, ⟨c, d, hd, hc, hy⟩, rfl⟩,
  have : ∀n, ∃d', x + d' ∈ s ∧ ∥c n • d'∥ < ((1:ℝ)/2)^n,
  { assume n,
    rcases mem_closure_iff_nhds.1 hs _ (eventually_nhds_norm_smul_sub_lt (c n) x
      (pow_pos one_half_pos n)) with ⟨z, hz, hzs⟩,
    exact ⟨z - x, by simpa using hzs, by simpa using hz⟩ },
  choose d' hd' using this,
  refine ⟨c, λn, (d' n, d n), _, hc, _⟩,
  show ∀ᶠ n in at_top, (x, y) + (d' n, d n) ∈ set.prod s t,
  { filter_upwards [hd],
    assume n hn,
    simp [hn, (hd' n).1] },
  { apply tendsto.prod_mk_nhds _ hy,
    refine squeeze_zero_norm (λn, (hd' n).2.le) _,
    exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one }
end

/-- The tangent cone of a product contains the tangent cone of each factor. -/
lemma maps_to_tangent_cone_pi {ι : Type*} [decidable_eq ι] {E : ι → Type*}
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  {s : Π i, set (E i)} {x : Π i, E i} {i : ι} (hi : ∀ j ≠ i, x j ∈ closure (s j)) :
  maps_to (linear_map.single i : E i →ₗ[𝕜] Π j, E j) (tangent_cone_at 𝕜 (s i) (x i))
    (tangent_cone_at 𝕜 (set.pi univ s) x) :=
begin
  rintros w ⟨c, d, hd, hc, hy⟩,
  have : ∀ n (j ≠ i), ∃ d', x j + d' ∈ s j ∧ ∥c n • d'∥ < (1 / 2 : ℝ) ^ n,
  { assume n j hj,
    rcases mem_closure_iff_nhds.1 (hi j hj) _ (eventually_nhds_norm_smul_sub_lt (c n) (x j)
      (pow_pos one_half_pos n)) with ⟨z, hz, hzs⟩,
    exact ⟨z - x j, by simpa using hzs, by simpa using hz⟩ },
  choose! d' hd's hcd',
  refine ⟨c, λ n, function.update (d' n) i (d n), hd.mono (λ n hn j hj', _), hc,
    tendsto_pi_nhds.2 $ λ j, _⟩,
  { rcases em (j = i) with rfl|hj; simp * },
  { rcases em (j = i) with rfl|hj,
    { simp [hy] },
    { suffices : tendsto (λ n, c n • d' n j) at_top (𝓝 0), by simpa [hj],
      refine squeeze_zero_norm (λ n, (hcd' n j hj).le) _,
      exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one } }
end

/-- If a subset of a real vector space contains a segment, then the direction of this
segment belongs to the tangent cone at its endpoints. -/
lemma mem_tangent_cone_of_segment_subset {s : set G} {x y : G} (h : segment ℝ x y ⊆ s) :
  y - x ∈ tangent_cone_at ℝ s x :=
begin
  let c := λn:ℕ, (2:ℝ)^n,
  let d := λn:ℕ, (c n)⁻¹ • (y-x),
  refine ⟨c, d, filter.univ_mem' (λn, h _), _, _⟩,
  show x + d n ∈ segment ℝ x y,
  { rw segment_eq_image,
    refine ⟨(c n)⁻¹, ⟨_, _⟩, _⟩,
    { rw inv_nonneg, apply pow_nonneg, norm_num },
    { apply inv_le_one, apply one_le_pow_of_one_le, norm_num },
    { simp only [d, sub_smul, smul_sub, one_smul], abel } },
  show filter.tendsto (λ (n : ℕ), ∥c n∥) filter.at_top filter.at_top,
  { have : (λ (n : ℕ), ∥c n∥) = c,
      by { ext n, exact abs_of_nonneg (pow_nonneg (by norm_num) _) },
    rw this,
    exact tendsto_pow_at_top_at_top_of_one_lt (by norm_num) },
  show filter.tendsto (λ (n : ℕ), c n • d n) filter.at_top (𝓝 (y - x)),
  { have : (λ (n : ℕ), c n • d n) = (λn, y - x),
    { ext n,
      simp only [d, smul_smul],
      rw [mul_inv_cancel, one_smul],
      exact pow_ne_zero _ (by norm_num) },
    rw this,
    apply tendsto_const_nhds }
end

end tangent_cone

section unique_diff
/-!
### Properties of `unique_diff_within_at` and `unique_diff_on`

This section is devoted to properties of the predicates
`unique_diff_within_at` and `unique_diff_on`. -/

lemma unique_diff_on.unique_diff_within_at {s : set E} {x} (hs : unique_diff_on 𝕜 s) (h : x ∈ s) :
  unique_diff_within_at 𝕜 s x :=
hs x h

lemma unique_diff_within_at_univ : unique_diff_within_at 𝕜 univ x :=
by { rw [unique_diff_within_at_iff, tangent_cone_univ], simp }

lemma unique_diff_on_univ : unique_diff_on 𝕜 (univ : set E) :=
λx hx, unique_diff_within_at_univ

lemma unique_diff_on_empty : unique_diff_on 𝕜 (∅ : set E) :=
λ x hx, hx.elim

lemma unique_diff_within_at.mono_nhds (h : unique_diff_within_at 𝕜 s x)
  (st : 𝓝[s] x ≤ 𝓝[t] x) :
  unique_diff_within_at 𝕜 t x :=
begin
  simp only [unique_diff_within_at_iff] at *,
  rw [mem_closure_iff_nhds_within_ne_bot] at h ⊢,
  exact ⟨h.1.mono $ submodule.span_mono $ tangent_cone_mono_nhds st,
    h.2.mono st⟩
end

lemma unique_diff_within_at.mono (h : unique_diff_within_at 𝕜 s x) (st : s ⊆ t) :
  unique_diff_within_at 𝕜 t x :=
h.mono_nhds $ nhds_within_mono _ st

lemma unique_diff_within_at_congr (st : 𝓝[s] x = 𝓝[t] x) :
  unique_diff_within_at 𝕜 s x ↔ unique_diff_within_at 𝕜 t x :=
⟨λ h, h.mono_nhds $ le_of_eq st, λ h, h.mono_nhds $ le_of_eq st.symm⟩

lemma unique_diff_within_at_inter (ht : t ∈ 𝓝 x) :
  unique_diff_within_at 𝕜 (s ∩ t) x ↔ unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_congr $ (nhds_within_restrict' _ ht).symm

lemma unique_diff_within_at.inter (hs : unique_diff_within_at 𝕜 s x) (ht : t ∈ 𝓝 x) :
  unique_diff_within_at 𝕜 (s ∩ t) x :=
(unique_diff_within_at_inter ht).2 hs

lemma unique_diff_within_at_inter' (ht : t ∈ 𝓝[s] x) :
  unique_diff_within_at 𝕜 (s ∩ t) x ↔ unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_congr $ (nhds_within_restrict'' _ ht).symm

lemma unique_diff_within_at.inter' (hs : unique_diff_within_at 𝕜 s x) (ht : t ∈ 𝓝[s] x) :
  unique_diff_within_at 𝕜 (s ∩ t) x :=
(unique_diff_within_at_inter' ht).2 hs

lemma unique_diff_within_at_of_mem_nhds (h : s ∈ 𝓝 x) : unique_diff_within_at 𝕜 s x :=
by simpa only [univ_inter] using unique_diff_within_at_univ.inter h

lemma is_open.unique_diff_within_at (hs : is_open s) (xs : x ∈ s) : unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_of_mem_nhds (is_open.mem_nhds hs xs)

lemma unique_diff_on.inter (hs : unique_diff_on 𝕜 s) (ht : is_open t) : unique_diff_on 𝕜 (s ∩ t) :=
λx hx, (hs x hx.1).inter (is_open.mem_nhds ht hx.2)

lemma is_open.unique_diff_on (hs : is_open s) : unique_diff_on 𝕜 s :=
λx hx, is_open.unique_diff_within_at hs hx

/-- The product of two sets of unique differentiability at points `x` and `y` has unique
differentiability at `(x, y)`. -/
lemma unique_diff_within_at.prod {t : set F} {y : F}
  (hs : unique_diff_within_at 𝕜 s x) (ht : unique_diff_within_at 𝕜 t y) :
  unique_diff_within_at 𝕜 (set.prod s t) (x, y) :=
begin
  rw [unique_diff_within_at_iff] at ⊢ hs ht,
  rw [closure_prod_eq],
  refine ⟨_, hs.2, ht.2⟩,
  have : _ ≤ submodule.span 𝕜 (tangent_cone_at 𝕜 (s.prod t) (x, y)) :=
    submodule.span_mono (union_subset (subset_tangent_cone_prod_left ht.2)
      (subset_tangent_cone_prod_right hs.2)),
  rw [linear_map.span_inl_union_inr, set_like.le_def] at this,
  exact (hs.1.prod ht.1).mono this
end

lemma unique_diff_within_at.univ_pi (ι : Type*) [fintype ι] (E : ι → Type*)
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (x : Π i, E i) (h : ∀ i, unique_diff_within_at 𝕜 (s i) (x i)) :
  unique_diff_within_at 𝕜 (set.pi univ s) x :=
begin
  classical,
  simp only [unique_diff_within_at_iff, closure_pi_set] at h ⊢,
  refine ⟨(dense_pi univ (λ i _, (h i).1)).mono _, λ i _, (h i).2⟩,
  norm_cast,
  simp only [← submodule.supr_map_single, supr_le_iff, linear_map.map_span, submodule.span_le,
    ← maps_to'],
  exact λ i, (maps_to_tangent_cone_pi $ λ j hj, (h j).2).mono subset.rfl submodule.subset_span
end

lemma unique_diff_within_at.pi (ι : Type*) [fintype ι] (E : ι → Type*)
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (x : Π i, E i) (I : set ι)
  (h : ∀ i ∈ I, unique_diff_within_at 𝕜 (s i) (x i)) :
  unique_diff_within_at 𝕜 (set.pi I s) x :=
begin
  classical,
  rw [← set.univ_pi_piecewise],
  refine unique_diff_within_at.univ_pi _ _ _ _ (λ i, _),
  by_cases hi : i ∈ I; simp [*, unique_diff_within_at_univ],
end

/-- The product of two sets of unique differentiability is a set of unique differentiability. -/
lemma unique_diff_on.prod {t : set F} (hs : unique_diff_on 𝕜 s) (ht : unique_diff_on 𝕜 t) :
  unique_diff_on 𝕜 (set.prod s t) :=
λ ⟨x, y⟩ h, unique_diff_within_at.prod (hs x h.1) (ht y h.2)

/-- The finite product of a family of sets of unique differentiability is a set of unique
differentiability. -/
lemma unique_diff_on.pi (ι : Type*) [fintype ι] (E : ι → Type*)
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (I : set ι) (h : ∀ i ∈ I, unique_diff_on 𝕜 (s i)) :
  unique_diff_on 𝕜 (set.pi I s) :=
λ x hx, unique_diff_within_at.pi _ _ _ _ _ $ λ i hi, h i hi (x i) (hx i hi)

/-- The finite product of a family of sets of unique differentiability is a set of unique
differentiability. -/
lemma unique_diff_on.univ_pi (ι : Type*) [fintype ι] (E : ι → Type*)
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (h : ∀ i, unique_diff_on 𝕜 (s i)) :
  unique_diff_on 𝕜 (set.pi univ s) :=
unique_diff_on.pi _ _ _ _ $ λ i _, h i

/-- In a real vector space, a convex set with nonempty interior is a set of unique
differentiability. -/
theorem unique_diff_on_convex {s : set G} (conv : convex ℝ s) (hs : (interior s).nonempty) :
  unique_diff_on ℝ s :=
begin
  assume x xs,
  rcases hs with ⟨y, hy⟩,
  suffices : y - x ∈ interior (tangent_cone_at ℝ s x),
  { refine ⟨dense.of_closure _, subset_closure xs⟩,
    simp [(submodule.span ℝ (tangent_cone_at ℝ s x)).eq_top_of_nonempty_interior'
      ⟨y - x, interior_mono submodule.subset_span this⟩] },
  rw [mem_interior_iff_mem_nhds] at hy ⊢,
  apply mem_of_superset ((is_open_map_sub_right x).image_mem_nhds hy),
  rintros _ ⟨z, zs, rfl⟩,
  exact mem_tangent_cone_of_segment_subset (conv.segment_subset xs zs)
end

lemma unique_diff_on_Ici (a : ℝ) : unique_diff_on ℝ (Ici a) :=
unique_diff_on_convex (convex_Ici a) $ by simp only [interior_Ici, nonempty_Ioi]

lemma unique_diff_on_Iic (a : ℝ) : unique_diff_on ℝ (Iic a) :=
unique_diff_on_convex (convex_Iic a) $ by simp only [interior_Iic, nonempty_Iio]

lemma unique_diff_on_Ioi (a : ℝ) : unique_diff_on ℝ (Ioi a) :=
is_open_Ioi.unique_diff_on

lemma unique_diff_on_Iio (a : ℝ) : unique_diff_on ℝ (Iio a) :=
is_open_Iio.unique_diff_on

lemma unique_diff_on_Icc {a b : ℝ} (hab : a < b) : unique_diff_on ℝ (Icc a b) :=
unique_diff_on_convex (convex_Icc a b) $ by simp only [interior_Icc, nonempty_Ioo, hab]

lemma unique_diff_on_Ico (a b : ℝ) : unique_diff_on ℝ (Ico a b) :=
if hab : a < b
then unique_diff_on_convex (convex_Ico a b) $ by simp only [interior_Ico, nonempty_Ioo, hab]
else by simp only [Ico_eq_empty hab, unique_diff_on_empty]

lemma unique_diff_on_Ioc (a b : ℝ) : unique_diff_on ℝ (Ioc a b) :=
if hab : a < b
then unique_diff_on_convex (convex_Ioc a b) $ by simp only [interior_Ioc, nonempty_Ioo, hab]
else by simp only [Ioc_eq_empty hab, unique_diff_on_empty]

lemma unique_diff_on_Ioo (a b : ℝ) : unique_diff_on ℝ (Ioo a b) :=
is_open_Ioo.unique_diff_on

/-- The real interval `[0, 1]` is a set of unique differentiability. -/
lemma unique_diff_on_Icc_zero_one : unique_diff_on ℝ (Icc (0:ℝ) 1) :=
unique_diff_on_Icc zero_lt_one

end unique_diff


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

/-!
# Extra lemmas about `ulift` and `plift`

In this file we provide `subsingleton`, `unique`, `decidable_eq`, and `is_empty` instances for
`ulift α` and `plift α`. We also prove `ulift.forall`, `ulift.exists`, `plift.forall`, and
`plift.exists`.
-/

universes u v
open function

namespace plift

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

instance [subsingleton α] : subsingleton (plift α) := equiv.plift.subsingleton
instance [unique α] : unique (plift α) := equiv.plift.unique
instance [decidable_eq α] : decidable_eq (plift α) := equiv.plift.decidable_eq
instance [is_empty α] : is_empty (plift α) := equiv.plift.is_empty

lemma up_injective : injective (@up α) := equiv.plift.symm.injective
lemma up_surjective : surjective (@up α) := equiv.plift.symm.surjective
lemma up_bijective : bijective (@up α) := equiv.plift.symm.bijective

@[simp] lemma up_inj {x y : α} : up x = up y ↔ x = y := up_injective.eq_iff

lemma down_surjective : surjective (@down α) := equiv.plift.surjective
lemma down_bijective : bijective (@down α) := equiv.plift.bijective

@[simp] lemma «forall» {p : plift α → Prop} : (∀ x, p x) ↔ ∀ x : α, p (plift.up x) :=
up_surjective.forall

@[simp] lemma «exists» {p : plift α → Prop} : (∃ x, p x) ↔ ∃ x : α, p (plift.up x) :=
up_surjective.exists

end plift

namespace ulift

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

instance [subsingleton α] : subsingleton (ulift α) := equiv.ulift.subsingleton
instance [unique α] : unique (ulift α) := equiv.ulift.unique
instance [decidable_eq α] : decidable_eq (ulift α) := equiv.ulift.decidable_eq
instance [is_empty α] : is_empty (ulift α) := equiv.ulift.is_empty

lemma up_injective : injective (@up α) := equiv.ulift.symm.injective
lemma up_surjective : surjective (@up α) := equiv.ulift.symm.surjective
lemma up_bijective : bijective (@up α) := equiv.ulift.symm.bijective

@[simp] lemma up_inj {x y : α} : up x = up y ↔ x = y := up_injective.eq_iff

lemma down_surjective : surjective (@down α) := equiv.ulift.surjective
lemma down_bijective : bijective (@down α) := equiv.ulift.bijective

@[simp] lemma «forall» {p : ulift α → Prop} : (∀ x, p x) ↔ ∀ x : α, p (ulift.up x) :=
up_surjective.forall

@[simp] lemma «exists» {p : ulift α → Prop} : (∃ x, p x) ↔ ∃ x : α, p (ulift.up x) :=
up_surjective.exists

end ulift


import MLIR.Util.Arith
import Init.Data.List
import Std.Data.List.Basic
import Std.Data.List.Lemmas

namespace List

-- General theorems

theorem all_one {α} (P: α → Bool) a:
    all [a] P ↔ P a := by
  simp [all, foldr]

@[simp] -- repeat for @[simp]
theorem length_replicate_2 {α} (N: Nat) (a: α):
    length (List.replicate N a) = N :=
  length_replicate _ _

@[simp]
theorem ne_mem_cons {α} ⦃x a: α⦄ ⦃as: List α⦄:
    x ∉ a::as → x ≠ a ∧ x ∉ as := by
  intros Hne
  apply And.intro <;> intros _ <;> apply Hne
  . subst x; constructor
  . constructor; assumption

-- getF and reasoning on lists by extensionality

def getF {α} (l: List α) (n: Nat) (h: n < l.length): α :=
  match l, n, h with
  | a::as, 0, h => a
  | a::as, n+1, h => getF as n (Nat.lt_of_succ_lt_succ h)

def extF {α} (l₁ l₂: List α) (h_len: l₁.length = l₂.length):
    (∀ (n: Nat) (h: n < l₁.length),
      l₁.getF n h = l₂.getF n (by simp [←h_len, h])) →
    l₁ = l₂ := by
  revert l₂
  induction l₁ with
  | nil =>
      intros l₂ h_len; simp at h_len;
      cases l₂; simp; simp at h_len
  | cons x₁ t₁ ih =>
      intros l₂ h_len; simp at h_len
      cases l₂; simp at h_len
      case cons x₂ t₂ =>
        intros h_ext
        have h_x: x₁ = x₂ := by
          specialize (h_ext 0 (by simp));
          simp [getF] at h_ext; apply h_ext
        rw [h_x, ih t₂]
        . simp at h_len; apply h_len
        . intros n h; specialize (h_ext (n+1) (
            by simp; apply Nat.succ_lt_succ; apply h))
          simp [getF] at h_ext; apply h_ext

@[simp]
def getF_map {α β} (l: List α) (f: α → β) n h:
    getF (l.map f) n h = f (getF l n (by simp at h; apply h)) := by
  revert n
  induction l with
  | nil =>
      intros n h
      cases (Nat.not_lt_zero n h)
  | cons a as ih =>
      intros n h
      exact match n with
      | 0 => by simp [getF]
      | m+1 => by simp [getF, ih]

@[simp]
def getF_replicate {α} (a: α) (N: Nat) (h: n < N):
    getF (List.replicate N a) n (by simp [List.length_replicate, h]) = a := by
  revert n
  induction N with
  | zero => intros n h; cases h
  | succ m ih =>
      intros n h
      simp [replicate]
      cases n <;> simp [getF]
      rw [ih]
      apply Nat.lt_of_succ_lt_succ; assumption

@[simp]
def getF_take {α: Type} {l: List α} {N n: Nat} (h: n < length (take N l)):
    getF (List.take N l) n h = getF l n (by
      simp [length_take] at h
      exact (And.right h)) := by
  revert n l
  induction N with
  | zero => intros l n h; cases h
  | succ m ih =>
      intros l n h
      cases l with
      | nil => simp [take]
      | cons head tail =>
          simp [take]
          cases n <;> simp [getF, ih]

theorem List.getF_implies_mem: ∀ {α: Type} (xs: List α) (i: Nat) (INBOUND: i < xs.length),
 List.Mem (List.getF xs i INBOUND) xs := by {
  intros α xs;
  induction xs;
  case nil => {
    intros i INBOUND; simp at INBOUND;
  }
  case cons x' xs IH => {
    intros i INBOUND;
    cases i;
    case zero => {
       simp [List.getF];
       constructor;
    }
    case succ i' => {
     simp [List.getF];
     constructor;
     apply IH;
   }
  }
}

/- theorem getF_eq_get {α} (l: List α) n:
    get? l n.val = some (getF l n) := by -/

-- uniform

def uniform {α} (v: α): Nat → List α
  | 0 => []
  | n+1 => v :: uniform v n

theorem length_uniform {α} (v: α) n: (uniform v n).length = n := by
  induction n <;> simp [uniform]; assumption

-- rangeF

def rangeF (n: Nat): List (Fin n) :=
  match n with
  | 0 => []
  | n+1 => ⟨0,Nat.zero_lt_succ n⟩ ::
      (rangeF n).map (fun i => ⟨i.val+1, Nat.succ_lt_succ i.isLt⟩)

@[simp]
theorem length_rangeF (n: Nat):
    length (rangeF n) = n := by
  induction n with
  | zero => simp
  | succ m ih => simp [rangeF, ih]

@[simp]
theorem getF_rangeF (n: Nat): ∀ i h,
    getF (rangeF n) i h = ⟨i, by simp at h; apply h⟩ := by
  induction n with
  | zero =>
      intro i h;
      simp;
  | succ m ih =>
      intro i
      exact match i with
      | 0 => by simp [getF]
      | j+1 => by simp [rangeF, getF, ih]

--

def remap {α} (l: List α) (f: Nat→Nat) (h: ∀n, n < l.length → f n < l.length) :=
  (rangeF l.length).map (fun i => l.getF (f i.val) (h i.val i.isLt))

@[simp]
theorem length_remap {α} (l: List α) f h:
    (l.remap f h).length = l.length := by
  simp [remap]

@[simp]
theorem getF_remap {α} (l: List α) f h_f n h_n:
    getF (l.remap f h_f) n h_n
    = getF l (f n) (by apply h_f; simp at h_n; apply h_n) := by
  simp [remap]

theorem remap_remap {α} (l: List α) f h_f g h_g:
    remap (remap l f h_f) g h_g
    = remap l (f ∘ g) (fun n h =>
        by simp [Function.comp] at *; apply h_f; apply h_g; apply h) := by
  apply extF <;> simp

end List


/-
 Ejemplos de las diversas tácticas usadas en el desarrollo del TFM.
 -/

 /-
 TÁCTICA SORRY
 -/
import data.real.basic
import data.int.parity
import algebra.group.pi
import data.nat.prime
variables (a b c : ℤ)

example (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c :=
begin
  sorry,
end

/-
TÁCTICA SORRY Y HAVE
-/

example (a b : ℝ) : a = a*b → a = 0 ∨ b = 1 :=
begin
  have H : a*(1 - b) = 0, by sorry,
  sorry,
end

/-
TÁCTICA REWRITE
-/

example (a b : ℝ) : (a + b)*(a - b) = a^2 - b^2 :=
begin
  rw mul_sub (a+b) a b,
  rw add_mul a b b,
  rw pow_two a,
  rw pow_two b,
  rw mul_comm a b,
  rw ← sub_sub ((a+b)*a) (b*a) (b*b),
  rw add_mul a b a,
  rw ← add_sub,
  rw sub_self,
  rw add_zero (a*a),
end

/-
TÁCTICAS REWRITE Y EXACT
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  rw hyp' at hyp,
  rw mul_comm d a at hyp,
  rw ← two_mul (a*d) at hyp,
  rw ← mul_assoc 2 a d at hyp,
  exact hyp,
end

/-
TÁCTICAS INTRO e INTROS
-/
example (a b : ℝ): 0 ≤ b → a ≤ a + b :=
begin
  intro hb,
  exact le_add_of_nonneg_right hb,
end

example (P Q : Prop) (h₁ : P ∨ Q) (h₂ : ¬ (P ∧ Q)) : Q → ¬P :=
begin
  intros q p,
  exact h₂ ⟨ p,q⟩ ,
end

/-
TÁCTICA APPLY
-/
def non_decreasing (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≤ f x₂
def non_increasing (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≥ f x₂

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_increasing g) :
non_increasing (g ∘ f) :=
begin
  intros x1 x2 h,
  apply hg,
  apply hf,
  exact h,
end

/-
TÁCTICA LINARITH
-/
example (a b : ℝ) (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b :=
begin
  linarith,
end

/-
TÁCTICA NLINARITH
-/
example (a b c d : ℤ)
  (hba : b < a)
  (hcb : c < b)
  (hdc : d < c)
  (h : a*c + b*d = (a + b - c + d) * (-a + b + c + d))
  : a*c + b*d < a*b + c*d:=
begin
  nlinarith,
end

/-
TÁCTICA ASSUME
-/
variables{n : ℕ}
example : ∀ n, 3*n=n*3 :=
begin
  assume n,
  sorry,
end

/-
TÁCTICA BY_CONTRADICTION
-/

example (P Q : Prop) (h : ¬ Q → ¬ P) : P → Q :=
begin
  intro hP,
  by_contradiction hnQ,
  exact h hnQ hP,
end

/-
TÁCTICA LET
-/
variables (u v w : ℕ → ℝ) (l l' : ℝ)
notation `|`x`|` := abs x
def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

example {u : ℕ → ℝ} : tendsto_infinity u → ∀ l, ¬ seq_limit u l :=
begin
  intro h,
  intro l,
  intro lim,
  cases lim 1 (by linarith) with N1 hN1,
  cases h (l+2) with N2 hN2,
  let N3:= max N1 N2,
  sorry,
end

/-
TÁCTICA USE
-/

example : ∃ n : ℕ, 8 = 2*n :=
begin
  use 4,
  refl,
end

/-
TÁCTICA INDUCTION
-/

example (t a b : ℕ) : t * (a + b) = t * a + t * b :=
begin
induction b with k h,
{sorry,},

{sorry,},
end

/-
TÁCTICA CASES
-/
example {a b : ℝ} : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
begin
  intros hyp,
  cases hyp with ha hb,
  exact add_nonneg ha hb,
end

example (a b : ℝ) : a = a*b → a = 0 ∨ b = 1 :=
begin
  intro hyp,
  have H : a*(1 - b) = 0,
  { calc a*(1 - b) = a - a*b : by ring
               ... = 0       : by linarith, },
  rw mul_eq_zero at H,
  cases H with Ha Hb,
  { sorry, },
  { sorry, },
end

/-
TÁCTICA SPLIT
-/
example (P Q R : Prop) : (P ∧ Q → R) ↔ (P → (Q → R)) :=
begin
  split,
  {intros h1 h2 h3,
  exact h1 ⟨ h2,h3⟩ },
  {intros h1 h2,
  cases h2 with p q,
  exact h1 p q}
end

example (P Q : Prop) (hp: P) (hq : Q) : P ∧ Q :=
begin
  split,
  {exact hp,},
  {exact hq,},
end

/-
TÁCTICA FROM
-/

def up_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, a ≤ x}
def is_max (a : ℝ) (A : set ℝ) := a ∈ A ∧ a ∈ up_bounds A
infix ` is_a_max_of `:55 := is_max

example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) :
x = y :=
begin
  have : x ≤ y, from hy.2 x hx.1,
  have : y ≤ x, from hx.2 y hy.1,
  linarith,
end

/-
TÁCTICA LEFT RIGHT
-/
example (a b : ℝ) : a = a*b → a = 0 ∨ b = 1 :=
begin
  intro hyp,
  have H : a*(1 - b) = 0,
  { calc a*(1 - b) = a - a*b : by ring
               ... = 0       : by linarith, },
  rw mul_eq_zero at H,
  cases H with Ha Hb,
  { left,
    exact Ha, },
  { right,
    linarith, },
end

/-
TÁCTICA LIBRARY SEARCH
-/
example (a b : ℝ): 0 ≤ a → b ≤ a + b :=
begin
  library_search,
end

example (a b : ℝ): 0 ≤ a → b ≤ a + b :=
begin
  exact le_add_of_nonneg_left,
end

/-
TÁCTICA NORM NUM
-/

example : (2 : ℝ) + 2 = 4 :=
begin
  norm_num,
end

example : (73 : ℝ) < 789/2 :=
begin
  norm_num,
end

/-
TÁCTICA REFINE
-/
example (p : ℕ) (h: p.prime) : 1 ∣ p :=
begin
  refine is_unit.dvd _,
  exact is_unit_one,
end

/-
TÁCTICA RING
-/

example (a b : ℝ) : (a + b) + a = 2*a + b :=
begin
  by ring,
end

/-
TÁCTICA SIMP
-/
example (a b : ℝ) (h : b=0): a + b = a :=
begin
  simp,
  exact h,
end

/-
TÁCTICA SIMPA
-/
example (a b : ℝ) (h : b=0): a + b = a :=
begin
  simpa,
end

/-
TÁCTICA SUGGEST
-/

example (a b : ℕ) : a + b ≤ a + b +1 :=
begin
  suggest,
  sorry,
end

example (a b : ℕ) : a + b ≤ a + b +1 :=
begin
  exact (a + b).le_succ,
end

example (a b : ℕ) : a + b ≤ a + b +1 :=
begin
  exact nat.le.intro rfl,
end


import game.sup_inf.level01
import game.sup_inf.level02
import data.real.basic
import game.limits.Blockus_Time
import game.Completeness.Bruh2
import tactic

namespace xena -- hide
/-
# Chapter 7 : Limits

## Level 14

Prove that for a non-empty set S that is bounded above with a supremum (x)
and for a positive real number epsilon,
if epsilon is positive, then (x - ε) is not an upperbound of S.
-/

lemma generate_element {x : ℝ}{S : set ℝ} {h1 : S ≠ ∅} (h2 : is_lub S x) (ε : ℝ) : (0 < ε)→ ¬ (is_upper_bound S (x-ε)) :=
begin
intro h,
unfold is_lub at h2,
cases h2 with h2l h2r,
have Q := h2r(x-ε),
by_contradiction,
have R := Q(h),
linarith,
end

end xena


/-
Copyright (c) 2021 Jordan Brown, Thomas Browning and Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jordan Brown, Thomas Browning and Patrick Lutz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.abelianization
import Mathlib.data.bracket
import Mathlib.PostPort

universes u_1 u_2 l

namespace Mathlib

/-!
# Solvable Groups

In this file we introduce the notion of a solvable group. We define a solvable group as one whose
derived series is eventually trivial. This requires defining the commutator of two subgroups and
the derived series of a group.

## Main definitions

* `general_commutator H₁ H₂` : the commutator of the subgroups `H₁` and `H₂`
* `derived_series G n` : the `n`th term in the derived series of `G`, defined by iterating
  `general_commutator` starting with the top subgroup
* `is_solvable G` : the group `G` is solvable
-/

/-- The commutator of two subgroups `H₁` and `H₂`. -/
protected instance general_commutator {G : Type u_1} [group G] :
    has_bracket (subgroup G) (subgroup G) :=
  has_bracket.mk
    fun (H₁ H₂ : subgroup G) =>
      subgroup.closure
        (set_of
          fun (x : G) =>
            ∃ (p : G), ∃ (H : p ∈ H₁), ∃ (q : G), ∃ (H : q ∈ H₂), p * q * (p⁻¹) * (q⁻¹) = x)

theorem general_commutator_def {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) :
    has_bracket.bracket H₁ H₂ =
        subgroup.closure
          (set_of
            fun (x : G) =>
              ∃ (p : G), ∃ (H : p ∈ H₁), ∃ (q : G), ∃ (H : q ∈ H₂), p * q * (p⁻¹) * (q⁻¹) = x) :=
  rfl

protected instance general_commutator_normal {G : Type u_1} [group G] (H₁ : subgroup G)
    (H₂ : subgroup G) [h₁ : subgroup.normal H₁] [h₂ : subgroup.normal H₂] :
    subgroup.normal (has_bracket.bracket H₁ H₂) :=
  sorry

theorem general_commutator_mono {G : Type u_1} [group G] {H₁ : subgroup G} {H₂ : subgroup G}
    {K₁ : subgroup G} {K₂ : subgroup G} (h₁ : H₁ ≤ K₁) (h₂ : H₂ ≤ K₂) :
    has_bracket.bracket H₁ H₂ ≤ has_bracket.bracket K₁ K₂ :=
  sorry

theorem general_commutator_def' {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G)
    [subgroup.normal H₁] [subgroup.normal H₂] :
    has_bracket.bracket H₁ H₂ =
        subgroup.normal_closure
          (set_of
            fun (x : G) =>
              ∃ (p : G), ∃ (H : p ∈ H₁), ∃ (q : G), ∃ (H : q ∈ H₂), p * q * (p⁻¹) * (q⁻¹) = x) :=
  sorry

theorem general_commutator_le {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G)
    (K : subgroup G) :
    has_bracket.bracket H₁ H₂ ≤ K ↔
        ∀ (p : G), p ∈ H₁ → ∀ (q : G), q ∈ H₂ → p * q * (p⁻¹) * (q⁻¹) ∈ K :=
  sorry

theorem general_commutator_comm {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) :
    has_bracket.bracket H₁ H₂ = has_bracket.bracket H₂ H₁ :=
  sorry

theorem general_commutator_le_right {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G)
    [h : subgroup.normal H₂] : has_bracket.bracket H₁ H₂ ≤ H₂ :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (has_bracket.bracket H₁ H₂ ≤ H₂))
        (propext (general_commutator_le H₁ H₂ H₂))))
    fun (p : G) (hp : p ∈ H₁) (q : G) (hq : q ∈ H₂) =>
      subgroup.mul_mem H₂ (subgroup.normal.conj_mem h q hq p) (subgroup.inv_mem H₂ hq)

theorem general_commutator_le_left {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G)
    [h : subgroup.normal H₁] : has_bracket.bracket H₁ H₂ ≤ H₁ :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (has_bracket.bracket H₁ H₂ ≤ H₁)) (general_commutator_comm H₁ H₂)))
    (general_commutator_le_right H₂ H₁)

@[simp] theorem general_commutator_bot {G : Type u_1} [group G] (H : subgroup G) :
    has_bracket.bracket H ⊥ = ⊥ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (has_bracket.bracket H ⊥ = ⊥)) (propext eq_bot_iff)))
    (general_commutator_le_right H ⊥)

@[simp] theorem bot_general_commutator {G : Type u_1} [group G] (H : subgroup G) :
    has_bracket.bracket ⊥ H = ⊥ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (has_bracket.bracket ⊥ H = ⊥)) (propext eq_bot_iff)))
    (general_commutator_le_left ⊥ H)

theorem general_commutator_le_inf {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G)
    [subgroup.normal H₁] [subgroup.normal H₂] : has_bracket.bracket H₁ H₂ ≤ H₁ ⊓ H₂ :=
  sorry

/-- The derived series of the group `G`, obtained by starting from the subgroup `⊤` and repeatedly
  taking the commutator of the previous subgroup with itself for `n` times. -/
def derived_series (G : Type u_1) [group G] : ℕ → subgroup G := sorry

@[simp] theorem derived_series_zero (G : Type u_1) [group G] : derived_series G 0 = ⊤ := rfl

@[simp] theorem derived_series_succ (G : Type u_1) [group G] (n : ℕ) :
    derived_series G (n + 1) = has_bracket.bracket (derived_series G n) (derived_series G n) :=
  rfl

theorem derived_series_normal (G : Type u_1) [group G] (n : ℕ) :
    subgroup.normal (derived_series G n) :=
  sorry

@[simp] theorem general_commutator_eq_commutator (G : Type u_1) [group G] :
    has_bracket.bracket ⊤ ⊤ = commutator G :=
  sorry

theorem commutator_def' (G : Type u_1) [group G] :
    commutator G =
        subgroup.closure (set_of fun (x : G) => ∃ (p : G), ∃ (q : G), p * q * (p⁻¹) * (q⁻¹) = x) :=
  sorry

@[simp] theorem derived_series_one (G : Type u_1) [group G] : derived_series G 1 = commutator G :=
  general_commutator_eq_commutator G

theorem map_commutator_eq_commutator_map {G : Type u_1} [group G] {G' : Type u_2} [group G']
    {f : G →* G'} (H₁ : subgroup G) (H₂ : subgroup G) :
    subgroup.map f (has_bracket.bracket H₁ H₂) =
        has_bracket.bracket (subgroup.map f H₁) (subgroup.map f H₂) :=
  sorry

theorem commutator_le_map_commutator {G : Type u_1} [group G] {G' : Type u_2} [group G']
    {f : G →* G'} {H₁ : subgroup G} {H₂ : subgroup G} {K₁ : subgroup G'} {K₂ : subgroup G'}
    (h₁ : K₁ ≤ subgroup.map f H₁) (h₂ : K₂ ≤ subgroup.map f H₂) :
    has_bracket.bracket K₁ K₂ ≤ subgroup.map f (has_bracket.bracket H₁ H₂) :=
  sorry

theorem map_derived_series_le_derived_series {G : Type u_1} [group G] {G' : Type u_2} [group G']
    (f : G →* G') (n : ℕ) : subgroup.map f (derived_series G n) ≤ derived_series G' n :=
  sorry

theorem derived_series_le_map_derived_series {G : Type u_1} [group G] {G' : Type u_2} [group G']
    {f : G →* G'} (hf : function.surjective ⇑f) (n : ℕ) :
    derived_series G' n ≤ subgroup.map f (derived_series G n) :=
  sorry

theorem map_derived_series_eq {G : Type u_1} [group G] {G' : Type u_2} [group G'] {f : G →* G'}
    (hf : function.surjective ⇑f) (n : ℕ) :
    subgroup.map f (derived_series G n) = derived_series G' n :=
  le_antisymm (map_derived_series_le_derived_series f n) (derived_series_le_map_derived_series hf n)

/-- A group `G` is solvable if its derived series is eventually trivial. We use this definition
  because it's the most convenient one to work with. -/
class is_solvable (G : Type u_1) [group G] where
  solvable : ∃ (n : ℕ), derived_series G n = ⊥

theorem is_solvable_def (G : Type u_1) [group G] :
    is_solvable G ↔ ∃ (n : ℕ), derived_series G n = ⊥ :=
  { mp := fun (h : is_solvable G) => is_solvable.solvable,
    mpr := fun (h : ∃ (n : ℕ), derived_series G n = ⊥) => is_solvable.mk h }

protected instance is_solvable_of_comm {G : Type u_1} [comm_group G] : is_solvable G :=
  is_solvable.mk
    (Exists.intro 1
      (id
        (eq.mpr (id (Eq._oldrec (Eq.refl (derived_series G 1 = ⊥)) (propext eq_bot_iff)))
          (eq.mpr (id (Eq._oldrec (Eq.refl (derived_series G 1 ≤ ⊥)) (derived_series_one G)))
            (trans_rel_left LessEq (abelianization.commutator_subset_ker (monoid_hom.id G)) rfl)))))

theorem is_solvable_of_top_eq_bot (G : Type u_1) [group G] (h : ⊤ = ⊥) : is_solvable G := sorry

protected instance is_solvable_of_subsingleton (G : Type u_1) [group G] [subsingleton G] :
    is_solvable G :=
  is_solvable_of_top_eq_bot G
    (subgroup.ext
      fun (x : G) =>
        eq.mpr
          (id
            (Eq.trans
              ((fun (a a_1 : Prop) (e_1 : a = a_1) (b b_1 : Prop) (e_2 : b = b_1) =>
                  congr (congr_arg Iff e_1) e_2)
                (x ∈ ⊤) True
                (propext ((fun {G : Type u_1} (x : G) => iff_true_intro (subgroup.mem_top x)) x))
                (x ∈ ⊥) True
                (Eq.trans (propext subgroup.mem_bot) (propext (eq_iff_true_of_subsingleton x 1))))
              (propext (iff_self True))))
          trivial)

theorem solvable_of_solvable_injective {G : Type u_1} [group G] {G' : Type u_2} [group G']
    {f : G →* G'} (hf : function.injective ⇑f) [h : is_solvable G'] : is_solvable G :=
  sorry

protected instance subgroup_solvable_of_solvable {G : Type u_1} [group G] (H : subgroup G)
    [h : is_solvable G] : is_solvable ↥H :=
  solvable_of_solvable_injective
    ((fun (this : function.injective ⇑(subgroup.subtype H)) => this) subtype.val_injective)

theorem solvable_of_surjective {G : Type u_1} [group G] {G' : Type u_2} [group G'] {f : G →* G'}
    (hf : function.surjective ⇑f) [h : is_solvable G] : is_solvable G' :=
  sorry

protected instance solvable_quotient_of_solvable {G : Type u_1} [group G] (H : subgroup G)
    [subgroup.normal H] [h : is_solvable G] : is_solvable (quotient_group.quotient H) :=
  solvable_of_surjective
    ((fun (this : function.surjective ⇑(quotient_group.mk' H)) => this)
      (id
        fun (b : quotient_group.quotient H) =>
          quot.rec (fun (b : G) => Exists.intro b (Eq.refl (coe_fn (quotient_group.mk' H) b)))
            (fun (b_a b_b : G) (b_p : setoid.r b_a b_b) =>
              Eq.refl
                (Eq._oldrec (Exists.intro b_a (Eq.refl (coe_fn (quotient_group.mk' H) b_a)))
                  (quot.sound b_p)))
            b))

end Mathlib


notation "#(" a ")" => ⟨a, by decreasing_tactic⟩

def List.unfoldr {α β : Type u} [sz : SizeOf β] (f : (b : β) → Option (α × { b' : β // sizeOf b' < sizeOf b})) (b : β) : List α :=
  match f b with
  | none => []
  | some (a, ⟨b', h⟩) => a :: unfoldr f b'

def tst1 (n : Nat) : List Nat :=
  List.unfoldr (b := n) fun
    | 0 => none
    | b+1 => some (3*n - b*2, #(b))

#eval tst1 10

def tst2 (n : Nat) : List Nat :=
  -- Similar example where we provide our custom `SizeOf` instance
  List.unfoldr (sz := ⟨fun b => n - b⟩) (b := 0) fun b =>
    if h : b < n then
      some (b*2, #(b+1))
    else
      none

#eval tst2 10

-- More general (and less convenient to use) version that can take an arbitrary well-founded relation.
def List.unfoldr' {α β : Type u} [w : WellFoundedRelation β] (f : (b : β) → Option (α × { b' : β // w.rel b' b})) (b : β) : List α :=
  match f b with
  | none => []
  | some (a, ⟨b', h⟩) => a :: unfoldr' f b'
termination_by unfoldr' b => b

-- We need the `master` branch to test the following example

def tst3 (n : Nat) : List Nat :=
  List.unfoldr' (b := n) fun
    | 0 => none
    | b+1 => some (3*n - b*2, #(b))

#eval tst3 10

def tst4 (n : Nat) : List Nat :=
  List.unfoldr' (w := invImage (fun b => n - b) inferInstance) (b := 0) fun b =>
    if h : b < n then
      some (2*b, #(b+1))
    else
      none

#eval tst4 10


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import algebra.order.field
import data.rat.defs

/-!
# Order for Rational Numbers

## Summary

We define the order on `ℚ`, prove that `ℚ` is a discrete, linearly ordered field, and define
functions such as `abs` and `sqrt` that depend on this order.

## Notations

- `/.` is infix notation for `rat.mk`.

## Tags

rat, rationals, field, ℚ, numerator, denominator, num, denom, order, ordering, sqrt, abs
-/

namespace rat
variables (a b c : ℚ)
open_locale rat

/-- A rational number is called nonnegative if its numerator is nonnegative. -/
protected def nonneg (r : ℚ) : Prop := 0 ≤ r.num

@[simp]

protected lemma nonneg_add {a b} : rat.nonneg a → rat.nonneg b → rat.nonneg (a + b) :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
begin
  have d₁0 : 0 < (d₁:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h₁),
  have d₂0 : 0 < (d₂:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h₂),
  simp [d₁0, d₂0, h₁, h₂, mul_pos d₁0 d₂0],
  intros n₁0 n₂0,
  apply add_nonneg; apply mul_nonneg; {assumption <|> apply int.coe_zero_le},
end

protected lemma nonneg_mul {a b} : rat.nonneg a → rat.nonneg b → rat.nonneg (a * b) :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
begin
  have d₁0 : 0 < (d₁:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h₁),
  have d₂0 : 0 < (d₂:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h₂),
  simp [d₁0, d₂0, h₁, h₂, mul_pos d₁0 d₂0, mul_nonneg] { contextual := tt }
end

protected lemma nonneg_antisymm {a} : rat.nonneg a → rat.nonneg (-a) → a = 0 :=
num_denom_cases_on' a $ λ n d h,
begin
  have d0 : 0 < (d:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h),
  simp [d0, h],
  exact λ h₁ h₂, le_antisymm h₂ h₁
end

protected lemma nonneg_total : rat.nonneg a ∨ rat.nonneg (-a) :=
by cases a with n; exact
or.imp_right neg_nonneg_of_nonpos (le_total 0 n)

instance decidable_nonneg : decidable (rat.nonneg a) :=
by cases a; unfold rat.nonneg; apply_instance

/-- Relation `a ≤ b` on `ℚ` defined as `a ≤ b ↔ rat.nonneg (b - a)`. Use `a ≤ b` instead of
`rat.le a b`. -/
protected def le (a b : ℚ) := rat.nonneg (b - a)

instance : has_le ℚ := ⟨rat.le⟩

instance decidable_le : decidable_rel ((≤) : ℚ → ℚ → Prop)
| a b := show decidable (rat.nonneg (b - a)), by apply_instance

protected theorem le_def {a b c d : ℤ} (b0 : 0 < b) (d0 : 0 < d) :
  a /. b ≤ c /. d ↔ a * d ≤ c * b :=
begin
  show rat.nonneg _ ↔ _,
  rw ← sub_nonneg,
  simp [sub_eq_add_neg, ne_of_gt b0, ne_of_gt d0, mul_pos d0 b0]
end

protected theorem le_refl : a ≤ a :=
show rat.nonneg (a - a), by rw sub_self; exact le_refl (0 : ℤ)

protected theorem le_total : a ≤ b ∨ b ≤ a :=
by have := rat.nonneg_total (b - a); rwa neg_sub at this

protected theorem le_antisymm {a b : ℚ} (hab : a ≤ b) (hba : b ≤ a) : a = b :=
by { have := eq_neg_of_add_eq_zero_left (rat.nonneg_antisymm hba $
 by rwa [← sub_eq_add_neg, neg_sub]), rwa neg_neg at this }

protected theorem le_trans {a b c : ℚ} (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
have rat.nonneg (b - a + (c - b)), from rat.nonneg_add hab hbc,
by simpa [sub_eq_add_neg, add_comm, add_left_comm]

instance : linear_order ℚ :=
{ le              := rat.le,
  le_refl         := rat.le_refl,
  le_trans        := @rat.le_trans,
  le_antisymm     := @rat.le_antisymm,
  le_total        := rat.le_total,
  decidable_eq    := by apply_instance,
  decidable_le    := assume a b, rat.decidable_nonneg (b - a) }

/- Extra instances to short-circuit type class resolution -/
instance : has_lt ℚ          := by apply_instance
instance : distrib_lattice ℚ := by apply_instance
instance : lattice ℚ         := by apply_instance
instance : semilattice_inf ℚ := by apply_instance
instance : semilattice_sup ℚ := by apply_instance
instance : has_inf ℚ         := by apply_instance
instance : has_sup ℚ         := by apply_instance
instance : partial_order ℚ   := by apply_instance
instance : preorder ℚ        := by apply_instance

protected lemma le_def' {p q : ℚ} : p ≤ q ↔ p.num * q.denom ≤ q.num * p.denom :=
begin
  rw [←(@num_denom q), ←(@num_denom p)],
  conv_rhs { simp only [num_denom] },
  exact rat.le_def (by exact_mod_cast p.pos) (by exact_mod_cast q.pos)
end

protected lemma lt_def {p q : ℚ} : p < q ↔ p.num * q.denom < q.num * p.denom :=
begin
  rw [lt_iff_le_and_ne, rat.le_def'],
  suffices : p ≠ q ↔ p.num * q.denom ≠ q.num * p.denom, by
  { split; intro h,
    { exact lt_iff_le_and_ne.elim_right ⟨h.left, (this.elim_left h.right)⟩ },
    { have tmp := lt_iff_le_and_ne.elim_left h, exact ⟨tmp.left, this.elim_right tmp.right⟩ }},
  exact (not_iff_not.elim_right eq_iff_mul_eq_mul)
end

theorem nonneg_iff_zero_le {a} : rat.nonneg a ↔ 0 ≤ a :=
show rat.nonneg a ↔ rat.nonneg (a - 0), by simp

theorem num_nonneg_iff_zero_le : ∀ {a : ℚ}, 0 ≤ a.num ↔ 0 ≤ a
| ⟨n, d, h, c⟩ := @nonneg_iff_zero_le ⟨n, d, h, c⟩

protected theorem add_le_add_left {a b c : ℚ} : c + a ≤ c + b ↔ a ≤ b :=
by unfold has_le.le rat.le; rw add_sub_add_left_eq_sub

protected theorem mul_nonneg {a b : ℚ} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b :=
by rw ← nonneg_iff_zero_le at ha hb ⊢; exact rat.nonneg_mul ha hb

instance : linear_ordered_field ℚ :=
{ zero_le_one     := dec_trivial,
  add_le_add_left := assume a b ab c, rat.add_le_add_left.2 ab,
  mul_pos         := assume a b ha hb, lt_of_le_of_ne
    (rat.mul_nonneg (le_of_lt ha) (le_of_lt hb))
    (mul_ne_zero (ne_of_lt ha).symm (ne_of_lt hb).symm).symm,
  ..rat.field,
  ..rat.linear_order,
  ..rat.semiring }

/- Extra instances to short-circuit type class resolution -/
instance : linear_ordered_comm_ring ℚ       := by apply_instance
instance : linear_ordered_ring ℚ            := by apply_instance
instance : ordered_ring ℚ                   := by apply_instance
instance : linear_ordered_semiring ℚ        := by apply_instance
instance : ordered_semiring ℚ               := by apply_instance
instance : linear_ordered_add_comm_group ℚ  := by apply_instance
instance : ordered_add_comm_group ℚ         := by apply_instance
instance : ordered_cancel_add_comm_monoid ℚ := by apply_instance
instance : ordered_add_comm_monoid ℚ        := by apply_instance

attribute [irreducible] rat.le

theorem num_pos_iff_pos {a : ℚ} : 0 < a.num ↔ 0 < a :=
lt_iff_lt_of_le_iff_le $
by simpa [(by cases a; refl : (-a).num = -a.num)]
   using @num_nonneg_iff_zero_le (-a)

lemma div_lt_div_iff_mul_lt_mul {a b c d : ℤ} (b_pos : 0 < b) (d_pos : 0 < d) :
  (a : ℚ) / b < c / d ↔ a * d < c * b :=
begin
  simp only [lt_iff_le_not_le],
  apply and_congr,
  { simp [div_num_denom, (rat.le_def b_pos d_pos)] },
  { apply not_iff_not_of_iff, simp [div_num_denom, (rat.le_def d_pos b_pos)] }
end

lemma lt_one_iff_num_lt_denom {q : ℚ} : q < 1 ↔ q.num < q.denom :=
by simp [rat.lt_def]

theorem abs_def (q : ℚ) : |q| = q.num.nat_abs /. q.denom :=
begin
  cases le_total q 0 with hq hq,
  { rw [abs_of_nonpos hq],
    rw [←(@num_denom q), ← mk_zero_one, rat.le_def (int.coe_nat_pos.2 q.pos) zero_lt_one,
        mul_one, zero_mul] at hq,
    rw [int.of_nat_nat_abs_of_nonpos hq, ← neg_def, num_denom] },
  { rw [abs_of_nonneg hq],
    rw [←(@num_denom q), ← mk_zero_one, rat.le_def zero_lt_one (int.coe_nat_pos.2 q.pos),
        mul_one, zero_mul] at hq,
    rw [int.nat_abs_of_nonneg hq, num_denom] }
end

end rat


import .love01_definitions_and_statements_demo

/- # LoVe Demo 2: Backward Proofs

A __tactic__ operates on a proof goal and either proves it or creates new
subgoals. Tactics are a __backward__ proof mechanism: They start from the goal
and work towards the available hypotheses and lemmas. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/- ## Tactic Mode

Syntax of tactical proofs:

    begin
      _tactic₁_,
      …,
      _tacticN_
    end -/

lemma fst_of_two_props :
  ∀a b : Prop, a → b → a :=
begin
  intros a b,
  intros ha hb,
  apply ha
end

/- ## Basic Tactics

`intro`(`s`) moves `∀`-quantified variables, or the assumptions of
implications `→`, from the goal's conclusion (after `⊢`) into the goal's
hypotheses (before `⊢`).

`apply` matches the goal's conclusion with the conclusion of the specified lemma
and adds the lemma's hypotheses as new goals. -/

lemma fst_of_two_props₂ (a b : Prop) (ha : a) (hb : b) :
  a :=
begin
  apply ha
end

/- Terminal tactic syntax:

    by _tactic_

abbreviates

    begin
      _tactic_
    end -/

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

lemma prop_comp (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
begin
  intro ha,
  apply hbc,
  apply hab,
  apply ha
end

/- `exact` matches the goal's conclusion with the specified lemma, closing the
goal. We can often use `apply` in such situations, but `exact` communicates our
intentions better. -/

lemma fst_of_two_props₄ (a b : Prop) (ha : a) (hb : b) :
  a :=
by exact ha

/- `assumption` finds a hypothesis from the local context that matches the
goal's conclusion and applies it to prove the goal. -/

lemma fst_of_two_props₅ (a b : Prop) (ha : a) (hb : b) :
  a :=
by assumption

/- `refl` proves `l = r`, where the two sides are syntactically equal up to
computation. Computation means unfolding of definitions, β-reduction
(application of λ to an argument), `let`, and more. -/

lemma α_example {α β : Type} (f : α → β) :
  (λx, f x) = (λy, f y) :=
begin
  refl
end

lemma α_example₂ {α β : Type} (f : α → β) :
  (λx, f x) = (λy, f y) :=
by refl

lemma β_example {α β : Type} (f : α → β) (a : α) :
  (λx, f x) a = f a :=
by refl

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

lemma δ_example :
  double 5 = 5 + 5 :=
by refl

lemma ζ_example :
  (let n : ℕ := 2 in n + n) = 4 :=
by refl

lemma η_example {α β : Type} (f : α → β) :
  (λx, f x) = f :=
by refl

lemma ι_example {α β : Type} (a : α) (b : β) :
  prod.fst (a, b) = a :=
by refl

/- ## Reasoning about Logical Connectives and Quantifiers

Introduction rules: -/

#check true.intro
#check not.intro
#check and.intro
#check or.intro_left
#check or.intro_right
#check iff.intro
#check exists.intro

/- Elimination rules: -/

#check false.elim
#check and.elim_left
#check and.elim_right
#check or.elim
#check iff.elim_left
#check iff.elim_right
#check exists.elim

/- Definition of `¬` and related lemmas: -/

#print not
#check not_def
#check classical.em
#check classical.by_contradiction

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

/- The `{ … }` combinator focuses on the first subgoal. The tactic inside must
fully prove it. -/

lemma and_swap₂ :
  ∀a b : Prop, a ∧ b → b ∧ a :=
begin
  intros a b hab,
  apply and.intro,
  { exact and.elim_right hab },
  { exact and.elim_left hab }
end

/- Notice above how we pass the hypothesis `hab` directly to the lemmas
`and.elim_right` and `and.elim_left`, instead of waiting for the lemmas's
assumptions to appear as new subgoals. This is a small forward step in an
otherwise backward proof. -/

lemma or_swap (a b : Prop) :
  a ∨ b → b ∨ a :=
begin
  intros hab,
  apply or.elim hab,
  { intro ha,
    exact or.intro_right _ ha },
  { intro hb,
    exact or.intro_left _ hb }
end

lemma modus_ponens (a b : Prop) :
  (a → b) → a → b :=
begin
  intros hab ha,
  apply hab,
  exact ha
end

lemma not_not_intro (a : Prop) :
  a → ¬¬ a :=
begin
  intro ha,
  apply not.intro,
  intro hna,
  apply hna,
  exact ha
end

lemma not_not_intro₂ (a : Prop) :
  a → ¬¬ a :=
begin
  intros ha hna,
  apply hna,
  exact ha
end

lemma nat_exists_double_iden :
  ∃n : ℕ, double n = n :=
begin
  apply exists.intro 0,
  refl
end

/- ## Reasoning about Equality -/

#check eq.refl
#check eq.symm
#check eq.trans
#check eq.subst

/- The above rules can be used directly: -/

lemma cong_fst_arg {α : Type} (a a' b : α)
    (f : α → α → α) (ha : a = a') :
  f a b = f a' b :=
begin
  apply eq.subst ha,
  apply eq.refl
end

lemma cong_two_args {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
begin
  apply eq.subst ha,
  apply eq.subst hb,
  apply eq.refl
end

/- `rw` applies a single equation as a left-to-right rewrite rule, once. To
apply an equation right-to-left, prefix its name with `←`. -/

lemma cong_two_args₂ {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
begin
  rw ha,
  rw hb
end

lemma a_proof_of_negation₃ (a : Prop) :
  a → ¬¬ a :=
begin
  rw not_def,
  rw not_def,
  intro ha,
  intro hna,
  apply hna,
  exact ha
end

/- `simp` applies a standard set of rewrite rules (the __simp set__)
exhaustively. The set can be extended using the `@[simp]` attribute. Lemmas can
be temporarily added to the simp set with the syntax
`simp [_lemma₁_, …, _lemmaN_]`. -/

lemma cong_two_args_etc {α : Type} (a a' b b' : α)
    (g : α → α → ℕ → α) (ha : a = a') (hb : b = b') :
  g a b (1 + 1) = g a' b' 2 :=
by simp [ha, hb]

/- `cc` applies __congruence closure__ to derive new equalities. -/

lemma cong_two_args₃ {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
by cc

/- `cc` can also reason up to associativity and commutativity of `+`, `*`,
and other binary operators. -/

lemma cong_assoc_comm (a a' b c : ℝ) (f : ℝ → ℝ)
    (ha : a = a') :
  f (a + b + c) = f (c + b + a') :=
by cc

/- ## Proofs by Mathematical Induction

`induction'` performs induction on the specified variable. It gives rise to one
subgoal per constructor. -/

lemma add_zero (n : ℕ) :
  add 0 n = n :=
begin
  induction' n,
  { refl },
  { simp [add, ih] }
end

/- We use `induction'`, a variant of Lean's built-in `induction` tactic. The
two tactics are similar, but `induction'` is more user-friendly. -/

lemma add_succ (m n : ℕ) :
  add (nat.succ m) n = nat.succ (add m n) :=
begin
  induction' n,
  { refl },
  { simp [add, ih] }
end

lemma add_comm (m n : ℕ) :
  add m n = add n m :=
begin
  induction' n,
  { simp [add, add_zero] },
  { simp [add, add_succ, ih] }
end

lemma add_assoc (l m n : ℕ) :
  add (add l m) n = add l (add m n) :=
begin
  induction' n,
  { refl },
  { simp [add, ih] }
end

/- `cc` is extensible. We can register `add` as a commutative and associative
operator using the type class instance mechanism (explained in lecture 4). This
is useful for the `cc` invocation below. -/

@[instance] def add.is_commutative : is_commutative ℕ add :=
{ comm := add_comm }

@[instance] def add.is_associative : is_associative ℕ add :=
{ assoc := add_assoc }

lemma mul_add (l m n : ℕ) :
  mul l (add m n) = add (mul l m) (mul l n) :=
begin
  induction' n,
  { refl },
  { simp [add, mul, ih],
    cc }
end

/- ## Cleanup Tactics

`rename` changes the name of a variable or hypothesis.

`clear` removes unused variables or hypotheses. -/

lemma cleanup_example (a b c : Prop) (ha : a) (hb : b)
    (hab : a → b) (hbc : b → c) :
  c :=
begin
  clear ha hab a,
  apply hbc,
  clear hbc c,
  rename hb h,
  exact h
end

end backward_proofs

end LoVe


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov
-/
import data.real.ennreal

/-!
# Real conjugate exponents

`p.is_conjugate_exponent q` registers the fact that the real numbers `p` and `q` are `> 1` and
satisfy `1/p + 1/q = 1`. This property shows up often in analysis, especially when dealing with
`L^p` spaces.

We make several basic facts available through dot notation in this situation.

We also introduce `p.conjugate_exponent` for `p / (p-1)`. When `p > 1`, it is conjugate to `p`.
-/

noncomputable theory
namespace real

/-- Two real exponents `p, q` are conjugate if they are `> 1` and satisfy the equality
`1/p + 1/q = 1`. This condition shows up in many theorems in analysis, notably related to `L^p`
norms. -/
structure is_conjugate_exponent (p q : ℝ) : Prop :=
(one_lt : 1 < p)
(inv_add_inv_conj : 1/p + 1/q = 1)

/-- The conjugate exponent of `p` is `q = p/(p-1)`, so that `1/p + 1/q = 1`. -/
def conjugate_exponent (p : ℝ) : ℝ := p/(p-1)

namespace is_conjugate_exponent

variables {p q : ℝ} (h : p.is_conjugate_exponent q)
include h

/- Register several non-vanishing results following from the fact that `p` has a conjugate exponent
`q`: many computations using these exponents require clearing out denominators, which can be done
with `field_simp` given a proof that these denominators are non-zero, so we record the most usual
ones. -/
lemma pos : 0 < p :=
lt_trans zero_lt_one h.one_lt

lemma nonneg : 0 ≤ p := le_of_lt h.pos

lemma ne_zero : p ≠ 0 :=
ne_of_gt h.pos

lemma sub_one_pos : 0 < p - 1 :=
sub_pos.2 h.one_lt

lemma sub_one_ne_zero : p - 1 ≠ 0 :=
ne_of_gt h.sub_one_pos

lemma one_div_pos : 0 < 1/p :=
one_div_pos.2 h.pos

lemma one_div_nonneg : 0 ≤ 1/p :=
le_of_lt h.one_div_pos

lemma one_div_ne_zero : 1/p ≠ 0 :=
ne_of_gt (h.one_div_pos)

lemma conj_eq : q = p/(p-1) :=
begin
  have := h.inv_add_inv_conj,
  rw [← eq_sub_iff_add_eq', one_div, inv_eq_iff] at this,
  field_simp [← this, h.ne_zero]
end

lemma conjugate_eq : conjugate_exponent p = q := h.conj_eq.symm

lemma sub_one_mul_conj : (p - 1) * q = p :=
mul_comm q (p - 1) ▸ (eq_div_iff h.sub_one_ne_zero).1 h.conj_eq

lemma mul_eq_add : p * q = p + q :=
by simpa only [sub_mul, sub_eq_iff_eq_add, one_mul] using h.sub_one_mul_conj

@[symm] protected lemma symm : q.is_conjugate_exponent p :=
{ one_lt := by { rw [h.conj_eq], exact (one_lt_div h.sub_one_pos).mpr (sub_one_lt p) },
  inv_add_inv_conj := by simpa [add_comm] using h.inv_add_inv_conj }

lemma one_lt_nnreal : 1 < nnreal.of_real p :=
begin
  rw [←nnreal.of_real_one, nnreal.of_real_lt_of_real_iff h.pos],
  exact h.one_lt,
end

lemma inv_add_inv_conj_nnreal : 1 / nnreal.of_real p + 1 / nnreal.of_real q = 1 :=
by rw [←nnreal.of_real_one, ←nnreal.of_real_div' h.nonneg, ←nnreal.of_real_div' h.symm.nonneg,
  ←nnreal.of_real_add h.one_div_nonneg h.symm.one_div_nonneg, h.inv_add_inv_conj]

lemma inv_add_inv_conj_ennreal : 1 / ennreal.of_real p + 1 / ennreal.of_real q = 1 :=
by rw [←ennreal.of_real_one, ←ennreal.of_real_div_of_pos h.pos,
  ←ennreal.of_real_div_of_pos h.symm.pos,
  ←ennreal.of_real_add h.one_div_nonneg h.symm.one_div_nonneg, h.inv_add_inv_conj]

end is_conjugate_exponent

lemma is_conjugate_exponent_iff {p q : ℝ} (h : 1 < p) :
  p.is_conjugate_exponent q ↔ q = p/(p-1) :=
⟨λ H, H.conj_eq, λ H, ⟨h, by field_simp [H, ne_of_gt (lt_trans zero_lt_one h)]⟩⟩

lemma is_conjugate_exponent_conjugate_exponent {p : ℝ} (h : 1 < p) :
  p.is_conjugate_exponent (conjugate_exponent p) :=
(is_conjugate_exponent_iff h).2 rfl

end real


import algebraic_geometry.prime_spectrum.basic

open_locale big_operators

lemma pi.single_apply_eq_zero {ι : Type*} {R : ι → Type*} [∀ i, has_zero (R i)] [decidable_eq ι]
  {i j : ι} (h : i ≠ j) (x : R i) : pi.single i x j = 0 :=
dif_neg h.symm

lemma pi.single_mul_eq_single {ι : Type*} {R : ι → Type*} [decidable_eq ι]
  [∀ i, monoid_with_zero (R i)]
  (i : ι) (x : R i) (f) :
  pi.single i x * f = pi.single i (x * f i) :=
begin
  ext j,
  by_cases i = j,
  { subst h, simp },
  { simp [pi.single_apply_eq_zero h] },
end

lemma pi.sum_single_eq {ι : Type*} [fintype ι] {R : ι → Type*} [decidable_eq ι]
  [∀ i, add_comm_monoid (R i)] (x : Π i, R i) : ∑ i, pi.single i (x i) = x :=
by { ext i, simp [pi.single, function.update] }

lemma ideal.span_range_pi_single {ι : Type*} [finite ι] [decidable_eq ι] {R : ι → Type*}
  [∀ i, comm_ring (R i)] :
  ideal.span (set.range $ λ i : ι, pi.single i 1 : set $ Π i, R i) = ⊤ :=
begin
  rw eq_top_iff,
  rintro x -,
  haveI := fintype.of_finite ι,
  rw ← pi.sum_single_eq x,
  refine sum_mem (λ i _, _),
  rw [← mul_one (x i), pi.single_mul i (x i)],
  exact ideal.mul_mem_left _ _ (ideal.subset_span $ set.mem_range_self i),
end

lemma prime_spectrum.pi_exists_unique {ι : Type*} [finite ι] {R : ι → Type*} [∀ i, comm_ring (R i)]
  (p : prime_spectrum (Π i, R i)) : ∃! i, ∃ q, prime_spectrum.comap (pi.eval_ring_hom R i) q = p :=
begin
  haveI := fintype.of_finite ι,
  classical,
  obtain ⟨i, hi⟩ : ∃ i, (pi.single i 1 : Π i, R i) ∉ p.as_ideal,
  { by_contra h, push_neg at h, apply p.2.1,
    rw [eq_top_iff, ← ideal.span_range_pi_single, ideal.span_le], rintro _ ⟨i, rfl⟩, exact h i },
  have : ∀ j ≠ i, (pi.single j 1 : Π i, R i) ∈ p.as_ideal,
  { by_contra h, push_neg at h, obtain ⟨j, hj, hj'⟩ := h,
    have : (pi.single i 1 * pi.single j 1 : Π i, R i) = 0,
    { ext k, cases hj.ne_or_ne k; simp [pi.single_apply_eq_zero h] },
    exact hj' ((p.2.mem_or_mem_of_mul_eq_zero this).resolve_left hi) },
  refine ⟨i, _, _⟩,
  { change p ∈ set.range (prime_spectrum.comap (pi.eval_ring_hom R i)),
    rw [prime_spectrum.range_comap_of_surjective],
    { rintros x (hx : x i = 0),
      rw [set_like.mem_coe, ← pi.sum_single_eq x],
      apply sum_mem,
      rintro j -,
      by_cases hj : j = i,
      { subst hj, rw [hx, pi.single_zero], exact zero_mem _ },
      { rw [← mul_one (x j), pi.single_mul j (x j)],  exact ideal.mul_mem_left _ _ (this _ hj) } },
    { intro x, use pi.single i x, exact dif_pos rfl } },
  { rintros j ⟨q, rfl⟩, by_contra h,
    apply q.2.1,
    rw [ideal.eq_top_iff_one, ← pi.single_eq_same j (1 : R j)],
    exact this _ h }
end

@[simps symm_apply] noncomputable
def prime_spectrum.pi_equiv {ι : Type*} [finite ι] (R : ι → Type*) [∀ i, comm_ring (R i)] :
  prime_spectrum (Π i, R i) ≃ Σ i, prime_spectrum (R i) :=
{ to_fun := λ p, ⟨_, p.pi_exists_unique.some_spec.1.some⟩,
  inv_fun := λ s, prime_spectrum.comap (pi.eval_ring_hom R s.1) s.2,
  left_inv := λ p, p.pi_exists_unique.some_spec.1.some_spec,
  right_inv := begin
    classical,
    refine function.right_inverse_of_injective_of_left_inverse _
      (λ p, p.pi_exists_unique.some_spec.1.some_spec),
    rintro ⟨s, ps⟩ ⟨t, pt⟩ e,
    dsimp at e,
    obtain ⟨i, hi, hi'⟩ := (prime_spectrum.comap (pi.eval_ring_hom R t) pt).pi_exists_unique,
    obtain ⟨rfl, rfl⟩ := ⟨hi' s ⟨ps, e⟩, hi' t ⟨pt, rfl⟩⟩,
    congr' 1,
    refine prime_spectrum.comap_injective_of_surjective _ _ e,
    exact λ x, ⟨pi.single t x, dif_pos rfl⟩
  end }