/-
Copyright © 2022 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Floris van Doorn
-/

import topology.vector_bundle.basic
import analysis.normed_space.operator_norm

/-!
# The vector bundle of continuous (semi)linear maps

We define the (topological) vector bundle of continuous (semi)linear maps between two vector bundles
over the same base.

Given bundles `E₁ E₂ : B → Type*`, normed spaces `F₁` and `F₂`, and a ring-homomorphism `σ` between
their respective scalar fields, we define `bundle.continuous_linear_map σ F₁ E₁ F₂ E₂ x` to be a
type synonym for `λ x, E₁ x →SL[σ] E₂ x`. If the `E₁` and `E₂` are vector bundles with model fibers
`F₁` and `F₂`, then this will be a vector bundle with fiber `F₁ →SL[σ] F₂`.

The topology is constructed from the trivializations for `E₁` and `E₂` and the norm-topology on the
model fiber `F₁ →SL[𝕜] F₂` using the `vector_prebundle` construction.  This is a bit awkward because
it introduces a spurious (?) dependence on the normed space structure of the model fiber, rather
than just its topological vector space structure; this might be fixable now that we have
`continuous_linear_map.strong_topology`.

Similar constructions should be possible (but are yet to be formalized) for tensor products of
topological vector bundles, exterior algebras, and so on, where again the topology can be defined
using a norm on the fiber model if this helps.

## Main Definitions

* `bundle.continuous_linear_map.vector_bundle`: continuous semilinear maps between
  vector bundles form a vector bundle.

-/

noncomputable theory

open_locale bundle
open bundle set continuous_linear_map

section defs
variables {𝕜₁ 𝕜₂ : Type*} [normed_field 𝕜₁] [normed_field 𝕜₂]
variables (σ : 𝕜₁ →+* 𝕜₂)
variables {B : Type*}
variables (F₁ : Type*) (E₁ : B → Type*) [Π x, add_comm_monoid (E₁ x)] [Π x, module 𝕜₁ (E₁ x)]
variables [Π x : B, topological_space (E₁ x)]
variables (F₂ : Type*) (E₂ : B → Type*) [Π x, add_comm_monoid (E₂ x)] [Π x, module 𝕜₂ (E₂ x)]
variables [Π x : B, topological_space (E₂ x)]

include F₁ F₂

-- In this definition we require the scalar rings `𝕜₁` and `𝕜₂` to be normed fields, although
-- something much weaker (maybe `comm_semiring`) would suffice mathematically -- this is because of
-- a typeclass inference bug with pi-types:
-- https://leanprover.zulipchat.com/#narrow/stream/116395-maths/topic/vector.20bundles.20--.20typeclass.20inference.20issue
/-- The bundle of continuous `σ`-semilinear maps between the topological vector bundles `E₁` and
`E₂`. This is a type synonym for `λ x, E₁ x →SL[σ] E₂ x`.

We intentionally add `F₁` and `F₂` as arguments to this type, so that instances on this type
(that depend on `F₁` and `F₂`) actually refer to `F₁` and `F₂`. -/
@[derive inhabited, nolint unused_arguments]
def bundle.continuous_linear_map (x : B) : Type* :=
E₁ x →SL[σ] E₂ x

instance bundle.continuous_linear_map.add_monoid_hom_class (x : B) :
  add_monoid_hom_class (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂ x) (E₁ x) (E₂ x) :=
by delta_instance bundle.continuous_linear_map

variables [Π x, has_continuous_add (E₂ x)]

instance (x : B) : add_comm_monoid (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂ x) :=
by delta_instance bundle.continuous_linear_map

variables [∀ x, has_continuous_smul 𝕜₂ (E₂ x)]

instance (x : B) : module 𝕜₂ (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂ x) :=
by delta_instance bundle.continuous_linear_map

end defs

variables {𝕜₁ : Type*} [nontrivially_normed_field 𝕜₁] {𝕜₂ : Type*} [nontrivially_normed_field 𝕜₂]
  (σ : 𝕜₁ →+* 𝕜₂) [iσ : ring_hom_isometric σ]

variables {B : Type*} [topological_space B]

variables (F₁ : Type*) [normed_add_comm_group F₁] [normed_space 𝕜₁ F₁]
  (E₁ : B → Type*) [Π x, add_comm_monoid (E₁ x)] [Π x, module 𝕜₁ (E₁ x)]
  [topological_space (total_space E₁)]
variables (F₂ : Type*) [normed_add_comm_group F₂][normed_space 𝕜₂ F₂]
  (E₂ : B → Type*) [Π x, add_comm_monoid (E₂ x)] [Π x, module 𝕜₂ (E₂ x)]
  [topological_space (total_space E₂)]

variables {F₁ E₁ F₂ E₂} (e₁ e₁' : trivialization F₁ (π E₁)) (e₂ e₂' : trivialization F₂ (π E₂))

namespace pretrivialization

include iσ

/-- Assume `eᵢ` and `eᵢ'` are trivializations of the bundles `Eᵢ` over base `B` with fiber `Fᵢ`
(`i ∈ {1,2}`), then `continuous_linear_map_coord_change σ e₁ e₁' e₂ e₂'` is the coordinate change
function between the two induced (pre)trivializations
`pretrivialization.continuous_linear_map σ e₁ e₂` and
`pretrivialization.continuous_linear_map σ e₁' e₂'` of `bundle.continuous_linear_map`. -/
def continuous_linear_map_coord_change
  [e₁.is_linear 𝕜₁] [e₁'.is_linear 𝕜₁] [e₂.is_linear 𝕜₂] [e₂'.is_linear 𝕜₂] (b : B) :
  (F₁ →SL[σ] F₂) →L[𝕜₂] F₁ →SL[σ] F₂ :=
((e₁'.coord_changeL 𝕜₁ e₁ b).symm.arrow_congrSL (e₂.coord_changeL 𝕜₂ e₂' b) :
  (F₁ →SL[σ] F₂) ≃L[𝕜₂] F₁ →SL[σ] F₂)

variables {σ e₁ e₁' e₂ e₂'}
variables [Π x : B, topological_space (E₁ x)] [fiber_bundle F₁ E₁]
variables [Π x : B, topological_space (E₂ x)] [fiber_bundle F₂ E₂]

