/-
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

! This file was ported from Lean 3 source module analysis.calculus.tangent_cone
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Topology
import Mathbin.Analysis.NormedSpace.Basic
import Mathbin.Analysis.SpecificLimits.Basic

/-!
# 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.
-/

variable (𝕜 : Type _) [NontriviallyNormedField 𝕜]

open Filter Set

open Topology

section TangentCone

variable {E : Type _} [AddCommMonoid E] [Module 𝕜 E] [TopologicalSpace E]

/-- The set of all tangent directions to the set `s` at the point `x`. -/
def tangentConeAt (s : Set E) (x : E) : Set E :=
  { y : E |
    ∃ (c : ℕ → 𝕜)(d : ℕ → E),
      (∀ᶠ n in atTop, x + d n ∈ s) ∧
        Tendsto (fun n => ‖c n‖) atTop atTop ∧ Tendsto (fun n => c n • d n) atTop (𝓝 y) }
#align tangent_cone_at tangentConeAt

/-- 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 UniqueDiffWithinAt (s : Set E) (x : E) : Prop where
  dense_tangent_cone : Dense (Submodule.span 𝕜 (tangentConeAt 𝕜 s x) : Set E)
  mem_closure : x ∈ closure s
#align unique_diff_within_at UniqueDiffWithinAt

/-- 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 UniqueDiffOn (s : Set E) : Prop :=
  ∀ x ∈ s, UniqueDiffWithinAt 𝕜 s x
#align unique_diff_on UniqueDiffOn

end TangentCone

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace 𝕜 E]

variable {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F]

variable {G : Type _} [NormedAddCommGroup G] [NormedSpace ℝ G]

variable {𝕜} {x y : E} {s t : Set E}

section TangentCone

-- This section is devoted to the properties of the tangent cone.
open NormedField

theorem tangent_cone_univ : tangentConeAt 𝕜 univ x = univ :=
  by
  refine' univ_subset_iff.1 fun y hy => _
  rcases exists_one_lt_norm 𝕜 with ⟨w, hw⟩
  refine' ⟨fun n => w ^ n, fun n => (w ^ n)⁻¹ • y, univ_mem' fun n => mem_univ _, _, _⟩
  · simp only [norm_pow]
    exact tendsto_pow_atTop_atTop_of_one_lt hw
  · convert tendsto_const_nhds
    ext n
    have : w ^ n * (w ^ n)⁻¹ = 1 := by
      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]
#align tangent_cone_univ tangent_cone_univ

theorem tangent_cone_mono (h : s ⊆ t) : tangentConeAt 𝕜 s x ⊆ tangentConeAt 𝕜 t x :=
  by
  rintro y ⟨c, d, ds, ctop, clim⟩
  exact ⟨c, d, mem_of_superset ds fun n hn => h hn, Ctop, clim⟩
#align tangent_cone_mono tangent_cone_mono

/-- Auxiliary lemma ensuring that, under the assumptions defining the tangent cone,
the sequence `d` tends to 0 at infinity. -/
theorem tangentConeAt.lim_zero {α : Type _} (l : Filter α) {c : α → 𝕜} {d : α → E}
    (hc : Tendsto (fun n => ‖c n‖) l atTop) (hd : Tendsto (fun n => c n • d n) l (𝓝 y)) :
    Tendsto d l (𝓝 0) :=
  by
  have A : tendsto (fun n => ‖c n‖⁻¹) l (𝓝 0) := tendsto_inv_at_top_zero.comp hc
  have B : tendsto (fun n => ‖c n • d n‖) l (𝓝 ‖y‖) := (continuous_norm.tendsto _).comp hd
  have C : tendsto (fun n => ‖c n‖⁻¹ * ‖c n • d n‖) l (𝓝 (0 * ‖y‖)) := A.mul B
  rw [MulZeroClass.zero_mul] at C
  have : ∀ᶠ n in l, ‖c n‖⁻¹ * ‖c n • d n‖ = ‖d n‖ :=
    by
    apply (eventually_ne_of_tendsto_norm_atTop hc 0).mono fun n hn => _
    rw [norm_smul, ← mul_assoc, inv_mul_cancel, one_mul]
    rwa [Ne.def, norm_eq_zero]
  have D : tendsto (fun n => ‖d n‖) l (𝓝 0) := tendsto.congr' this C
  rw [tendsto_zero_iff_norm_tendsto_zero]
  exact D
#align tangent_cone_at.lim_zero tangentConeAt.lim_zero

theorem tangent_cone_mono_nhds (h : 𝓝[s] x ≤ 𝓝[t] x) : tangentConeAt 𝕜 s x ⊆ tangentConeAt 𝕜 t x :=
  by
  rintro y ⟨c, d, ds, ctop, clim⟩
  refine' ⟨c, d, _, Ctop, clim⟩
  suffices : tendsto (fun n => x + d n) at_top (𝓝[t] x)
  exact 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 (tangentConeAt.lim_zero at_top Ctop clim)
#align tangent_cone_mono_nhds tangent_cone_mono_nhds

/-- Tangent cone of `s` at `x` depends only on `𝓝[s] x`. -/
theorem tangent_cone_congr (h : 𝓝[s] x = 𝓝[t] x) : tangentConeAt 𝕜 s x = tangentConeAt 𝕜 t x :=
  Subset.antisymm (tangent_cone_mono_nhds <| le_of_eq h) (tangent_cone_mono_nhds <| le_of_eq h.symm)
#align tangent_cone_congr tangent_cone_congr

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

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The tangent cone of a product contains the tangent cone of its left factor. -/
theorem subset_tangent_cone_prod_left {t : Set F} {y : F} (ht : y ∈ closure t) :
    LinearMap.inl 𝕜 E F '' tangentConeAt 𝕜 s x ⊆ tangentConeAt 𝕜 (s ×ˢ t) (x, y) :=
  by
  rintro _ ⟨v, ⟨c, d, hd, hc, hy⟩, rfl⟩
  have : ∀ n, ∃ d', y + d' ∈ t ∧ ‖c n • d'‖ < ((1 : ℝ) / 2) ^ n :=
    by
    intro 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, fun n => (d n, d' n), _, hc, _⟩
  show ∀ᶠ n in at_top, (x, y) + (d n, d' n) ∈ s ×ˢ t
  · filter_upwards [hd]with n hn
    simp [hn, (hd' n).1]
  · apply tendsto.prod_mk_nhds hy _
    refine' squeeze_zero_norm (fun n => (hd' n).2.le) _
    exact tendsto_pow_atTop_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one
#align subset_tangent_cone_prod_left subset_tangent_cone_prod_left

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The tangent cone of a product contains the tangent cone of its right factor. -/
theorem subset_tangent_cone_prod_right {t : Set F} {y : F} (hs : x ∈ closure s) :
    LinearMap.inr 𝕜 E F '' tangentConeAt 𝕜 t y ⊆ tangentConeAt 𝕜 (s ×ˢ t) (x, y) :=
  by
  rintro _ ⟨w, ⟨c, d, hd, hc, hy⟩, rfl⟩
  have : ∀ n, ∃ d', x + d' ∈ s ∧ ‖c n • d'‖ < ((1 : ℝ) / 2) ^ n :=
    by
    intro 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, fun n => (d' n, d n), _, hc, _⟩
  show ∀ᶠ n in at_top, (x, y) + (d' n, d n) ∈ s ×ˢ t
  · filter_upwards [hd]with n hn
    simp [hn, (hd' n).1]
  · apply tendsto.prod_mk_nhds _ hy
    refine' squeeze_zero_norm (fun n => (hd' n).2.le) _
    exact tendsto_pow_atTop_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one
#align subset_tangent_cone_prod_right subset_tangent_cone_prod_right

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (j «expr ≠ » i) -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (j «expr ≠ » i) -/
/-- The tangent cone of a product contains the tangent cone of each factor. -/
theorem mapsTo_tangent_cone_pi {ι : Type _} [DecidableEq ι] {E : ι → Type _}
    [∀ i, NormedAddCommGroup (E i)] [∀ i, NormedSpace 𝕜 (E i)] {s : ∀ i, Set (E i)} {x : ∀ i, E i}
    {i : ι} (hi : ∀ (j) (_ : j ≠ i), x j ∈ closure (s j)) :
    MapsTo (LinearMap.single i : E i →ₗ[𝕜] ∀ j, E j) (tangentConeAt 𝕜 (s i) (x i))
      (tangentConeAt 𝕜 (Set.pi univ s) x) :=
  by
  rintro w ⟨c, d, hd, hc, hy⟩
  have : ∀ (n) (j) (_ : j ≠ i), ∃ d', x j + d' ∈ s j ∧ ‖c n • d'‖ < (1 / 2 : ℝ) ^ n :=
    by
    intro 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, fun n => Function.update (d' n) i (d n), hd.mono fun n hn j hj' => _, hc,
      tendsto_pi_nhds.2 fun j => _⟩
  · rcases em (j = i) with (rfl | hj) <;> simp [*]
  · rcases em (j = i) with (rfl | hj)
    · simp [hy]
    · suffices tendsto (fun n => c n • d' n j) at_top (𝓝 0) by simpa [hj]
      refine' squeeze_zero_norm (fun n => (hcd' n j hj).le) _
      exact tendsto_pow_atTop_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one
#align maps_to_tangent_cone_pi mapsTo_tangent_cone_pi

/-- If a subset of a real vector space contains an open segment, then the direction of this
segment belongs to the tangent cone at its endpoints. -/
theorem mem_tangent_cone_of_openSegment_subset {s : Set G} {x y : G} (h : openSegment ℝ x y ⊆ s) :
    y - x ∈ tangentConeAt ℝ s x :=
  by
  let c := fun n : ℕ => (2 : ℝ) ^ (n + 1)
  let d := fun n : ℕ => (c n)⁻¹ • (y - x)
  refine' ⟨c, d, Filter.univ_mem' fun n => h _, _, _⟩
  show x + d n ∈ openSegment ℝ x y
  · rw [openSegment_eq_image]
    refine' ⟨(c n)⁻¹, ⟨_, _⟩, _⟩
    · rw [inv_pos]
      apply pow_pos
      norm_num
    · apply inv_lt_one
      apply one_lt_pow _ (Nat.succ_ne_zero _)
      norm_num
    · simp only [d, sub_smul, smul_sub, one_smul]
      abel
  show Filter.Tendsto (fun n : ℕ => ‖c n‖) Filter.atTop Filter.atTop
  · have : (fun n : ℕ => ‖c n‖) = c := by
      ext n
      exact abs_of_nonneg (pow_nonneg (by norm_num) _)
    rw [this]
    exact (tendsto_pow_atTop_atTop_of_one_lt (by norm_num)).comp (tendsto_add_at_top_nat 1)
  show Filter.Tendsto (fun n : ℕ => c n • d n) Filter.atTop (𝓝 (y - x))
  · have : (fun n : ℕ => c n • d n) = fun n => y - x :=
      by
      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
#align mem_tangent_cone_of_open_segment_subset mem_tangent_cone_of_openSegment_subset

/-- 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. -/
theorem mem_tangent_cone_of_segment_subset {s : Set G} {x y : G} (h : segment ℝ x y ⊆ s) :
    y - x ∈ tangentConeAt ℝ s x :=
  mem_tangent_cone_of_openSegment_subset ((openSegment_subset_segment ℝ x y).trans h)
#align mem_tangent_cone_of_segment_subset mem_tangent_cone_of_segment_subset

end TangentCone

section UniqueDiff

/-!
### 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`. -/

theorem UniqueDiffOn.uniqueDiffWithinAt {s : Set E} {x} (hs : UniqueDiffOn 𝕜 s) (h : x ∈ s) :
    UniqueDiffWithinAt 𝕜 s x :=
  hs x h
#align unique_diff_on.unique_diff_within_at UniqueDiffOn.uniqueDiffWithinAt

theorem uniqueDiffWithinAt_univ : UniqueDiffWithinAt 𝕜 univ x :=
  by
  rw [uniqueDiffWithinAt_iff, tangent_cone_univ]
  simp
#align unique_diff_within_at_univ uniqueDiffWithinAt_univ

theorem uniqueDiffOn_univ : UniqueDiffOn 𝕜 (univ : Set E) := fun x hx => uniqueDiffWithinAt_univ
#align unique_diff_on_univ uniqueDiffOn_univ

theorem uniqueDiffOn_empty : UniqueDiffOn 𝕜 (∅ : Set E) := fun x hx => hx.elim
#align unique_diff_on_empty uniqueDiffOn_empty

theorem UniqueDiffWithinAt.mono_nhds (h : UniqueDiffWithinAt 𝕜 s x) (st : 𝓝[s] x ≤ 𝓝[t] x) :
    UniqueDiffWithinAt 𝕜 t x :=
  by
  simp only [uniqueDiffWithinAt_iff] at *
  rw [mem_closure_iff_nhdsWithin_neBot] at h⊢
  exact ⟨h.1.mono <| Submodule.span_mono <| tangent_cone_mono_nhds st, h.2.mono st⟩
#align unique_diff_within_at.mono_nhds UniqueDiffWithinAt.mono_nhds

theorem UniqueDiffWithinAt.mono (h : UniqueDiffWithinAt 𝕜 s x) (st : s ⊆ t) :
    UniqueDiffWithinAt 𝕜 t x :=
  h.mono_nhds <| nhdsWithin_mono _ st
#align unique_diff_within_at.mono UniqueDiffWithinAt.mono

theorem uniqueDiffWithinAt_congr (st : 𝓝[s] x = 𝓝[t] x) :
    UniqueDiffWithinAt 𝕜 s x ↔ UniqueDiffWithinAt 𝕜 t x :=
  ⟨fun h => h.mono_nhds <| le_of_eq st, fun h => h.mono_nhds <| le_of_eq st.symm⟩
#align unique_diff_within_at_congr uniqueDiffWithinAt_congr

theorem uniqueDiffWithinAt_inter (ht : t ∈ 𝓝 x) :
    UniqueDiffWithinAt 𝕜 (s ∩ t) x ↔ UniqueDiffWithinAt 𝕜 s x :=
  uniqueDiffWithinAt_congr <| (nhdsWithin_restrict' _ ht).symm
#align unique_diff_within_at_inter uniqueDiffWithinAt_inter

theorem UniqueDiffWithinAt.inter (hs : UniqueDiffWithinAt 𝕜 s x) (ht : t ∈ 𝓝 x) :
    UniqueDiffWithinAt 𝕜 (s ∩ t) x :=
  (uniqueDiffWithinAt_inter ht).2 hs
#align unique_diff_within_at.inter UniqueDiffWithinAt.inter

theorem uniqueDiffWithinAt_inter' (ht : t ∈ 𝓝[s] x) :
    UniqueDiffWithinAt 𝕜 (s ∩ t) x ↔ UniqueDiffWithinAt 𝕜 s x :=
  uniqueDiffWithinAt_congr <| (nhdsWithin_restrict'' _ ht).symm
#align unique_diff_within_at_inter' uniqueDiffWithinAt_inter'

theorem UniqueDiffWithinAt.inter' (hs : UniqueDiffWithinAt 𝕜 s x) (ht : t ∈ 𝓝[s] x) :
    UniqueDiffWithinAt 𝕜 (s ∩ t) x :=
  (uniqueDiffWithinAt_inter' ht).2 hs
#align unique_diff_within_at.inter' UniqueDiffWithinAt.inter'

theorem uniqueDiffWithinAt_of_mem_nhds (h : s ∈ 𝓝 x) : UniqueDiffWithinAt 𝕜 s x := by
  simpa only [univ_inter] using unique_diff_within_at_univ.inter h
#align unique_diff_within_at_of_mem_nhds uniqueDiffWithinAt_of_mem_nhds

theorem IsOpen.uniqueDiffWithinAt (hs : IsOpen s) (xs : x ∈ s) : UniqueDiffWithinAt 𝕜 s x :=
  uniqueDiffWithinAt_of_mem_nhds (IsOpen.mem_nhds hs xs)
#align is_open.unique_diff_within_at IsOpen.uniqueDiffWithinAt

theorem UniqueDiffOn.inter (hs : UniqueDiffOn 𝕜 s) (ht : IsOpen t) : UniqueDiffOn 𝕜 (s ∩ t) :=
  fun x hx => (hs x hx.1).inter (IsOpen.mem_nhds ht hx.2)
#align unique_diff_on.inter UniqueDiffOn.inter

theorem IsOpen.uniqueDiffOn (hs : IsOpen s) : UniqueDiffOn 𝕜 s := fun x hx =>
  IsOpen.uniqueDiffWithinAt hs hx
#align is_open.unique_diff_on IsOpen.uniqueDiffOn

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The product of two sets of unique differentiability at points `x` and `y` has unique
differentiability at `(x, y)`. -/
theorem UniqueDiffWithinAt.prod {t : Set F} {y : F} (hs : UniqueDiffWithinAt 𝕜 s x)
    (ht : UniqueDiffWithinAt 𝕜 t y) : UniqueDiffWithinAt 𝕜 (s ×ˢ t) (x, y) :=
  by
  rw [uniqueDiffWithinAt_iff] at hs ht⊢
  rw [closure_prod_eq]
  refine' ⟨_, hs.2, ht.2⟩
  have : _ ≤ Submodule.span 𝕜 (tangentConeAt 𝕜 (s ×ˢ t) (x, y)) :=
    Submodule.span_mono
      (union_subset (subset_tangent_cone_prod_left ht.2) (subset_tangent_cone_prod_right hs.2))
  rw [LinearMap.span_inl_union_inr, SetLike.le_def] at this
  exact (hs.1.Prod ht.1).mono this
#align unique_diff_within_at.prod UniqueDiffWithinAt.prod

theorem UniqueDiffWithinAt.univ_pi (ι : Type _) [Finite ι] (E : ι → Type _)
    [∀ i, NormedAddCommGroup (E i)] [∀ i, NormedSpace 𝕜 (E i)] (s : ∀ i, Set (E i)) (x : ∀ i, E i)
    (h : ∀ i, UniqueDiffWithinAt 𝕜 (s i) (x i)) : UniqueDiffWithinAt 𝕜 (Set.pi univ s) x := by
  classical
    simp only [uniqueDiffWithinAt_iff, closure_pi_set] at h⊢
    refine' ⟨(dense_pi univ fun i _ => (h i).1).mono _, fun i _ => (h i).2⟩
    norm_cast
    simp only [← Submodule.supᵢ_map_single, supᵢ_le_iff, LinearMap.map_span, Submodule.span_le, ←
      maps_to']
    exact fun i =>
      (mapsTo_tangent_cone_pi fun j hj => (h j).2).mono subset.rfl Submodule.subset_span
#align unique_diff_within_at.univ_pi UniqueDiffWithinAt.univ_pi

theorem UniqueDiffWithinAt.pi (ι : Type _) [Finite ι] (E : ι → Type _)
    [∀ i, NormedAddCommGroup (E i)] [∀ i, NormedSpace 𝕜 (E i)] (s : ∀ i, Set (E i)) (x : ∀ i, E i)
    (I : Set ι) (h : ∀ i ∈ I, UniqueDiffWithinAt 𝕜 (s i) (x i)) :
    UniqueDiffWithinAt 𝕜 (Set.pi I s) x := by
  classical
    rw [← Set.univ_pi_piecewise_univ]
    refine' UniqueDiffWithinAt.univ_pi _ _ _ _ fun i => _
    by_cases hi : i ∈ I <;> simp [*, uniqueDiffWithinAt_univ]
#align unique_diff_within_at.pi UniqueDiffWithinAt.pi

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The product of two sets of unique differentiability is a set of unique differentiability. -/
theorem UniqueDiffOn.prod {t : Set F} (hs : UniqueDiffOn 𝕜 s) (ht : UniqueDiffOn 𝕜 t) :
    UniqueDiffOn 𝕜 (s ×ˢ t) := fun ⟨x, y⟩ h => UniqueDiffWithinAt.prod (hs x h.1) (ht y h.2)
#align unique_diff_on.prod UniqueDiffOn.prod

/-- The finite product of a family of sets of unique differentiability is a set of unique
differentiability. -/
theorem UniqueDiffOn.pi (ι : Type _) [Finite ι] (E : ι → Type _) [∀ i, NormedAddCommGroup (E i)]
    [∀ i, NormedSpace 𝕜 (E i)] (s : ∀ i, Set (E i)) (I : Set ι)
    (h : ∀ i ∈ I, UniqueDiffOn 𝕜 (s i)) : UniqueDiffOn 𝕜 (Set.pi I s) := fun x hx =>
  UniqueDiffWithinAt.pi _ _ _ _ _ fun i hi => h i hi (x i) (hx i hi)
#align unique_diff_on.pi UniqueDiffOn.pi

/-- The finite product of a family of sets of unique differentiability is a set of unique
differentiability. -/
theorem UniqueDiffOn.univ_pi (ι : Type _) [Finite ι] (E : ι → Type _)
    [∀ i, NormedAddCommGroup (E i)] [∀ i, NormedSpace 𝕜 (E i)] (s : ∀ i, Set (E i))
    (h : ∀ i, UniqueDiffOn 𝕜 (s i)) : UniqueDiffOn 𝕜 (Set.pi univ s) :=
  UniqueDiffOn.pi _ _ _ _ fun i _ => h i
#align unique_diff_on.univ_pi UniqueDiffOn.univ_pi

/-- In a real vector space, a convex set with nonempty interior is a set of unique
differentiability at every point of its closure. -/
theorem uniqueDiffWithinAt_convex {s : Set G} (conv : Convex ℝ s) (hs : (interior s).Nonempty)
    {x : G} (hx : x ∈ closure s) : UniqueDiffWithinAt ℝ s x :=
  by
  rcases hs with ⟨y, hy⟩
  suffices y - x ∈ interior (tangentConeAt ℝ s x)
    by
    refine' ⟨Dense.of_closure _, hx⟩
    simp [(Submodule.span ℝ (tangentConeAt ℝ s x)).eq_top_of_nonempty_interior'
        ⟨y - x, interior_mono Submodule.subset_span this⟩]
  rw [mem_interior_iff_mem_nhds]
  replace hy : interior s ∈ 𝓝 y := IsOpen.mem_nhds isOpen_interior hy
  apply mem_of_superset ((isOpenMap_sub_right x).image_mem_nhds hy)
  rintro _ ⟨z, zs, rfl⟩
  refine' mem_tangent_cone_of_openSegment_subset (subset.trans _ interior_subset)
  exact conv.open_segment_closure_interior_subset_interior hx zs
#align unique_diff_within_at_convex uniqueDiffWithinAt_convex

/-- In a real vector space, a convex set with nonempty interior is a set of unique
differentiability. -/
theorem uniqueDiffOn_convex {s : Set G} (conv : Convex ℝ s) (hs : (interior s).Nonempty) :
    UniqueDiffOn ℝ s := fun x xs => uniqueDiffWithinAt_convex conv hs (subset_closure xs)
#align unique_diff_on_convex uniqueDiffOn_convex

theorem uniqueDiffOn_Ici (a : ℝ) : UniqueDiffOn ℝ (Ici a) :=
  uniqueDiffOn_convex (convex_Ici a) <| by simp only [interior_Ici, nonempty_Ioi]
#align unique_diff_on_Ici uniqueDiffOn_Ici

theorem uniqueDiffOn_Iic (a : ℝ) : UniqueDiffOn ℝ (Iic a) :=
  uniqueDiffOn_convex (convex_Iic a) <| by simp only [interior_Iic, nonempty_Iio]
#align unique_diff_on_Iic uniqueDiffOn_Iic

theorem uniqueDiffOn_Ioi (a : ℝ) : UniqueDiffOn ℝ (Ioi a) :=
  isOpen_Ioi.UniqueDiffOn
#align unique_diff_on_Ioi uniqueDiffOn_Ioi

theorem uniqueDiffOn_Iio (a : ℝ) : UniqueDiffOn ℝ (Iio a) :=
  isOpen_Iio.UniqueDiffOn
#align unique_diff_on_Iio uniqueDiffOn_Iio

theorem uniqueDiffOn_Icc {a b : ℝ} (hab : a < b) : UniqueDiffOn ℝ (Icc a b) :=
  uniqueDiffOn_convex (convex_Icc a b) <| by simp only [interior_Icc, nonempty_Ioo, hab]
#align unique_diff_on_Icc uniqueDiffOn_Icc

theorem uniqueDiffOn_Ico (a b : ℝ) : UniqueDiffOn ℝ (Ico a b) :=
  if hab : a < b then
    uniqueDiffOn_convex (convex_Ico a b) <| by simp only [interior_Ico, nonempty_Ioo, hab]
  else by simp only [Ico_eq_empty hab, uniqueDiffOn_empty]
#align unique_diff_on_Ico uniqueDiffOn_Ico

theorem uniqueDiffOn_Ioc (a b : ℝ) : UniqueDiffOn ℝ (Ioc a b) :=
  if hab : a < b then
    uniqueDiffOn_convex (convex_Ioc a b) <| by simp only [interior_Ioc, nonempty_Ioo, hab]
  else by simp only [Ioc_eq_empty hab, uniqueDiffOn_empty]
#align unique_diff_on_Ioc uniqueDiffOn_Ioc

theorem uniqueDiffOn_Ioo (a b : ℝ) : UniqueDiffOn ℝ (Ioo a b) :=
  isOpen_Ioo.UniqueDiffOn
#align unique_diff_on_Ioo uniqueDiffOn_Ioo

/-- The real interval `[0, 1]` is a set of unique differentiability. -/
theorem uniqueDiffOn_Icc_zero_one : UniqueDiffOn ℝ (Icc (0 : ℝ) 1) :=
  uniqueDiffOn_Icc zero_lt_one
#align unique_diff_on_Icc_zero_one uniqueDiffOn_Icc_zero_one

theorem uniqueDiffWithinAt_Ioo {a b t : ℝ} (ht : t ∈ Set.Ioo a b) :
    UniqueDiffWithinAt ℝ (Set.Ioo a b) t :=
  IsOpen.uniqueDiffWithinAt isOpen_Ioo ht
#align unique_diff_within_at_Ioo uniqueDiffWithinAt_Ioo

theorem uniqueDiffWithinAt_Ioi (a : ℝ) : UniqueDiffWithinAt ℝ (Ioi a) a :=
  uniqueDiffWithinAt_convex (convex_Ioi a) (by simp) (by simp)
#align unique_diff_within_at_Ioi uniqueDiffWithinAt_Ioi

theorem uniqueDiffWithinAt_Iio (a : ℝ) : UniqueDiffWithinAt ℝ (Iio a) a :=
  uniqueDiffWithinAt_convex (convex_Iio a) (by simp) (by simp)
#align unique_diff_within_at_Iio uniqueDiffWithinAt_Iio

end UniqueDiff


@[simp] def f (x : Nat) := x + 1

@[simp] def g (x : Nat) := id x

def h (x : Nat) := g (g x)

namespace Extra
  attribute [scoped simp] h
end Extra

theorem ex1 : f (g (h x)) = x + 1 := by
  simp -- did not unfold h
  simp [h]

theorem ex2 : f (g (h x)) = x + 1 := by
  open Extra in simp -- unfold f,g,h

theorem ex3 : f (g x) = x + 1 := by
  simp [-f] -- did not unfold f
  simp


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jeremy Avigad, Yury Kudryashov
-/
import order.filter.cofinite

/-!
# Ultrafilters

An ultrafilter is a minimal (maximal in the set order) proper filter.
In this file we define

* `ultrafilter.of`: an ultrafilter that is less than or equal to a given filter;
* `ultrafilter`: subtype of ultrafilters;
* `ultrafilter.pure`: `pure x` as an `ultrafiler`;
* `ultrafilter.map`, `ultrafilter.bind`, `ultrafilter.comap` : operations on ultrafilters;
* `hyperfilter`: the ultrafilter extending the cofinite filter.
-/

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

open set zorn filter function
open_locale classical filter

/-- An ultrafilter is a minimal (maximal in the set order) proper filter. -/
@[protect_proj]
structure ultrafilter (α : Type*) extends filter α :=
(ne_bot' : ne_bot to_filter)
(le_of_le : ∀ g, filter.ne_bot g → g ≤ to_filter → to_filter ≤ g)

namespace ultrafilter

variables {f g : ultrafilter α} {s t : set α} {p q : α → Prop}

instance : has_coe_t (ultrafilter α) (filter α) := ⟨ultrafilter.to_filter⟩

instance : has_mem (set α) (ultrafilter α) := ⟨λ s f, s ∈ (f : filter α)⟩

lemma unique (f : ultrafilter α) {g : filter α} (h : g ≤ f)
  (hne : ne_bot g . tactic.apply_instance) : g = f :=
le_antisymm h $ f.le_of_le g hne h

instance ne_bot (f : ultrafilter α) : ne_bot (f : filter α) := f.ne_bot'

@[simp, norm_cast] lemma mem_coe : s ∈ (f : filter α) ↔ s ∈ f := iff.rfl

lemma coe_injective : injective (coe : ultrafilter α → filter α)
| ⟨f, h₁, h₂⟩ ⟨g, h₃, h₄⟩ rfl := by congr

@[simp, norm_cast] lemma coe_le_coe {f g : ultrafilter α} : (f : filter α) ≤ g ↔ f = g :=
⟨λ h, coe_injective $ g.unique h, λ h, h ▸ le_rfl⟩

@[simp, norm_cast] lemma coe_inj : (f : filter α) = g ↔ f = g := coe_injective.eq_iff

@[ext] lemma ext ⦃f g : ultrafilter α⦄ (h : ∀ s, s ∈ f ↔ s ∈ g) : f = g :=
coe_injective $ filter.ext h

lemma le_of_inf_ne_bot (f : ultrafilter α) {g : filter α} (hg : ne_bot (↑f ⊓ g)) : ↑f ≤ g :=
le_of_inf_eq (f.unique inf_le_left hg)

lemma le_of_inf_ne_bot' (f : ultrafilter α) {g : filter α} (hg : ne_bot (g ⊓ f)) : ↑f ≤ g :=
f.le_of_inf_ne_bot $ by rwa inf_comm

@[simp] lemma compl_not_mem_iff : sᶜ ∉ f ↔ s ∈ f :=
⟨λ hsc, le_principal_iff.1 $ f.le_of_inf_ne_bot
  ⟨λ h, hsc $ mem_sets_of_eq_bot $ by rwa compl_compl⟩, compl_not_mem_sets⟩

@[simp] lemma frequently_iff_eventually : (∃ᶠ x in f, p x) ↔ ∀ᶠ x in f, p x :=
compl_not_mem_iff

alias frequently_iff_eventually ↔ filter.frequently.eventually _

lemma compl_mem_iff_not_mem : sᶜ ∈ f ↔ s ∉ f := by rw [← compl_not_mem_iff, compl_compl]

lemma diff_mem_iff (f : ultrafilter α) : s \ t ∈ f ↔ s ∈ f ∧ t ∉ f :=
inter_mem_sets_iff.trans $ and_congr iff.rfl compl_mem_iff_not_mem

/-- If `sᶜ ∉ f ↔ s ∈ f`, then `f` is an ultrafilter. The other implication is given by
`ultrafilter.compl_not_mem_iff`.  -/
def of_compl_not_mem_iff (f : filter α) (h : ∀ s, sᶜ ∉ f ↔ s ∈ f) : ultrafilter α :=
{ to_filter := f,
  ne_bot' := ⟨λ hf, by simpa [hf] using h⟩,
  le_of_le := λ g hg hgf s hs, (h s).1 $ λ hsc, by exactI compl_not_mem_sets hs (hgf hsc) }

lemma nonempty_of_mem (hs : s ∈ f) : s.nonempty := nonempty_of_mem_sets hs
lemma ne_empty_of_mem (hs : s ∈ f) : s ≠ ∅ := (nonempty_of_mem hs).ne_empty
@[simp] lemma empty_not_mem : ∅ ∉ f := empty_nmem_sets f

lemma mem_or_compl_mem (f : ultrafilter α) (s : set α) : s ∈ f ∨ sᶜ ∈ f :=
or_iff_not_imp_left.2 compl_mem_iff_not_mem.2

protected lemma em (f : ultrafilter α) (p : α → Prop) :
  (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, ¬p x :=
f.mem_or_compl_mem {x | p x}

lemma eventually_or : (∀ᶠ x in f, p x ∨ q x) ↔ (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, q x :=
⟨λ H, (f.em p).imp_right $ λ hp, (H.and hp).mono $ λ x ⟨hx, hnx⟩, hx.resolve_left hnx,
  λ H, H.elim (λ hp, hp.mono $ λ x, or.inl) (λ hp, hp.mono $ λ x, or.inr)⟩

lemma union_mem_iff : s ∪ t ∈ f ↔ s ∈ f ∨ t ∈ f := eventually_or

lemma eventually_not : (∀ᶠ x in f, ¬p x) ↔ ¬∀ᶠ x in f, p x := compl_mem_iff_not_mem

lemma eventually_imp : (∀ᶠ x in f, p x → q x) ↔ (∀ᶠ x in f, p x) → ∀ᶠ x in f, q x :=
by simp only [imp_iff_not_or, eventually_or, eventually_not]

lemma finite_sUnion_mem_iff {s : set (set α)} (hs : finite s) : ⋃₀ s ∈ f ↔ ∃t∈s, t ∈ f :=
finite.induction_on hs (by simp) $ λ a s ha hs his,
  by simp [union_mem_iff, his, or_and_distrib_right, exists_or_distrib]

lemma finite_bUnion_mem_iff {is : set β} {s : β → set α} (his : finite is) :
  (⋃i∈is, s i) ∈ f ↔ ∃i∈is, s i ∈ f :=
by simp only [← sUnion_image, finite_sUnion_mem_iff (his.image s), bex_image_iff]

/-- Pushforward for ultrafilters. -/
def map (m : α → β) (f : ultrafilter α) : ultrafilter β :=
of_compl_not_mem_iff (map m f) $ λ s, @compl_not_mem_iff _ f (m ⁻¹' s)

@[simp, norm_cast] lemma coe_map (m : α → β) (f : ultrafilter α) :
  (map m f : filter β) = filter.map m ↑f := rfl

@[simp] lemma mem_map {m : α → β} {f : ultrafilter α} {s : set β} :
  s ∈ map m f ↔ m ⁻¹' s ∈ f := iff.rfl

/-- The pullback of an ultrafilter along an injection whose range is large with respect to the given
ultrafilter. -/
def comap {m : α → β} (u : ultrafilter β) (inj : injective m)
  (large : set.range m ∈ u) : ultrafilter α :=
{ to_filter := comap m u,
  ne_bot' := u.ne_bot'.comap_of_range_mem large,
  le_of_le := λ g hg hgu, by { resetI,
    simp only [← u.unique (map_le_iff_le_comap.2 hgu), comap_map inj, le_rfl] } }

/-- The principal ultrafilter associated to a point `x`. -/
instance : has_pure ultrafilter :=
⟨λ α a, of_compl_not_mem_iff (pure a) $ λ s, by simp⟩

@[simp] lemma mem_pure_sets {a : α} {s : set α} : s ∈ (pure a : ultrafilter α) ↔ a ∈ s := iff.rfl

instance [inhabited α] : inhabited (ultrafilter α) := ⟨pure (default _)⟩

/-- Monadic bind for ultrafilters, coming from the one on filters
defined in terms of map and join.-/
def bind (f : ultrafilter α) (m : α → ultrafilter β) : ultrafilter β :=
of_compl_not_mem_iff (bind ↑f (λ x, ↑(m x))) $ λ s,
  by simp only [mem_bind_sets', mem_coe, ← compl_mem_iff_not_mem, compl_set_of, compl_compl]

instance ultrafilter.has_bind : has_bind ultrafilter := ⟨@ultrafilter.bind⟩
instance ultrafilter.functor : functor ultrafilter := { map := @ultrafilter.map }
instance ultrafilter.monad : monad ultrafilter := { map := @ultrafilter.map }

section

local attribute [instance] filter.monad filter.is_lawful_monad

instance ultrafilter.is_lawful_monad : is_lawful_monad ultrafilter :=
{ id_map := assume α f, coe_injective (id_map f.1),
  pure_bind := assume α β a f, coe_injective (pure_bind a (coe ∘ f)),
  bind_assoc := assume α β γ f m₁ m₂, coe_injective (filter_eq rfl),
  bind_pure_comp_eq_map := assume α β f x, coe_injective (bind_pure_comp_eq_map f x.1) }

end

/-- The ultrafilter lemma: Any proper filter is contained in an ultrafilter. -/

alias exists_le ← filter.exists_ultrafilter_le

/-- Construct an ultrafilter extending a given filter.
  The ultrafilter lemma is the assertion that such a filter exists;
  we use the axiom of choice to pick one. -/
noncomputable def of (f : filter α) [ne_bot f] : ultrafilter α :=
classical.some (exists_le f)

lemma of_le (f : filter α) [ne_bot f] : ↑(of f) ≤ f := classical.some_spec (exists_le f)

lemma of_coe (f : ultrafilter α) : of ↑f = f :=
coe_inj.1 $ f.unique (of_le f)

lemma exists_ultrafilter_of_finite_inter_nonempty (S : set (set α))
  (cond : ∀ T : finset (set α), (↑T : set (set α)) ⊆ S → (⋂₀ (↑T : set (set α))).nonempty) :
  ∃ F : ultrafilter α, S ⊆ F.sets :=
begin
  suffices : ∃ F : filter α, ne_bot F ∧ S ⊆ F.sets,
  { rcases this with ⟨F, cond, hF⟩,
    resetI,
    obtain ⟨G : ultrafilter α, h1 : ↑G ≤ F⟩ := exists_le F,
    exact ⟨G, λ T hT, h1 (hF hT)⟩ },
  use filter.generate S,
  refine ⟨_, λ T hT, filter.generate_sets.basic hT⟩,
  rw ← forall_sets_nonempty_iff_ne_bot,
  intros T hT,
  rcases mem_generate_iff.mp hT with ⟨A, h1, h2, h3⟩,
  let B := set.finite.to_finset h2,
  rw (show A = ↑B, by simp) at *,
  rcases cond B h1 with ⟨x, hx⟩,
  exact ⟨x, h3 hx⟩,
end

end ultrafilter

namespace filter

open ultrafilter

lemma mem_iff_ultrafilter {s : set α} {f : filter α} :
  s ∈ f ↔ ∀ g : ultrafilter α, ↑g ≤ f → s ∈ g :=
begin
  refine ⟨λ hf g hg, hg hf, λ H, by_contra $ λ hf, _⟩,
  set g : filter ↥sᶜ := comap coe f,
  haveI : ne_bot g := comap_ne_bot_iff_compl_range.2 (by simpa [compl_set_of]),
  simpa using H ((of g).map coe) (map_le_iff_le_comap.mpr (of_le g))
end

lemma le_iff_ultrafilter {f₁ f₂ : filter α} : f₁ ≤ f₂ ↔ ∀ g : ultrafilter α, ↑g ≤ f₁ → ↑g ≤ f₂ :=
⟨λ h g h₁, h₁.trans h, λ h s hs, mem_iff_ultrafilter.2 $ λ g hg, h g hg hs⟩

/-- A filter equals the intersection of all the ultrafilters which contain it. -/
lemma supr_ultrafilter_le_eq (f : filter α) :
  (⨆ (g : ultrafilter α) (hg : ↑g ≤ f), (g : filter α)) = f :=
eq_of_forall_ge_iff $ λ f', by simp only [supr_le_iff, ← le_iff_ultrafilter]

/-- The `tendsto` relation can be checked on ultrafilters. -/
lemma tendsto_iff_ultrafilter (f : α → β) (l₁ : filter α) (l₂ : filter β) :
  tendsto f l₁ l₂ ↔ ∀ g : ultrafilter α, ↑g ≤ l₁ → tendsto f g l₂ :=
by simpa only [tendsto_iff_comap] using le_iff_ultrafilter

lemma exists_ultrafilter_iff {f : filter α} : (∃ (u : ultrafilter α), ↑u ≤ f) ↔ ne_bot f :=
⟨λ ⟨u, uf⟩, ne_bot_of_le uf, λ h, @exists_ultrafilter_le _ _ h⟩

lemma forall_ne_bot_le_iff {g : filter α} {p : filter α → Prop} (hp : monotone p) :
  (∀ f : filter α, ne_bot f → f ≤ g → p f) ↔ ∀ f : ultrafilter α, ↑f ≤ g → p f :=
begin
  refine ⟨λ H f hf, H f f.ne_bot hf, _⟩,
  introsI H f hf hfg,
  exact hp (of_le f) (H _ ((of_le f).trans hfg))
end

section hyperfilter

variables (α) [infinite α]

/-- The ultrafilter extending the cofinite filter. -/
noncomputable def hyperfilter : ultrafilter α := ultrafilter.of cofinite

variable {α}

lemma hyperfilter_le_cofinite : ↑(hyperfilter α) ≤ @cofinite α :=
ultrafilter.of_le cofinite

@[simp] lemma bot_ne_hyperfilter : (⊥ : filter α) ≠ hyperfilter α :=
(by apply_instance : ne_bot ↑(hyperfilter α)).1.symm

theorem nmem_hyperfilter_of_finite {s : set α} (hf : s.finite) : s ∉ hyperfilter α :=
λ hy, compl_not_mem_sets hy $ hyperfilter_le_cofinite hf.compl_mem_cofinite

alias nmem_hyperfilter_of_finite ← set.finite.nmem_hyperfilter

theorem compl_mem_hyperfilter_of_finite {s : set α} (hf : set.finite s) :
  sᶜ ∈ hyperfilter α :=
compl_mem_iff_not_mem.2 hf.nmem_hyperfilter

alias compl_mem_hyperfilter_of_finite ← set.finite.compl_mem_hyperfilter

theorem mem_hyperfilter_of_finite_compl {s : set α} (hf : set.finite sᶜ) :
  s ∈ hyperfilter α :=
compl_compl s ▸ hf.compl_mem_hyperfilter

end hyperfilter

end filter


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

! This file was ported from Lean 3 source module data.set_like.basic
! leanprover-community/mathlib commit feb99064803fd3108e37c18b0f77d0a8344677a3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Basic
import Mathbin.Tactic.Monotonicity.Basic

/-!
# Typeclass for types with a set-like extensionality property

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

The `has_mem` typeclass is used to let terms of a type have elements.
Many instances of `has_mem` have a set-like extensionality property:
things are equal iff they have the same elements.  The `set_like`
typeclass provides a unified interface to define a `has_mem` that is
extensional in this way.

The main use of `set_like` is for algebraic subobjects (such as
`submonoid` and `submodule`), whose non-proof data consists only of a
carrier set.  In such a situation, the projection to the carrier set
is injective.

In general, a type `A` is `set_like` with elements of type `B` if it
has an injective map to `set B`.  This module provides standard
boilerplate for every `set_like`: a `coe_sort`, a `coe` to set, a
`partial_order`, and various extensionality and simp lemmas.

A typical subobject should be declared as:
```
structure my_subobject (X : Type*) [object_typeclass X] :=
(carrier : set X)
(op_mem' : ∀ {x : X}, x ∈ carrier → sorry ∈ carrier)

namespace my_subobject

variables {X : Type*} [object_typeclass X] {x : X}

instance : set_like (my_subobject X) X :=
⟨my_subobject.carrier, λ p q h, by cases p; cases q; congr'⟩

@[simp] lemma mem_carrier {p : my_subobject X} : x ∈ p.carrier ↔ x ∈ (p : set X) := iff.rfl

@[ext] theorem ext {p q : my_subobject X} (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q := set_like.ext h

/-- Copy of a `my_subobject` with a new `carrier` equal to the old one. Useful to fix definitional
equalities. See Note [range copy pattern]. -/
protected def copy (p : my_subobject X) (s : set X) (hs : s = ↑p) : my_subobject X :=
{ carrier := s,
  op_mem' := hs.symm ▸ p.op_mem' }

@[simp] lemma coe_copy (p : my_subobject X) (s : set X) (hs : s = ↑p) :
  (p.copy s hs : set X) = s := rfl

lemma copy_eq (p : my_subobject X) (s : set X) (hs : s = ↑p) : p.copy s hs = p :=
set_like.coe_injective hs

end my_subobject
```

An alternative to `set_like` could have been an extensional `has_mem` typeclass:
```
class has_ext_mem (α : out_param $ Type u) (β : Type v) extends has_mem α β :=
(ext_iff : ∀ {s t : β}, s = t ↔ ∀ (x : α), x ∈ s ↔ x ∈ t)
```
While this is equivalent, `set_like` conveniently uses a carrier set projection directly.

## Tags

subobjects
-/

#print SetLike /-
/-- A class to indicate that there is a canonical injection between `A` and `set B`.

This has the effect of giving terms of `A` elements of type `B` (through a `has_mem`
instance) and a compatible coercion to `Type*` as a subtype.

Note: if `set_like.coe` is a projection, implementers should create a simp lemma such as
```
@[simp] lemma mem_carrier {p : my_subobject X} : x ∈ p.carrier ↔ x ∈ (p : set X) := iff.rfl
```
to normalize terms.

If you declare an unbundled subclass of `set_like`, for example:
```
class mul_mem_class (S : Type*) (M : Type*) [has_mul M] [set_like S M] where
  ...
```
Then you should *not* repeat the `out_param` declaration, `set_like` will supply the value instead.
This ensures in Lean 4 your subclass will not have issues with synthesis of the `[has_mul M]`
parameter starting before the value of `M` is known.
-/
@[protect_proj]
class SetLike (A : Type _) (B : outParam <| Type _) where
  coe : A → Set B
  coe_injective' : Function.Injective coe
#align set_like SetLike
-/

namespace SetLike

variable {A : Type _} {B : Type _} [i : SetLike A B]

include i

instance : CoeTC A (Set B) :=
  ⟨SetLike.coe⟩

instance (priority := 100) : Membership B A :=
  ⟨fun x p => x ∈ (p : Set B)⟩

-- `dangerous_instance` does not know that `B` is used only as an `out_param`
@[nolint dangerous_instance]
instance (priority := 100) : CoeSort A (Type _) :=
  ⟨fun p => { x : B // x ∈ p }⟩

variable (p q : A)

#print SetLike.coe_sort_coe /-
@[simp, norm_cast]
theorem coe_sort_coe : ((p : Set B) : Type _) = p :=
  rfl
#align set_like.coe_sort_coe SetLike.coe_sort_coe
-/

variable {p q}

#print SetLike.exists /-
protected theorem exists {q : p → Prop} : (∃ x, q x) ↔ ∃ x ∈ p, q ⟨x, ‹_›⟩ :=
  SetCoe.exists
#align set_like.exists SetLike.exists
-/

#print SetLike.forall /-
protected theorem forall {q : p → Prop} : (∀ x, q x) ↔ ∀ x ∈ p, q ⟨x, ‹_›⟩ :=
  SetCoe.forall
#align set_like.forall SetLike.forall
-/

/- warning: set_like.coe_injective -> SetLike.coe_injective is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B], Function.Injective.{succ u1, succ u2} A (Set.{u2} B) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B], Function.Injective.{succ u2, succ u1} A (Set.{u1} B) (SetLike.coe.{u2, u1} A B i)
Case conversion may be inaccurate. Consider using '#align set_like.coe_injective SetLike.coe_injectiveₓ'. -/
theorem coe_injective : Function.Injective (coe : A → Set B) := fun x y h =>
  SetLike.coe_injective' h
#align set_like.coe_injective SetLike.coe_injective

#print SetLike.coe_set_eq /-
@[simp, norm_cast]
theorem coe_set_eq : (p : Set B) = q ↔ p = q :=
  coe_injective.eq_iff
#align set_like.coe_set_eq SetLike.coe_set_eq
-/

#print SetLike.ext' /-
theorem ext' (h : (p : Set B) = q) : p = q :=
  coe_injective h
#align set_like.ext' SetLike.ext'
-/

/- warning: set_like.ext'_iff -> SetLike.ext'_iff is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {p : A} {q : A}, Iff (Eq.{succ u1} A p q) (Eq.{succ u2} (Set.{u2} B) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))) p) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))) q))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B] {p : A} {q : A}, Iff (Eq.{succ u2} A p q) (Eq.{succ u1} (Set.{u1} B) (SetLike.coe.{u2, u1} A B i p) (SetLike.coe.{u2, u1} A B i q))
Case conversion may be inaccurate. Consider using '#align set_like.ext'_iff SetLike.ext'_iffₓ'. -/
theorem ext'_iff : p = q ↔ (p : Set B) = q :=
  coe_set_eq.symm
#align set_like.ext'_iff SetLike.ext'_iff

#print SetLike.ext /-
/-- Note: implementers of `set_like` must copy this lemma in order to tag it with `@[ext]`. -/
theorem ext (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q :=
  coe_injective <| Set.ext h
#align set_like.ext SetLike.ext
-/

/- warning: set_like.ext_iff -> SetLike.ext_iff is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {p : A} {q : A}, Iff (Eq.{succ u1} A p q) (forall (x : B), Iff (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p) (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x q))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B] {p : A} {q : A}, Iff (Eq.{succ u2} A p q) (forall (x : B), Iff (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x p) (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x q))
Case conversion may be inaccurate. Consider using '#align set_like.ext_iff SetLike.ext_iffₓ'. -/
theorem ext_iff : p = q ↔ ∀ x, x ∈ p ↔ x ∈ q :=
  coe_injective.eq_iff.symm.trans Set.ext_iff
#align set_like.ext_iff SetLike.ext_iff

#print SetLike.mem_coe /-
@[simp]
theorem mem_coe {x : B} : x ∈ (p : Set B) ↔ x ∈ p :=
  Iff.rfl
#align set_like.mem_coe SetLike.mem_coe
-/

#print SetLike.coe_eq_coe /-
@[simp, norm_cast]
theorem coe_eq_coe {x y : p} : (x : B) = y ↔ x = y :=
  Subtype.ext_iff_val.symm
#align set_like.coe_eq_coe SetLike.coe_eq_coe
-/

/- warning: set_like.coe_mk clashes with [anonymous] -> [anonymous]
warning: set_like.coe_mk -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {p : A} (x : B) (hx : Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p), Eq.{succ u2} B ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Subtype.{succ u2} B (fun (x : B) => Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p)) B (HasLiftT.mk.{succ u2, succ u2} (Subtype.{succ u2} B (fun (x : B) => Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p)) B (CoeTCₓ.coe.{succ u2, succ u2} (Subtype.{succ u2} B (fun (x : B) => Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p)) B (coeBase.{succ u2, succ u2} (Subtype.{succ u2} B (fun (x : B) => Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p)) B (coeSubtype.{succ u2} B (fun (x : B) => Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p))))) (Subtype.mk.{succ u2} B (fun (x : B) => Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p) x hx)) x
but is expected to have type
  forall {A : Type.{u1}} {B : Type.{u2}}, (Nat -> A -> B) -> Nat -> (List.{u1} A) -> (List.{u2} B)