lemma continuous_on_continuous_linear_map_coord_change
  [vector_bundle 𝕜₁ F₁ E₁] [vector_bundle 𝕜₂ F₂ E₂]
  [mem_trivialization_atlas e₁] [mem_trivialization_atlas e₁']
  [mem_trivialization_atlas e₂] [mem_trivialization_atlas e₂'] :
  continuous_on (continuous_linear_map_coord_change σ e₁ e₁' e₂ e₂')
    ((e₁.base_set ∩ e₂.base_set) ∩ (e₁'.base_set ∩ e₂'.base_set)) :=
begin
  have h₁ := (compSL F₁ F₂ F₂ σ (ring_hom.id 𝕜₂)).continuous,
  have h₂ := (continuous_linear_map.flip (compSL F₁ F₁ F₂ (ring_hom.id 𝕜₁) σ)).continuous,
  have h₃ := (continuous_on_coord_change 𝕜₁ e₁' e₁),
  have h₄ := (continuous_on_coord_change 𝕜₂ e₂ e₂'),
  refine ((h₁.comp_continuous_on (h₄.mono _)).clm_comp (h₂.comp_continuous_on (h₃.mono _))).congr _,
  { mfld_set_tac },
  { mfld_set_tac },
  { intros b hb, ext L v,
    simp only [continuous_linear_map_coord_change, continuous_linear_equiv.coe_coe,
      continuous_linear_equiv.arrow_congrSL_apply, comp_apply, function.comp, compSL_apply,
      flip_apply, continuous_linear_equiv.symm_symm] },
end

omit iσ

variables (σ e₁ e₁' e₂ e₂')
  [e₁.is_linear 𝕜₁] [e₁'.is_linear 𝕜₁] [e₂.is_linear 𝕜₂] [e₂'.is_linear 𝕜₂]

/-- Given trivializations `e₁`, `e₂` for vector bundles `E₁`, `E₂` over a base `B`,
`pretrivialization.continuous_linear_map σ e₁ e₂` is the induced pretrivialization for the
continuous `σ`-semilinear maps from `E₁` to `E₂`. That is, the map which will later become a
trivialization, after the bundle of continuous semilinear maps is equipped with the right
topological vector bundle structure. -/
def continuous_linear_map :
  pretrivialization (F₁ →SL[σ] F₂) (π (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂)) :=
{ to_fun := λ p, ⟨p.1, (e₂.continuous_linear_map_at 𝕜₂ p.1).comp $ p.2.comp $ e₁.symmL 𝕜₁ p.1⟩,
  inv_fun := λ p, ⟨p.1, (e₂.symmL 𝕜₂ p.1).comp $ p.2.comp $ e₁.continuous_linear_map_at 𝕜₁ p.1⟩,
  source := (bundle.total_space.proj) ⁻¹' (e₁.base_set ∩ e₂.base_set),
  target := (e₁.base_set ∩ e₂.base_set) ×ˢ set.univ,
  map_source' := λ ⟨x, L⟩ h, ⟨h, set.mem_univ _⟩,
  map_target' := λ ⟨x, f⟩ h, h.1,
  left_inv' := λ ⟨x, L⟩ ⟨h₁, h₂⟩,
  begin
    simp_rw [sigma.mk.inj_iff, eq_self_iff_true, heq_iff_eq, true_and],
    ext v,
    simp only [comp_apply, trivialization.symmL_continuous_linear_map_at, h₁, h₂]
  end,
  right_inv' := λ ⟨x, f⟩ ⟨⟨h₁, h₂⟩, _⟩,
  begin
    simp_rw [prod.mk.inj_iff, eq_self_iff_true, true_and],
    ext v,
    simp only [comp_apply, trivialization.continuous_linear_map_at_symmL, h₁, h₂]
  end,
  open_target := (e₁.open_base_set.inter e₂.open_base_set).prod is_open_univ,
  base_set := e₁.base_set ∩ e₂.base_set,
  open_base_set := e₁.open_base_set.inter e₂.open_base_set,
  source_eq := rfl,
  target_eq := rfl,
  proj_to_fun := λ ⟨x, f⟩ h, rfl }

instance continuous_linear_map.is_linear
  [Π x, has_continuous_add (E₂ x)] [Π x, has_continuous_smul 𝕜₂ (E₂ x)] :
  (pretrivialization.continuous_linear_map σ e₁ e₂).is_linear 𝕜₂ :=
{ linear := λ x h,
  { map_add := λ L L',
    show (e₂.continuous_linear_map_at 𝕜₂ x).comp ((L + L').comp (e₁.symmL 𝕜₁ x)) = _,
    begin
      simp_rw [add_comp, comp_add],
      refl
    end,
    map_smul := λ c L,
    show (e₂.continuous_linear_map_at 𝕜₂ x).comp ((c • L).comp (e₁.symmL 𝕜₁ x)) = _,
    begin
      simp_rw [smul_comp, comp_smulₛₗ, ring_hom.id_apply],
      refl
    end, } }

lemma continuous_linear_map_apply
  (p : total_space (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂)) :
  (continuous_linear_map σ e₁ e₂) p =
  ⟨p.1, (e₂.continuous_linear_map_at 𝕜₂ p.1).comp $ p.2.comp $ e₁.symmL 𝕜₁ p.1⟩ :=
rfl

lemma continuous_linear_map_symm_apply (p : B × (F₁ →SL[σ] F₂)) :
  (continuous_linear_map σ e₁ e₂).to_local_equiv.symm p =
  ⟨p.1, (e₂.symmL 𝕜₂ p.1).comp $ p.2.comp $ e₁.continuous_linear_map_at 𝕜₁ p.1⟩ :=
rfl

variables [Π x, has_continuous_add (E₂ x)]

lemma continuous_linear_map_symm_apply' {b : B} (hb : b ∈ e₁.base_set ∩ e₂.base_set)
  (L : F₁ →SL[σ] F₂) :
  (continuous_linear_map σ e₁ e₂).symm b L =
  (e₂.symmL 𝕜₂ b).comp (L.comp $ e₁.continuous_linear_map_at 𝕜₁ b) :=
begin
  rw [symm_apply], refl, exact hb
end

lemma continuous_linear_map_coord_change_apply [ring_hom_isometric σ] (b : B)
  (hb : b ∈ (e₁.base_set ∩ e₂.base_set) ∩ (e₁'.base_set ∩ e₂'.base_set)) (L : F₁ →SL[σ] F₂) :
  continuous_linear_map_coord_change σ e₁ e₁' e₂ e₂' b L =
  (continuous_linear_map σ e₁' e₂'
    (total_space_mk b ((continuous_linear_map σ e₁ e₂).symm b L))).2 :=
begin
  ext v,
  simp_rw [continuous_linear_map_coord_change, continuous_linear_equiv.coe_coe,
    continuous_linear_equiv.arrow_congrSL_apply,
    continuous_linear_map_apply, continuous_linear_map_symm_apply' σ e₁ e₂ hb.1,
    comp_apply, continuous_linear_equiv.coe_coe, continuous_linear_equiv.symm_symm,
    trivialization.continuous_linear_map_at_apply, trivialization.symmL_apply],
  dsimp only [total_space_mk],
  rw [e₂.coord_changeL_apply e₂', e₁'.coord_changeL_apply e₁, e₁.coe_linear_map_at_of_mem hb.1.1,
    e₂'.coe_linear_map_at_of_mem hb.2.2],
  exacts [⟨hb.2.1, hb.1.1⟩, ⟨hb.1.2, hb.2.2⟩]
end

end pretrivialization

open pretrivialization
variables (F₁ E₁ F₂ E₂) [ring_hom_isometric σ]
variables [Π x : B, topological_space (E₁ x)] [fiber_bundle F₁ E₁] [vector_bundle 𝕜₁ F₁ E₁]
variables [Π x : B, topological_space (E₂ x)] [fiber_bundle F₂ E₂] [vector_bundle 𝕜₂ F₂ E₂]
variables [Π x, has_continuous_add (E₂ x)] [Π x, has_continuous_smul 𝕜₂ (E₂ x)]

/-- The continuous `σ`-semilinear maps between two topological vector bundles form a
`vector_prebundle` (this is an auxiliary construction for the
`vector_bundle` instance, in which the pretrivializations are collated but no topology
on the total space is yet provided). -/
def _root_.bundle.continuous_linear_map.vector_prebundle :
  vector_prebundle 𝕜₂ (F₁ →SL[σ] F₂)
  (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂) :=
{ pretrivialization_atlas :=
    {e |  ∃ (e₁ : trivialization F₁ (π E₁)) (e₂ : trivialization F₂ (π E₂))
    [mem_trivialization_atlas e₁] [mem_trivialization_atlas e₂], by exactI
    e = pretrivialization.continuous_linear_map σ e₁ e₂},
  pretrivialization_linear' := begin
    rintro _ ⟨e₁, he₁, e₂, he₂, rfl⟩,
    apply_instance
  end,
  pretrivialization_at := λ x, pretrivialization.continuous_linear_map σ
    (trivialization_at F₁ E₁ x) (trivialization_at F₂ E₂ x),
  mem_base_pretrivialization_at := λ x,
    ⟨mem_base_set_trivialization_at F₁ E₁ x, mem_base_set_trivialization_at F₂ E₂ x⟩,
  pretrivialization_mem_atlas := λ x,
    ⟨trivialization_at F₁ E₁ x, trivialization_at F₂ E₂ x, _, _, rfl⟩,
  exists_coord_change := by { rintro _ ⟨e₁, e₂, he₁, he₂, rfl⟩ _ ⟨e₁', e₂', he₁', he₂', rfl⟩,
    resetI,
    exact ⟨continuous_linear_map_coord_change σ e₁ e₁' e₂ e₂',
    continuous_on_continuous_linear_map_coord_change,
    continuous_linear_map_coord_change_apply σ e₁ e₁' e₂ e₂'⟩ } }

/-- Topology on the continuous `σ`-semilinear_maps between the respective fibers at a point of two
"normable" vector bundles over the same base. Here "normable" means that the bundles have fibers
modelled on normed spaces `F₁`, `F₂` respectively.  The topology we put on the continuous
`σ`-semilinear_maps is the topology coming from the operator norm on maps from `F₁` to `F₂`. -/
instance (x : B) : topological_space (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂ x) :=
(bundle.continuous_linear_map.vector_prebundle σ F₁ E₁ F₂ E₂).fiber_topology x

/-- Topology on the total space of the continuous `σ`-semilinear_maps between two "normable" vector
bundles over the same base. -/
instance bundle.continuous_linear_map.topological_space_total_space :
  topological_space (total_space (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂)) :=
(bundle.continuous_linear_map.vector_prebundle
  σ F₁ E₁ F₂ E₂).total_space_topology

/-- The continuous `σ`-semilinear_maps between two vector bundles form a fiber bundle. -/
instance _root_.bundle.continuous_linear_map.fiber_bundle :
  fiber_bundle (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂) :=
(bundle.continuous_linear_map.vector_prebundle
  σ F₁ E₁ F₂ E₂).to_fiber_bundle

/-- The continuous `σ`-semilinear_maps between two vector bundles form a vector bundle. -/
instance _root_.bundle.continuous_linear_map.vector_bundle :
  vector_bundle 𝕜₂ (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂) :=
(bundle.continuous_linear_map.vector_prebundle
  σ F₁ E₁ F₂ E₂).to_vector_bundle

variables (e₁ e₂) [he₁ : mem_trivialization_atlas e₁] [he₂ : mem_trivialization_atlas e₂]
  {F₁ E₁ F₂ E₂}

include he₁ he₂

/-- Given trivializations `e₁`, `e₂` in the atlas for vector bundles `E₁`, `E₂` over a base `B`,
the induced trivialization for the continuous `σ`-semilinear maps from `E₁` to `E₂`,
whose base set is `e₁.base_set ∩ e₂.base_set`. -/
def trivialization.continuous_linear_map :
  trivialization (F₁ →SL[σ] F₂) (π (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂)) :=
vector_prebundle.trivialization_of_mem_pretrivialization_atlas _ ⟨e₁, e₂, he₁, he₂, rfl⟩

instance _root_.bundle.continuous_linear_map.mem_trivialization_atlas :
  mem_trivialization_atlas (e₁.continuous_linear_map σ e₂ :
    trivialization (F₁ →SL[σ] F₂) (π (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂))) :=
{ out := ⟨_, ⟨e₁, e₂, by apply_instance, by apply_instance, rfl⟩, rfl⟩ }

variables {e₁ e₂}

@[simp] lemma trivialization.base_set_continuous_linear_map :
  (e₁.continuous_linear_map σ e₂).base_set = e₁.base_set ∩ e₂.base_set :=
rfl

lemma trivialization.continuous_linear_map_apply
  (p : total_space (bundle.continuous_linear_map σ F₁ E₁ F₂ E₂)) :
  e₁.continuous_linear_map σ e₂ p =
  ⟨p.1, (e₂.continuous_linear_map_at 𝕜₂ p.1).comp $ p.2.comp $ e₁.symmL 𝕜₁ p.1⟩ :=
rfl


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

! This file was ported from Lean 3 source module analysis.normed_space.compact_operator
! 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.NormedSpace.OperatorNorm
import Mathbin.Analysis.LocallyConvex.Bounded

/-!
# Compact operators

In this file we define compact linear operators between two topological vector spaces (TVS).

## Main definitions

* `is_compact_operator` : predicate for compact operators

## Main statements

* `is_compact_operator_iff_is_compact_closure_image_closed_ball` : the usual characterization of
  compact operators from a normed space to a T2 TVS.
* `is_compact_operator.comp_clm` : precomposing a compact operator by a continuous linear map gives
  a compact operator
* `is_compact_operator.clm_comp` : postcomposing a compact operator by a continuous linear map
  gives a compact operator
* `is_compact_operator.continuous` : compact operators are automatically continuous
* `is_closed_set_of_is_compact_operator` : the set of compact operators is closed for the operator
  norm

## Implementation details

We define `is_compact_operator` as a predicate, because the space of compact operators inherits all
of its structure from the space of continuous linear maps (e.g we want to have the usual operator
norm on compact operators).

The two natural options then would be to make it a predicate over linear maps or continuous linear
maps. Instead we define it as a predicate over bare functions, although it really only makes sense
for linear functions, because Lean is really good at finding coercions to bare functions (whereas
coercing from continuous linear maps to linear maps often needs type ascriptions).

## References

* Bourbaki, *Spectral Theory*, chapters 3 to 5, to be published (2022)

## Tags

Compact operator
-/

open Function Set Filter Bornology Metric

open Pointwise BigOperators Topology

/-- A compact operator between two topological vector spaces. This definition is usually
given as "there exists a neighborhood of zero whose image is contained in a compact set",
but we choose a definition which involves fewer existential quantifiers and replaces images
with preimages.

We prove the equivalence in `is_compact_operator_iff_exists_mem_nhds_image_subset_compact`. -/
def IsCompactOperator {M₁ M₂ : Type _} [Zero M₁] [TopologicalSpace M₁] [TopologicalSpace M₂]
    (f : M₁ → M₂) : Prop :=
  ∃ K, IsCompact K ∧ f ⁻¹' K ∈ (𝓝 0 : Filter M₁)
#align is_compact_operator IsCompactOperator

theorem isCompactOperator_zero {M₁ M₂ : Type _} [Zero M₁] [TopologicalSpace M₁]
    [TopologicalSpace M₂] [Zero M₂] : IsCompactOperator (0 : M₁ → M₂) :=
  ⟨{0}, isCompact_singleton, mem_of_superset univ_mem fun x _ => rfl⟩
#align is_compact_operator_zero isCompactOperator_zero

section Characterizations

section

variable {R₁ R₂ : Type _} [Semiring R₁] [Semiring R₂] {σ₁₂ : R₁ →+* R₂} {M₁ M₂ : Type _}
  [TopologicalSpace M₁] [AddCommMonoid M₁] [TopologicalSpace M₂]

theorem isCompactOperator_iff_exists_mem_nhds_image_subset_compact (f : M₁ → M₂) :
    IsCompactOperator f ↔ ∃ V ∈ (𝓝 0 : Filter M₁), ∃ K : Set M₂, IsCompact K ∧ f '' V ⊆ K :=
  ⟨fun ⟨K, hK, hKf⟩ => ⟨f ⁻¹' K, hKf, K, hK, image_preimage_subset _ _⟩, fun ⟨V, hV, K, hK, hVK⟩ =>
    ⟨K, hK, mem_of_superset hV (image_subset_iff.mp hVK)⟩⟩
#align is_compact_operator_iff_exists_mem_nhds_image_subset_compact isCompactOperator_iff_exists_mem_nhds_image_subset_compact

theorem isCompactOperator_iff_exists_mem_nhds_isCompact_closure_image [T2Space M₂] (f : M₁ → M₂) :
    IsCompactOperator f ↔ ∃ V ∈ (𝓝 0 : Filter M₁), IsCompact (closure <| f '' V) :=
  by
  rw [isCompactOperator_iff_exists_mem_nhds_image_subset_compact]
  exact
    ⟨fun ⟨V, hV, K, hK, hKV⟩ => ⟨V, hV, isCompact_closure_of_subset_compact hK hKV⟩,
      fun ⟨V, hV, hVc⟩ => ⟨V, hV, closure (f '' V), hVc, subset_closure⟩⟩
#align is_compact_operator_iff_exists_mem_nhds_is_compact_closure_image isCompactOperator_iff_exists_mem_nhds_isCompact_closure_image

end

section Bounded

variable {𝕜₁ 𝕜₂ : Type _} [NontriviallyNormedField 𝕜₁] [SeminormedRing 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂}
  {M₁ M₂ : Type _} [TopologicalSpace M₁] [AddCommMonoid M₁] [TopologicalSpace M₂] [AddCommMonoid M₂]
  [Module 𝕜₁ M₁] [Module 𝕜₂ M₂] [ContinuousConstSMul 𝕜₂ M₂]

theorem IsCompactOperator.image_subset_compact_of_vonN_bounded {f : M₁ →ₛₗ[σ₁₂] M₂}
    (hf : IsCompactOperator f) {S : Set M₁} (hS : IsVonNBounded 𝕜₁ S) :
    ∃ K : Set M₂, IsCompact K ∧ f '' S ⊆ K :=
  let ⟨K, hK, hKf⟩ := hf
  let ⟨r, hr, hrS⟩ := hS hKf
  let ⟨c, hc⟩ := NormedField.exists_lt_norm 𝕜₁ r
  let this := ne_zero_of_norm_ne_zero (hr.trans hc).Ne.symm
  ⟨σ₁₂ c • K, hK.image <| continuous_id.const_smul (σ₁₂ c), by
    rw [image_subset_iff, preimage_smul_setₛₗ _ _ _ f this.is_unit] <;> exact hrS c hc.le⟩
#align is_compact_operator.image_subset_compact_of_vonN_bounded IsCompactOperator.image_subset_compact_of_vonN_bounded

theorem IsCompactOperator.isCompact_closure_image_of_vonN_bounded [T2Space M₂] {f : M₁ →ₛₗ[σ₁₂] M₂}
    (hf : IsCompactOperator f) {S : Set M₁} (hS : IsVonNBounded 𝕜₁ S) :
    IsCompact (closure <| f '' S) :=
  let ⟨K, hK, hKf⟩ := hf.image_subset_compact_of_vonN_bounded hS
  isCompact_closure_of_subset_compact hK hKf
#align is_compact_operator.is_compact_closure_image_of_vonN_bounded IsCompactOperator.isCompact_closure_image_of_vonN_bounded

end Bounded

section NormedSpace

variable {𝕜₁ 𝕜₂ : Type _} [NontriviallyNormedField 𝕜₁] [SeminormedRing 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂}
  {M₁ M₂ M₃ : Type _} [SeminormedAddCommGroup M₁] [TopologicalSpace M₂] [AddCommMonoid M₂]
  [NormedSpace 𝕜₁ M₁] [Module 𝕜₂ M₂]

theorem IsCompactOperator.image_subset_compact_of_bounded [ContinuousConstSMul 𝕜₂ M₂]
    {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : IsCompactOperator f) {S : Set M₁} (hS : Metric.Bounded S) :
    ∃ K : Set M₂, IsCompact K ∧ f '' S ⊆ K :=
  hf.image_subset_compact_of_vonN_bounded
    (by rwa [NormedSpace.isVonNBounded_iff, ← Metric.bounded_iff_isBounded])
#align is_compact_operator.image_subset_compact_of_bounded IsCompactOperator.image_subset_compact_of_bounded

theorem IsCompactOperator.isCompact_closure_image_of_bounded [ContinuousConstSMul 𝕜₂ M₂]
    [T2Space M₂] {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : IsCompactOperator f) {S : Set M₁}
    (hS : Metric.Bounded S) : IsCompact (closure <| f '' S) :=
  hf.isCompact_closure_image_of_vonN_bounded
    (by rwa [NormedSpace.isVonNBounded_iff, ← Metric.bounded_iff_isBounded])
#align is_compact_operator.is_compact_closure_image_of_bounded IsCompactOperator.isCompact_closure_image_of_bounded

theorem IsCompactOperator.image_ball_subset_compact [ContinuousConstSMul 𝕜₂ M₂] {f : M₁ →ₛₗ[σ₁₂] M₂}
    (hf : IsCompactOperator f) (r : ℝ) : ∃ K : Set M₂, IsCompact K ∧ f '' Metric.ball 0 r ⊆ K :=
  hf.image_subset_compact_of_vonN_bounded (NormedSpace.isVonNBounded_ball 𝕜₁ M₁ r)
#align is_compact_operator.image_ball_subset_compact IsCompactOperator.image_ball_subset_compact

theorem IsCompactOperator.image_closedBall_subset_compact [ContinuousConstSMul 𝕜₂ M₂]
    {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : IsCompactOperator f) (r : ℝ) :
    ∃ K : Set M₂, IsCompact K ∧ f '' Metric.closedBall 0 r ⊆ K :=
  hf.image_subset_compact_of_vonN_bounded (NormedSpace.isVonNBounded_closedBall 𝕜₁ M₁ r)
#align is_compact_operator.image_closed_ball_subset_compact IsCompactOperator.image_closedBall_subset_compact

theorem IsCompactOperator.isCompact_closure_image_ball [ContinuousConstSMul 𝕜₂ M₂] [T2Space M₂]
    {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : IsCompactOperator f) (r : ℝ) :
    IsCompact (closure <| f '' Metric.ball 0 r) :=
  hf.isCompact_closure_image_of_vonN_bounded (NormedSpace.isVonNBounded_ball 𝕜₁ M₁ r)
#align is_compact_operator.is_compact_closure_image_ball IsCompactOperator.isCompact_closure_image_ball

theorem IsCompactOperator.isCompact_closure_image_closedBall [ContinuousConstSMul 𝕜₂ M₂]
    [T2Space M₂] {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : IsCompactOperator f) (r : ℝ) :
    IsCompact (closure <| f '' Metric.closedBall 0 r) :=
  hf.isCompact_closure_image_of_vonN_bounded (NormedSpace.isVonNBounded_closedBall 𝕜₁ M₁ r)
#align is_compact_operator.is_compact_closure_image_closed_ball IsCompactOperator.isCompact_closure_image_closedBall

theorem isCompactOperator_iff_image_ball_subset_compact [ContinuousConstSMul 𝕜₂ M₂]
    (f : M₁ →ₛₗ[σ₁₂] M₂) {r : ℝ} (hr : 0 < r) :
    IsCompactOperator f ↔ ∃ K : Set M₂, IsCompact K ∧ f '' Metric.ball 0 r ⊆ K :=
  ⟨fun hf => hf.image_ball_subset_compact r, fun ⟨K, hK, hKr⟩ =>
    (isCompactOperator_iff_exists_mem_nhds_image_subset_compact f).mpr
      ⟨Metric.ball 0 r, ball_mem_nhds _ hr, K, hK, hKr⟩⟩
#align is_compact_operator_iff_image_ball_subset_compact isCompactOperator_iff_image_ball_subset_compact

theorem isCompactOperator_iff_image_closedBall_subset_compact [ContinuousConstSMul 𝕜₂ M₂]
    (f : M₁ →ₛₗ[σ₁₂] M₂) {r : ℝ} (hr : 0 < r) :
    IsCompactOperator f ↔ ∃ K : Set M₂, IsCompact K ∧ f '' Metric.closedBall 0 r ⊆ K :=
  ⟨fun hf => hf.image_closedBall_subset_compact r, fun ⟨K, hK, hKr⟩ =>
    (isCompactOperator_iff_exists_mem_nhds_image_subset_compact f).mpr
      ⟨Metric.closedBall 0 r, closedBall_mem_nhds _ hr, K, hK, hKr⟩⟩
#align is_compact_operator_iff_image_closed_ball_subset_compact isCompactOperator_iff_image_closedBall_subset_compact

theorem isCompactOperator_iff_isCompact_closure_image_ball [ContinuousConstSMul 𝕜₂ M₂] [T2Space M₂]
    (f : M₁ →ₛₗ[σ₁₂] M₂) {r : ℝ} (hr : 0 < r) :
    IsCompactOperator f ↔ IsCompact (closure <| f '' Metric.ball 0 r) :=
  ⟨fun hf => hf.isCompact_closure_image_ball r, fun hf =>
    (isCompactOperator_iff_exists_mem_nhds_isCompact_closure_image f).mpr
      ⟨Metric.ball 0 r, ball_mem_nhds _ hr, hf⟩⟩
#align is_compact_operator_iff_is_compact_closure_image_ball isCompactOperator_iff_isCompact_closure_image_ball

theorem isCompactOperator_iff_isCompact_closure_image_closedBall [ContinuousConstSMul 𝕜₂ M₂]
    [T2Space M₂] (f : M₁ →ₛₗ[σ₁₂] M₂) {r : ℝ} (hr : 0 < r) :
    IsCompactOperator f ↔ IsCompact (closure <| f '' Metric.closedBall 0 r) :=
  ⟨fun hf => hf.isCompact_closure_image_closedBall r, fun hf =>
    (isCompactOperator_iff_exists_mem_nhds_isCompact_closure_image f).mpr
      ⟨Metric.closedBall 0 r, closedBall_mem_nhds _ hr, hf⟩⟩
#align is_compact_operator_iff_is_compact_closure_image_closed_ball isCompactOperator_iff_isCompact_closure_image_closedBall

end NormedSpace

end Characterizations

section Operations

variable {R₁ R₂ R₃ R₄ : Type _} [Semiring R₁] [Semiring R₂] [CommSemiring R₃] [CommSemiring R₄]
  {σ₁₂ : R₁ →+* R₂} {σ₁₄ : R₁ →+* R₄} {σ₃₄ : R₃ →+* R₄} {M₁ M₂ M₃ M₄ : Type _} [TopologicalSpace M₁]
  [AddCommMonoid M₁] [TopologicalSpace M₂] [AddCommMonoid M₂] [TopologicalSpace M₃]
  [AddCommGroup M₃] [TopologicalSpace M₄] [AddCommGroup M₄]

theorem IsCompactOperator.smul {S : Type _} [Monoid S] [DistribMulAction S M₂]
    [ContinuousConstSMul S M₂] {f : M₁ → M₂} (hf : IsCompactOperator f) (c : S) :
    IsCompactOperator (c • f) :=
  let ⟨K, hK, hKf⟩ := hf
  ⟨c • K, hK.image <| continuous_id.const_smul c,
    mem_of_superset hKf fun x hx => smul_mem_smul_set hx⟩
#align is_compact_operator.smul IsCompactOperator.smul

theorem IsCompactOperator.add [ContinuousAdd M₂] {f g : M₁ → M₂} (hf : IsCompactOperator f)
    (hg : IsCompactOperator g) : IsCompactOperator (f + g) :=
  let ⟨A, hA, hAf⟩ := hf
  let ⟨B, hB, hBg⟩ := hg
  ⟨A + B, hA.add hB,
    mem_of_superset (inter_mem hAf hBg) fun x ⟨hxA, hxB⟩ => Set.add_mem_add hxA hxB⟩
#align is_compact_operator.add IsCompactOperator.add

theorem IsCompactOperator.neg [ContinuousNeg M₄] {f : M₁ → M₄} (hf : IsCompactOperator f) :
    IsCompactOperator (-f) :=
  let ⟨K, hK, hKf⟩ := hf
  ⟨-K, hK.neg, mem_of_superset hKf fun x (hx : f x ∈ K) => Set.neg_mem_neg.mpr hx⟩
#align is_compact_operator.neg IsCompactOperator.neg

theorem IsCompactOperator.sub [TopologicalAddGroup M₄] {f g : M₁ → M₄} (hf : IsCompactOperator f)
    (hg : IsCompactOperator g) : IsCompactOperator (f - g) := by
  rw [sub_eq_add_neg] <;> exact hf.add hg.neg
#align is_compact_operator.sub IsCompactOperator.sub

variable (σ₁₄ M₁ M₄)

/-- The submodule of compact continuous linear maps. -/
def compactOperator [Module R₁ M₁] [Module R₄ M₄] [ContinuousConstSMul R₄ M₄]
    [TopologicalAddGroup M₄] : Submodule R₄ (M₁ →SL[σ₁₄] M₄)
    where
  carrier := { f | IsCompactOperator f }
  add_mem' f g hf hg := hf.add hg
  zero_mem' := isCompactOperator_zero
  smul_mem' c f hf := hf.smul c
#align compact_operator compactOperator

end Operations

section Comp

variable {R₁ R₂ R₃ : Type _} [Semiring R₁] [Semiring R₂] [Semiring R₃] {σ₁₂ : R₁ →+* R₂}
  {σ₂₃ : R₂ →+* R₃} {M₁ M₂ M₃ : Type _} [TopologicalSpace M₁] [TopologicalSpace M₂]
  [TopologicalSpace M₃] [AddCommMonoid M₁] [Module R₁ M₁]

theorem IsCompactOperator.comp_clm [AddCommMonoid M₂] [Module R₂ M₂] {f : M₂ → M₃}
    (hf : IsCompactOperator f) (g : M₁ →SL[σ₁₂] M₂) : IsCompactOperator (f ∘ g) :=
  by
  have := g.continuous.tendsto 0
  rw [map_zero] at this
  rcases hf with ⟨K, hK, hKf⟩
  exact ⟨K, hK, this hKf⟩
#align is_compact_operator.comp_clm IsCompactOperator.comp_clm

theorem IsCompactOperator.continuous_comp {f : M₁ → M₂} (hf : IsCompactOperator f) {g : M₂ → M₃}
    (hg : Continuous g) : IsCompactOperator (g ∘ f) :=
  by
  rcases hf with ⟨K, hK, hKf⟩
  refine' ⟨g '' K, hK.image hg, mem_of_superset hKf _⟩
  nth_rw 2 [preimage_comp]
  exact preimage_mono (subset_preimage_image _ _)
#align is_compact_operator.continuous_comp IsCompactOperator.continuous_comp

theorem IsCompactOperator.clm_comp [AddCommMonoid M₂] [Module R₂ M₂] [AddCommMonoid M₃]
    [Module R₃ M₃] {f : M₁ → M₂} (hf : IsCompactOperator f) (g : M₂ →SL[σ₂₃] M₃) :
    IsCompactOperator (g ∘ f) :=
  hf.continuous_comp g.Continuous
#align is_compact_operator.clm_comp IsCompactOperator.clm_comp

end Comp

section CodRestrict

variable {R₁ R₂ : Type _} [Semiring R₁] [Semiring R₂] {σ₁₂ : R₁ →+* R₂} {M₁ M₂ : Type _}
  [TopologicalSpace M₁] [TopologicalSpace M₂] [AddCommMonoid M₁] [AddCommMonoid M₂] [Module R₁ M₁]
  [Module R₂ M₂]

theorem IsCompactOperator.codRestrict {f : M₁ → M₂} (hf : IsCompactOperator f) {V : Submodule R₂ M₂}
    (hV : ∀ x, f x ∈ V) (h_closed : IsClosed (V : Set M₂)) :
    IsCompactOperator (Set.codRestrict f V hV) :=
  let ⟨K, hK, hKf⟩ := hf
  ⟨coe ⁻¹' K, (closedEmbedding_subtype_val h_closed).isCompact_preimage hK, hKf⟩
#align is_compact_operator.cod_restrict IsCompactOperator.codRestrict

end CodRestrict

section Restrict

variable {R₁ R₂ R₃ : Type _} [Semiring R₁] [Semiring R₂] [Semiring R₃] {σ₁₂ : R₁ →+* R₂}
  {σ₂₃ : R₂ →+* R₃} {M₁ M₂ M₃ : Type _} [TopologicalSpace M₁] [UniformSpace M₂]
  [TopologicalSpace M₃] [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid M₃] [Module R₁ M₁]
  [Module R₂ M₂] [Module R₃ M₃]

/-- If a compact operator preserves a closed submodule, its restriction to that submodule is
compact.

Note that, following mathlib's convention in linear algebra, `restrict` designates the restriction
of an endomorphism `f : E →ₗ E` to an endomorphism `f' : ↥V →ₗ ↥V`. To prove that the restriction
`f' : ↥U →ₛₗ ↥V` of a compact operator `f : E →ₛₗ F` is compact, apply
`is_compact_operator.cod_restrict` to `f ∘ U.subtypeL`, which is compact by
`is_compact_operator.comp_clm`. -/
theorem IsCompactOperator.restrict {f : M₁ →ₗ[R₁] M₁} (hf : IsCompactOperator f)
    {V : Submodule R₁ M₁} (hV : ∀ v ∈ V, f v ∈ V) (h_closed : IsClosed (V : Set M₁)) :
    IsCompactOperator (f.restrict hV) :=
  (hf.comp_clm V.subtypeL).codRestrict (SetLike.forall.2 hV) h_closed
#align is_compact_operator.restrict IsCompactOperator.restrict

/-- If a compact operator preserves a complete submodule, its restriction to that submodule is
compact.

Note that, following mathlib's convention in linear algebra, `restrict` designates the restriction
of an endomorphism `f : E →ₗ E` to an endomorphism `f' : ↥V →ₗ ↥V`. To prove that the restriction
`f' : ↥U →ₛₗ ↥V` of a compact operator `f : E →ₛₗ F` is compact, apply
`is_compact_operator.cod_restrict` to `f ∘ U.subtypeL`, which is compact by
`is_compact_operator.comp_clm`. -/
theorem IsCompactOperator.restrict' [SeparatedSpace M₂] {f : M₂ →ₗ[R₂] M₂}
    (hf : IsCompactOperator f) {V : Submodule R₂ M₂} (hV : ∀ v ∈ V, f v ∈ V)
    [hcomplete : CompleteSpace V] : IsCompactOperator (f.restrict hV) :=
  hf.restrict hV (completeSpace_coe_iff_isComplete.mp hcomplete).IsClosed
#align is_compact_operator.restrict' IsCompactOperator.restrict'

end Restrict

section Continuous

variable {𝕜₁ 𝕜₂ : Type _} [NontriviallyNormedField 𝕜₁] [NontriviallyNormedField 𝕜₂]
  {σ₁₂ : 𝕜₁ →+* 𝕜₂} [RingHomIsometric σ₁₂] {M₁ M₂ : Type _} [TopologicalSpace M₁] [AddCommGroup M₁]
  [TopologicalSpace M₂] [AddCommGroup M₂] [Module 𝕜₁ M₁] [Module 𝕜₂ M₂] [TopologicalAddGroup M₁]
  [ContinuousConstSMul 𝕜₁ M₁] [TopologicalAddGroup M₂] [ContinuousSMul 𝕜₂ M₂]

@[continuity]
theorem IsCompactOperator.continuous {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : IsCompactOperator f) :
    Continuous f :=
  by
  letI : UniformSpace M₂ := TopologicalAddGroup.toUniformSpace _
  haveI : UniformAddGroup M₂ := comm_topologicalAddGroup_is_uniform
  -- Since `f` is linear, we only need to show that it is continuous at zero.
  -- Let `U` be a neighborhood of `0` in `M₂`.
  refine' continuous_of_continuousAt_zero f fun U hU => _
  rw [map_zero] at hU
  -- The compactness of `f` gives us a compact set `K : set M₂` such that `f ⁻¹' K` is a
  -- neighborhood of `0` in `M₁`.
  rcases hf with ⟨K, hK, hKf⟩
  -- But any compact set is totally bounded, hence Von-Neumann bounded. Thus, `K` absorbs `U`.
  -- This gives `r > 0` such that `∀ a : 𝕜₂, r ≤ ‖a‖ → K ⊆ a • U`.
  rcases hK.totally_bounded.is_vonN_bounded 𝕜₂ hU with ⟨r, hr, hrU⟩
  -- Choose `c : 𝕜₂` with `r < ‖c‖`.
  rcases NormedField.exists_lt_norm 𝕜₁ r with ⟨c, hc⟩
  have hcnz : c ≠ 0 := ne_zero_of_norm_ne_zero (hr.trans hc).Ne.symm
  -- We have `f ⁻¹' ((σ₁₂ c⁻¹) • K) = c⁻¹ • f ⁻¹' K ∈ 𝓝 0`. Thus, showing that
  -- `(σ₁₂ c⁻¹) • K ⊆ U` is enough to deduce that `f ⁻¹' U ∈ 𝓝 0`.
  suffices (σ₁₂ <| c⁻¹) • K ⊆ U by
    refine' mem_of_superset _ this
    have : IsUnit c⁻¹ := hcnz.is_unit.inv
    rwa [mem_map, preimage_smul_setₛₗ _ _ _ f this, set_smul_mem_nhds_zero_iff (inv_ne_zero hcnz)]
    infer_instance
  -- Since `σ₁₂ c⁻¹` = `(σ₁₂ c)⁻¹`, we have to prove that `K ⊆ σ₁₂ c • U`.
  rw [map_inv₀, ← subset_set_smul_iff₀ ((map_ne_zero σ₁₂).mpr hcnz)]
  -- But `σ₁₂` is isometric, so `‖σ₁₂ c‖ = ‖c‖ > r`, which concludes the argument since
  -- `∀ a : 𝕜₂, r ≤ ‖a‖ → K ⊆ a • U`.
  refine' hrU (σ₁₂ c) _
  rw [RingHomIsometric.is_iso]
  exact hc.le
#align is_compact_operator.continuous IsCompactOperator.continuous

/-- Upgrade a compact `linear_map` to a `continuous_linear_map`. -/
def ContinuousLinearMap.mkOfIsCompactOperator {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : IsCompactOperator f) :
    M₁ →SL[σ₁₂] M₂ :=
  ⟨f, hf.Continuous⟩
#align continuous_linear_map.mk_of_is_compact_operator ContinuousLinearMap.mkOfIsCompactOperator

@[simp]
theorem ContinuousLinearMap.mkOfIsCompactOperator_to_linearMap {f : M₁ →ₛₗ[σ₁₂] M₂}
    (hf : IsCompactOperator f) :
    (ContinuousLinearMap.mkOfIsCompactOperator hf : M₁ →ₛₗ[σ₁₂] M₂) = f :=
  rfl
#align continuous_linear_map.mk_of_is_compact_operator_to_linear_map ContinuousLinearMap.mkOfIsCompactOperator_to_linearMap

@[simp]
theorem ContinuousLinearMap.coe_mkOfIsCompactOperator {f : M₁ →ₛₗ[σ₁₂] M₂}
    (hf : IsCompactOperator f) : (ContinuousLinearMap.mkOfIsCompactOperator hf : M₁ → M₂) = f :=
  rfl
#align continuous_linear_map.coe_mk_of_is_compact_operator ContinuousLinearMap.coe_mkOfIsCompactOperator

theorem ContinuousLinearMap.mkOfIsCompactOperator_mem_compactOperator {f : M₁ →ₛₗ[σ₁₂] M₂}
    (hf : IsCompactOperator f) :
    ContinuousLinearMap.mkOfIsCompactOperator hf ∈ compactOperator σ₁₂ M₁ M₂ :=
  hf
#align continuous_linear_map.mk_of_is_compact_operator_mem_compact_operator ContinuousLinearMap.mkOfIsCompactOperator_mem_compactOperator

end Continuous

/-- The set of compact operators from a normed space to a complete topological vector space is
closed. -/
theorem isClosed_setOf_isCompactOperator {𝕜₁ 𝕜₂ : Type _} [NontriviallyNormedField 𝕜₁]
    [NormedField 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂} {M₁ M₂ : Type _} [SeminormedAddCommGroup M₁]
    [AddCommGroup M₂] [NormedSpace 𝕜₁ M₁] [Module 𝕜₂ M₂] [UniformSpace M₂] [UniformAddGroup M₂]
    [ContinuousConstSMul 𝕜₂ M₂] [T2Space M₂] [CompleteSpace M₂] :
    IsClosed { f : M₁ →SL[σ₁₂] M₂ | IsCompactOperator f } :=
  by
  refine' isClosed_of_closure_subset _
  rintro u hu
  rw [mem_closure_iff_nhds_zero] at hu
  suffices TotallyBounded (u '' Metric.closedBall 0 1)
    by
    change IsCompactOperator (u : M₁ →ₛₗ[σ₁₂] M₂)
    rw [isCompactOperator_iff_isCompact_closure_image_closedBall (u : M₁ →ₛₗ[σ₁₂] M₂) zero_lt_one]
    exact isCompact_of_totallyBounded_isClosed this.closure isClosed_closure
  rw [totallyBounded_iff_subset_finite_unionᵢ_nhds_zero]
  intro U hU
  rcases exists_nhds_zero_half hU with ⟨V, hV, hVU⟩
  let SV : Set M₁ × Set M₂ := ⟨closed_ball 0 1, -V⟩
  rcases hu { f | ∀ x ∈ SV.1, f x ∈ SV.2 }
      (continuous_linear_map.has_basis_nhds_zero.mem_of_mem
        ⟨NormedSpace.isVonNBounded_closedBall _ _ _, neg_mem_nhds_zero M₂ hV⟩) with
    ⟨v, hv, huv⟩
  rcases totally_bounded_iff_subset_finite_Union_nhds_zero.mp
      (hv.is_compact_closure_image_closed_ball 1).TotallyBounded V hV with
    ⟨T, hT, hTv⟩
  have hTv : v '' closed_ball 0 1 ⊆ _ := subset_closure.trans hTv
  refine' ⟨T, hT, _⟩
  rw [image_subset_iff, preimage_Union₂] at hTv⊢
  intro x hx
  specialize hTv hx
  rw [mem_Union₂] at hTv⊢
  rcases hTv with ⟨t, ht, htx⟩
  refine' ⟨t, ht, _⟩
  rw [mem_preimage, mem_vadd_set_iff_neg_vadd_mem, vadd_eq_add, neg_add_eq_sub] at htx⊢
  convert hVU _ htx _ (huv x hx) using 1
  rw [ContinuousLinearMap.sub_apply]
  abel
#align is_closed_set_of_is_compact_operator isClosed_setOf_isCompactOperator

theorem compactOperator_topologicalClosure {𝕜₁ 𝕜₂ : Type _} [NontriviallyNormedField 𝕜₁]
    [NormedField 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂} {M₁ M₂ : Type _} [SeminormedAddCommGroup M₁]
    [AddCommGroup M₂] [NormedSpace 𝕜₁ M₁] [Module 𝕜₂ M₂] [UniformSpace M₂] [UniformAddGroup M₂]
    [ContinuousConstSMul 𝕜₂ M₂] [T2Space M₂] [CompleteSpace M₂]
    [ContinuousSMul 𝕜₂ (M₁ →SL[σ₁₂] M₂)] :
    (compactOperator σ₁₂ M₁ M₂).topologicalClosure = compactOperator σ₁₂ M₁ M₂ :=
  SetLike.ext' isClosed_setOf_isCompactOperator.closure_eq
#align compact_operator_topological_closure compactOperator_topologicalClosure

theorem isCompactOperator_of_tendsto {ι 𝕜₁ 𝕜₂ : Type _} [NontriviallyNormedField 𝕜₁]
    [NormedField 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂} {M₁ M₂ : Type _} [SeminormedAddCommGroup M₁]
    [AddCommGroup M₂] [NormedSpace 𝕜₁ M₁] [Module 𝕜₂ M₂] [UniformSpace M₂] [UniformAddGroup M₂]
    [ContinuousConstSMul 𝕜₂ M₂] [T2Space M₂] [CompleteSpace M₂] {l : Filter ι} [l.ne_bot]
    {F : ι → M₁ →SL[σ₁₂] M₂} {f : M₁ →SL[σ₁₂] M₂} (hf : Tendsto F l (𝓝 f))
    (hF : ∀ᶠ i in l, IsCompactOperator (F i)) : IsCompactOperator f :=
  isClosed_setOf_isCompactOperator.mem_of_tendsto hf hF
#align is_compact_operator_of_tendsto isCompactOperator_of_tendsto


import data.polynomial

universe u
variables {K : Type u} {L : Type u} [discrete_field K] [discrete_field L]
  (i : K ≃r L)

open polynomial

-- polynomial.map is very hard to use
example (f : polynomial L) (x : K) (hfx : f.eval₂ i.symm.to_equiv x = 0) :
  ∃ y : L, f.eval y = 0 :=
⟨i.to_equiv x, begin
  rw [← i.symm.to_equiv.injective.eq_iff],
  -- cannot find the pattern, but it is there
  rw [← eval₂_hom],

end⟩


import data.nat.basic

example (n : ℕ) (h : n < 2) : n = 0 ∨ n = 1 :=
by dec_trivial!

example (n : ℕ) (h : n < 3) : true :=
begin
  let k : ℕ := n - 1,
  have : ∀ i < k, i = 0 ∨ i = 1,
  by dec_trivial!,
  trivial
end

example (b : bool) (h : b = tt) : true :=
begin
  let b₁ : bool := b,
  have : ∀ b₂ : bool, b₂ ≠ b₁ → b₂ = ff,
  by dec_trivial!,
  trivial
end

example (n : ℕ) : (0 : fin (n+1)) + 0 = 0 :=
begin
  success_if_fail { dec_trivial! },
  dec_trivial
end


import data.real.basic
import game.Completeness.level04
import game.Completeness.level02

noncomputable theory
open_locale classical

definition has_lub (S : set ℝ) := ∃ x, is_lub S x

--sup(S) - ε < s < sup(S)

--lemma thinklater (S : set ℝ) (x y ε : ℝ) (H : has_lub S) (S ≠ ∅) (hy : is_sup S y) :
  --∀ ε > 0, ∃ x ∈ S, is_sup S y - ε < x ∧ x ≤ is_sup S y :=

lemma do_now {x : ℝ} {S : set ℝ} (h : S ≠ ∅) (Hsup : is_sup S x)  : (∀ ε > 0, ∃ s ∈ S, x-ε<s ∧ s ≤ x) :=
begin

    rw is_sup at Hsup,
    cases Hsup with a ha,
    rw upper_bound at a,

    intro ε, intro h,
    use x, split, swap,

    split,
    linarith, linarith,

     -- rewrite this level cause I am pretty sure it is written incorrectly

end


import o_minimal.examples.isolating

-- Simple functions: just constants and coordinates.
-- We prove they determine an o-minimal structure on any DUNLO.

namespace o_minimal

universe u

variables (R : Type u)

/-- Codes for simple functions: constants and coordinate projections. -/
inductive simple_function_type (n : ℕ) : Type u
| const : Π (r : R),     simple_function_type
| coord : Π (i : fin n), simple_function_type

namespace simple_function_type

variables {R}

/-- The interpretation of a code for a simple function. -/
protected def to_fun {n : ℕ} : simple_function_type R n → finvec n R → R
| (const r) := λ x, r
| (coord i) := λ x, x i

/-- (The code for) the extension of a simple function by an argument on the left. -/
def extend_left {n : ℕ} :
  simple_function_type R n → simple_function_type R (n+1)
| (const r) := const r
| (coord i) := coord i.succ

lemma to_fun_extend_left {n : ℕ} (f : simple_function_type R n) :
  f.extend_left.to_fun = f.to_fun ∘ finvec.tail :=
by cases f; ext; simp [simple_function_type.to_fun, extend_left, finvec.tail]

def extend_right {n : ℕ} :
  simple_function_type R n → simple_function_type R (n+1)
| (const r) := const r
| (coord i) := coord i.cast_succ

lemma to_fun_extend_right {n : ℕ} (f : simple_function_type R n) :
  f.extend_right.to_fun = f.to_fun ∘ finvec.init :=
by cases f; ext; simp [simple_function_type.to_fun, extend_right, finvec.init]

end simple_function_type

open simple_function_type

/-- The family of simple functions, consisting of just constants and coordinate projections. -/
def simple_function_family : function_family R :=
{ carrier := simple_function_type R,
  to_fun := @simple_function_type.to_fun R,
  const := λ n r, const r,
  to_fun_const := λ n r, rfl,
  coord := λ n i, coord i,
  to_fun_coord := λ n i, rfl,
  extend_left := @extend_left R,
  to_fun_extend_left := @to_fun_extend_left R,
  extend_right := @extend_right R,
  to_fun_extend_right := @to_fun_extend_right R }

-- TODO: Add some simp lemmas, phrased in terms of coercions

variables {R}

/-- A simple function in n+1 variables is either the last coordinate
or can be pushed down to a simple function in n variables. -/
lemma simple.last_coord_or_push {n : ℕ} :
  ∀ (f : simple_function_family R (n+1)),
  f = (simple_function_family R).coord (fin.last n) ∨
  ∃ f', f = (simple_function_family R).extend_right f'
| (simple_function_type.const r) := or.inr ⟨simple_function_type.const r, rfl⟩
| (simple_function_type.coord i) :=
begin
  -- TODO: simplify & share logic with `fin.snoc`?
  by_cases h : i < fin.last n,
  { refine or.inr ⟨simple_function_type.coord (fin.cast_lt i h), _⟩,
    change _ = simple_function_type.coord _,
    rw fin.cast_succ_cast_lt i h },
  { replace h := fin.eq_last_of_not_lt h,
    subst i,
    refine or.inl rfl }
end

variables [DUNLO R]

lemma simple_function_family_is_isolating : (simple_function_family R).is_isolating :=
begin
  -- Analyze the given constraint and push down the functions if possible: 8 cases
  rintros n _ hs,
  rcases hs with (⟨f,g⟩|⟨f,g⟩); clear hs;
    rcases simple.last_coord_or_push f with rfl|⟨f', rfl⟩;
    rcases simple.last_coord_or_push g with rfl|⟨g', rfl⟩,
  { refine ⟨isolated_constraint.tt, _⟩,
    simp [isolated_constraint.to_set], refl },
  { exact ⟨isolated_constraint.eq g', rfl⟩ },
  { refine ⟨isolated_constraint.eq f', _⟩,
    conv_rhs { funext, rw eq_comm },
    refl },
  { exact ⟨isolated_constraint.push_eq f' g', rfl⟩ },
  { refine ⟨isolated_constraint.ff, _⟩,
    simp [isolated_constraint.to_set], refl },
  { refine ⟨isolated_constraint.lt g', rfl⟩ },
  { refine ⟨isolated_constraint.gt f', _⟩,
    conv_rhs { funext, rw ←gt_iff_lt },
    refl },
  { refine ⟨isolated_constraint.push_lt f' g', rfl⟩ }
end

/-- The structure defined by (R, <). -/
def simple_struc : struc R := struc_of_isolating' simple_function_family_is_isolating

/-- The structure defined by (R, <) is o-minimal. -/
instance : o_minimal (simple_struc : struc R) := by apply o_minimal_of_isolating

end o_minimal


inductive MyFin : Nat → Type
  | z : MyFin (n+1)
  | s : MyFin n → MyFin (n+1)

theorem ex1 (x : MyFin 0) : False := by
  contradiction

inductive Color
| Red
| Black
open Color

inductive rbnode : Nat → Color → Type where
  | Leaf : rbnode 1 Black
  | R {h}
      (left : rbnode h Black)
      (value : Int)
      (right : rbnode h Black) : rbnode h Red
  | B {h cl cr}
      (left : rbnode h cl)
      (value : Int)
      (right : rbnode h cr) : rbnode (h+1) Black

theorem ex2 (x : rbnode 0 Color.Red) : False := by
  contradiction


import data.real.basic
import combinatorics.simplicial_complex.basic
import combinatorics.simplicial_complex.finite
import combinatorics.simplicial_complex.sperner

variables {m n : ℕ}
local notation `E` := fin m → ℝ

noncomputable def barycenter(L: list E): E :=
  (list.foldl (λ x:E , λ y:E, x + y) (0 : E) L) / L.length

variables (L : list E) [pseudo_metric_space E]

namespace list

-- Given an order of the vertices of each face, we have a simplex of the barycentric subdivision.
  -- Recursive definition
  -- If L.length > 1,
  -- add the point `barycenter L` and all the points of `face_barycentric_subdivision L.tail`
  -- If L.length = 1, add the point.

noncomputable def face_baricentric_subdivision(L : list E) : finset E :=
  begin
    induction L with head tail smaller_dim_baricentric_subdivision,
    { exact (∅ : finset E) },
    { exact { barycenter (list.cons head tail) } ∪ smaller_dim_baricentric_subdivision },
  end

open affine

-- The goal is to complete this definition.
noncomputable def simplicial_complex.barycentric_subdivision (S : simplicial_complex E) : simplicial_complex E :=
  { faces := {X | ∃ {L : list E}, list.nodup L ∧ list.to_finset L ∈ S.faces ∧ X = face_baricentric_subdivision L},
  indep :=
    begin
      rintros face ⟨vertex_list, ⟨vertex_nodup, ⟨h_face3, face_from_vertex_list⟩⟩⟩,
      cases S,
      simp at h_face3,
      -- help?
      sorry,
    end,
  down_closed := sorry,
  disjoint := sorry }

-- The maximum distance bewteen any pair of vertices in a simplicial complex.
noncomputable def distance_vertices  (A : set E) : ℝ :=
  metric.diam A
  --Sup {d | ∃ x y ∈ A, d = edist x y}

lemma distance_vertices_eq_diam_convexhull(A : set E):
  metric.diam (convex_hull A) = metric.diam A :=
  begin
    -- apply convex_hull_diam,
    sorry,
  end

open affine
open set

-- simplicial_complex.mesh_size
def diameter (S: simplicial_complex E) [simplicial_complex.finite S]: ℝ :=
 sorry
 -- maxim diametre entre totes les cares.

end list


import analysis.special_functions.pow
import analysis.specific_limits.basic
import analysis.normed_space.basic
import analysis.mean_inequalities_pow
import category_theory.Fintype

import pseudo_normed_group.basic
import pseudo_normed_group.category

import for_mathlib.nnreal
import for_mathlib.real

/-

# Real measures

If `p : ℝ≥0` and `S : Fintype` then `real_measures p S` is just the functions
from `S` to `ℝ`, equipped with its `ℓᵖ` norm.
-/
universe u

noncomputable theory
open_locale big_operators nnreal classical

/-- `real_measures p S` is the vector space of maps `S → ℝ` equipped with the `ℓᵖ` norm,
which gives it the structure of a `CompHausl`y-filtered normed group.  -/
@[nolint unused_arguments, derive add_comm_group]
def real_measures (p : ℝ≥0) (S : Fintype) := S → ℝ

variables {p : ℝ≥0} {S S' : Fintype.{u}}

local notation `ℳ` := real_measures
local notation `ϖ` := Fintype.of punit

namespace real_measures

@[simp] lemma zero_apply (s : S) : (0 : ℳ p S) s = 0 := rfl

@[simp] lemma add_apply (F G : ℳ p S) (s : S) : (F + G) s = F s + G s := rfl

@[simp] lemma neg_apply (F : ℳ p S) (s : S) : (-F) s = - (F s) := rfl

@[simp] lemma sub_apply (F G : ℳ p S) (s : S) : (F - G) s = F s - G s := rfl

instance : has_norm (ℳ p S) := ⟨λ F, ∑ s, ∥F s∥ ^ (p:ℝ)⟩

lemma norm_def (F : ℳ p S) : ∥F∥ = ∑ s, ∥F s∥ ^ (p:ℝ) := rfl

instance : has_nnnorm (ℳ p S) := ⟨λ F, ∑ s, ∥F s∥₊ ^ (p:ℝ)⟩

lemma nnnorm_def (F : ℳ p S) : ∥F∥₊ = ∑ s, ∥F s∥₊ ^ (p:ℝ) := rfl

@[simp] protected lemma coe_nnnorm (F : ℳ p S) : (∥F∥₊ : ℝ) = ∥F∥ :=
by simp only [norm_def, nnnorm_def, nnreal.coe_sum, nnreal.coe_rpow, coe_nnnorm]

lemma real_measures.norm_nonneg (F : ℳ p S) : 0 ≤ ∥ F ∥ := by {rw [← F.coe_nnnorm], from ∥ F ∥₊.2}

@[simp] protected lemma nnnorm_zero [hp : fact (0 < p)] : ∥(0 : ℳ p S)∥₊ = 0 :=
begin
  rw [nnnorm_def, finset.sum_eq_zero],
  rintro s -,
  rw [zero_apply, nnnorm_zero, nnreal.zero_rpow],
  exact_mod_cast hp.out.ne',
end

protected lemma nnnorm_add [h0p : fact (0 ≤ p)] [hp1 : fact (p ≤ 1)]
  (F G : ℳ p S) : ∥F + G∥₊ ≤ ∥F∥₊ + ∥G∥₊ :=
begin
  dsimp [nnnorm_def],
  rw ← finset.sum_add_distrib,
  apply finset.sum_le_sum,
  intros s hs,
  have h0p' : (0 : ℝ) ≤ p, exact_mod_cast h0p.out,
  have hp1' : (p : ℝ) ≤ 1, exact_mod_cast hp1.out,
  exact (nnreal.rpow_le_rpow (nnnorm_add_le _ _) h0p').trans
    (@nnreal.rpow_add_le_add_rpow p (∥F s∥₊) (∥G s∥₊) h0p' hp1'),
end

--needed? [FAE] Yes!
instance png_real_measures [fact (0 < p)] [fact (p ≤ 1)] : pseudo_normed_group (ℳ p S) :=
{ filtration := λ c, { F | ∥F∥₊ ≤ c },
  filtration_mono := λ c₁ c₂ h F hF, by {dsimp at *, exact le_trans hF h},
  zero_mem_filtration := λ c, by simp only [real_measures.nnnorm_zero, zero_le', set.mem_set_of_eq],
  neg_mem_filtration := λ c F h, by { dsimp [nnnorm_def] at *, simp only [h, nnnorm_neg] },
  add_mem_filtration := λ c₁ c₂ F₁ F₂ h₁ h₂,
    (real_measures.nnnorm_add _ _).trans (add_le_add h₁ h₂) }

lemma mem_filtration_iff [fact (0 < p)] [fact (p ≤ 1)] (F : ℳ p S) (c : ℝ≥0) :
  F ∈ pseudo_normed_group.filtration (ℳ p S) c ↔ ∥F∥₊ ≤ c := iff.rfl

def map (f : S ⟶ S') : ℳ p S → ℳ p S' :=
λ F s', ∑ s in finset.univ.filter (λ t, f t = s'), F s

@[simp]
lemma map_apply (f : S ⟶ S') (F : ℳ p S) (s' : S') :
  map f F s' = ∑ s in finset.univ.filter (λ t, f t = s'), F s := rfl

@[simp]
lemma map_id : (map (𝟙 S) : ℳ p S → ℳ p S) = id :=
begin
  ext F s,
  rw [map_apply, finset.sum_filter, id.def],
  simp only [Fintype.id_apply, finset.sum_ite_eq', finset.mem_univ, if_true],
end

@[simp]
lemma map_comp {S'' : Fintype.{u}} (f : S ⟶ S') (g : S' ⟶ S'') :
  (map (f ≫ g) : ℳ p S → ℳ p S'') = map g ∘ map f :=
begin
  ext F s,
  simp only [function.comp_app, map_apply],
  convert finset.sum_bUnion _ using 1, swap 2, { classical, apply_instance },
  { apply finset.sum_congr,
    { change finset.univ.filter (λ t, g (f t) = s) = _,
      ext i,
      simp only [true_and, exists_prop, finset.mem_univ, finset.mem_bUnion,
        exists_eq_right', finset.mem_filter] },
    { intros, refl } },
  { intros i hi j hj h k hk,
    refine h _,
    simp only [true_and, finset.inf_eq_inter, finset.mem_univ,
      finset.mem_filter, finset.mem_inter] at hk,
    rw [← hk.1, ← hk.2] }
end

lemma map_bound [h0p : fact (0 < p)] [hp1 : fact (p ≤ 1)] (f : S ⟶ S') (F : ℳ p S) :
  ∥map f F∥₊ ≤ ∥F∥₊ :=
begin
  calc ∑ s', ∥∑ s in finset.univ.filter (λ t, f t = s'), F s∥₊ ^ (p:ℝ)
      ≤ ∑ s' : S', ∑ s in finset.univ.filter (λ t, f t = s'), ∥F s∥₊ ^ (p:ℝ) : _
  ... = ∑ s, ∥F s∥₊ ^ (p:ℝ) : _,
  { apply finset.sum_le_sum,
    rintros s' -,
    have h0p' : (0 : ℝ) < p, exact_mod_cast h0p.out,
    have hp1' : (p : ℝ) ≤ 1, exact_mod_cast hp1.out,
    exact (nnreal.rpow_le_rpow (nnnorm_sum_le _ _) h0p'.le).trans
      (nnreal.rpow_sum_le_sum_rpow _ _ h0p' hp1'), },
  { rw ← finset.sum_bUnion,
    { refine finset.sum_congr _ _,
      { ext s,
        simp only [true_and, finset.mem_univ, finset.mem_bUnion, iff_true,
          exists_true_left, finset.mem_filter],
        refine ⟨_, rfl⟩, },
      { intros, refl } },
    { rintro x - y - h i hi,
      apply h,
      simp only [true_and, finset.inf_eq_inter, finset.mem_univ,
        finset.mem_filter, finset.mem_inter] at hi,
      rw [← hi.1, ← hi.2] } },
end

def seval_ℳ {r : ℝ≥0} (S : Fintype) (s : S): (real_measures r S) →
  (real_measures r (Fintype.of punit)) := λ F, (λ _, F s)

variables [fact (0 < p)] [fact (p ≤ 1)]

open pseudo_normed_group (filtration)

instance topological_space (c : ℝ≥0) : topological_space (filtration (ℳ p S) c) :=
@subtype.topological_space _ _ Pi.topological_space

instance t2_space (c : ℝ≥0) : t2_space (filtration (ℳ p S) c) :=
@subtype.t2_space _ _ Pi.topological_space _

lemma nnnorm_apply_le_of_nnnorm_le (F : ℳ p S) (s : S) (c : ℝ≥0) (h : ∥F∥₊ ≤ c) :
  ∥F s∥₊ ≤ c ^ (p⁻¹ : ℝ) :=
begin
  calc ∥F s∥₊ = (∥F s∥₊ ^ (p:ℝ)) ^ (p⁻¹ : ℝ) : _
  ... ≤ c ^ (p⁻¹ : ℝ) : _,
  { rw_mod_cast [← nnreal.rpow_mul, mul_inv_cancel, nnreal.rpow_one],
    exact ne_of_gt (‹fact (0 < p)›.out) },
  { apply nnreal.rpow_le_rpow _ (inv_pos.mpr _).le,
    { refine le_trans _ h,
      have aux := finset.sum_pi_single' s (∥F s∥₊ ^ (p:ℝ)) finset.univ,
      simp only [finset.mem_univ, if_true] at aux,
      rw ← aux,
      apply finset.sum_le_sum,
      rintro t -,
      split_ifs, { subst t }, { exact zero_le' } },
    { norm_cast, exact ‹fact (0 < p)›.out } }
end

lemma apply_mem_Icc_of_nnnorm_le (F : ℳ p S) (s : S) (c : ℝ≥0) (h : ∥F∥₊ ≤ c) :
  F s ∈ set.Icc (-c ^ (p⁻¹ : ℝ) : ℝ) (c ^ (p⁻¹ : ℝ) : ℝ) :=
begin
  have := @set.mem_Icc_iff_abs_le ℝ _ 0 (F s) (c ^ (p:ℝ)⁻¹),
  simp only [zero_sub, abs_neg, zero_add, ← real.norm_eq_abs, ← coe_nnnorm, nnnorm_neg] at this,
  rw ← this,
  norm_cast,
  exact nnnorm_apply_le_of_nnnorm_le F s c h
end

-- move me
lemma continuous.sum {ι X A : Type*} [topological_space X]
  [topological_space A] [add_comm_monoid A] [has_continuous_add A]
  (s : finset ι) (f : ι → X → A) (hf : ∀ i ∈ s, continuous (f i)) :
  continuous (∑ i in s, f i) :=
begin
  induction s using finset.induction_on with i s his IH,
  { simp only [finset.sum_empty], exact @continuous_zero X A _ _ _ },
  { simp only [his, finset.sum_insert, not_false_iff],
    refine (hf i $ s.mem_insert_self i).add (IH $ λ i hi, hf i $ finset.mem_insert_of_mem hi), }
end

-- move me
lemma continuous.sum' {ι X A : Type*} [topological_space X]
  [topological_space A] [add_comm_monoid A] [has_continuous_add A]
  (s : finset ι) (f : ι → X → A) (hf : ∀ i ∈ s, continuous (f i)) :
  continuous (λ x, ∑ i in s, f i x) :=
begin
  induction s using finset.induction_on with i s his IH,
  { simp only [finset.sum_empty], exact @continuous_zero X A _ _ _ },
  { simp only [his, finset.sum_insert, not_false_iff],
    refine (hf i $ s.mem_insert_self i).add (IH $ λ i hi, hf i $ finset.mem_insert_of_mem hi), }
end

instance compact_space (c : ℝ≥0) : compact_space (filtration (ℳ p S) c) :=
begin
  constructor,
  rw [← embedding_subtype_coe.to_inducing.is_compact_iff],
  simp only [set.image_univ, subtype.range_coe_subtype, set.set_of_mem_eq],
  let d : ℝ := c ^ (p⁻¹ : ℝ),
  let T : set (S → ℝ) := {x | ∀ s, x s ∈ set.Icc (-d) d},
  have hT : is_compact T := is_compact_pi_infinite (λ s, is_compact_Icc),
  refine compact_of_is_closed_subset hT _ (λ F hF s, apply_mem_Icc_of_nnnorm_le F s c hF),
  refine is_closed_le (continuous.sum' _ _ _) continuous_const,
  rintro s -,
  have h0p : 0 ≤ (p : ℝ), { norm_cast, exact fact.out _ },
  exact (nnreal.continuous_rpow_const h0p).comp (continuous_nnnorm.comp (continuous_apply s)),
end

open metric

def equiv_filtration_ϖ_ball (c : ℝ≥0) : filtration (ℳ p ϖ) c ≃ closed_ball (0 : ℝ)
  (c ^ (p⁻¹ : ℝ) : ℝ≥0):=
{ to_fun := λ f, ⟨f.1 punit.star, begin
    simp only [mem_closed_ball_zero_iff],
    have hf := (mem_filtration_iff f.1 c).mp f.2,
    simp only [← nnreal.coe_le_coe, real_measures.coe_nnnorm, nnnorm_def, fintype.univ_punit, finset.sum_singleton, norm_def]
      at hf,
    have := @nnreal.rpow_le_rpow_iff (∥f.1 punit.star∥₊) (c ^ (p⁻¹ : ℝ)) p _,
    rw [← nnreal.rpow_mul, inv_mul_cancel, nnreal.rpow_one] at this,
    exact this.mp hf,
    exact (nnreal.coe_ne_zero.mpr (ne_of_gt (fact.out _))),
    rw ← nnreal.coe_zero,
    exact nnreal.coe_lt_coe.mpr (fact.out _),
  end⟩,
  inv_fun := λ x, ⟨λ _, x, begin
    have := @real.rpow_le_rpow_iff (|↑x| : ℝ) (c ^ (p⁻¹ : ℝ)) p _ _ _,
    rw [← real.rpow_mul, inv_mul_cancel, real.rpow_one] at this,
    have hx := x.2,
    simp only [mem_filtration_iff, subtype.val_eq_coe, nnnorm, fintype.univ_punit,
      finset.sum_singleton, ← nnreal.coe_le_coe, nnreal.coe_rpow, subtype.coe_mk, real.norm_eq_abs,
      this, abs_le, mem_closed_ball_zero_iff] at hx ⊢,
    exact hx,
    { rw nnreal.coe_ne_zero,
      exact ne_of_gt (fact.out _) },
    { exact c.2 },
    { exact abs_nonneg x },
    { rw ← nnreal.coe_rpow,
     exact (c ^ (p⁻¹ : ℝ)).2 },
    { rw [← nnreal.coe_zero, nnreal.coe_lt_coe],
      exact fact.out _ }
  end⟩,
  left_inv := begin
    intro,
      ext,
      simp only [subtype.val_eq_coe, subtype.coe_mk],
      apply congr_arg,
      simp only [eq_iff_true_of_subsingleton]
  end,
  right_inv := begin
    intro,
    simp only [subtype.coe_eta]
  end }

def homeo_filtration_ϖ_ball (c : ℝ≥0) : filtration (ℳ p ϖ) c ≃ₜ closed_ball (0 : ℝ)
  (c ^ (p⁻¹ : ℝ) : ℝ≥0) :=
{ to_equiv := equiv_filtration_ϖ_ball c,
  continuous_to_fun := begin
    refine continuous.subtype_mk _ _,
    exact continuous.comp (continuous_apply punit.star) continuous_subtype_coe,
  end,
  continuous_inv_fun := begin
    simp only [equiv_filtration_ϖ_ball],
    continuity,
  end
}

lemma real_measures.dist_eq {c : ℝ≥0} (F G : filtration (ℳ p ϖ) c) : ∥ F.1 - G.1 ∥ ^ (p⁻¹ : ℝ) =
  | ((homeo_filtration_ϖ_ball c F) - (homeo_filtration_ϖ_ball c G) : ℝ)| :=
begin
  have hp : (p : ℝ) ≠ 0,
  { rw ← nnreal.coe_zero,
    exact (ne_of_gt (nnreal.coe_lt_coe.mpr (fact.out _))) },
  simp only [norm_def, fintype.univ_punit, subtype.val_eq_coe, sub_apply, finset.sum_singleton,
    ← real.rpow_mul (norm_nonneg _), mul_inv_cancel hp],
  simpa only [real.rpow_one, real.norm_eq_abs],
end

instance {c : ℝ≥0} : has_zero (closed_ball (0 : ℝ) c):=
  { zero := ⟨0, by {simp only [mem_closed_ball_zero_iff, norm_zero, nnreal.zero_le_coe]}⟩}

lemma homeo_filtration_ϖ_ball_preimage {c ε: ℝ≥0} (h : ε ^ (p : ℝ) ≤ c) :
  (homeo_filtration_ϖ_ball c)⁻¹' (closed_ball 0 ε) =
  (set.range (set.inclusion (@pseudo_normed_group.filtration_mono (ℳ p ϖ) _ _ _ h))) :=
begin
  ext ⟨x, hx⟩,
  simp only [homeo_filtration_ϖ_ball, equiv_filtration_ϖ_ball, subtype.val_eq_coe, subtype.coe_mk,
    homeomorph.homeomorph_mk_coe, equiv.coe_fn_mk, set.mem_preimage, mem_closed_ball, dist_le_coe,
    set.range_inclusion, set.mem_set_of_eq],
  change _ ↔ ∑ s : punit, ∥x s∥₊ ^ (p:ℝ) ≤ _,
  simp only [fintype.univ_punit, finset.sum_singleton],
  rw nnreal.rpow_le_rpow_iff,
  { convert iff.rfl,
    convert (sub_zero _).symm },
  { norm_cast, exact fact.elim infer_instance },
end

-- **[FAE]** The following ones with `_Icc_` might be useless

-- def equiv_filtration_ϖ_Icc (c : ℝ≥0) : filtration (ℳ p ϖ) c ≃ set.Icc ((- c ^ (p⁻¹ : ℝ)) : ℝ)
--   (c ^ (p⁻¹ : ℝ)):=
-- begin
--   fconstructor,
--   { intro f,
--     exact ⟨f.1 punit.star, apply_mem_Icc_of_nnnorm_le _ _ _ f.2⟩ },
--   { intro x,
--     use (λ _, x),
--     have := @real.rpow_le_rpow_iff (|↑x| : ℝ) (c ^ (p⁻¹ : ℝ)) p _ _ _,
--     rw [← real.rpow_mul, inv_mul_cancel, real.rpow_one] at this,
--     have hx := x.2,
--     simpa only [mem_filtration_iff, subtype.val_eq_coe, set.mem_Icc, nnnorm, fintype.univ_punit,
--       finset.sum_singleton, ← nnreal.coe_le_coe, nnreal.coe_rpow, subtype.coe_mk, real.norm_eq_abs,
--       this, abs_le],
--     { rw nnreal.coe_ne_zero,
--       exact ne_of_gt (fact.out _) },
--     { exact c.2 },
--     { exact abs_nonneg x },
--     { rw ← nnreal.coe_rpow,
--      exact (c ^ (p⁻¹ : ℝ)).2 },
--     { rw [← nnreal.coe_zero, nnreal.coe_lt_coe],
--       exact fact.out _ } },
--     { intro f,
--       ext s,
--       simp only [subtype.val_eq_coe, subtype.coe_mk],
--       apply congr_arg,
--       simp only [eq_iff_true_of_subsingleton] },
--     { intro x,
--       simp only [subtype.coe_eta] },
-- end

-- def homeo_filtration_ϖ_Icc (c : ℝ≥0) : filtration (ℳ p ϖ) c ≃ₜ set.Icc ((- c ^ (p⁻¹ : ℝ)) : ℝ)
--   (c ^ (p⁻¹ : ℝ)) :=
-- { to_equiv := equiv_filtration_ϖ_Icc c,
--   continuous_to_fun := admit,
--   continuous_inv_fun := admit
-- }

-- lemma homeo_filtration_ϖ_Icc_apply (c c': ℝ≥0) (h : c ≤ c') :
-- (homeo_filtration_ϖ_Icc c').to_fun '' (set.range (set.inclusion (@pseudo_normed_group.filtration_mono (ℳ p ϖ) _ _ _ h)))
--   = ⊥ := --set.Icc ((- c ^ (p⁻¹ : ℝ)) : ℝ) ((c ^ (p⁻¹ : ℝ) : ℝ)) :=
-- begin
--   admit,
-- end

instance chpng_real_measures : comphaus_filtered_pseudo_normed_group (ℳ p S) :=
{ continuous_add' := begin
    intros c₁ c₂,
    rw continuous_induced_rng,
    simp only [function.comp, pseudo_normed_group.add'_eq],
    exact (continuous_subtype_val.comp continuous_fst).add
          (continuous_subtype_val.comp continuous_snd),
  end,
  continuous_neg' := begin
    intros c,
    rw continuous_induced_rng,
    simp only [function.comp, pseudo_normed_group.neg'_eq],
    exact continuous_subtype_val.neg,
  end,
  continuous_cast_le := begin
    introsI c₁ c₂ h,
    rw continuous_induced_rng,
    simp only [function.comp, pseudo_normed_group.coe_cast_le],
    exact continuous_subtype_val,
  end,
  ..(infer_instance : (pseudo_normed_group (ℳ p S))) }

variable {α : Type*}

open pseudo_normed_group comphaus_filtered_pseudo_normed_group

@[simps]
def map_hom [fact (0 < p)] (f : S ⟶ S') :
  strict_comphaus_filtered_pseudo_normed_group_hom (ℳ p S) (ℳ p S') :=
{ to_fun := map f,
  map_zero' := by { ext F s i, simp only [map_apply, finset.sum_const_zero, zero_apply], },
  map_add' := λ F G, by { ext s i, simp only [finset.sum_add_distrib, add_apply, map_apply], },
  strict' := λ c F hF, (map_bound _ _).trans hF,
  continuous' := λ c, begin
    rw continuous_induced_rng,
    apply continuous_pi _,
    intro s',
    simp only [function.comp, map_apply],
    refine continuous.sum' _ _ _,
    rintro s -,
    exact (continuous_apply s).comp continuous_subtype_val,
  end }

@[simps]
def functor (p : ℝ≥0) [fact (0 < p)] [fact (p ≤ 1)] : Fintype.{u} ⥤ CompHausFiltPseuNormGrp₁.{u} :=
{ obj := λ S, ⟨ℳ p S, λ F, ⟨∥F∥₊, (mem_filtration_iff _ _).mpr le_rfl⟩⟩,
  map := λ S T f, map_hom f,
  map_id' := λ S, by { ext1, rw [map_hom_to_fun, map_id], refl, },
  map_comp' := λ S S' S'' f g, by { ext1, simp only [map_hom_to_fun, map_comp], refl } }

end real_measures


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker, Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.basic
import Mathlib.data.polynomial.div
import Mathlib.data.polynomial.algebra_map
import Mathlib.data.set.finite
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

/-!
# Theory of univariate polynomials

This file starts looking like the ring theory of $ R[X] $

-/

namespace polynomial

theorem nat_degree_pos_of_aeval_root {R : Type u} {S : Type v} [comm_ring R] [comm_ring S]
    [algebra R S] {p : polynomial R} (hp : p ≠ 0) {z : S} (hz : coe_fn (aeval z) p = 0)
    (inj : ∀ (x : R), coe_fn (algebra_map R S) x = 0 → x = 0) : 0 < nat_degree p :=
  nat_degree_pos_of_eval₂_root hp (algebra_map R S) hz inj

theorem degree_pos_of_aeval_root {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] [algebra R S]
    {p : polynomial R} (hp : p ≠ 0) {z : S} (hz : coe_fn (aeval z) p = 0)
    (inj : ∀ (x : R), coe_fn (algebra_map R S) x = 0 → x = 0) : 0 < degree p :=
  iff.mp nat_degree_pos_iff_degree_pos (nat_degree_pos_of_aeval_root hp hz inj)

theorem aeval_mod_by_monic_eq_self_of_root {R : Type u} {S : Type v} [comm_ring R] [comm_ring S]
    [algebra R S] {p : polynomial R} {q : polynomial R} (hq : monic q) {x : S}
    (hx : coe_fn (aeval x) q = 0) : coe_fn (aeval x) (p %ₘ q) = coe_fn (aeval x) p :=
  eval₂_mod_by_monic_eq_self_of_root hq hx

protected instance integral_domain {R : Type u} [integral_domain R] :
    integral_domain (polynomial R) :=
  integral_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub
    sorry sorry comm_ring.mul sorry comm_ring.one sorry sorry sorry sorry sorry sorry sorry

theorem nat_degree_mul {R : Type u} [integral_domain R] {p : polynomial R} {q : polynomial R}
    (hp : p ≠ 0) (hq : q ≠ 0) : nat_degree (p * q) = nat_degree p + nat_degree q :=
  sorry

@[simp] theorem nat_degree_pow {R : Type u} [integral_domain R] (p : polynomial R) (n : ℕ) :
    nat_degree (p ^ n) = n * nat_degree p :=
  sorry

theorem root_mul {R : Type u} {a : R} [integral_domain R] {p : polynomial R} {q : polynomial R} :
    is_root (p * q) a ↔ is_root p a ∨ is_root q a :=
  sorry

theorem root_or_root_of_root_mul {R : Type u} {a : R} [integral_domain R] {p : polynomial R}
    {q : polynomial R} (h : is_root (p * q) a) : is_root p a ∨ is_root q a :=
  iff.mp root_mul h

theorem degree_le_mul_left {R : Type u} [integral_domain R] {q : polynomial R} (p : polynomial R)
    (hq : q ≠ 0) : degree p ≤ degree (p * q) :=
  sorry

theorem nat_degree_le_of_dvd {R : Type u} [integral_domain R] {p : polynomial R} {q : polynomial R}
    (h1 : p ∣ q) (h2 : q ≠ 0) : nat_degree p ≤ nat_degree q :=
  sorry

theorem degree_eq_zero_of_is_unit {R : Type u} [integral_domain R] {p : polynomial R}
    (h : is_unit p) : degree p = 0 :=
  sorry

@[simp] theorem degree_coe_units {R : Type u} [integral_domain R] (u : units (polynomial R)) :
    degree ↑u = 0 :=
  degree_eq_zero_of_is_unit (Exists.intro u rfl)

theorem prime_X_sub_C {R : Type u} [integral_domain R] {r : R} : prime (X - coe_fn C r) := sorry

theorem prime_X {R : Type u} [integral_domain R] : prime X := sorry

theorem prime_of_degree_eq_one_of_monic {R : Type u} [integral_domain R] {p : polynomial R}
    (hp1 : degree p = 1) (hm : monic p) : prime p :=
  sorry

theorem irreducible_X_sub_C {R : Type u} [integral_domain R] (r : R) :
    irreducible (X - coe_fn C r) :=
  irreducible_of_prime prime_X_sub_C

theorem irreducible_X {R : Type u} [integral_domain R] : irreducible X :=
  irreducible_of_prime prime_X

theorem irreducible_of_degree_eq_one_of_monic {R : Type u} [integral_domain R] {p : polynomial R}
    (hp1 : degree p = 1) (hm : monic p) : irreducible p :=
  irreducible_of_prime (prime_of_degree_eq_one_of_monic hp1 hm)

theorem eq_of_monic_of_associated {R : Type u} [integral_domain R] {p : polynomial R}
    {q : polynomial R} (hp : monic p) (hq : monic q) (hpq : associated p q) : p = q :=
  sorry

@[simp] theorem root_multiplicity_zero {R : Type u} [integral_domain R] {x : R} :
    root_multiplicity x 0 = 0 :=
  dif_pos rfl

theorem root_multiplicity_eq_zero {R : Type u} [integral_domain R] {p : polynomial R} {x : R}
    (h : ¬is_root p x) : root_multiplicity x p = 0 :=
  sorry

theorem root_multiplicity_pos {R : Type u} [integral_domain R] {p : polynomial R} (hp : p ≠ 0)
    {x : R} : 0 < root_multiplicity x p ↔ is_root p x :=
  sorry

theorem root_multiplicity_mul {R : Type u} [integral_domain R] {p : polynomial R} {q : polynomial R}
    {x : R} (hpq : p * q ≠ 0) :
    root_multiplicity x (p * q) = root_multiplicity x p + root_multiplicity x q :=
  sorry

theorem root_multiplicity_X_sub_C_self {R : Type u} [integral_domain R] {x : R} :
    root_multiplicity x (X - coe_fn C x) = 1 :=
  sorry

theorem root_multiplicity_X_sub_C {R : Type u} [integral_domain R] {x : R} {y : R} :
    root_multiplicity x (X - coe_fn C y) = ite (x = y) 1 0 :=
  sorry

/-- The multiplicity of `a` as root of `(X - a) ^ n` is `n`. -/
theorem root_multiplicity_X_sub_C_pow {R : Type u} [integral_domain R] (a : R) (n : ℕ) :
    root_multiplicity a ((X - coe_fn C a) ^ n) = n :=
  sorry

/-- If `(X - a) ^ n` divides a polynomial `p` then the multiplicity of `a` as root of `p` is at
least `n`. -/
theorem root_multiplicity_of_dvd {R : Type u} [integral_domain R] {p : polynomial R} {a : R} {n : ℕ}
    (hzero : p ≠ 0) (h : (X - coe_fn C a) ^ n ∣ p) : n ≤ root_multiplicity a p :=
  sorry

/-- The multiplicity of `p + q` is at least the minimum of the multiplicities. -/
theorem root_multiplicity_add {R : Type u} [integral_domain R] {p : polynomial R} {q : polynomial R}
    (a : R) (hzero : p + q ≠ 0) :
    min (root_multiplicity a p) (root_multiplicity a q) ≤ root_multiplicity a (p + q) :=
  root_multiplicity_of_dvd hzero
    (min_pow_dvd_add (pow_root_multiplicity_dvd p a) (pow_root_multiplicity_dvd q a))

theorem exists_multiset_roots {R : Type u} [integral_domain R] {p : polynomial R} (hp : p ≠ 0) :
    ∃ (s : multiset R),
        ↑(coe_fn multiset.card s) ≤ degree p ∧
          ∀ (a : R), multiset.count a s = root_multiplicity a p :=
  sorry

/-- `roots p` noncomputably gives a multiset containing all the roots of `p`,
including their multiplicities. -/
def roots {R : Type u} [integral_domain R] (p : polynomial R) : multiset R :=
  dite (p = 0) (fun (h : p = 0) => ∅) fun (h : ¬p = 0) => classical.some (exists_multiset_roots h)

@[simp] theorem roots_zero {R : Type u} [integral_domain R] : roots 0 = 0 := dif_pos rfl

theorem card_roots {R : Type u} [integral_domain R] {p : polynomial R} (hp0 : p ≠ 0) :
    ↑(coe_fn multiset.card (roots p)) ≤ degree p :=
  sorry

theorem card_roots' {R : Type u} [integral_domain R] {p : polynomial R} (hp0 : p ≠ 0) :
    coe_fn multiset.card (roots p) ≤ nat_degree p :=
  iff.mp with_bot.coe_le_coe (le_trans (card_roots hp0) (le_of_eq (degree_eq_nat_degree hp0)))

theorem card_roots_sub_C {R : Type u} [integral_domain R] {p : polynomial R} {a : R}
    (hp0 : 0 < degree p) : ↑(coe_fn multiset.card (roots (p - coe_fn C a))) ≤ degree p :=
  sorry

theorem card_roots_sub_C' {R : Type u} [integral_domain R] {p : polynomial R} {a : R}
    (hp0 : 0 < degree p) : coe_fn multiset.card (roots (p - coe_fn C a)) ≤ nat_degree p :=
  sorry

@[simp] theorem count_roots {R : Type u} {a : R} [integral_domain R] {p : polynomial R}
    (hp : p ≠ 0) : multiset.count a (roots p) = root_multiplicity a p :=
  sorry

@[simp] theorem mem_roots {R : Type u} {a : R} [integral_domain R] {p : polynomial R} (hp : p ≠ 0) :
    a ∈ roots p ↔ is_root p a :=
  sorry

theorem eq_zero_of_infinite_is_root {R : Type u} [integral_domain R] (p : polynomial R)
    (h : set.infinite (set_of fun (x : R) => is_root p x)) : p = 0 :=
  sorry

theorem eq_of_infinite_eval_eq {R : Type u_1} [integral_domain R] (p : polynomial R)
    (q : polynomial R) (h : set.infinite (set_of fun (x : R) => eval x p = eval x q)) : p = q :=
  sorry

theorem roots_mul {R : Type u} [integral_domain R] {p : polynomial R} {q : polynomial R}
    (hpq : p * q ≠ 0) : roots (p * q) = roots p + roots q :=
  sorry

@[simp] theorem mem_roots_sub_C {R : Type u} [integral_domain R] {p : polynomial R} {a : R} {x : R}
    (hp0 : 0 < degree p) : x ∈ roots (p - coe_fn C a) ↔ eval x p = a :=
  sorry

@[simp] theorem roots_X_sub_C {R : Type u} [integral_domain R] (r : R) :
    roots (X - coe_fn C r) = r ::ₘ 0 :=
  sorry

@[simp] theorem roots_C {R : Type u} [integral_domain R] (x : R) : roots (coe_fn C x) = 0 := sorry

@[simp] theorem roots_one {R : Type u} [integral_domain R] : roots 1 = ∅ := roots_C 1

theorem roots_list_prod {R : Type u} [integral_domain R] (L : List (polynomial R)) :
    (∀ (p : polynomial R), p ∈ L → p ≠ 0) → roots (list.prod L) = multiset.bind (↑L) roots :=
  sorry

theorem roots_multiset_prod {R : Type u} [integral_domain R] (m : multiset (polynomial R)) :
    (∀ (p : polynomial R), p ∈ m → p ≠ 0) → roots (multiset.prod m) = multiset.bind m roots :=
  sorry

theorem roots_prod {R : Type u} [integral_domain R] {ι : Type u_1} (f : ι → polynomial R)
    (s : finset ι) :
    finset.prod s f ≠ 0 →
        roots (finset.prod s f) = multiset.bind (finset.val s) fun (i : ι) => roots (f i) :=
  sorry

theorem roots_prod_X_sub_C {R : Type u} [integral_domain R] (s : finset R) :
    roots (finset.prod s fun (a : R) => X - coe_fn C a) = finset.val s :=
  sorry

theorem card_roots_X_pow_sub_C {R : Type u} [integral_domain R] {n : ℕ} (hn : 0 < n) (a : R) :
    coe_fn multiset.card (roots (X ^ n - coe_fn C a)) ≤ n :=
  iff.mp with_bot.coe_le_coe
    (trans_rel_left LessEq (card_roots (X_pow_sub_C_ne_zero hn a)) (degree_X_pow_sub_C hn a))

/-- `nth_roots n a` noncomputably returns the solutions to `x ^ n = a`-/
def nth_roots {R : Type u} [integral_domain R] (n : ℕ) (a : R) : multiset R :=
  roots (X ^ n - coe_fn C a)

@[simp] theorem mem_nth_roots {R : Type u} [integral_domain R] {n : ℕ} (hn : 0 < n) {a : R}
    {x : R} : x ∈ nth_roots n a ↔ x ^ n = a :=
  sorry

@[simp] theorem nth_roots_zero {R : Type u} [integral_domain R] (r : R) : nth_roots 0 r = 0 := sorry

theorem card_nth_roots {R : Type u} [integral_domain R] (n : ℕ) (a : R) :
    coe_fn multiset.card (nth_roots n a) ≤ n :=
  sorry

/-- The multiset `nth_roots ↑n (1 : R)` as a finset. -/
def nth_roots_finset (n : ℕ) (R : Type u_1) [integral_domain R] : finset R :=
  multiset.to_finset (nth_roots n 1)

@[simp] theorem mem_nth_roots_finset {R : Type u} [integral_domain R] {n : ℕ} (h : 0 < n) {x : R} :
    x ∈ nth_roots_finset n R ↔ x ^ n = 1 :=
  sorry

theorem coeff_comp_degree_mul_degree {R : Type u} [integral_domain R] {p : polynomial R}
    {q : polynomial R} (hqd0 : nat_degree q ≠ 0) :
    coeff (comp p q) (nat_degree p * nat_degree q) =
        leading_coeff p * leading_coeff q ^ nat_degree p :=
  sorry

theorem nat_degree_comp {R : Type u} [integral_domain R] {p : polynomial R} {q : polynomial R} :
    nat_degree (comp p q) = nat_degree p * nat_degree q :=
  sorry

theorem leading_coeff_comp {R : Type u} [integral_domain R] {p : polynomial R} {q : polynomial R}
    (hq : nat_degree q ≠ 0) :
    leading_coeff (comp p q) = leading_coeff p * leading_coeff q ^ nat_degree p :=
  sorry

theorem units_coeff_zero_smul {R : Type u} [integral_domain R] (c : units (polynomial R))
    (p : polynomial R) : coeff (↑c) 0 • p = ↑c * p :=
  sorry

@[simp] theorem nat_degree_coe_units {R : Type u} [integral_domain R] (u : units (polynomial R)) :
    nat_degree ↑u = 0 :=
  nat_degree_eq_of_degree_eq_some (degree_coe_units u)

theorem zero_of_eval_zero {R : Type u} [integral_domain R] [infinite R] (p : polynomial R)
    (h : ∀ (x : R), eval x p = 0) : p = 0 :=
  sorry

theorem funext {R : Type u} [integral_domain R] [infinite R] {p : polynomial R} {q : polynomial R}
    (ext : ∀ (r : R), eval r p = eval r q) : p = q :=
  sorry

theorem is_unit_iff {R : Type u} [integral_domain R] {f : polynomial R} :
    is_unit f ↔ ∃ (r : R), is_unit r ∧ coe_fn C r = f :=
  sorry

theorem coeff_coe_units_zero_ne_zero {R : Type u} [integral_domain R] (u : units (polynomial R)) :
    coeff (↑u) 0 ≠ 0 :=
  sorry

theorem degree_eq_degree_of_associated {R : Type u} [integral_domain R] {p : polynomial R}
    {q : polynomial R} (h : associated p q) : degree p = degree q :=
  sorry

theorem degree_eq_one_of_irreducible_of_root {R : Type u} [integral_domain R] {p : polynomial R}
    (hi : irreducible p) {x : R} (hx : is_root p x) : degree p = 1 :=
  sorry

/-- Division by a monic polynomial doesn't change the leading coefficient. -/
theorem leading_coeff_div_by_monic_of_monic {R : Type u} [integral_domain R] {p : polynomial R}
    {q : polynomial R} (hmonic : monic q) (hdegree : degree q ≤ degree p) :
    leading_coeff (p /ₘ q) = leading_coeff p :=
  sorry

theorem eq_of_monic_of_dvd_of_nat_degree_le {R : Type u} [integral_domain R] {p : polynomial R}
    {q : polynomial R} (hp : monic p) (hq : monic q) (hdiv : p ∣ q)
    (hdeg : nat_degree q ≤ nat_degree p) : q = p :=
  sorry

theorem is_unit_of_is_unit_leading_coeff_of_is_unit_map {R : Type u} {S : Type v} [semiring R]
    [integral_domain S] (φ : R →+* S) (f : polynomial R) (hf : is_unit (leading_coeff f))
    (H : is_unit (map φ f)) : is_unit f :=
  sorry

/--
A polynomial over an integral domain `R` is irreducible if it is monic and
  irreducible after mapping into an integral domain `S`.

A special case of this lemma is that a polynomial over `ℤ` is irreducible if
  it is monic and irreducible over `ℤ/pℤ` for some prime `p`.
-/
theorem monic.irreducible_of_irreducible_map {R : Type u} {S : Type v} [integral_domain R]
    [integral_domain S] (φ : R →+* S) (f : polynomial R) (h_mon : monic f)
    (h_irr : irreducible (map φ f)) : irreducible f :=
  sorry

end polynomial

namespace is_integral_domain

/-- Lift evidence that `is_integral_domain R` to `is_integral_domain (polynomial R)`. -/
theorem polynomial {R : Type u_1} [comm_ring R] (h : is_integral_domain R) :
    is_integral_domain (polynomial R) :=
  integral_domain.to_is_integral_domain (polynomial R)

end Mathlib


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

! This file was ported from Lean 3 source module tactic.interval_cases
! leanprover-community/mathlib commit f7707875544ef1f81b32cb68c79e0e24e45a0e76
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.FinCases
import Mathbin.Data.Fin.Interval
import Mathbin.Data.Int.Interval
import Mathbin.Data.Pnat.Interval
import Mathbin.Data.Pnat.Basic

/-!
# Case bash on variables in finite intervals

This file provides the tactic `interval_cases`. `interval_cases n` will:
1. inspect hypotheses looking for lower and upper bounds of the form `a ≤ n` and `n < b`
   (in `ℕ`, `ℤ`, `ℕ+`, bounds of the form `a < n` and `n ≤ b` are also allowed),
   and also makes use of lower and upper bounds found via `le_top` and `bot_le`
   (so for example if `n : ℕ`, then the bound `0 ≤ n` is automatically found).
2. call `fin_cases` on the synthesised hypothesis `n ∈ set.Ico a b`,
   assuming an appropriate `fintype` instance can be found for the type of `n`.

The variable `n` can belong to any type `α`, with the following restrictions:
* only bounds on which `expr.to_rat` succeeds will be considered "explicit" (TODO: generalise this?)
* an instance of `decidable_eq α` is available,
* an explicit lower bound can be found among the hypotheses, or from `bot_le n`,
* an explicit upper bound can be found among the hypotheses, or from `le_top n`,
* if multiple bounds are located, an instance of `linear_order α` is available, and
* an instance of `fintype set.Ico l u` is available for the relevant bounds.

You can also explicitly specify a lower and upper bound to use, as `interval_cases using hl hu`,
where the hypotheses should be of the form `hl : a ≤ n` and `hu : n < b`. In that case,
`interval_cases` calls `fin_cases` on the resulting hypothesis `h : n ∈ set.Ico a b`.
-/

-- These imports aren't required to compile this file,
-- These imports aren't required to compile this file,
-- but they are needed at the use site for the tactic to work
-- but they are needed at the use site for the tactic to work
-- (on values of type fin/int/pnat)
-- (on values of type fin/int/pnat)
open Set

namespace Tactic

namespace IntervalCases

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      If `e` easily implies `(%%n < %%b)`
      for some explicit `b`,
      return that proof.
      -/
    unsafe
  def
    gives_upper_bound
    ( n e : expr ) : tactic expr
    :=
      do
        let t ← infer_type e
          match
            t
            with
            | q( $ ( n' ) < $ ( b ) ) => do guard ( n = n' ) let b ← b return e
              | q( $ ( b ) > $ ( n' ) ) => do guard ( n = n' ) let b ← b return e
              |
                q( $ ( n' ) ≤ $ ( b ) )
                =>
                do
                  guard ( n = n' )
                    let b ← b
                    let tn ← infer_type n
                    match
                      tn
                      with
                      | q( ℕ ) => to_expr ` `( Nat.lt_add_one_iff . mpr $ ( e ) )
                        | q( ℕ+ ) => to_expr ` `( PNat.lt_add_one_iff . mpr $ ( e ) )
                        | q( ℤ ) => to_expr ` `( Int.lt_add_one_iff . mpr $ ( e ) )
                        | _ => failed
              |
                q( $ ( b ) ≥ $ ( n' ) )
                =>
                do
                  guard ( n = n' )
                    let b ← b
                    let tn ← infer_type n
                    match
                      tn
                      with
                      | q( ℕ ) => to_expr ` `( Nat.lt_add_one_iff . mpr $ ( e ) )
                        | q( ℕ+ ) => to_expr ` `( PNat.lt_add_one_iff . mpr $ ( e ) )
                        | q( ℤ ) => to_expr ` `( Int.lt_add_one_iff . mpr $ ( e ) )
                        | _ => failed
              | _ => failed
#align tactic.interval_cases.gives_upper_bound tactic.interval_cases.gives_upper_bound

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      If `e` easily implies `(%%n ≥ %%b)`
      for some explicit `b`,
      return that proof.
      -/
    unsafe
  def
    gives_lower_bound
    ( n e : expr ) : tactic expr
    :=
      do
        let t ← infer_type e
          match
            t
            with
            | q( $ ( n' ) ≥ $ ( b ) ) => do guard ( n = n' ) let b ← b return e
              | q( $ ( b ) ≤ $ ( n' ) ) => do guard ( n = n' ) let b ← b return e
              |
                q( $ ( n' ) > $ ( b ) )
                =>
                do
                  guard ( n = n' )
                    let b ← b
                    let tn ← infer_type n
                    match
                      tn
                      with
                      | q( ℕ ) => to_expr ` `( Nat.add_one_le_iff . mpr $ ( e ) )
                        | q( ℕ+ ) => to_expr ` `( PNat.add_one_le_iff . mpr $ ( e ) )
                        | q( ℤ ) => to_expr ` `( Int.add_one_le_iff . mpr $ ( e ) )
                        | _ => failed
              |
                q( $ ( b ) < $ ( n' ) )
                =>
                do
                  guard ( n = n' )
                    let b ← b
                    let tn ← infer_type n
                    match
                      tn
                      with
                      | q( ℕ ) => to_expr ` `( Nat.add_one_le_iff . mpr $ ( e ) )
                        | q( ℕ+ ) => to_expr ` `( PNat.add_one_le_iff . mpr $ ( e ) )
                        | q( ℤ ) => to_expr ` `( Int.add_one_le_iff . mpr $ ( e ) )
                        | _ => failed
              | _ => failed
#align tactic.interval_cases.gives_lower_bound tactic.interval_cases.gives_lower_bound

/-- Combine two upper bounds. -/
unsafe def combine_upper_bounds : Option expr → Option expr → tactic (Option expr)
  | none, none => return none
  | some prf, none => return <| some prf
  | none, some prf => return <| some prf
  | some prf₁, some prf₂ => do
    Option.some <$> to_expr ``(lt_min $(prf₁) $(prf₂))
#align tactic.interval_cases.combine_upper_bounds tactic.interval_cases.combine_upper_bounds

/-- Combine two lower bounds. -/
unsafe def combine_lower_bounds : Option expr → Option expr → tactic (Option expr)
  | none, none => return <| none
  | some prf, none => return <| some prf
  | none, some prf => return <| some prf
  | some prf₁, some prf₂ => do
    Option.some <$> to_expr ``(max_le $(prf₂) $(prf₁))
#align tactic.interval_cases.combine_lower_bounds tactic.interval_cases.combine_lower_bounds

/-- Inspect a given expression, using it to update a set of upper and lower bounds on `n`. -/
unsafe def update_bounds (n : expr) (bounds : Option expr × Option expr) (e : expr) :
    tactic (Option expr × Option expr) := do
  let nlb ← try_core <| gives_lower_bound n e
  let nub ← try_core <| gives_upper_bound n e
  let clb ← combine_lower_bounds bounds.1 nlb
  let cub ← combine_upper_bounds bounds.2 nub
  return (clb, cub)
#align tactic.interval_cases.update_bounds tactic.interval_cases.update_bounds

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Attempt to find a lower bound for the variable `n`, by evaluating `bot_le n`.
      -/
    unsafe
  def
    initial_lower_bound
    ( n : expr ) : tactic expr
    :=
      do
        let e ← to_expr ` `( @ bot_le _ _ _ $ ( n ) )
          let t ← infer_type e
          match t with | q( $ ( b ) ≤ $ ( n ) ) => do return e | _ => failed
#align tactic.interval_cases.initial_lower_bound tactic.interval_cases.initial_lower_bound

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Attempt to find an upper bound for the variable `n`, by evaluating `le_top n`.
      -/
    unsafe
  def
    initial_upper_bound
    ( n : expr ) : tactic expr
    :=
      do
        let e ← to_expr ` `( @ le_top _ _ _ $ ( n ) )
          match
            e
            with
            |
                q( $ ( n ) ≤ $ ( b ) )
                =>
                do
                  let tn ← infer_type n
                    let
                      e
                        ←
                        match
                          tn
                          with
                          | q( ℕ ) => to_expr ` `( Nat.add_one_le_iff . mpr $ ( e ) )
                            | q( ℕ+ ) => to_expr ` `( PNat.add_one_le_iff . mpr $ ( e ) )
                            | q( ℤ ) => to_expr ` `( Int.add_one_le_iff . mpr $ ( e ) )
                            | _ => failed
                    return e
              | _ => failed
#align tactic.interval_cases.initial_upper_bound tactic.interval_cases.initial_upper_bound

/-- Inspect the local hypotheses for upper and lower bounds on a variable `n`. -/
unsafe def get_bounds (n : expr) : tactic (expr × expr) := do
  let hl ← try_core (initial_lower_bound n)
  let hu ← try_core (initial_upper_bound n)
  let lc ← local_context
  let r ← lc.foldlM (update_bounds n) (hl, hu)
  match r with
    | (_, none) => fail "No upper bound located."
    | (none, _) => fail "No lower bound located."
    | (some lb_prf, some ub_prf) => return (lb_prf, ub_prf)
#align tactic.interval_cases.get_bounds tactic.interval_cases.get_bounds

/-- The finset of elements of a set `s` for which we have `fintype s`. -/
def setElems {α} [DecidableEq α] (s : Set α) [Fintype s] : Finset α :=
  (Fintype.elems s).image Subtype.val
#align tactic.interval_cases.set_elems Tactic.IntervalCases.setElems

/-- Each element of `s` is a member of `set_elems s`. -/
theorem mem_setElems {α} [DecidableEq α] (s : Set α) [Fintype s] {a : α} (h : a ∈ s) :
    a ∈ setElems s :=
  Finset.mem_image.2 ⟨⟨a, h⟩, Fintype.complete _, rfl⟩
#align tactic.interval_cases.mem_set_elems Tactic.IntervalCases.mem_setElems

end IntervalCases

open IntervalCases

/-- Call `fin_cases` on membership of the finset built from
an `Ico` interval corresponding to a lower and an upper bound.

Here `hl` should be an expression of the form `a ≤ n`, for some explicit `a`, and
`hu` should be of the form `n < b`, for some explicit `b`.

By default `interval_cases_using` automatically generates a name for the new hypothesis. The name
can be specified via the optional argument `n`.
-/
unsafe def interval_cases_using (hl hu : expr) (n : Option Name) : tactic Unit :=
  (to_expr ``(mem_setElems (Ico _ _) ⟨$(hl), $(hu)⟩) >>=
      if hn : n.isSome then note (Option.get hn) else note_anon none) >>=
    fin_cases_at none none
#align tactic.interval_cases_using tactic.interval_cases_using

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
namespace Interactive

-- mathport name: parser.optional
local postfix:1024 "?" => optional

/-- `interval_cases n` searches for upper and lower bounds on a variable `n`,
and if bounds are found,
splits into separate cases for each possible value of `n`.

As an example, in
```
example (n : ℕ) (w₁ : n ≥ 3) (w₂ : n < 5) : n = 3 ∨ n = 4 :=
begin
  interval_cases n,
  all_goals {simp}
end
```
after `interval_cases n`, the goals are `3 = 3 ∨ 3 = 4` and `4 = 3 ∨ 4 = 4`.

You can also explicitly specify a lower and upper bound to use,
as `interval_cases using hl hu`.
The hypotheses should be in the form `hl : a ≤ n` and `hu : n < b`,
in which case `interval_cases` calls `fin_cases` on the resulting fact `n ∈ set.Ico a b`.

You can specify a name `h` for the new hypothesis,
as `interval_cases n with h` or `interval_cases n using hl hu with h`.
-/
unsafe def interval_cases (n : parse texpr ?)
    (bounds : parse (tk "using" *> (Prod.mk <$> ident <*> ident))?)
    (lname : parse (tk "with" *> ident)?) : tactic Unit := do
  if h : n then do
      guard bounds <|> fail "Do not use the `using` keyword if specifying the variable explicitly."
      let n ← to_expr (Option.get h)
      let (hl, hu) ← get_bounds n
      tactic.interval_cases_using hl hu lname
    else
      if h' : bounds then do
        let [hl, hu] ← [(Option.get h').1, (Option.get h').2].mapM get_local
        tactic.interval_cases_using hl hu lname
      else
        fail
          ("Call `interval_cases n` (specifying a variable), or `interval_cases lb ub`\n" ++
            "(specifying a lower bound and upper bound on the same variable).")
#align tactic.interactive.interval_cases tactic.interactive.interval_cases

/-- `interval_cases n` searches for upper and lower bounds on a variable `n`,
and if bounds are found,
splits into separate cases for each possible value of `n`.

As an example, in
```
example (n : ℕ) (w₁ : n ≥ 3) (w₂ : n < 5) : n = 3 ∨ n = 4 :=
begin
  interval_cases n,
  all_goals {simp}
end
```
after `interval_cases n`, the goals are `3 = 3 ∨ 3 = 4` and `4 = 3 ∨ 4 = 4`.

You can also explicitly specify a lower and upper bound to use,
as `interval_cases using hl hu`.
The hypotheses should be in the form `hl : a ≤ n` and `hu : n < b`,
in which case `interval_cases` calls `fin_cases` on the resulting fact `n ∈ set.Ico a b`.

You can also explicitly specify a name to use for the hypothesis added,
as `interval_cases n with hn` or `interval_cases n using hl hu with hn`.

In particular, `interval_cases n`
1) inspects hypotheses looking for lower and upper bounds of the form `a ≤ n` and `n < b`
   (although in `ℕ`, `ℤ`, and `ℕ+` bounds of the form `a < n` and `n ≤ b` are also allowed),
   and also makes use of lower and upper bounds found via `le_top` and `bot_le`
   (so for example if `n : ℕ`, then the bound `0 ≤ n` is found automatically), then
2) calls `fin_cases` on the synthesised hypothesis `n ∈ set.Ico a b`,
   assuming an appropriate `fintype` instance can be found for the type of `n`.

The variable `n` can belong to any type `α`, with the following restrictions:
* only bounds on which `expr.to_rat` succeeds will be considered "explicit" (TODO: generalise this?)
* an instance of `decidable_eq α` is available,
* an explicit lower bound can be found amongst the hypotheses, or from `bot_le n`,
* an explicit upper bound can be found amongst the hypotheses, or from `le_top n`,
* if multiple bounds are located, an instance of `linear_order α` is available, and
* an instance of `fintype set.Ico l u` is available for the relevant bounds.
-/
add_tactic_doc
  { Name := "interval_cases"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.interval_cases]
    tags := ["case bashing"] }

end Interactive

end Tactic


import FOL.arithmetic

namespace fol
open logic logic.Theory axiomatic_classical_logic' axiomatic_classical_logic
open_locale logic_symbol
namespace arithmetic

local infix ` ≃₁ `:80 := ((≃) : term LA → term LA → formula LA)
local prefix `∏₁ `:64 := (has_univ_quantifier.univ : formula LA → formula LA)
local prefix `∐₁ `:64 := (has_exists_quantifier.ex : formula LA → formula LA)

def standard : Structure LA := {
  dom := ℕ,
  inhabited := nat.inhabited,
  fn := λ n l v,
    match n, l, v with
    | 0, langf.zero, v := 0
    | 1, langf.succ, v := v 0 + 1
    | 2, langf.add,  v := v 0 + v 1
    | 2, langf.mul,  v := v 0 * v 1
    end,
  pr := λ n l v,
    match n, l, v with
    | 2, langp.le, v := v 0 ≤ v 1
    end }

notation `ℕ*` := standard

@[reducible, simp] lemma nat_dom_eq : (ℕ*).dom = ℕ := rfl

@[simp] lemma standard_zero_eq (v : fin 0 → ℕ) : standard.fn has_zero_symbol.zero v = (0 : ℕ) := rfl

@[simp] lemma standard_succ_eq (v : fin 1 → ℕ) : standard.fn has_succ_symbol.succ v = (v 0 + 1 : ℕ) := rfl

@[simp] lemma standard_add_eq (v : fin 2 → ℕ) : standard.fn has_add_symbol.add v = (v 0 + v 1 : ℕ) := rfl

@[simp] lemma standard_mul_eq (v : fin 2 → ℕ) : standard.fn has_mul_symbol.mul v = (v 0 * v 1 : ℕ) := rfl

@[simp] lemma standard_le_eq (v : fin 2 → ℕ) : standard.pr has_le_symbol.le v ↔ (v 0 : ℕ) ≤ v 1 := by refl

lemma N_Structures_Q : ℕ* ⊧ 𝐐 := λ p hyp_p e,
begin
  cases hyp_p; simp[finitary.cons],
  { exact λ _, of_to_bool_ff rfl},
  { exact λ _ _, nat.succ.inj },
  { intros n, cases n,
    { left, refl }, { right, simp[ex_fn] } },
  { intros n, unfold has_add.add, simp },
  { intros n m, unfold has_add.add, simp, exact nat.mul_succ m n },
  { intros n m, split; intros h,
    refine ⟨(n - m : ℕ), nat.add_sub_of_le h⟩,
    rcases h with ⟨_, h⟩, exact nat.le.intro h }
end

theorem Q_consistent : Theory.consistent 𝐐 := Structure_consistent N_Structures_Q

lemma mjbjhv (p : formula LA) : ℕ* ⊧ 𝐈p := λ e,
by { simp[peano_induction], intros h0 ih n,
     induction n with n IH, exact h0, exact ih n IH
      }

lemma N_Structures_bd_PA (C : formula LA → Prop) : ℕ* ⊧ₜₕ 𝐐+𝐈C := λ p hyp_p e,
by { cases hyp_p with _ hyp_p p,
     exact N_Structures_Q p hyp_p e,
     simp,
     intros h0 ih n,
     induction n with n IH, exact h0, exact ih n IH }

theorem bd_PA_consistent (C) : Theory.consistent 𝐐+𝐈C := Structure_consistent (N_Structures_bd_PA C)

lemma N_Structures_PA : ℕ* ⊧ₜₕ 𝐏𝐀 := N_Structures_bd_PA _

theorem PA_consistent : Theory.consistent 𝐏𝐀 := Structure_consistent N_Structures_PA

def true_arithmetic : Theory LA := {p | ℕ* ⊧ p}
notation `𝐓𝐀` := true_arithmetic

lemma N_Structures_TA : ℕ* ⊧ₜₕ 𝐓𝐀 := λ p hyp_p e, hyp_p e

theorem TA_consistent : Theory.consistent 𝐓𝐀 := Structure_consistent N_Structures_TA

namespace nonstandard_Structure

inductive noncomm : Type
| nat₀ (n : ℕ) : noncomm
| int₁ (i : ℤ) : noncomm
| int₂ (i : ℤ) : noncomm

/-
                   - ... -2₁, -1₁, 0₁, 1₁, 2₁, ...
                  /
 0₀, 1₀, 2₀, ... -
                  \
                   - ... -2₂, -1₂, 0₂, 1₂, 2₂, ...
-/

namespace noncomm

@[simp] theorem nat₀.inj_iff {a b} : nat₀ a = nat₀ b ↔ a = b :=
⟨noncomm.nat₀.inj, congr_arg _⟩

@[simp] theorem int₁.inj_iff {a b} : int₁ a = int₁ b ↔ a = b :=
⟨noncomm.int₁.inj, congr_arg _⟩

@[simp] theorem int₂.inj_iff {a b} : int₂ a = int₂ b ↔ a = b :=
⟨noncomm.int₂.inj, congr_arg _⟩

@[simp] def succ : noncomm → noncomm
| (nat₀ n) := nat₀ (n + 1)
| (int₁ i) := int₁ (i + 1)
| (int₂ i) := int₂ (i + 1)

@[simp] def add : noncomm → noncomm → noncomm
| (nat₀ n) (nat₀ m) := nat₀ (n + m)
| (nat₀ n) (int₁ i) := int₁ (n + i)
| (nat₀ n) (int₂ i) := int₂ (n + i)
| (int₁ i) (nat₀ n) := int₁ (i + n)
| (int₁ i) (int₁ j) := int₁ (i + j)
| (int₁ i) (int₂ j) := int₁ (i + j)
| (int₂ i) (nat₀ n) := int₂ (i + n)
| (int₂ i) (int₁ j) := int₂ (i + j)
| (int₂ i) (int₂ j) := int₂ (i + j)

@[simp] def mul : noncomm → noncomm → noncomm
| n        (nat₀ 0)     := nat₀ 0
| n        (nat₀ (m+1)) := add (mul n (nat₀ m)) n
| (nat₀ n) (int₁ i)     := int₁ (n * i)
| (nat₀ n) (int₂ i)     := int₂ (n * i)
| (int₁ i) (int₁ j)     := int₁ (i * j)
| (int₁ i) (int₂ j)     := int₁ (i * j)
| (int₂ i) (int₁ j)     := int₂ (i * j)
| (int₂ i) (int₂ j)     := int₂ (i * j)

@[simp] def Noncomm_fn : ∀ n, LA.fn n → finitary noncomm n → noncomm
| 0 langf.zero _ := nat₀ 0
| 1 langf.succ v := (v 0).succ
| 2 langf.add  v := (v 0).add (v 1)
| 2 langf.mul  v := (v 0).mul (v 1)

@[simp] def Noncomm_pr : ∀ n, LA.pr n → finitary noncomm n → Prop
| 2 langp.le  v := ∃ d, (v 0).add d = v 1

def Noncomm : Structure LA := ⟨noncomm, ⟨nat₀ 0⟩, Noncomm_fn, Noncomm_pr⟩

@[reducible, simp] lemma Noncomm_dom_eq : |Noncomm| = noncomm := rfl

@[simp] lemma Noncomm_fn_eq : Noncomm.fn = Noncomm_fn := rfl

@[simp] lemma Noncomm_pr_eq : Noncomm.pr = Noncomm_pr := rfl

theorem Noncomm_Structures_Q : Noncomm ⊧ₜₕ 𝐐 := λ p hyp_p e,
begin
  cases hyp_p; simp[Noncomm_fn ,symbol.zero, symbol.succ, symbol.add, symbol.mul, finitary.cons],
  { intros d, cases d; simp, exact of_to_bool_ff rfl },
  { intros d₁ d₂, cases d₁; cases d₂; simp[sum.inl.inj_iff, sum.inr.inj_iff] },
  { intros d, cases d; simp,
    { cases d; simp, refine ⟨nat₀ d, rfl⟩ },
    { refine ⟨int₁ (d - 1), _⟩, simp },
    { refine ⟨int₂ (d - 1), _⟩, simp } },
  { intros d, cases d; simp },
  { intros d₁ d₂, cases d₁; cases d₂; simp[add_assoc] },
  { intros d, cases d; simp },
  { intros d₁ d₂, cases d₁; cases d₂; simp[int.distrib_left] },
  { intros d₁ d₂, refl }
end

theorem refutable_comm_add : ¬𝐐 ⊢ ∏₁ ∏₁ (#0 +̇ #1 ≃₁ #1 +̇ #0) := λ h,
by { have : Noncomm ⊧ ∏ ∏ (#0 +̇ #1 ≃ #1 +̇ #0), from soundness h Noncomm_Structures_Q,
     have : ∀ n m, add m n = add n m,
     { have := this (λ x, default _), simp[symbol.add] at this, exact this },
     have := this (int₁ 0) (int₂ 0),
     simp at this, exact this }

theorem refutable_comm_mul : ¬𝐐 ⊢ ∏₁ ∏₁ (#0 ×̇ #1 ≃₁ #1 ×̇ #0) := λ h,
by { have : Noncomm ⊧ ∏ ∏ (#0 ×̇ #1 ≃ #1 ×̇ #0), from soundness h Noncomm_Structures_Q,
     have : ∀ n m, mul m n = mul n m,
     { have := this (λ x, default _), simp at this, exact this },
     have := this (int₁ 0) (int₂ 0),
     simp at this, exact this }

theorem refutable_zero_mul : ¬𝐐 ⊢ ∏₁ (Ż ×̇ #0 ≃₁ Ż) := λ h,
by { have : Noncomm ⊧ ∏ (Ż ×̇ #0 ≃ Ż), from soundness h Noncomm_Structures_Q,
     have : ∀ n, mul (nat₀ 0) n = nat₀ 0,
     { have := this (λ x, default _), simp at this, exact this },
     have := this (int₁ 0),
     simp at this, exact this }

end noncomm

end nonstandard_Structure

end arithmetic

end fol