Case conversion may be inaccurate. Consider using '#align set_like.coe_mk [anonymous]ₓ'. -/
@[simp, norm_cast]
theorem [anonymous] (x : B) (hx : x ∈ p) : ((⟨x, hx⟩ : p) : B) = x :=
  rfl
#align set_like.coe_mk [anonymous]

#print SetLike.coe_mem /-
@[simp]
theorem coe_mem (x : p) : (x : B) ∈ p :=
  x.2
#align set_like.coe_mem SetLike.coe_mem
-/

#print SetLike.eta /-
@[simp]
protected theorem eta (x : p) (hx : (x : B) ∈ p) : (⟨x, hx⟩ : p) = x :=
  Subtype.eta x hx
#align set_like.eta SetLike.eta
-/

-- `dangerous_instance` does not know that `B` is used only as an `out_param`
@[nolint dangerous_instance]
instance (priority := 100) : PartialOrder A :=
  { PartialOrder.lift (coe : A → Set B) coe_injective with le := fun H K => ∀ ⦃x⦄, x ∈ H → x ∈ K }

/- warning: set_like.le_def -> SetLike.le_def is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {S : A} {T : A}, Iff (LE.le.{u1} A (Preorder.toLE.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i))) S T) (forall {{x : B}}, (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x S) -> (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x T))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B] {S : A} {T : A}, Iff (LE.le.{u2} A (Preorder.toLE.{u2} A (PartialOrder.toPreorder.{u2} A (SetLike.instPartialOrder.{u2, u1} A B i))) S T) (forall {{x : B}}, (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x S) -> (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x T))
Case conversion may be inaccurate. Consider using '#align set_like.le_def SetLike.le_defₓ'. -/
theorem le_def {S T : A} : S ≤ T ↔ ∀ ⦃x : B⦄, x ∈ S → x ∈ T :=
  Iff.rfl
#align set_like.le_def SetLike.le_def

/- warning: set_like.coe_subset_coe -> SetLike.coe_subset_coe is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {S : A} {T : A}, Iff (HasSubset.Subset.{u2} (Set.{u2} B) (Set.hasSubset.{u2} B) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))) S) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))) T)) (LE.le.{u1} A (Preorder.toLE.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i))) S T)
but is expected to have type
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {S : A} {T : A}, Iff (HasSubset.Subset.{u2} (Set.{u2} B) (Set.instHasSubsetSet.{u2} B) (SetLike.coe.{u1, u2} A B i S) (SetLike.coe.{u1, u2} A B i T)) (LE.le.{u1} A (Preorder.toLE.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.instPartialOrder.{u1, u2} A B i))) S T)
Case conversion may be inaccurate. Consider using '#align set_like.coe_subset_coe SetLike.coe_subset_coeₓ'. -/
@[simp, norm_cast]
theorem coe_subset_coe {S T : A} : (S : Set B) ⊆ T ↔ S ≤ T :=
  Iff.rfl
#align set_like.coe_subset_coe SetLike.coe_subset_coe

/- warning: set_like.coe_mono -> SetLike.coe_mono is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B], Monotone.{u1, u2} A (Set.{u2} B) (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i)) (PartialOrder.toPreorder.{u2} (Set.{u2} B) (SemilatticeInf.toPartialOrder.{u2} (Set.{u2} B) (Lattice.toSemilatticeInf.{u2} (Set.{u2} B) (GeneralizedCoheytingAlgebra.toLattice.{u2} (Set.{u2} B) (GeneralizedBooleanAlgebra.toGeneralizedCoheytingAlgebra.{u2} (Set.{u2} B) (BooleanAlgebra.toGeneralizedBooleanAlgebra.{u2} (Set.{u2} B) (Set.booleanAlgebra.{u2} B))))))) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B], Monotone.{u2, u1} A (Set.{u1} B) (PartialOrder.toPreorder.{u2} A (SetLike.instPartialOrder.{u2, u1} A B i)) (PartialOrder.toPreorder.{u1} (Set.{u1} B) (SemilatticeInf.toPartialOrder.{u1} (Set.{u1} B) (Lattice.toSemilatticeInf.{u1} (Set.{u1} B) (GeneralizedCoheytingAlgebra.toLattice.{u1} (Set.{u1} B) (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} (Set.{u1} B) (BiheytingAlgebra.toCoheytingAlgebra.{u1} (Set.{u1} B) (BooleanAlgebra.toBiheytingAlgebra.{u1} (Set.{u1} B) (Set.instBooleanAlgebraSet.{u1} B)))))))) (SetLike.coe.{u2, u1} A B i)
Case conversion may be inaccurate. Consider using '#align set_like.coe_mono SetLike.coe_monoₓ'. -/
@[mono]
theorem coe_mono : Monotone (coe : A → Set B) := fun a b => coe_subset_coe.mpr
#align set_like.coe_mono SetLike.coe_mono

/- warning: set_like.coe_ssubset_coe -> SetLike.coe_ssubset_coe is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {S : A} {T : A}, Iff (HasSSubset.SSubset.{u2} (Set.{u2} B) (Set.hasSsubset.{u2} B) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))) S) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))) T)) (LT.lt.{u1} A (Preorder.toLT.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i))) S T)
but is expected to have type
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {S : A} {T : A}, Iff (HasSSubset.SSubset.{u2} (Set.{u2} B) (Set.instHasSSubsetSet.{u2} B) (SetLike.coe.{u1, u2} A B i S) (SetLike.coe.{u1, u2} A B i T)) (LT.lt.{u1} A (Preorder.toLT.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.instPartialOrder.{u1, u2} A B i))) S T)
Case conversion may be inaccurate. Consider using '#align set_like.coe_ssubset_coe SetLike.coe_ssubset_coeₓ'. -/
@[simp, norm_cast]
theorem coe_ssubset_coe {S T : A} : (S : Set B) ⊂ T ↔ S < T :=
  Iff.rfl
#align set_like.coe_ssubset_coe SetLike.coe_ssubset_coe

/- warning: set_like.coe_strict_mono -> SetLike.coe_strictMono is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B], StrictMono.{u1, u2} A (Set.{u2} B) (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i)) (PartialOrder.toPreorder.{u2} (Set.{u2} B) (SemilatticeInf.toPartialOrder.{u2} (Set.{u2} B) (Lattice.toSemilatticeInf.{u2} (Set.{u2} B) (GeneralizedCoheytingAlgebra.toLattice.{u2} (Set.{u2} B) (GeneralizedBooleanAlgebra.toGeneralizedCoheytingAlgebra.{u2} (Set.{u2} B) (BooleanAlgebra.toGeneralizedBooleanAlgebra.{u2} (Set.{u2} B) (Set.booleanAlgebra.{u2} B))))))) ((fun (a : Type.{u1}) (b : Type.{u2}) [self : HasLiftT.{succ u1, succ u2} a b] => self.0) A (Set.{u2} B) (HasLiftT.mk.{succ u1, succ u2} A (Set.{u2} B) (CoeTCₓ.coe.{succ u1, succ u2} A (Set.{u2} B) (SetLike.Set.hasCoeT.{u1, u2} A B i))))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B], StrictMono.{u2, u1} A (Set.{u1} B) (PartialOrder.toPreorder.{u2} A (SetLike.instPartialOrder.{u2, u1} A B i)) (PartialOrder.toPreorder.{u1} (Set.{u1} B) (SemilatticeInf.toPartialOrder.{u1} (Set.{u1} B) (Lattice.toSemilatticeInf.{u1} (Set.{u1} B) (GeneralizedCoheytingAlgebra.toLattice.{u1} (Set.{u1} B) (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} (Set.{u1} B) (BiheytingAlgebra.toCoheytingAlgebra.{u1} (Set.{u1} B) (BooleanAlgebra.toBiheytingAlgebra.{u1} (Set.{u1} B) (Set.instBooleanAlgebraSet.{u1} B)))))))) (SetLike.coe.{u2, u1} A B i)
Case conversion may be inaccurate. Consider using '#align set_like.coe_strict_mono SetLike.coe_strictMonoₓ'. -/
@[mono]
theorem coe_strictMono : StrictMono (coe : A → Set B) := fun a b => coe_ssubset_coe.mpr
#align set_like.coe_strict_mono SetLike.coe_strictMono

/- warning: set_like.not_le_iff_exists -> SetLike.not_le_iff_exists is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {p : A} {q : A}, Iff (Not (LE.le.{u1} A (Preorder.toLE.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i))) p q)) (Exists.{succ u2} B (fun (x : B) => Exists.{0} (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p) (fun (H : Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p) => Not (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x q))))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B] {p : A} {q : A}, Iff (Not (LE.le.{u2} A (Preorder.toLE.{u2} A (PartialOrder.toPreorder.{u2} A (SetLike.instPartialOrder.{u2, u1} A B i))) p q)) (Exists.{succ u1} B (fun (x : B) => And (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x p) (Not (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x q))))
Case conversion may be inaccurate. Consider using '#align set_like.not_le_iff_exists SetLike.not_le_iff_existsₓ'. -/
theorem not_le_iff_exists : ¬p ≤ q ↔ ∃ x ∈ p, x ∉ q :=
  Set.not_subset
#align set_like.not_le_iff_exists SetLike.not_le_iff_exists

/- warning: set_like.exists_of_lt -> SetLike.exists_of_lt is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {p : A} {q : A}, (LT.lt.{u1} A (Preorder.toLT.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i))) p q) -> (Exists.{succ u2} B (fun (x : B) => Exists.{0} (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x q) (fun (H : Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x q) => Not (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p))))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B] {p : A} {q : A}, (LT.lt.{u2} A (Preorder.toLT.{u2} A (PartialOrder.toPreorder.{u2} A (SetLike.instPartialOrder.{u2, u1} A B i))) p q) -> (Exists.{succ u1} B (fun (x : B) => And (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x q) (Not (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x p))))
Case conversion may be inaccurate. Consider using '#align set_like.exists_of_lt SetLike.exists_of_ltₓ'. -/
theorem exists_of_lt : p < q → ∃ x ∈ q, x ∉ p :=
  Set.exists_of_ssubset
#align set_like.exists_of_lt SetLike.exists_of_lt

/- warning: set_like.lt_iff_le_and_exists -> SetLike.lt_iff_le_and_exists is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u1}} {B : Type.{u2}} [i : SetLike.{u1, u2} A B] {p : A} {q : A}, Iff (LT.lt.{u1} A (Preorder.toLT.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i))) p q) (And (LE.le.{u1} A (Preorder.toLE.{u1} A (PartialOrder.toPreorder.{u1} A (SetLike.partialOrder.{u1, u2} A B i))) p q) (Exists.{succ u2} B (fun (x : B) => Exists.{0} (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x q) (fun (H : Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x q) => Not (Membership.Mem.{u2, u1} B A (SetLike.hasMem.{u1, u2} A B i) x p)))))
but is expected to have type
  forall {A : Type.{u2}} {B : Type.{u1}} [i : SetLike.{u2, u1} A B] {p : A} {q : A}, Iff (LT.lt.{u2} A (Preorder.toLT.{u2} A (PartialOrder.toPreorder.{u2} A (SetLike.instPartialOrder.{u2, u1} A B i))) p q) (And (LE.le.{u2} A (Preorder.toLE.{u2} A (PartialOrder.toPreorder.{u2} A (SetLike.instPartialOrder.{u2, u1} A B i))) p q) (Exists.{succ u1} B (fun (x : B) => And (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x q) (Not (Membership.mem.{u1, u2} B A (SetLike.instMembership.{u2, u1} A B i) x p)))))
Case conversion may be inaccurate. Consider using '#align set_like.lt_iff_le_and_exists SetLike.lt_iff_le_and_existsₓ'. -/
theorem lt_iff_le_and_exists : p < q ↔ p ≤ q ∧ ∃ x ∈ q, x ∉ p := by
  rw [lt_iff_le_not_le, not_le_iff_exists]
#align set_like.lt_iff_le_and_exists SetLike.lt_iff_le_and_exists

end SetLike


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

noncomputable theory

/- This one just proves that a ring with axioms r1-r15
   (actually, r1, r2, r12 and r15 are not nedded)
   and 0 ≠ 1, has 0 < 1.

   Constructive reasoning only.
-/

constant ordring : Type
notation `ℝ` := ordring

namespace ordring

constant zero : ordring

constant one : ordring

constant add (x y: ordring) : ordring

constant mul (x y: ordring) : ordring

constant neg (x: ordring) : ordring

constant lt (x y: ordring) : Prop

instance : has_zero ℝ := ⟨zero⟩
instance : has_one ℝ := ⟨one⟩
instance : has_add ℝ := ⟨add⟩
instance : has_neg ℝ := ⟨neg⟩
instance : has_mul ℝ := ⟨mul⟩
instance : has_lt ℝ := ⟨lt⟩

variables (x y z t u: ordring)

-- axiom r1: x < x → false

-- axiom r2: x < y → y < z → x < z

axiom r3: x < 0 ∨ 0 = x ∨ 0 < x

axiom r4: x < y → x + z < y + z

axiom r5: 0 < x → 0 < y → 0 < x * y

axiom r6: 0 + x = x

axiom r7: 0 * x = 0

axiom r8: 1 * x = x

axiom r9: x + y = y + x

axiom r10: x * y = y * x

axiom r11: x + y + z = x + (y + z)

-- axiom r12: x * y * z = x * (y * z)

axiom r13: x * (y + z) = x * y + x * z

axiom r14: x + (-x) = 0

-- axiom r15: ∀ (f: ℕ → ℝ), (∀ (n: ℕ), f n < f (n + 1)) → (∃ (A: ℝ), ∀ (n: ℕ), f n < A) → (∃ (L: ℝ), ∀ (ε: ℝ), 0 < ε → ∃ (N: ℕ), ∀ n, N < n → L + -ε < f n ∧ f n < L + ε)

axiom r16: (0: ℝ) ≠ 1

theorem zero_lt_one : (0: ℝ) < 1 :=
begin
  cases (r3 1) with h1 h1,
  have h2 := r4 _ _ (-1) h1,
  rw [r14, r6] at h2,
  have h3 := r5 _ _ h2 h2,
  have h4 : (-1) * (1 + -1) = (0: ℝ),
  rw [r14, r10, r7],
  rw [r13, r10 _ 1, r8] at h4,
  have h5 : 1 + (-1 + (-1) * -1) = (1: ℝ),
  rw [h4, r9, r6],
  rw [← r11, r14, r6] at h5,
  rw [h5] at h3,
  exact h3,
  cases h1 with h1 h1,
  exfalso, exact (r16 h1),
  assumption,
end

#print axioms zero_lt_one

end ordring


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (hp : prime p) (x : ℕ) : coprime x p → x ∈ (units (ℤ_p)).val :=
begin
  assume h,
  have hx : (∀ y : ℤ_p, y * x = 1) := begin
    assume y,
    have h1 : (p ∣ x * y) := begin
      have h11 : (∃ (a : ℤ), a * x * y = p) := begin
        have h111 : (p * 1 < p * (1 + 1)) := begin
          sorry
        end
        sorry
      end
      sorry
    end
    sorry
  end,
  have h2 : (∃ (e : ℤ_p), e * x = 1) := begin
    have h21 : (p ∣ x * 1) := begin
      have h211 : (∃ (a : ℤ), a * x * 1 = p) := begin
        have h2111 : (p * 1< p * (1 + 1)) := begin
          sorry
        end
        sorry
      end
      sorry
    end
    sorry
  end,
  sorry
end

--OUTPUT 2
theorem p_adic_units {p : ℕ} [hp : prime p] (x : ℕ) (h : gcd x p = 1) : p ∣ x → ¬is_unit (x : ℤ/p) :=
begin
  -- By the contrapositive, we must prove that if $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
  assume hdiv : p ∣ x,
  -- Since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
  have hnorm : (x : ℤ/p).val > 1, from (coeff_ne_zero_of_ne_zero_of_dvd hdiv).2
    (begin
      -- But this must imply that $p | x$.
      assume hneq : x = 0,
      show false, from hdiv
        (show p = 0, by ring at hneq ⊢; exact hneq),
    end),
  exact mt (@is_unit_iff_norm_one_int ⟨x, hnorm⟩ (hp.pos)) hnorm,
end

--OUTPUT 3
theorem p_adic_units {p : ℕ} (h : prime p) (x : ℕ) (hcoprime : nat.coprime x p) : nat.is_unit x :=
begin
  assume h1 : ¬ nat.is_unit x,
  have : ¬ (1 : ℕ) ∈ (set.range (λ n : ℕ, n / p ^ x)) := (h1.elim
    (λ h2 : (1 : ℕ) ∉ set.range (λ n : ℕ, n / p ^ x), h2)
    (λ h2 : ¬ ∃ y : ℕ, ∃ y' : ℕ, (1 : ℕ) = y / p ^ y',
      by have : (1 : ℕ) = (1 : ℕ) / p ^ (1 : ℕ) := (div_one (1 : ℕ)).symm, from
        this.symm ▸ h2.elim (
          (λ h3 : ∃ y : ℕ, (1 : ℕ) = 1 / p ^ y,
            have : (1 : ℕ) = 1, from h3.elim (
            (λ h4 : ∃ y : ℕ, (1 : ℕ) = 1 / p ^ y,
              have : (1 : ℕ) = 1 / p ^ (1 : ℕ), from h4.elim (
              (λ h5 : (1 : ℕ) = 1 / p ^ 1,
                have : (1 : ℕ) / 1 = 1 / p ^ 1, from h5.symm ▸ (div_self (1 : ℕ)).symm,
                have := this ▸ (div_self (1 : ℕ)),
                have : ↑(p ^ 1) = 1, from nat.pow_one p,
                have : p ^ 1 = 1, from this.symm,
                have : p = 1, from h.not_one_iff.elim (
                λ h6 : 1 < p,
                  let h7 := h.ne_one in
                  have : 1 = 1, from
                    this.symm ▸ (eq_iff_modeq_nat.1 (le_of_lt h6.symm)).elim (
                    λ h8 : 1 % p = 0,
                      have : 0 < p, from nat.pos_of_ne_zero h.ne_one,
                      have : 1 % p < p, from modeq.modeq_lt _ h8,
                      have := this.symm,
                      have : 1 % p = p, from h.not_one_iff.elim (
                      λ h9 : 1 < p,
                        have : 1 % p < p, from modeq.modeq_lt _ h8,
                        have := this,
                        have := this.symm,
                        have : p < 1, from nat.lt_of_not_ge this,
                        have : p ≤ 1, from nat.not_lt_of_ge (le_of_not_gt this),
                        have := this.symm,
                        have : 1 = p, from eq.trans (modeq.modeq_zero_iff.2 (eq.trans (modeq.mod_modeq p 1 h5) this)) h8,
                        show false, from (ne_self_iff_lt 1).2 (this.symm ▸ h9)),
                      show false, from (ne_self_iff_lt 1).2 (h.not_one_iff.2 (this.trans h7))),
                    λ h8 : 1 % p = S p,
                      have : 1 = 1, from
                        (modeq.modeq_one_iff_dvd.2 h8).elim (
                        λ h9 : p ∣ 1,
                          have : 1 = p, from h.one_dvd.elim (
                          λ h10 : p = 1,
                            have : p = 1, from h10.symm,
                            have := this.symm,
                            have := this.symm,
                            have : 1 = p, from h.one_dvd.elim (
                            λ h11 : p = 1, this.symm ▸ h11.symm,
                            λ h11, h11.symm ▸ h.ne_one),
                            have := this.symm,
                            have := this.symm,
                            show false, from h5.symm ▸ (nat.dvd_iff_modeq.1 h9).symm),
                          λ h10 : p = S p,
                            have := h6.symm,
                            show false, from h10.symm ▸ (nat.dvd_iff_modeq.1 h9).symm),
                        λ h9 : p ∣ S p,
                          have : p ∣ 1, from nat.dvd_of_mod_eq_zero (
                            have : 1 % p = 0, from modeq.modeq_zero_iff.2 (eq.trans (modeq.mod_modeq _ _ h5) h8),
                            show 0 = 0, from modeq.mod_eq_of_dvd h9 this),
                          have := h6.symm,
                          show false, from h.ne_one ▸ h9),
                    λ h9 : 1 % p = p,
                      have : 1 = 1, from modeq.modeq_zero_iff.2 (eq.trans (modeq.modeq_add_div_iff.2 h9) h5.symm),
                      show false, from this.symm ▸ h5),
                  have := this,
                  have : nat.succ (1 % p) = p, from (modeq.modeq_add_div_iff.2 h8).trans this,
                  have : 1 % p + 1 = p, from (nat.succ_eq_add_one).mp this,
                  have := this,
                  have : 1 % p ≠ p, from ne_of_lt this,
                  have := (modeq.modeq_lt_iff_eq_nat _ _).mp this,
                  show false, from this.symm ▸ h5)),
              (λ h4 : ∃ y : ℕ, (1 : ℕ) = 1 / p ^ (1+y),
                have : ∃ y : ℕ, (1 : ℕ) = 1 / p ^ (1+y), from ⟨1, h4.elim (
                λ h5 : ∃ y : ℕ, (1 : ℕ) = 1 / p ^ (1+y),
                  have : (1 : ℕ) = 1 / p ^ 2, from h5.elim (
                  λ h6 : (1 : ℕ) = 1 / p ^ 2,
                    have : (1 : ℕ) / p = 1 / p ^ 2, from h6.symm ▸ (div_one (p : ℕ)).symm,
                    have := this ▸ (div_one p),
                    have : ↑(p ^ 2) = 1, from nat.pow_one p ▸ (pow_two p).symm,
                    have : p ^ 2 = 1, from this.symm,
                    have : p = 1, from h.not_one_iff.elim (
                    λ h7 : 1 < p,
                      let h8 := h.ne_one in
                      have : 1 = 1, from
                        this.symm ▸ (eq_iff_modeq_nat.1 (le_of_lt h7.symm)).elim (
                        λ h9 : 1 % p = 0,
                          have : 0 < p, from nat.pos_of_ne_zero h.ne_one,
                          have : 1 % p < p, from modeq.modeq_lt _ h9,
                          have := this.symm,
                          have : 1 % p = p, from h.not_one_iff.elim (
                          λ h10 : 1 < p,
                            have : 1 % p < p, from modeq.modeq_lt _ h9,
                            have := this,
                            have := this.symm,
                            have : p < 1, from
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem p_adic_units {p : ℕ} (hp : prime p) {x : ℕ} (hx : coprime x p) : p^(-1) ∈ units (ℤ p) :=
begin
  -- Proving the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
 -- $x$ is a unit of $\mathbb{Z}_p$ iff $x$ has norm 1, so $\Vert x \Vert \neq 1$.
  suffices h1 : ¬(p^(-1) ∈ units (ℤ p)) → ¬(coprime x p), from by {split,apply h1, from hx};
    assume (h : ¬(p^(-1) ∈ units (ℤ p))),
  have h2 : ¬(∥p^(-1)∥ = 1), from by {rw [norm_eq_one_iff_is_unit], split, apply h},
  have h3 : ∥p^(-1)∥ < 1, from by {rw [lt_iff_le_and_ne (norm_nonneg _),ne.def h2],simp},
  have h4 : coprime x p, from by {rw [coprime_iff_gcd_eq_one,dvd_iff_mod_eq_zero,←pow_one], rw [norm_eq_pow_two,lt_iff_le_and_ne h3],simp},
  show ¬(coprime x p), from not_not.mp h4
end

--OUTPUT 5
theorem p_adic_units {p : ℕ} (hp : prime p) :
    ∀ x : ℕ, coprime p x → x ∈ units (ℤ/p) :=
begin
  assume x : ℕ,
  assume hcop : coprime p x,

  have hprime : p ≠ 0, from hp.ne_zero,
  have h1 : ¬(is_unit (ℤ/p) ⟨x, by {apply nat.mod_lt,assumption,}⟩), from
    (nat.coprime.eq_one_of_is_unit_of_not_dvd hcop hp.dvd_of_dvd_pow)
    .elim (λ (h₁ : (ℤ/p)^⟨x,by {apply nat.mod_lt,assumption,}⟩ = 1), by contradiction)
    (λ (h₂ : (ℤ/p)^⟨x,by {apply nat.mod_lt,assumption,}⟩ ≠ 1), by {
    have h : (ℤ/p)^⟨x,by {apply nat.mod_lt,assumption,}⟩ = ⟨0,begin apply nat.mod_lt,assumption, end ⟩, from
    by {
    rsimp at h₂,
    rw nnreal.eq_one_of_is_unit_of_pos_of_not_unit_ne_one (⟨x, by {apply nat.mod_lt,assumption,}⟩)
      (nnreal.of_real_ge_one_of_ne_zero (real.pow_pos_iff_one_le.2 (⟨0,begin apply nat.mod_lt,assumption, end ⟩)) (by assumption)) (or.inl h₂),
  },
  have : is_unit (ℤ/p) ⟨0, by {apply nat.mod_lt,assumption,}⟩, from by {
    rw h,
    assume h₁,
    assumption,
    assume h₂,
    rw h₂,
    apply nat.mod_lt,
    assume h₃,
    have : 0 ≤ p, from zero_le _,
    have : p ≤ 0, from le_of_not_gt hprime,
    show (1 : ℕ), from begin
      apply le_antisymm,
      assumption,
      assumption,
    end,
    assumption,
    assumption,
    assume h₃,
    have : 0 ≤ p, from zero_le _,
    have : p ≤ 0, from le_of_not_gt hprime,
    show (1 : ℕ), from begin
      apply le_antisymm,
      assumption,
      assumption,
    end,
  },
  contradiction,
  }),
  show x ∈ units (ℤ/p), from
  (units_iff_exists_inv _).2 ⟨⟨x, by {apply nat.mod_lt,assumption,}⟩,⟨x, by {apply nat.mod_lt,assumption,}⟩,begin
    have hn : ¬(is_unit (ℤ/p) ⟨x, by {apply nat.mod_lt,assumption,}⟩), from h1,
    assume h₁,
    assume h₂,
    have hl1 : (ℤ/p)^⟨x,by {apply nat.mod_lt,assumption,}⟩ ≠ 1, from mt (nat.coprime.eq_one_of_is_unit_of_not_dvd hcop hp.dvd_of_dvd_pow).1 h₂,
    have hl2 : (ℤ/p)^⟨x,by {apply nat.mod_lt,assumption,}⟩ = 1, from mt (nat.coprime.eq_one_of_is_unit_of_not_dvd hcop hp.dvd_of_dvd_pow).2 h₂,
    have : is_unit (ℤ/p) ⟨x, by {apply nat.mod_lt,assumption,}⟩ := and_congr h₁ hl2,
    contradiction,
    assumption,
    assumption,
  end ⟩,
end

--OUTPUT 6
theorem p_adic_units {p : ℕ} (h_prime : prime p) (x : ℕ) (h_coprime : nat.coprime p x) : is_unit (nat.cast_to_zp p x) :=
begin
    -- We prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
    have h_init : ¬ nat.coprime p x → ¬ is_unit (nat.cast_to_zp p x), from nat.cast_to_zp_neg_of_coprime,
    have h_not_coprime : ¬ nat.coprime p x, from mt (iff.mp (h_init x h_coprime)) h_coprime,
    have h_eq : norm_zp' p x = 1 - ((p : ℤ) : ℚ), begin
        unfold norm_zp',
        rw nat.cast_to_zp_cast_nat,
        unfold nat.cast_to_zp_aux,
        rw nat.cast_pow,
        rwa nat.power_eq_pow,
    end,
    have h_div : p ∣ x, from mt (iff.mp h_eq) (ne_of_lt (calc   norm_zp' p x
                                                                = (1 - ((p : ℤ) : ℚ)) : by rw h_eq
                                                            ... < 1 : by {unfold norm_zp', rw ← nat.cast_to_zp_cast_nat, simp, }
                                                            ... = (1 : ℚ))),
    have h_eq_2 : p ∣ x, from iff.elim_right (h_not_coprime.elim_right (mt h_div h_coprime)) rfl,
    exact h_eq_2,
end

--OUTPUT 7
theorem p_adic_units_non_units :
  (∀ (p : ℕ) (h : prime p), (∀ (x : ℕ) (hx : coprime x p), x ∈ units (padic_int p))) :=
begin
  assume (p : ℕ) (h : prime p),
  assume (x : ℕ),
  assume (hx : coprime x p),
  show x ∈ units (padic_int p), from
    begin
      sorry
    end
end

--OUTPUT 8
theorem p_adic_units : ∀ (p : ℕ) (x : ℕ), x.coprime p → x.nat_abs ∈ units (p_adic_int p) :=
begin
    assume (p : ℕ) (x : ℕ) (hcoprime : x.coprime p),
    push_neg at hcoprime,
    show ¬ x.nat_abs ∉ units (p_adic_int p),
    { by_contradiction hne,
        have h1: norm_p p (x.nat_abs) ≠ 1,
        { assume h2: norm_p p (x.nat_abs) = 1,
            have h3: x.nat_abs ∈ units (p_adic_int p),
            from by {exact norm_p.eq_one_iff.mp h2},
            exact hne h3},
        have h4: norm_p p (x.nat_abs) < 1,
        { have h5: norm_p p (x.nat_abs) ≤ 1,
            from norm_p_le_one p (x.nat_abs),
            have h6: norm_p p (x.nat_abs) ≠ 1,
            from by {apply h1},
            exact lt_of_not_ge h6 h5},
        have h7: dvd p (x.nat_abs),
        { exact lt_of_norm_p_lt h4},
        exact hcoprime h7,
    }
end

--OUTPUT 9
theorem padic_units_2 (p : ℕ) (x : ℤ) (hp : prime p) (h : coprime x p) : is_unit x :=
begin
  have h1 : is_unit x ↔ (norm_num x) = 1, from by {
    have h2 : (norm_num x) = 1 ↔ x * (x⁻¹) = 1, from by {
      rw [norm_num_def], refine ⟨_,_⟩; assume h3 : (norm_num x) = 1, have h4 : (∃ z : ℤ, z⁻¹ = x),
        from by {have h5 : (x ∈ (units ℤ)), from by {
          apply set.mem_of_eq h3,
          rw [set.mem_range],
        },
        use x,
        exact set.mem_units_iff_exists_inv.1 h5,
      },
      refine ⟨_,_⟩;assume h3 : (norm_num x) = 1,
      show x * (x⁻¹) = 1, from by {
        rw [←mul_one x],
        have h4 : (∃ z : ℤ, z⁻¹ = x),
          from by {have h5 : (x ∈ (units ℤ)), from by {
            apply set.mem_of_eq h3,
            rw [set.mem_range],
          },
          use x,
          exact set.mem_units_iff_exists_inv.1 h5,
        },
        rw [inv_eq_of_mul_eq_one h4],
      },
      assume h3 : x * (x⁻¹) = 1,
      show (norm_num x) = 1, from by {
        rw [set.mem_range],
        have h4 : (x ∈ units ℤ), from set.mem_units_iff_exists_inv.2 ⟨x⁻¹, h3⟩,
        apply set.mem_of_eq,
        rw [←h2],
        exact h4,
      },
    },
    refine ⟨_,_⟩; assume h2 : is_unit x,
    show (norm_num x) = 1, from by {
      rw [←h1],
      exact h2,
    },
    assume h2 : (norm_num x) = 1,
    show is_unit x, from by {
      rw [h1],
      exact h2,
    },
  },
  have h2 : ¬(is_unit x), from by {
    rw [h1],
    have h3 : ¬(p ∣ 1), from by {rw [←int.cast_one], exact show ¬(p ∣ 1), from hp.not_dvd_one,},
    have h4 : (¬(p ∣ x)) ∨ (p ∣ 1), from not_or_distrib.2 ⟨h, h3⟩,
    have h5 : (p ∣ x) → (p ∣ 1), from by {
      assume h5 : (p ∣ x),
      exact h5,
    },
    assume h6 : (norm_num x) = 1,
    have h7 : (p ∣ x), from dvd_of_nonunits_norm_lt_one hp h6,
    have h8 : (p ∣ 1), from h5 h7,
    exact h8,
  },
  show is_unit x, from by { apply h2, exact h},
end

--OUTPUT 10
theorem p_adic_units (p : ℕ) (h : nat.prime p) (x : ℕ) (h2 : nat.coprime x p) : ∃ y : ℕ, y * x = 1 :=
begin
  -- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$. But this must imply that $p | x$.
  have h_converse : ¬ ∃ y : ℕ, y * x = 1 → ¬ nat.coprime x p, from
    assume h_notunit : ¬ ∃ y : ℕ, y * x = 1,
    have p_factor : ∃ z : ℕ, z * p = x, from by {
    have h_norm : p_adic_norm x p < 1, from by {
      rw lt_iff_not_ge,
      rw not_ge,
      assume h_unit : ∃ y : ℕ, y * x = 1,
      rw p_adic_norm_eq_zero_iff h_unit at h_norm,
      exact h_norm,
    },
    have h_norm_lt : p_adic_norm x p < p, from by {
      rw lt_iff_not_ge,
      rw not_ge,
      assume h_unit : ∃ y : ℕ, y * x = 1,
      exact h_norm,
    },
    exact ⟨x,by {
      rw le_antisymm_iff,
      split,
      exact rat.cast_le.mp (p_adic_norm_le h h_norm_lt),
      exact rat.cast_le.mp (p_adic_norm_le h h_norm),
    }⟩,
    -- But this must imply that $p | x$.
    exact p_factor_or_coprime h x,
  have h_unit : ¬ nat.coprime x p, from h_converse h2,
  exact nat.dvd_or_coprime_of_dvd h_unit,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Denumerable (countably infinite) types, as a typeclass extending
encodable. This is used to provide explicit encode/decode functions
from nat, where the functions are known inverses of each other.
-/
import data.equiv.encodable.basic
import data.sigma
import data.fintype.basic
import data.list.min_max
open nat

/-- A denumerable type is one which is (constructively) bijective with ℕ.
  Although we already have a name for this property, namely `α ≃ ℕ`,
  we are here interested in using it as a typeclass. -/
class denumerable (α : Type*) extends encodable α :=
(decode_inv : ∀ n, ∃ a ∈ decode n, encode a = n)

namespace denumerable

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

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

def of_nat (α) [f : denumerable α] (n : ℕ) : α :=
option.get (decode_is_some α n)

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

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

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

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

def eqv (α) [denumerable α] : α ≃ ℕ :=
⟨encode, of_nat α, of_nat_encode, encode_of_nat⟩

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

def of_equiv (α) {β} [denumerable α] (e : β ≃ α) : denumerable β :=
{ decode_inv := λ n, by simp,
  ..encodable.of_equiv _ e }

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

def equiv₂ (α β) [denumerable α] [denumerable β] : α ≃ β := (eqv α).trans (eqv β).symm

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

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

instance option : denumerable (option α) := ⟨λ n, by cases n; simp⟩

instance sum : denumerable (α ⊕ β) :=
⟨λ n, begin
  suffices : ∃ a ∈ @decode_sum α β _ _ n,
    encode_sum a = bit (bodd n) (div2 n), {simpa [bit_decomp]},
  simp [decode_sum]; cases bodd n; simp [decode_sum, bit, encode_sum]
end⟩

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

instance sigma : denumerable (sigma γ) :=
⟨λ n, by simp [decode_sigma]; exact ⟨_, _, ⟨rfl, heq.rfl⟩, by simp⟩⟩

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

end sigma

instance prod : denumerable (α × β) :=
of_equiv _ (equiv.sigma_equiv_prod α β).symm

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

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

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

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

instance ulift : denumerable (ulift α) := of_equiv _ equiv.ulift

instance plift : denumerable (plift α) := of_equiv _ equiv.plift

def pair : α × α ≃ α := equiv₂ _ _

end
end denumerable

namespace nat.subtype
open function encodable

variables {s : set ℕ} [infinite s]

section classical
open_locale classical

lemma exists_succ (x : s) : ∃ n, x.1 + n + 1 ∈ s :=
classical.by_contradiction $ λ h,
have ∀ (a : ℕ) (ha : a ∈ s), a < x.val.succ,
  from λ a ha, lt_of_not_ge (λ hax, h ⟨a - (x.1 + 1),
    by rwa [add_right_comm, nat.add_sub_cancel' hax]⟩),
infinite.not_fintype
  ⟨(((multiset.range x.1.succ).filter (∈ s)).pmap
      (λ (y : ℕ) (hy : y ∈ s), subtype.mk y hy)
      (by simp [-multiset.range_succ])).to_finset,
    by simpa [subtype.ext_iff_val, multiset.mem_filter, -multiset.range_succ]⟩

end classical

variable [decidable_pred s]

def succ (x : s) : s :=
have h : ∃ m, x.1 + m + 1 ∈ s, from exists_succ x,
⟨x.1 + nat.find h + 1, nat.find_spec h⟩

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

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

lemma lt_succ_self (x : s) : x < succ x :=
calc x.1 ≤ x.1 + _ : le_add_right (le_refl _)
... < succ x : nat.lt_succ_self (x.1 + _)

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

def of_nat (s : set ℕ) [decidable_pred s] [infinite s] : ℕ → s
| 0     := ⊥
| (n+1) := succ (of_nat n)

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

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

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

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

open finset

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

def denumerable (s : set ℕ) [decidable_pred s] [infinite s] : denumerable s :=
denumerable.of_equiv ℕ
{ to_fun := to_fun_aux,
  inv_fun := of_nat s,
  left_inv := left_inverse_of_surjective_of_right_inverse
    of_nat_surjective right_inverse_aux,
  right_inv := right_inverse_aux }

end nat.subtype

namespace denumerable
open encodable

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

end denumerable


import analysis.special_functions.arsinh
import data.real.sqrt

open real

--lemma arsinh_def : arsinh  = log (x + sqrt (1 + x^2)) := rfl

--lemma diff_arsinh (x : ℝ) : deriv (λ y, real.asinh y) x = 1/real.sqrt( 1 + x^2 ) := sorry

lemma la_reduc (x : ℝ) (f : ℝ → ℝ) : deriv (λ y, f y) x = deriv f x := rfl

example (x : ℝ) : has_deriv_at arsinh ( 1 / real.sqrt( 1 + x^2 ) ) x :=
begin
  rw has_deriv_at_iff_is_o_nhds_zero,
  have : (1 : ℕ) < 2 := by norm_num,
  refine (asymptotics.is_O.of_bound (∥1 / real.sqrt( 1 + x^2) ∥) _).trans_is_o (asymptotics.is_o_pow_id this),
  filter_upwards [metric.ball_mem_nhds (0 : ℝ) zero_lt_one],
  simp only [metric.mem_ball, dist_zero_right, normed_field.norm_pow],
  intros h Hh,
  /-
  x : ℝ,
  this : 1 < 2,
  h : ℝ,
  Hh : ∥h∥ < 1
  ⊢ ∥arsinh (x + h) - arsinh x - h • (1 / sqrt (1 + x ^ 2))∥ ≤ ∥1 / sqrt (1 + x ^ 2)∥ * ∥h∥ ^ 2
  -/
  unfold arsinh,
  rw sub_eq_add_neg _ (log (x + sqrt (1 + x ^ 2))),
  rw ← log_inv (x + sqrt (1 + x ^ 2)),
  rw ← log_mul,
  { ring,
    sorry
  },
  {
    sorry
  },
  { sorry}
end

example (a b : ℝ) : a - b = a + -b := sub_eq_add_neg a b

example (x : ℝ) (h : 0 ≤ x) : real.sqrt x = x^(1/2) :=
begin
  have H := mul_self_sqrt h,

  sorry
end