/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.completion
import Mathlib.topology.metric_space.isometry
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# The completion of a metric space

Completion of uniform spaces are already defined in `topology.uniform_space.completion`. We show
here that the uniform space completion of a metric space inherits a metric space structure,
by extending the distance to the completion and checking that it is indeed a distance, and that
it defines the same uniformity as the already defined uniform structure on the completion
-/

namespace metric

/-- The distance on the completion is obtained by extending the distance on the original space,
by uniform continuity. -/
protected instance uniform_space.completion.has_dist {α : Type u} [metric_space α] : has_dist (uniform_space.completion α) :=
  has_dist.mk (uniform_space.completion.extension₂ dist)

/-- The new distance is uniformly continuous. -/
protected theorem completion.uniform_continuous_dist {α : Type u} [metric_space α] : uniform_continuous fun (p : uniform_space.completion α × uniform_space.completion α) => dist (prod.fst p) (prod.snd p) :=
  uniform_space.completion.uniform_continuous_extension₂ dist

/-- The new distance is an extension of the original distance. -/
protected theorem completion.dist_eq {α : Type u} [metric_space α] (x : α) (y : α) : dist ↑x ↑y = dist x y :=
  uniform_space.completion.extension₂_coe_coe uniform_continuous_dist x y

/- Let us check that the new distance satisfies the axioms of a distance, by starting from the
properties on α and extending them to `completion α` by continuity. -/

protected theorem completion.dist_self {α : Type u} [metric_space α] (x : uniform_space.completion α) : dist x x = 0 := sorry

protected theorem completion.dist_comm {α : Type u} [metric_space α] (x : uniform_space.completion α) (y : uniform_space.completion α) : dist x y = dist y x := sorry

protected theorem completion.dist_triangle {α : Type u} [metric_space α] (x : uniform_space.completion α) (y : uniform_space.completion α) (z : uniform_space.completion α) : dist x z ≤ dist x y + dist y z := sorry

/-- Elements of the uniformity (defined generally for completions) can be characterized in terms
of the distance. -/
protected theorem completion.mem_uniformity_dist {α : Type u} [metric_space α] (s : set (uniform_space.completion α × uniform_space.completion α)) : s ∈ uniformity (uniform_space.completion α) ↔
  ∃ (ε : ℝ), ∃ (H : ε > 0), ∀ {a b : uniform_space.completion α}, dist a b < ε → (a, b) ∈ s := sorry

/-- If two points are at distance 0, then they coincide. -/
protected theorem completion.eq_of_dist_eq_zero {α : Type u} [metric_space α] (x : uniform_space.completion α) (y : uniform_space.completion α) (h : dist x y = 0) : x = y := sorry

/-- Reformulate `completion.mem_uniformity_dist` in terms that are suitable for the definition
of the metric space structure. -/
protected theorem completion.uniformity_dist' {α : Type u} [metric_space α] : uniformity (uniform_space.completion α) =
  infi
    fun (ε : Subtype fun (ε : ℝ) => 0 < ε) =>
      filter.principal
        (set_of
          fun (p : uniform_space.completion α × uniform_space.completion α) =>
            dist (prod.fst p) (prod.snd p) < subtype.val ε) := sorry

protected theorem completion.uniformity_dist {α : Type u} [metric_space α] : uniformity (uniform_space.completion α) =
  infi
    fun (ε : ℝ) =>
      infi
        fun (H : ε > 0) =>
          filter.principal
            (set_of
              fun (p : uniform_space.completion α × uniform_space.completion α) => dist (prod.fst p) (prod.snd p) < ε) := sorry

/-- Metric space structure on the completion of a metric space. -/
protected instance completion.metric_space {α : Type u} [metric_space α] : metric_space (uniform_space.completion α) :=
  metric_space.mk completion.dist_self completion.eq_of_dist_eq_zero completion.dist_comm completion.dist_triangle
    (fun (x y : uniform_space.completion α) => ennreal.of_real (uniform_space.completion.extension₂ dist x y))
    (uniform_space.completion.uniform_space α)

/-- The embedding of a metric space in its completion is an isometry. -/
theorem completion.coe_isometry {α : Type u} [metric_space α] : isometry coe :=
  iff.mpr isometry_emetric_iff_metric completion.dist_eq


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import linear_algebra.matrix.to_lin
import linear_algebra.invariant_basis_number

/-!
# Invertible matrices over a ring with invariant basis number are square.
-/

variables {n m : Type*} [fintype n] [decidable_eq n] [fintype m] [decidable_eq m]
variables {R : Type*} [semiring R] [invariant_basis_number R]

open_locale matrix

lemma matrix.square_of_invertible
  (M : matrix n m R) (N : matrix m n R) (h : M ⬝ N = 1) (h' : N ⬝ M = 1) :
  fintype.card n = fintype.card m :=
card_eq_of_lequiv R (matrix.to_linear_equiv_right'_of_inv h' h)


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simple_graph.density
import set_theory.ordinal.basic

/-!
# Graph uniformity and uniform partitions

In this file we define uniformity of a pair of vertices in a graph and uniformity of a partition of
vertices of a graph. Both are also known as ε-regularity.

Finsets of vertices `s` and `t` are `ε`-uniform in a graph `G` if their edge density is at most
`ε`-far from the density of any big enough `s'` and `t'` where `s' ⊆ s`, `t' ⊆ t`.
The definition is pretty technical, but it amounts to the edges between `s` and `t` being "random"
The literature contains several definitions which are equivalent up to scaling `ε` by some constant
when the partition is equitable.

A partition `P` of the vertices is `ε`-uniform if the proportion of non `ε`-uniform pairs of parts
is less than `ε`.

## Main declarations

* `simple_graph.is_uniform`: Graph uniformity of a pair of finsets of vertices.
* `simple_graph.nonuniform_witness`: `G.nonuniform_witness ε s t` and `G.nonuniform_witness ε t s`
  together witness the non-uniformity of `s` and `t`.
* `finpartition.non_uniforms`: Non uniform pairs of parts of a partition.
* `finpartition.is_uniform`: Uniformity of a partition.
* `finpartition.nonuniform_witnesses`: For each non-uniform pair of parts of a partition, pick
  witnesses of non-uniformity and dump them all together.
-/

open finset

variables {α 𝕜 : Type*} [linear_ordered_field 𝕜]

/-! ###  Graph uniformity -/

namespace simple_graph
variables (G : simple_graph α) [decidable_rel G.adj] (ε : 𝕜) {s t : finset α} {a b : α}

/-- A pair of finsets of vertices is `ε`-uniform (aka `ε`-regular) iff their edge density is close
to the density of any big enough pair of subsets. Intuitively, the edges between them are
random-like. -/
def is_uniform (s t : finset α) : Prop :=
∀ ⦃s'⦄, s' ⊆ s → ∀ ⦃t'⦄, t' ⊆ t → (s.card : 𝕜) * ε ≤ s'.card → (t.card : 𝕜) * ε ≤ t'.card →
  |(G.edge_density s' t' : 𝕜) - (G.edge_density s t : 𝕜)| < ε

variables {G ε}

lemma is_uniform.mono {ε' : 𝕜} (h : ε ≤ ε') (hε : is_uniform G ε s t) : is_uniform G ε' s t :=
λ s' hs' t' ht' hs ht, by refine (hε hs' ht' (le_trans _ hs) (le_trans _ ht)).trans_le h;
  exact mul_le_mul_of_nonneg_left h (nat.cast_nonneg _)

lemma is_uniform.symm : symmetric (is_uniform G ε) :=
λ s t h t' ht' s' hs' ht hs,
  by { rw [edge_density_comm _ t', edge_density_comm _ t], exact h hs' ht' hs ht }

variables (G)

lemma is_uniform_comm : is_uniform G ε s t ↔ is_uniform G ε t s := ⟨λ h, h.symm, λ h, h.symm⟩

lemma is_uniform_singleton (hε : 0 < ε) : G.is_uniform ε {a} {b} :=
begin
  intros s' hs' t' ht' hs ht,
  rw [card_singleton, nat.cast_one, one_mul] at hs ht,
  obtain rfl | rfl := finset.subset_singleton_iff.1 hs',
  { replace hs : ε ≤ 0 := by simpa using hs,
    exact (hε.not_le hs).elim },
  obtain rfl | rfl := finset.subset_singleton_iff.1 ht',
  { replace ht : ε ≤ 0 := by simpa using ht,
    exact (hε.not_le ht).elim },
  { rwa [sub_self, abs_zero] }
end

lemma not_is_uniform_zero : ¬ G.is_uniform (0 : 𝕜) s t :=
λ h, (abs_nonneg _).not_lt $ h (empty_subset _) (empty_subset _) (by simp) (by simp)

lemma is_uniform_one : G.is_uniform (1 : 𝕜) s t :=
begin
  intros s' hs' t' ht' hs ht,
  rw mul_one at hs ht,
  rw [eq_of_subset_of_card_le hs' (nat.cast_le.1 hs),
    eq_of_subset_of_card_le ht' (nat.cast_le.1 ht), sub_self, abs_zero],
  exact zero_lt_one,
end

variables {G}

lemma not_is_uniform_iff :
  ¬ G.is_uniform ε s t ↔ ∃ s', s' ⊆ s ∧ ∃ t', t' ⊆ t ∧ ↑s.card * ε ≤ s'.card ∧
    ↑t.card * ε ≤ t'.card ∧  ε ≤ |G.edge_density s' t' - G.edge_density s t| :=
by { unfold is_uniform, simp only [not_forall, not_lt, exists_prop] }

open_locale classical
variables (G)

/-- An arbitrary pair of subsets witnessing the non-uniformity of `(s, t)`. If `(s, t)` is uniform,
returns `(s, t)`. Witnesses for `(s, t)` and `(t, s)` don't necessarily match. See
`simple_graph.nonuniform_witness`. -/
noncomputable def nonuniform_witnesses (ε : 𝕜) (s t : finset α) : finset α × finset α :=
if h : ¬ G.is_uniform ε s t
  then ((not_is_uniform_iff.1 h).some, (not_is_uniform_iff.1 h).some_spec.2.some)
  else (s, t)

lemma left_nonuniform_witnesses_subset (h : ¬ G.is_uniform ε s t) :
  (G.nonuniform_witnesses ε s t).1 ⊆ s :=
by { rw [nonuniform_witnesses, dif_pos h], exact (not_is_uniform_iff.1 h).some_spec.1 }

lemma left_nonuniform_witnesses_card (h : ¬ G.is_uniform ε s t) :
  (s.card : 𝕜) * ε ≤ (G.nonuniform_witnesses ε s t).1.card :=
by { rw [nonuniform_witnesses, dif_pos h],
  exact (not_is_uniform_iff.1 h).some_spec.2.some_spec.2.1 }

lemma right_nonuniform_witnesses_subset (h : ¬ G.is_uniform ε s t) :
  (G.nonuniform_witnesses ε s t).2 ⊆ t :=
by { rw [nonuniform_witnesses, dif_pos h], exact (not_is_uniform_iff.1 h).some_spec.2.some_spec.1 }

lemma right_nonuniform_witnesses_card (h : ¬ G.is_uniform ε s t) :
  (t.card : 𝕜) * ε ≤ (G.nonuniform_witnesses ε s t).2.card :=
by { rw [nonuniform_witnesses, dif_pos h],
  exact (not_is_uniform_iff.1 h).some_spec.2.some_spec.2.2.1 }

lemma nonuniform_witnesses_spec (h : ¬ G.is_uniform ε s t) :
  ε ≤ |G.edge_density (G.nonuniform_witnesses ε s t).1 (G.nonuniform_witnesses ε s t).2
    - G.edge_density s t| :=
by { rw [nonuniform_witnesses, dif_pos h],
  exact (not_is_uniform_iff.1 h).some_spec.2.some_spec.2.2.2 }

/-- Arbitrary witness of non-uniformity. `G.nonuniform_witness ε s t` and
`G.nonuniform_witness ε t s` form a pair of subsets witnessing the non-uniformity of `(s, t)`. If
`(s, t)` is uniform, returns `s`. -/
noncomputable def nonuniform_witness (ε : 𝕜) (s t : finset α) : finset α :=
if well_ordering_rel s t then (G.nonuniform_witnesses ε s t).1 else (G.nonuniform_witnesses ε t s).2

lemma nonuniform_witness_subset (h : ¬ G.is_uniform ε s t) : G.nonuniform_witness ε s t ⊆ s :=
begin
  unfold nonuniform_witness,
  split_ifs,
  { exact G.left_nonuniform_witnesses_subset h },
  { exact G.right_nonuniform_witnesses_subset (λ i, h i.symm) }
end

lemma nonuniform_witness_card_le (h : ¬ G.is_uniform ε s t) :
  (s.card : 𝕜) * ε ≤ (G.nonuniform_witness ε s t).card :=
begin
  unfold nonuniform_witness,
  split_ifs,
  { exact G.left_nonuniform_witnesses_card h },
  { exact G.right_nonuniform_witnesses_card (λ i, h i.symm) }
end

lemma nonuniform_witness_spec (h₁ : s ≠ t) (h₂ : ¬ G.is_uniform ε s t) :
  ε ≤ |G.edge_density (G.nonuniform_witness ε s t) (G.nonuniform_witness ε t s)
    - G.edge_density s t| :=
begin
  unfold nonuniform_witness,
  rcases trichotomous_of well_ordering_rel s t with lt | rfl | gt,
  { rw [if_pos lt, if_neg (asymm lt)],
    exact G.nonuniform_witnesses_spec h₂ },
  { cases h₁ rfl },
  { rw [if_neg (asymm gt), if_pos gt, edge_density_comm, edge_density_comm _ s],
    apply G.nonuniform_witnesses_spec (λ i, h₂ i.symm) }
end

end simple_graph

/-! ### Uniform partitions -/

variables [decidable_eq α] {A : finset α} (P : finpartition A) (G : simple_graph α)
  [decidable_rel G.adj] {ε : 𝕜}

namespace finpartition
open_locale classical

/-- The pairs of parts of a partition `P` which are not `ε`-uniform in a graph `G`. Note that we
dismiss the diagonal. We do not care whether `s` is `ε`-uniform with itself. -/
noncomputable def non_uniforms (ε : 𝕜) : finset (finset α × finset α) :=
P.parts.off_diag.filter $ λ uv, ¬G.is_uniform ε uv.1 uv.2

lemma mk_mem_non_uniforms_iff (u v : finset α) (ε : 𝕜) :
  (u, v) ∈ P.non_uniforms G ε ↔ u ∈ P.parts ∧ v ∈ P.parts ∧ u ≠ v ∧ ¬G.is_uniform ε u v :=
by rw [non_uniforms, mem_filter, mem_off_diag, and_assoc, and_assoc]

lemma non_uniforms_mono {ε ε' : 𝕜} (h : ε ≤ ε') : P.non_uniforms G ε' ⊆ P.non_uniforms G ε :=
monotone_filter_right _ $ λ uv, mt $ simple_graph.is_uniform.mono h

lemma non_uniforms_bot (hε : 0 < ε) : (⊥ : finpartition A).non_uniforms G ε = ∅ :=
begin
  rw eq_empty_iff_forall_not_mem,
  rintro ⟨u, v⟩,
  simp only [finpartition.mk_mem_non_uniforms_iff, finpartition.parts_bot, mem_map, not_and,
    not_not, exists_imp_distrib],
  rintro x hx rfl y hy rfl h,
  exact G.is_uniform_singleton hε,
end

/-- A finpartition of a graph's vertex set is `ε`-uniform (aka `ε`-regular) iff the proportion of
its pairs of parts that are not `ε`-uniform is at most `ε`. -/
def is_uniform (ε : 𝕜) : Prop :=
((P.non_uniforms G ε).card : 𝕜) ≤ (P.parts.card * (P.parts.card - 1) : ℕ) * ε

lemma bot_is_uniform (hε : 0 < ε) : (⊥ : finpartition A).is_uniform G ε :=
begin
  rw [finpartition.is_uniform, finpartition.card_bot, non_uniforms_bot _ hε,
    finset.card_empty, nat.cast_zero],
  exact mul_nonneg (nat.cast_nonneg _) hε.le,
end

lemma is_uniform_one : P.is_uniform G (1 : 𝕜) :=
begin
  rw [is_uniform, mul_one, nat.cast_le],
  refine (card_filter_le _ _).trans _,
  rw [off_diag_card, nat.mul_sub_left_distrib, mul_one],
end

variables {P G}

lemma is_uniform.mono {ε ε' : 𝕜} (hP : P.is_uniform G ε) (h : ε ≤ ε') : P.is_uniform G ε' :=
((nat.cast_le.2 $ card_le_of_subset $ P.non_uniforms_mono G h).trans hP).trans $
  mul_le_mul_of_nonneg_left h $ nat.cast_nonneg _

lemma is_uniform_of_empty (hP : P.parts = ∅) : P.is_uniform G ε :=
by simp [is_uniform, hP, non_uniforms]

lemma nonempty_of_not_uniform (h : ¬ P.is_uniform G ε) : P.parts.nonempty :=
nonempty_of_ne_empty $ λ h₁, h $ is_uniform_of_empty h₁

variables (P G ε) (s : finset α)

/-- A choice of witnesses of non-uniformity among the parts of a finpartition. -/
noncomputable def nonuniform_witnesses : finset (finset α) :=
(P.parts.filter $ λ t, s ≠ t ∧ ¬ G.is_uniform ε s t).image (G.nonuniform_witness ε s)

variables {P G ε s} {t : finset α}

lemma nonuniform_witness_mem_nonuniform_witnesses (h : ¬ G.is_uniform ε s t) (ht : t ∈ P.parts)
  (hst : s ≠ t) :
  G.nonuniform_witness ε s t ∈ P.nonuniform_witnesses G ε s :=
mem_image_of_mem _ $ mem_filter.2 ⟨ht, hst, h⟩

end finpartition


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

! This file was ported from Lean 3 source module algebra.direct_sum.basic
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Dfinsupp.Basic
import Mathlib.GroupTheory.Submonoid.Operations
import Mathlib.Tactic.ScopedNS

/-!
# Direct sum

This file defines the direct sum of abelian groups, indexed by a discrete type.

## Notation

`⨁ i, β i` is the n-ary direct sum `DirectSum`.
This notation is in the `DirectSum` locale, accessible after `open DirectSum`.

## References

* https://en.wikipedia.org/wiki/Direct_sum
-/

open BigOperators

universe u v w u₁

variable (ι : Type v) [dec_ι : DecidableEq ι] (β : ι → Type w)

/-- `DirectSum β` is the direct sum of a family of additive commutative monoids `β i`.

Note: `open DirectSum` will enable the notation `⨁ i, β i` for `DirectSum β`. -/
def DirectSum [∀ i, AddCommMonoid (β i)] : Type _ :=
  -- Porting note: Failed to synthesize
  -- Π₀ i, β i deriving AddCommMonoid, Inhabited
  Π₀ i, β i
#align direct_sum DirectSum

-- Porting note: Added inhabited instance manually
instance [∀ i, AddCommMonoid (β i)] : Inhabited (DirectSum ι β) :=
  inferInstanceAs (Inhabited (Π₀ i, β i))

-- Porting note: Added addCommMonoid instance manually
instance [∀ i, AddCommMonoid (β i)] : AddCommMonoid (DirectSum ι β) :=
  inferInstanceAs (AddCommMonoid (Π₀ i, β i))

instance [∀ i, AddCommMonoid (β i)] : CoeFun (DirectSum ι β) fun _ => ∀ i : ι, β i :=
  inferInstanceAs (CoeFun (Π₀ i, β i) fun _ => ∀ i : ι, β i)

-- Porting note: scoped does not work with notation3; TODO rewrite as lean4 notation?
-- scoped[DirectSum]
/-- `⨁ i, f i` is notation for `DirectSum _ f` and equals the direct sum of `fun i ↦ f i`.
Taking the direct sum over multiple arguments is possible, e.g. `⨁ (i) (j), f i j`. -/
notation3"⨁ "(...)", "r:(scoped f => DirectSum _ f) => r

-- Porting note: The below recreates some of the lean3 notation, not fully yet
-- section
-- open Std.ExtendedBinder
-- syntax (name := bigdirectsum) "⨁ " extBinders ", " term : term
-- macro_rules (kind := bigdirectsum)
--   | `(⨁ $_:ident, $y:ident → $z:ident) => `(DirectSum _ (fun $y ↦ $z))
--   | `(⨁ $x:ident, $p) => `(DirectSum _ (fun $x ↦ $p))
--   | `(⨁ $_:ident : $t:ident, $p) => `(DirectSum _ (fun $t ↦ $p))
--   | `(⨁ ($x:ident) ($y:ident), $p) => `(DirectSum _ (fun $x ↦ fun $y ↦ $p))
-- end

namespace DirectSum

variable {ι}

section AddCommGroup

variable [∀ i, AddCommGroup (β i)]

instance : AddCommGroup (DirectSum ι β) :=
  inferInstanceAs (AddCommGroup (Π₀ i, β i))
variable {β}

@[simp]
theorem sub_apply (g₁ g₂ : ⨁ i, β i) (i : ι) : (g₁ - g₂) i = g₁ i - g₂ i :=
  rfl
#align direct_sum.sub_apply DirectSum.sub_apply

end AddCommGroup

variable [∀ i, AddCommMonoid (β i)]

@[simp]
theorem zero_apply (i : ι) : (0 : ⨁ i, β i) i = 0 :=
  rfl
#align direct_sum.zero_apply DirectSum.zero_apply

variable {β}

@[simp]
theorem add_apply (g₁ g₂ : ⨁ i, β i) (i : ι) : (g₁ + g₂) i = g₁ i + g₂ i :=
  rfl
#align direct_sum.add_apply DirectSum.add_apply

variable (β)

-- Porting note: commented out
-- include dec_ι

/-- `mk β s x` is the element of `⨁ i, β i` that is zero outside `s`
and has coefficient `x i` for `i` in `s`. -/
def mk (s : Finset ι) : (∀ i : (↑s : Set ι), β i.1) →+ ⨁ i, β i
    where
  toFun := Dfinsupp.mk s
  map_add' _ _ := Dfinsupp.mk_add
  map_zero' := Dfinsupp.mk_zero
#align direct_sum.mk DirectSum.mk

/-- `of i` is the natural inclusion map from `β i` to `⨁ i, β i`. -/
def of (i : ι) : β i →+ ⨁ i, β i :=
  Dfinsupp.singleAddHom β i
#align direct_sum.of DirectSum.of

@[simp]
theorem of_eq_same (i : ι) (x : β i) : (of _ i x) i = x :=
  Dfinsupp.single_eq_same
#align direct_sum.of_eq_same DirectSum.of_eq_same

theorem of_eq_of_ne (i j : ι) (x : β i) (h : i ≠ j) : (of _ i x) j = 0 :=
  Dfinsupp.single_eq_of_ne h
#align direct_sum.of_eq_of_ne DirectSum.of_eq_of_ne

@[simp]
theorem support_zero [∀ (i : ι) (x : β i), Decidable (x ≠ 0)] : (0 : ⨁ i, β i).support = ∅ :=
  Dfinsupp.support_zero
#align direct_sum.support_zero DirectSum.support_zero

@[simp]
theorem support_of [∀ (i : ι) (x : β i), Decidable (x ≠ 0)] (i : ι) (x : β i) (h : x ≠ 0) :
    (of _ i x).support = {i} :=
  Dfinsupp.support_single_ne_zero h
#align direct_sum.support_of DirectSum.support_of

theorem support_of_subset [∀ (i : ι) (x : β i), Decidable (x ≠ 0)] {i : ι} {b : β i} :
    (of _ i b).support ⊆ {i} :=
  Dfinsupp.support_single_subset
#align direct_sum.support_of_subset DirectSum.support_of_subset

theorem sum_support_of [∀ (i : ι) (x : β i), Decidable (x ≠ 0)] (x : ⨁ i, β i) :
    (∑ i in x.support, of β i (x i)) = x :=
  Dfinsupp.sum_single
#align direct_sum.sum_support_of DirectSum.sum_support_of

variable {β}

theorem mk_injective (s : Finset ι) : Function.Injective (mk β s) :=
  Dfinsupp.mk_injective s
#align direct_sum.mk_injective DirectSum.mk_injective

@[elab_as_elim]
protected theorem induction_on {C : (⨁ i, β i) → Prop} (x : ⨁ i, β i) (H_zero : C 0)
    (H_basic : ∀ (i : ι) (x : β i), C (of β i x)) (H_plus : ∀ x y, C x → C y → C (x + y)) : C x :=
  by
  apply Dfinsupp.induction x H_zero
  intro i b f h1 h2 ih
  solve_by_elim
#align direct_sum.induction_on DirectSum.induction_on

/-- If two additive homomorphisms from `⨁ i, β i` are equal on each `of β i y`,
then they are equal. -/
theorem addHom_ext {γ : Type _} [AddMonoid γ] ⦃f g : (⨁ i, β i) →+ γ⦄
    (H : ∀ (i : ι) (y : β i), f (of _ i y) = g (of _ i y)) : f = g :=
  Dfinsupp.addHom_ext H
#align direct_sum.add_hom_ext DirectSum.addHom_ext

/-- If two additive homomorphisms from `⨁ i, β i` are equal on each `of β i y`,
then they are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem addHom_ext' {γ : Type _} [AddMonoid γ] ⦃f g : (⨁ i, β i) →+ γ⦄
    (H : ∀ i : ι, f.comp (of _ i) = g.comp (of _ i)) : f = g :=
  addHom_ext fun i => FunLike.congr_fun <| H i
#align direct_sum.add_hom_ext' DirectSum.addHom_ext'

variable {γ : Type u₁} [AddCommMonoid γ]

section ToAddMonoid

variable (φ : ∀ i, β i →+ γ) (ψ : (⨁ i, β i) →+ γ)

-- Porting note: The elaborator is struggling with `liftAddHom`. Passing it `β` explicitly helps.
-- This applies to roughly the remainder of the file.

/-- `toAddMonoid φ` is the natural homomorphism from `⨁ i, β i` to `γ`
induced by a family `φ` of homomorphisms `β i → γ`. -/
def toAddMonoid : (⨁ i, β i) →+ γ :=
  Dfinsupp.liftAddHom (β := β) φ
#align direct_sum.to_add_monoid DirectSum.toAddMonoid

@[simp]
theorem toAddMonoid_of (i) (x : β i) : toAddMonoid φ (of β i x) = φ i x :=
  Dfinsupp.liftAddHom_apply_single φ i x
#align direct_sum.to_add_monoid_of DirectSum.toAddMonoid_of

theorem toAddMonoid.unique (f : ⨁ i, β i) : ψ f = toAddMonoid (fun i => ψ.comp (of β i)) f := by
  congr
  -- Porting note: ext applied unsuitable ext lemma
  apply Dfinsupp.addHom_ext'
  simp [toAddMonoid, of]

#align direct_sum.to_add_monoid.unique DirectSum.toAddMonoid.unique

end ToAddMonoid

section FromAddMonoid

/-- `fromAddMonoid φ` is the natural homomorphism from `γ` to `⨁ i, β i`
induced by a family `φ` of homomorphisms `γ → β i`.

Note that this is not an isomorphism. Not every homomorphism `γ →+ ⨁ i, β i` arises in this way. -/
def fromAddMonoid : (⨁ i, γ →+ β i) →+ γ →+ ⨁ i, β i :=
  toAddMonoid fun i => AddMonoidHom.compHom (of β i)
#align direct_sum.from_add_monoid DirectSum.fromAddMonoid

@[simp]
theorem fromAddMonoid_of (i : ι) (f : γ →+ β i) : fromAddMonoid (of _ i f) = (of _ i).comp f := by
  rw [fromAddMonoid, toAddMonoid_of]
  rfl
#align direct_sum.from_add_monoid_of DirectSum.fromAddMonoid_of

theorem fromAddMonoid_of_apply (i : ι) (f : γ →+ β i) (x : γ) :
    fromAddMonoid (of _ i f) x = of _ i (f x) := by
      rw [fromAddMonoid_of, AddMonoidHom.coe_comp, Function.comp]
#align direct_sum.from_add_monoid_of_apply DirectSum.fromAddMonoid_of_apply

end FromAddMonoid

variable (β)

-- TODO: generalize this to remove the assumption `S ⊆ T`.
/-- `setToSet β S T h` is the natural homomorphism `⨁ (i : S), β i → ⨁ (i : T), β i`,
where `h : S ⊆ T`. -/
def setToSet (S T : Set ι) (H : S ⊆ T) : (⨁ i : S, β i) →+ ⨁ i : T, β i :=
  toAddMonoid fun i => of (fun i : Subtype T => β i) ⟨↑i, H i.2⟩
#align direct_sum.set_to_set DirectSum.setToSet

variable {β}

-- Porting note: commented out
-- omit dec_ι

instance unique [∀ i, Subsingleton (β i)] : Unique (⨁ i, β i) :=
  Dfinsupp.unique
#align direct_sum.unique DirectSum.unique

/-- A direct sum over an empty type is trivial. -/
instance uniqueOfIsEmpty [IsEmpty ι] : Unique (⨁ i, β i) :=
  Dfinsupp.uniqueOfIsEmpty
#align direct_sum.unique_of_is_empty DirectSum.uniqueOfIsEmpty

/-- The natural equivalence between `⨁ _ : ι, M` and `M` when `Unique ι`. -/
protected def id (M : Type v) (ι : Type _ := PUnit) [AddCommMonoid M] [Unique ι] :
    (⨁ _x : ι, M) ≃+ M :=
  {
    DirectSum.toAddMonoid fun _ =>
      AddMonoidHom.id
        M with
    toFun := DirectSum.toAddMonoid fun _ => AddMonoidHom.id M
    invFun := of (fun _ => M) default
    left_inv := fun x =>
      DirectSum.induction_on x (by rw [AddMonoidHom.map_zero, AddMonoidHom.map_zero])
        (fun p x => by rw [Unique.default_eq p, toAddMonoid_of]; rfl) fun x y ihx ihy => by
        rw [AddMonoidHom.map_add, AddMonoidHom.map_add, ihx, ihy]
    right_inv := fun x => toAddMonoid_of _ _ _ }
#align direct_sum.id DirectSum.id

section CongrLeft

variable {κ : Type _}

/-- Reindexing terms of a direct sum.-/
def equivCongrLeft (h : ι ≃ κ) : (⨁ i, β i) ≃+ ⨁ k, β (h.symm k) :=
  { Dfinsupp.equivCongrLeft h with map_add' := Dfinsupp.comapDomain'_add _ h.right_inv}
#align direct_sum.equiv_congr_left DirectSum.equivCongrLeft

@[simp]
theorem equivCongrLeft_apply (h : ι ≃ κ) (f : ⨁ i, β i) (k : κ) :
    equivCongrLeft h f k = f (h.symm k) := by
  exact Dfinsupp.comapDomain'_apply _ h.right_inv _ _
#align direct_sum.equiv_congr_left_apply DirectSum.equivCongrLeft_apply

end CongrLeft

section Option

variable {α : Option ι → Type w} [∀ i, AddCommMonoid (α i)]

-- Porting note: commented out
-- include dec_ι

/-- Isomorphism obtained by separating the term of index `none` of a direct sum over `Option ι`.-/
@[simps]
noncomputable def addEquivProdDirectSum : (⨁ i, α i) ≃+ α none × ⨁ i, α (some i) :=
  { Dfinsupp.equivProdDfinsupp with map_add' := Dfinsupp.equivProdDfinsupp_add }
#align direct_sum.add_equiv_prod_direct_sum DirectSum.addEquivProdDirectSum

end Option

section Sigma

variable {α : ι → Type u} {δ : ∀ i, α i → Type w} [∀ i j, AddCommMonoid (δ i j)]

/-- The natural map between `⨁ (i : Σ i, α i), δ i.1 i.2` and `⨁ i (j : α i), δ i j`.-/
noncomputable def sigmaCurry : (⨁ i : Σ _i, _, δ i.1 i.2) →+ ⨁ (i) (j), δ i j
    where
  toFun := @Dfinsupp.sigmaCurry _ _ δ _
  map_zero' := Dfinsupp.sigmaCurry_zero
  map_add' f g := @Dfinsupp.sigmaCurry_add _ _ δ _ f g
#align direct_sum.sigma_curry DirectSum.sigmaCurry

@[simp]
theorem sigmaCurry_apply (f : ⨁ i : Σ _i, _, δ i.1 i.2) (i : ι) (j : α i) :
    sigmaCurry f i j = f ⟨i, j⟩ :=
  @Dfinsupp.sigmaCurry_apply _ _ δ _ _ i j
#align direct_sum.sigma_curry_apply DirectSum.sigmaCurry_apply

-- Porting note: marked noncomputable
/-- The natural map between `⨁ i (j : α i), δ i j` and `Π₀ (i : Σ i, α i), δ i.1 i.2`, inverse of
`curry`.-/
noncomputable def sigmaUncurry [∀ i, DecidableEq (α i)] [∀ i j, DecidableEq (δ i j)] :
    (⨁ (i) (j), δ i j) →+ ⨁ i : Σ _i, _, δ i.1 i.2
    where
  toFun := Dfinsupp.sigmaUncurry
  map_zero' := Dfinsupp.sigmaUncurry_zero
  map_add' := Dfinsupp.sigmaUncurry_add
#align direct_sum.sigma_uncurry DirectSum.sigmaUncurry

@[simp]
theorem sigmaUncurry_apply [∀ i, DecidableEq (α i)] [∀ i j, DecidableEq (δ i j)]
    (f : ⨁ (i) (j), δ i j) (i : ι) (j : α i) : sigmaUncurry f ⟨i, j⟩ = f i j :=
  Dfinsupp.sigmaUncurry_apply f i j
#align direct_sum.sigma_uncurry_apply DirectSum.sigmaUncurry_apply

/-- The natural map between `⨁ (i : Σ i, α i), δ i.1 i.2` and `⨁ i (j : α i), δ i j`.-/
noncomputable def sigmaCurryEquiv [∀ i, DecidableEq (α i)] [∀ i j, DecidableEq (δ i j)] :
    (⨁ i : Σ _i, _, δ i.1 i.2) ≃+ ⨁ (i) (j), δ i j :=
  { sigmaCurry, Dfinsupp.sigmaCurryEquiv with }
#align direct_sum.sigma_curry_equiv DirectSum.sigmaCurryEquiv

end Sigma

/-- The canonical embedding from `⨁ i, A i` to `M` where `A` is a collection of `AddSubmonoid M`
indexed by `ι`.

When `S = Submodule _ M`, this is available as a `LinearMap`, `DirectSum.coe_linearMap`. -/
protected def coeAddMonoidHom {M S : Type _} [DecidableEq ι] [AddCommMonoid M] [SetLike S M]
    [AddSubmonoidClass S M] (A : ι → S) : (⨁ i, A i) →+ M :=
  toAddMonoid fun i => AddSubmonoidClass.Subtype (A i)
#align direct_sum.coe_add_monoid_hom DirectSum.coeAddMonoidHom

@[simp]
theorem coeAddMonoidHom_of {M S : Type _} [DecidableEq ι] [AddCommMonoid M] [SetLike S M]
    [AddSubmonoidClass S M] (A : ι → S) (i : ι) (x : A i) :
    DirectSum.coeAddMonoidHom A (of (fun i => A i) i x) = x :=
  toAddMonoid_of _ _ _
#align direct_sum.coe_add_monoid_hom_of DirectSum.coeAddMonoidHom_of

theorem coe_of_apply {M S : Type _} [DecidableEq ι] [AddCommMonoid M] [SetLike S M]
    [AddSubmonoidClass S M] {A : ι → S} (i j : ι) (x : A i) :
    (of (fun i ↦ {x // x ∈ A i}) i x j : M) = if i = j then x else 0 := by
  obtain rfl | h := Decidable.eq_or_ne i j
  · rw [DirectSum.of_eq_same, if_pos rfl]
  · rw [DirectSum.of_eq_of_ne _ _ _ _ h, if_neg h, ZeroMemClass.coe_zero, ZeroMemClass.coe_zero]
#align direct_sum.coe_of_apply DirectSum.coe_of_apply

/-- The `DirectSum` formed by a collection of additive submonoids (or subgroups, or submodules) of
`M` is said to be internal if the canonical map `(⨁ i, A i) →+ M` is bijective.

For the alternate statement in terms of independence and spanning, see
`DirectSum.subgroup_isInternal_iff_independent_and_supr_eq_top` and
`DirectSum.isInternalSubmodule_iff_independent_and_supr_eq_top`. -/
def IsInternal {M S : Type _} [DecidableEq ι] [AddCommMonoid M] [SetLike S M]
    [AddSubmonoidClass S M] (A : ι → S) : Prop :=
  Function.Bijective (DirectSum.coeAddMonoidHom A)
#align direct_sum.is_internal DirectSum.IsInternal

-- Porting note: This times out; lean4#2003 may fix this?
set_option maxHeartbeats 0
theorem IsInternal.addSubmonoid_supᵢ_eq_top {M : Type _} [DecidableEq ι] [AddCommMonoid M]
    (A : ι → AddSubmonoid M) (h : IsInternal A) : supᵢ A = ⊤ := by
  rw [AddSubmonoid.supᵢ_eq_mrange_dfinsupp_sumAddHom, AddMonoidHom.mrange_top_iff_surjective]
  exact Function.Bijective.surjective h
#align direct_sum.is_internal.add_submonoid_supr_eq_top DirectSum.IsInternal.addSubmonoid_supᵢ_eq_top

end DirectSum


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

! This file was ported from Lean 3 source module topology.metric_space.algebra
! leanprover-community/mathlib commit f47581155c818e6361af4e4fda60d27d020c226b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.MulAction
import Mathbin.Topology.MetricSpace.Lipschitz

/-!
# Compatibility of algebraic operations with metric space structures

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

In this file we define mixin typeclasses `has_lipschitz_mul`, `has_lipschitz_add`,
`has_bounded_smul` expressing compatibility of multiplication, addition and scalar-multiplication
operations with an underlying metric space structure.  The intended use case is to abstract certain
properties shared by normed groups and by `R≥0`.

## Implementation notes

We deduce a `has_continuous_mul` instance from `has_lipschitz_mul`, etc.  In principle there should
be an intermediate typeclass for uniform spaces, but the algebraic hierarchy there (see
`uniform_group`) is structured differently.

-/

open NNReal

noncomputable section

variable (α β : Type _) [PseudoMetricSpace α] [PseudoMetricSpace β]

section LipschitzMul

#print LipschitzAdd /-
/-- Class `has_lipschitz_add M` says that the addition `(+) : X × X → X` is Lipschitz jointly in
the two arguments. -/
class LipschitzAdd [AddMonoid β] : Prop where
  lipschitz_add : ∃ C, LipschitzWith C fun p : β × β => p.1 + p.2
#align has_lipschitz_add LipschitzAdd
-/

#print LipschitzMul /-
/-- Class `has_lipschitz_mul M` says that the multiplication `(*) : X × X → X` is Lipschitz jointly
in the two arguments. -/
@[to_additive]
class LipschitzMul [Monoid β] : Prop where
  lipschitz_mul : ∃ C, LipschitzWith C fun p : β × β => p.1 * p.2
#align has_lipschitz_mul LipschitzMul
#align has_lipschitz_add LipschitzAdd
-/

variable [Monoid β]

#print LipschitzMul.C /-
/-- The Lipschitz constant of a monoid `β` satisfying `has_lipschitz_mul` -/
@[to_additive "The Lipschitz constant of an `add_monoid` `β` satisfying `has_lipschitz_add`"]
def LipschitzMul.C [_i : LipschitzMul β] : ℝ≥0 :=
  Classical.choose _i.lipschitz_mul
#align has_lipschitz_mul.C LipschitzMul.C
#align has_lipschitz_add.C LipschitzAdd.C
-/

variable {β}

/- warning: lipschitz_with_lipschitz_const_mul_edist -> lipschitzWith_lipschitz_const_mul_edist is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} [_inst_2 : PseudoMetricSpace.{u1} β] [_inst_3 : Monoid.{u1} β] [_i : LipschitzMul.{u1} β _inst_2 _inst_3], LipschitzWith.{u1, u1} (Prod.{u1, u1} β β) β (Prod.pseudoEMetricSpaceMax.{u1, u1} β β (PseudoMetricSpace.toPseudoEMetricSpace.{u1} β _inst_2) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} β _inst_2)) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} β _inst_2) (LipschitzMul.C.{u1} β _inst_2 _inst_3 _i) (fun (p : Prod.{u1, u1} β β) => HMul.hMul.{u1, u1, u1} β β β (instHMul.{u1} β (MulOneClass.toHasMul.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) (Prod.fst.{u1, u1} β β p) (Prod.snd.{u1, u1} β β p))
but is expected to have type
  forall {β : Type.{u1}} [_inst_2 : PseudoMetricSpace.{u1} β] [_inst_3 : Monoid.{u1} β] [_i : LipschitzMul.{u1} β _inst_2 _inst_3], LipschitzWith.{u1, u1} (Prod.{u1, u1} β β) β (Prod.pseudoEMetricSpaceMax.{u1, u1} β β (PseudoMetricSpace.toPseudoEMetricSpace.{u1} β _inst_2) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} β _inst_2)) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} β _inst_2) (LipschitzMul.C.{u1} β _inst_2 _inst_3 _i) (fun (p : Prod.{u1, u1} β β) => HMul.hMul.{u1, u1, u1} β β β (instHMul.{u1} β (MulOneClass.toMul.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) (Prod.fst.{u1, u1} β β p) (Prod.snd.{u1, u1} β β p))
Case conversion may be inaccurate. Consider using '#align lipschitz_with_lipschitz_const_mul_edist lipschitzWith_lipschitz_const_mul_edistₓ'. -/
@[to_additive]
theorem lipschitzWith_lipschitz_const_mul_edist [_i : LipschitzMul β] :
    LipschitzWith (LipschitzMul.C β) fun p : β × β => p.1 * p.2 :=
  Classical.choose_spec _i.lipschitz_mul
#align lipschitz_with_lipschitz_const_mul_edist lipschitzWith_lipschitz_const_mul_edist
#align lipschitz_with_lipschitz_const_add_edist lipschitzWith_lipschitz_const_add_edist

variable [LipschitzMul β]

/- warning: lipschitz_with_lipschitz_const_mul -> lipschitz_with_lipschitz_const_mul is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} [_inst_2 : PseudoMetricSpace.{u1} β] [_inst_3 : Monoid.{u1} β] [_inst_4 : LipschitzMul.{u1} β _inst_2 _inst_3] (p : Prod.{u1, u1} β β) (q : Prod.{u1, u1} β β), LE.le.{0} Real Real.hasLe (Dist.dist.{u1} β (PseudoMetricSpace.toHasDist.{u1} β _inst_2) (HMul.hMul.{u1, u1, u1} β β β (instHMul.{u1} β (MulOneClass.toHasMul.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) (Prod.fst.{u1, u1} β β p) (Prod.snd.{u1, u1} β β p)) (HMul.hMul.{u1, u1, u1} β β β (instHMul.{u1} β (MulOneClass.toHasMul.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) (Prod.fst.{u1, u1} β β q) (Prod.snd.{u1, u1} β β q))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) NNReal Real (HasLiftT.mk.{1, 1} NNReal Real (CoeTCₓ.coe.{1, 1} NNReal Real (coeBase.{1, 1} NNReal Real NNReal.Real.hasCoe))) (LipschitzMul.C.{u1} β _inst_2 _inst_3 _inst_4)) (Dist.dist.{u1} (Prod.{u1, u1} β β) (PseudoMetricSpace.toHasDist.{u1} (Prod.{u1, u1} β β) (Prod.pseudoMetricSpaceMax.{u1, u1} β β _inst_2 _inst_2)) p q))
but is expected to have type
  forall {β : Type.{u1}} [_inst_2 : PseudoMetricSpace.{u1} β] [_inst_3 : Monoid.{u1} β] [_inst_4 : LipschitzMul.{u1} β _inst_2 _inst_3] (p : Prod.{u1, u1} β β) (q : Prod.{u1, u1} β β), LE.le.{0} Real Real.instLEReal (Dist.dist.{u1} β (PseudoMetricSpace.toDist.{u1} β _inst_2) (HMul.hMul.{u1, u1, u1} β β β (instHMul.{u1} β (MulOneClass.toMul.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) (Prod.fst.{u1, u1} β β p) (Prod.snd.{u1, u1} β β p)) (HMul.hMul.{u1, u1, u1} β β β (instHMul.{u1} β (MulOneClass.toMul.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) (Prod.fst.{u1, u1} β β q) (Prod.snd.{u1, u1} β β q))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (NNReal.toReal (LipschitzMul.C.{u1} β _inst_2 _inst_3 _inst_4)) (Dist.dist.{u1} (Prod.{u1, u1} β β) (PseudoMetricSpace.toDist.{u1} (Prod.{u1, u1} β β) (Prod.pseudoMetricSpaceMax.{u1, u1} β β _inst_2 _inst_2)) p q))
Case conversion may be inaccurate. Consider using '#align lipschitz_with_lipschitz_const_mul lipschitz_with_lipschitz_const_mulₓ'. -/
@[to_additive]
theorem lipschitz_with_lipschitz_const_mul :
    ∀ p q : β × β, dist (p.1 * p.2) (q.1 * q.2) ≤ LipschitzMul.C β * dist p q :=
  by
  rw [← lipschitzWith_iff_dist_le_mul]
  exact lipschitzWith_lipschitz_const_mul_edist
#align lipschitz_with_lipschitz_const_mul lipschitz_with_lipschitz_const_mul
#align lipschitz_with_lipschitz_const_add lipschitz_with_lipschitz_const_add

/- warning: has_lipschitz_mul.has_continuous_mul -> LipschitzMul.continuousMul is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} [_inst_2 : PseudoMetricSpace.{u1} β] [_inst_3 : Monoid.{u1} β] [_inst_4 : LipschitzMul.{u1} β _inst_2 _inst_3], ContinuousMul.{u1} β (UniformSpace.toTopologicalSpace.{u1} β (PseudoMetricSpace.toUniformSpace.{u1} β _inst_2)) (MulOneClass.toHasMul.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))
but is expected to have type
  forall {β : Type.{u1}} [_inst_2 : PseudoMetricSpace.{u1} β] [_inst_3 : Monoid.{u1} β] [_inst_4 : LipschitzMul.{u1} β _inst_2 _inst_3], ContinuousMul.{u1} β (UniformSpace.toTopologicalSpace.{u1} β (PseudoMetricSpace.toUniformSpace.{u1} β _inst_2)) (MulOneClass.toMul.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))
Case conversion may be inaccurate. Consider using '#align has_lipschitz_mul.has_continuous_mul LipschitzMul.continuousMulₓ'. -/
-- see Note [lower instance priority]
@[to_additive]
instance (priority := 100) LipschitzMul.continuousMul : ContinuousMul β :=
  ⟨lipschitzWith_lipschitz_const_mul_edist.Continuous⟩
#align has_lipschitz_mul.has_continuous_mul LipschitzMul.continuousMul
#align has_lipschitz_add.has_continuous_add LipschitzAdd.continuousAdd

/- warning: submonoid.has_lipschitz_mul -> Submonoid.lipschitzMul is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} [_inst_2 : PseudoMetricSpace.{u1} β] [_inst_3 : Monoid.{u1} β] [_inst_4 : LipschitzMul.{u1} β _inst_2 _inst_3] (s : Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)), LipschitzMul.{u1} (coeSort.{succ u1, succ (succ u1)} (Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)) β (Submonoid.setLike.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) s) (Subtype.pseudoMetricSpace.{u1} β _inst_2 (fun (x : β) => Membership.Mem.{u1, u1} β (Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)) (SetLike.hasMem.{u1, u1} (Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)) β (Submonoid.setLike.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) x s)) (Submonoid.toMonoid.{u1} β _inst_3 s)
but is expected to have type
  forall {β : Type.{u1}} [_inst_2 : PseudoMetricSpace.{u1} β] [_inst_3 : Monoid.{u1} β] [_inst_4 : LipschitzMul.{u1} β _inst_2 _inst_3] (s : Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)), LipschitzMul.{u1} (Subtype.{succ u1} β (fun (x : β) => Membership.mem.{u1, u1} β (Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)) (SetLike.instMembership.{u1, u1} (Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)) β (Submonoid.instSetLikeSubmonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) x s)) (Subtype.pseudoMetricSpace.{u1} β _inst_2 (fun (x : β) => Membership.mem.{u1, u1} β (Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)) (SetLike.instMembership.{u1, u1} (Submonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3)) β (Submonoid.instSetLikeSubmonoid.{u1} β (Monoid.toMulOneClass.{u1} β _inst_3))) x s)) (Submonoid.toMonoid.{u1} β _inst_3 s)
Case conversion may be inaccurate. Consider using '#align submonoid.has_lipschitz_mul Submonoid.lipschitzMulₓ'. -/
@[to_additive]
instance Submonoid.lipschitzMul (s : Submonoid β) : LipschitzMul s
    where lipschitz_mul :=
    ⟨LipschitzMul.C β, by
      rintro ⟨x₁, x₂⟩ ⟨y₁, y₂⟩
      convert lipschitzWith_lipschitz_const_mul_edist ⟨(x₁ : β), x₂⟩ ⟨y₁, y₂⟩ using 1⟩
#align submonoid.has_lipschitz_mul Submonoid.lipschitzMul
#align add_submonoid.has_lipschitz_add AddSubmonoid.lipschitzAdd

#print MulOpposite.lipschitzMul /-
@[to_additive]
instance MulOpposite.lipschitzMul : LipschitzMul βᵐᵒᵖ
    where lipschitz_mul :=
    ⟨LipschitzMul.C β, fun ⟨x₁, x₂⟩ ⟨y₁, y₂⟩ =>
      (lipschitzWith_lipschitz_const_mul_edist ⟨x₂.unop, x₁.unop⟩ ⟨y₂.unop, y₁.unop⟩).trans_eq
        (congr_arg _ <| max_comm _ _)⟩
#align mul_opposite.has_lipschitz_mul MulOpposite.lipschitzMul
#align add_opposite.has_lipschitz_add AddOpposite.lipschitzAdd
-/

/- warning: real.has_lipschitz_add -> Real.hasLipschitzAdd is a dubious translation:
lean 3 declaration is
  LipschitzAdd.{0} Real Real.pseudoMetricSpace Real.addMonoid
but is expected to have type
  LipschitzAdd.{0} Real Real.pseudoMetricSpace Real.instAddMonoidReal
Case conversion may be inaccurate. Consider using '#align real.has_lipschitz_add Real.hasLipschitzAddₓ'. -/
-- this instance could be deduced from `normed_add_comm_group.has_lipschitz_add`, but we prove it
-- separately here so that it is available earlier in the hierarchy
instance Real.hasLipschitzAdd : LipschitzAdd ℝ
    where lipschitz_add :=
    ⟨2, by
      rw [lipschitzWith_iff_dist_le_mul]
      intro p q
      simp only [Real.dist_eq, Prod.dist_eq, Prod.fst_sub, Prod.snd_sub, NNReal.coe_one,
        [anonymous]]
      convert le_trans (abs_add (p.1 - q.1) (p.2 - q.2)) _ using 2
      · abel
      have := le_max_left (|p.1 - q.1|) (|p.2 - q.2|)
      have := le_max_right (|p.1 - q.1|) (|p.2 - q.2|)
      linarith⟩
#align real.has_lipschitz_add Real.hasLipschitzAdd

/- warning: nnreal.has_lipschitz_add -> NNReal.hasLipschitzAdd is a dubious translation:
lean 3 declaration is
  LipschitzAdd.{0} NNReal NNReal.pseudoMetricSpace (AddMonoidWithOne.toAddMonoid.{0} NNReal (AddCommMonoidWithOne.toAddMonoidWithOne.{0} NNReal (NonAssocSemiring.toAddCommMonoidWithOne.{0} NNReal (Semiring.toNonAssocSemiring.{0} NNReal NNReal.semiring))))
but is expected to have type
  LipschitzAdd.{0} NNReal instPseudoMetricSpaceNNReal (AddMonoidWithOne.toAddMonoid.{0} NNReal (AddCommMonoidWithOne.toAddMonoidWithOne.{0} NNReal (NonAssocSemiring.toAddCommMonoidWithOne.{0} NNReal (Semiring.toNonAssocSemiring.{0} NNReal instNNRealSemiring))))
Case conversion may be inaccurate. Consider using '#align nnreal.has_lipschitz_add NNReal.hasLipschitzAddₓ'. -/
-- this instance has the same proof as `add_submonoid.has_lipschitz_add`, but the former can't
-- directly be applied here since `ℝ≥0` is a subtype of `ℝ`, not an additive submonoid.
instance NNReal.hasLipschitzAdd : LipschitzAdd ℝ≥0
    where lipschitz_add :=
    ⟨LipschitzAdd.C ℝ, by
      rintro ⟨x₁, x₂⟩ ⟨y₁, y₂⟩
      convert lipschitzWith_lipschitz_const_add_edist ⟨(x₁ : ℝ), x₂⟩ ⟨y₁, y₂⟩ using 1⟩
#align nnreal.has_lipschitz_add NNReal.hasLipschitzAdd

end LipschitzMul

section BoundedSMul

variable [Zero α] [Zero β] [SMul α β]

#print BoundedSMul /-
/-- Mixin typeclass on a scalar action of a metric space `α` on a metric space `β` both with
distinguished points `0`, requiring compatibility of the action in the sense that
`dist (x • y₁) (x • y₂) ≤ dist x 0 * dist y₁ y₂` and
`dist (x₁ • y) (x₂ • y) ≤ dist x₁ x₂ * dist y 0`. -/
class BoundedSMul : Prop where
  dist_smul_pair' : ∀ x : α, ∀ y₁ y₂ : β, dist (x • y₁) (x • y₂) ≤ dist x 0 * dist y₁ y₂
  dist_pair_smul' : ∀ x₁ x₂ : α, ∀ y : β, dist (x₁ • y) (x₂ • y) ≤ dist x₁ x₂ * dist y 0
#align has_bounded_smul BoundedSMul
-/

variable {α β} [BoundedSMul α β]

/- warning: dist_smul_pair -> dist_smul_pair is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : PseudoMetricSpace.{u1} α] [_inst_2 : PseudoMetricSpace.{u2} β] [_inst_3 : Zero.{u1} α] [_inst_4 : Zero.{u2} β] [_inst_5 : SMul.{u1, u2} α β] [_inst_6 : BoundedSMul.{u1, u2} α β _inst_1 _inst_2 _inst_3 _inst_4 _inst_5] (x : α) (y₁ : β) (y₂ : β), LE.le.{0} Real Real.hasLe (Dist.dist.{u2} β (PseudoMetricSpace.toHasDist.{u2} β _inst_2) (SMul.smul.{u1, u2} α β _inst_5 x y₁) (SMul.smul.{u1, u2} α β _inst_5 x y₂)) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (Dist.dist.{u1} α (PseudoMetricSpace.toHasDist.{u1} α _inst_1) x (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_3)))) (Dist.dist.{u2} β (PseudoMetricSpace.toHasDist.{u2} β _inst_2) y₁ y₂))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : PseudoMetricSpace.{u1} α] [_inst_2 : PseudoMetricSpace.{u2} β] [_inst_3 : Zero.{u1} α] [_inst_4 : Zero.{u2} β] [_inst_5 : SMul.{u1, u2} α β] [_inst_6 : BoundedSMul.{u1, u2} α β _inst_1 _inst_2 _inst_3 _inst_4 _inst_5] (x : α) (y₁ : β) (y₂ : β), LE.le.{0} Real Real.instLEReal (Dist.dist.{u2} β (PseudoMetricSpace.toDist.{u2} β _inst_2) (HSMul.hSMul.{u1, u2, u2} α β β (instHSMul.{u1, u2} α β _inst_5) x y₁) (HSMul.hSMul.{u1, u2, u2} α β β (instHSMul.{u1, u2} α β _inst_5) x y₂)) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (Dist.dist.{u1} α (PseudoMetricSpace.toDist.{u1} α _inst_1) x (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_3))) (Dist.dist.{u2} β (PseudoMetricSpace.toDist.{u2} β _inst_2) y₁ y₂))
Case conversion may be inaccurate. Consider using '#align dist_smul_pair dist_smul_pairₓ'. -/
theorem dist_smul_pair (x : α) (y₁ y₂ : β) : dist (x • y₁) (x • y₂) ≤ dist x 0 * dist y₁ y₂ :=
  BoundedSMul.dist_smul_pair' x y₁ y₂
#align dist_smul_pair dist_smul_pair

/- warning: dist_pair_smul -> dist_pair_smul is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : PseudoMetricSpace.{u1} α] [_inst_2 : PseudoMetricSpace.{u2} β] [_inst_3 : Zero.{u1} α] [_inst_4 : Zero.{u2} β] [_inst_5 : SMul.{u1, u2} α β] [_inst_6 : BoundedSMul.{u1, u2} α β _inst_1 _inst_2 _inst_3 _inst_4 _inst_5] (x₁ : α) (x₂ : α) (y : β), LE.le.{0} Real Real.hasLe (Dist.dist.{u2} β (PseudoMetricSpace.toHasDist.{u2} β _inst_2) (SMul.smul.{u1, u2} α β _inst_5 x₁ y) (SMul.smul.{u1, u2} α β _inst_5 x₂ y)) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (Dist.dist.{u1} α (PseudoMetricSpace.toHasDist.{u1} α _inst_1) x₁ x₂) (Dist.dist.{u2} β (PseudoMetricSpace.toHasDist.{u2} β _inst_2) y (OfNat.ofNat.{u2} β 0 (OfNat.mk.{u2} β 0 (Zero.zero.{u2} β _inst_4)))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : PseudoMetricSpace.{u1} α] [_inst_2 : PseudoMetricSpace.{u2} β] [_inst_3 : Zero.{u1} α] [_inst_4 : Zero.{u2} β] [_inst_5 : SMul.{u1, u2} α β] [_inst_6 : BoundedSMul.{u1, u2} α β _inst_1 _inst_2 _inst_3 _inst_4 _inst_5] (x₁ : α) (x₂ : α) (y : β), LE.le.{0} Real Real.instLEReal (Dist.dist.{u2} β (PseudoMetricSpace.toDist.{u2} β _inst_2) (HSMul.hSMul.{u1, u2, u2} α β β (instHSMul.{u1, u2} α β _inst_5) x₁ y) (HSMul.hSMul.{u1, u2, u2} α β β (instHSMul.{u1, u2} α β _inst_5) x₂ y)) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (Dist.dist.{u1} α (PseudoMetricSpace.toDist.{u1} α _inst_1) x₁ x₂) (Dist.dist.{u2} β (PseudoMetricSpace.toDist.{u2} β _inst_2) y (OfNat.ofNat.{u2} β 0 (Zero.toOfNat0.{u2} β _inst_4))))
Case conversion may be inaccurate. Consider using '#align dist_pair_smul dist_pair_smulₓ'. -/
theorem dist_pair_smul (x₁ x₂ : α) (y : β) : dist (x₁ • y) (x₂ • y) ≤ dist x₁ x₂ * dist y 0 :=
  BoundedSMul.dist_pair_smul' x₁ x₂ y
#align dist_pair_smul dist_pair_smul

#print BoundedSMul.continuousSMul /-
-- see Note [lower instance priority]
/-- The typeclass `has_bounded_smul` on a metric-space scalar action implies continuity of the
action. -/
instance (priority := 100) BoundedSMul.continuousSMul : ContinuousSMul α β
    where continuous_smul := by
    rw [Metric.continuous_iff]
    rintro ⟨a, b⟩ ε hε
    have : 0 ≤ dist a 0 := dist_nonneg
    have : 0 ≤ dist b 0 := dist_nonneg
    let δ : ℝ := min 1 ((dist a 0 + dist b 0 + 2)⁻¹ * ε)
    have hδ_pos : 0 < δ :=
      by
      refine' lt_min_iff.mpr ⟨by norm_num, mul_pos _ hε⟩
      rw [inv_pos]
      linarith
    refine' ⟨δ, hδ_pos, _⟩
    rintro ⟨a', b'⟩ hab'
    calc
      _ ≤ _ := dist_triangle _ (a • b') _
      _ ≤ δ * (dist a 0 + dist b 0 + δ) := _
      _ < ε := _

    · have : 0 ≤ dist a' a := dist_nonneg
      have := dist_triangle b' b 0
      have := dist_comm (a • b') (a' • b')
      have := dist_comm a a'
      have : dist a' a ≤ dist (a', b') (a, b) := le_max_left _ _
      have : dist b' b ≤ dist (a', b') (a, b) := le_max_right _ _
      have := dist_smul_pair a b' b
      have := dist_pair_smul a a' b'
      nlinarith
    · have : δ ≤ _ := min_le_right _ _
      have : δ ≤ _ := min_le_left _ _
      have : (dist a 0 + dist b 0 + 2)⁻¹ * (ε * (dist a 0 + dist b 0 + δ)) < ε := by
        rw [inv_mul_lt_iff] <;> nlinarith
      nlinarith
#align has_bounded_smul.has_continuous_smul BoundedSMul.continuousSMul
-/

/- warning: real.has_bounded_smul -> Real.boundedSMul is a dubious translation:
lean 3 declaration is
  BoundedSMul.{0, 0} Real Real Real.pseudoMetricSpace Real.pseudoMetricSpace Real.hasZero Real.hasZero (Mul.toSMul.{0} Real Real.hasMul)
but is expected to have type
  BoundedSMul.{0, 0} Real Real Real.pseudoMetricSpace Real.pseudoMetricSpace Real.instZeroReal Real.instZeroReal (Algebra.toSMul.{0, 0} Real Real Real.instCommSemiringReal Real.semiring (Algebra.id.{0} Real Real.instCommSemiringReal))
Case conversion may be inaccurate. Consider using '#align real.has_bounded_smul Real.boundedSMulₓ'. -/
-- this instance could be deduced from `normed_space.has_bounded_smul`, but we prove it separately
-- here so that it is available earlier in the hierarchy
instance Real.boundedSMul : BoundedSMul ℝ ℝ
    where
  dist_smul_pair' x y₁ y₂ := by simpa [Real.dist_eq, mul_sub] using (abs_mul x (y₁ - y₂)).le
  dist_pair_smul' x₁ x₂ y := by simpa [Real.dist_eq, sub_mul] using (abs_mul (x₁ - x₂) y).le
#align real.has_bounded_smul Real.boundedSMul

/- warning: nnreal.has_bounded_smul -> NNReal.boundedSMul is a dubious translation:
lean 3 declaration is
  BoundedSMul.{0, 0} NNReal NNReal NNReal.pseudoMetricSpace NNReal.pseudoMetricSpace (MulZeroClass.toHasZero.{0} NNReal (NonUnitalNonAssocSemiring.toMulZeroClass.{0} NNReal (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} NNReal (Semiring.toNonAssocSemiring.{0} NNReal NNReal.semiring)))) (MulZeroClass.toHasZero.{0} NNReal (NonUnitalNonAssocSemiring.toMulZeroClass.{0} NNReal (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} NNReal (Semiring.toNonAssocSemiring.{0} NNReal NNReal.semiring)))) (Mul.toSMul.{0} NNReal (Distrib.toHasMul.{0} NNReal (NonUnitalNonAssocSemiring.toDistrib.{0} NNReal (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} NNReal (Semiring.toNonAssocSemiring.{0} NNReal NNReal.semiring)))))
but is expected to have type
  BoundedSMul.{0, 0} NNReal NNReal instPseudoMetricSpaceNNReal instPseudoMetricSpaceNNReal instNNRealZero instNNRealZero (Algebra.toSMul.{0, 0} NNReal NNReal instNNRealCommSemiring instNNRealSemiring (Algebra.id.{0} NNReal instNNRealCommSemiring))
Case conversion may be inaccurate. Consider using '#align nnreal.has_bounded_smul NNReal.boundedSMulₓ'. -/
instance NNReal.boundedSMul : BoundedSMul ℝ≥0 ℝ≥0
    where
  dist_smul_pair' x y₁ y₂ := by convert dist_smul_pair (x : ℝ) (y₁ : ℝ) y₂ using 1
  dist_pair_smul' x₁ x₂ y := by convert dist_pair_smul (x₁ : ℝ) x₂ (y : ℝ) using 1
#align nnreal.has_bounded_smul NNReal.boundedSMul

#print BoundedSMul.op /-
/-- If a scalar is central, then its right action is bounded when its left action is. -/
instance BoundedSMul.op [SMul αᵐᵒᵖ β] [IsCentralScalar α β] : BoundedSMul αᵐᵒᵖ β
    where
  dist_smul_pair' :=
    MulOpposite.rec' fun x y₁ y₂ => by simpa only [op_smul_eq_smul] using dist_smul_pair x y₁ y₂
  dist_pair_smul' :=
    MulOpposite.rec' fun x₁ =>
      MulOpposite.rec' fun x₂ y => by simpa only [op_smul_eq_smul] using dist_pair_smul x₁ x₂ y
#align has_bounded_smul.op BoundedSMul.op
-/

end BoundedSMul

instance [Monoid α] [LipschitzMul α] : LipschitzAdd (Additive α) :=
  ⟨@LipschitzMul.lipschitz_mul α _ _ _⟩

instance [AddMonoid α] [LipschitzAdd α] : LipschitzMul (Multiplicative α) :=
  ⟨@LipschitzAdd.lipschitz_add α _ _ _⟩

@[to_additive]
instance [Monoid α] [LipschitzMul α] : LipschitzMul αᵒᵈ :=
  ‹LipschitzMul α›


/-
Copyright (c) 2022 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.fintype.order
import algebra.direct_limit
import model_theory.quotients
import model_theory.finitely_generated

/-!
# Direct Limits of First-Order Structures
This file constructs the direct limit of a directed system of first-order embeddings.

## Main Definitions
* `first_order.language.direct_limit G f`  is the direct limit of the directed system `f` of
  first-order embeddings between the structures indexed by `G`.
-/

universes v w u₁ u₂

open_locale first_order
namespace first_order
namespace language
open Structure set

variables {L : language} {ι : Type v} [preorder ι]
variables {G : ι → Type w} [Π i, L.Structure (G i)]
variables (f : Π i j, i ≤ j → G i ↪[L] G j)

namespace directed_system

/-- A copy of `directed_system.map_self` specialized to `L`-embeddings, as otherwise the
`λ i j h, f i j h` can confuse the simplifier. -/
lemma map_self [directed_system G (λ i j h, f i j h)] (i x h) :
  f i i h x = x :=
directed_system.map_self (λ i j h, f i j h) i x h

/-- A copy of `directed_system.map_map` specialized to `L`-embeddings, as otherwise the
`λ i j h, f i j h` can confuse the simplifier. -/
lemma map_map [directed_system G (λ i j h, f i j h)] {i j k} (hij hjk x) :
  f j k hjk (f i j hij x) = f i k (le_trans hij hjk) x :=
directed_system.map_map (λ i j h, f i j h) hij hjk x

variables {G' : ℕ → Type w} [Π i, L.Structure (G' i)] (f' : Π (n : ℕ), G' n ↪[L] G' (n + 1))

/-- Given a chain of embeddings of structures indexed by `ℕ`, defines a `directed_system` by
composing them. -/
def nat_le_rec (m n : ℕ) (h : m ≤ n) : G' m ↪[L] G' n :=
nat.le_rec_on h (λ k g, (f' k).comp g) (embedding.refl L _)

@[simp]

instance nat_le_rec.directed_system : directed_system G' (λ i j h, nat_le_rec f' i j h) :=
⟨λ i x h, congr (congr rfl (nat.le_rec_on_self _)) rfl,
  λ i j k ij jk, by simp [nat.le_rec_on_trans ij jk]⟩

end directed_system

namespace direct_limit

/-- Raises a family of elements in the `Σ`-type to the same level along the embeddings. -/
def unify {α : Type*} (x : α → (Σ i, G i)) (i : ι)
  (h : i ∈ upper_bounds (range (sigma.fst ∘ x))) (a : α) : G i :=
f (x a).1 i (h (mem_range_self a)) (x a).2

variable [directed_system G (λ i j h, f i j h)]

@[simp] lemma unify_sigma_mk_self {α : Type*} {i : ι}
  {x : α → G i} :
  unify f (sigma.mk i ∘ x) i (λ j ⟨a, hj⟩, trans (le_of_eq hj.symm) (refl _)) = x :=
begin
  ext a,
  simp only [unify, directed_system.map_self],
end

lemma comp_unify {α : Type*} {x : α → (Σ i, G i)} {i j : ι}
  (ij : i ≤ j) (h : i ∈ upper_bounds (range (sigma.fst ∘ x))) :
  (f i j ij) ∘ (unify f x i h) = unify f x j (λ k hk, trans (mem_upper_bounds.1 h k hk) ij) :=
begin
  ext a,
  simp [unify, directed_system.map_map],
end

end direct_limit

variables (G)

namespace direct_limit

/-- The directed limit glues together the structures along the embeddings. -/
def setoid [directed_system G (λ i j h, f i j h)] [is_directed ι (≤)] :
  setoid (Σ i, G i) :=
{ r := λ ⟨i, x⟩ ⟨j, y⟩, ∃ (k : ι) (ik : i ≤ k) (jk : j ≤ k), f i k ik x = f j k jk y,
  iseqv := ⟨λ ⟨i, x⟩, ⟨i, refl i, refl i, rfl⟩,
    λ ⟨i, x⟩ ⟨j, y⟩ ⟨k, ik, jk, h⟩, ⟨k, jk, ik, h.symm⟩,
    λ ⟨i, x⟩ ⟨j, y⟩ ⟨k, z⟩ ⟨ij, hiij, hjij, hij⟩ ⟨jk, hjjk, hkjk, hjk⟩,
      begin
        obtain ⟨ijk, hijijk, hjkijk⟩ := (directed_of (≤) ij jk),
        refine ⟨ijk, le_trans hiij hijijk, le_trans hkjk hjkijk, _⟩,
        rw [← directed_system.map_map, hij, directed_system.map_map],
        symmetry,
        rw [← directed_system.map_map, ← hjk, directed_system.map_map],
      end ⟩ }

/-- The structure on the `Σ`-type which becomes the structure on the direct limit after quotienting.
 -/
noncomputable def sigma_structure [is_directed ι (≤)] [nonempty ι] : L.Structure (Σ i, G i) :=
{ fun_map := λ n F x, ⟨_, fun_map F (unify f x
  (classical.some (fintype.bdd_above_range (λ a, (x a).1)))
  (classical.some_spec (fintype.bdd_above_range (λ a, (x a).1))))⟩,
                    rel_map := λ n R x, rel_map R (unify f x
  (classical.some (fintype.bdd_above_range (λ a, (x a).1)))
  (classical.some_spec (fintype.bdd_above_range (λ a, (x a).1)))) }

end direct_limit

/-- The direct limit of a directed system is the structures glued together along the embeddings. -/
def direct_limit [directed_system G (λ i j h, f i j h)] [is_directed ι (≤)] :=
quotient (direct_limit.setoid G f)

local attribute [instance] direct_limit.setoid

instance [directed_system G (λ i j h, f i j h)] [is_directed ι (≤)] [inhabited ι]
  [inhabited (G default)] : inhabited (direct_limit G f) :=
⟨⟦⟨default, default⟩⟧⟩

namespace direct_limit

variables [is_directed ι (≤)] [directed_system G (λ i j h, f i j h)]

lemma equiv_iff {x y : Σ i, G i} {i : ι} (hx : x.1 ≤ i) (hy : y.1 ≤ i) :
  x ≈ y ↔ (f x.1 i hx) x.2 = (f y.1 i hy) y.2 :=
begin
  cases x,
  cases y,
  refine ⟨λ xy, _, λ xy, ⟨i, hx, hy, xy⟩⟩,
  obtain ⟨j, _, _, h⟩ := xy,
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i j,
  have h := congr_arg (f j k jk) h,
  apply (f i k ik).injective,
  rw [directed_system.map_map, directed_system.map_map] at *,
  exact h
end

lemma fun_map_unify_equiv {n : ℕ} (F : L.functions n) (x : (fin n) → (Σ i, G i)) (i j : ι)
  (hi : i ∈ upper_bounds (range (sigma.fst ∘ x))) (hj : j ∈ upper_bounds (range (sigma.fst ∘ x))) :
  (⟨i, fun_map F (unify f x i hi)⟩ : Σ i, G i) ≈ ⟨j, fun_map F (unify f x j hj)⟩ :=
begin
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i j,
  refine ⟨k, ik, jk, _⟩,
  rw [(f i k ik).map_fun, (f j k jk).map_fun, comp_unify, comp_unify],
end

lemma rel_map_unify_equiv {n : ℕ} (R : L.relations n) (x : (fin n) → (Σ i, G i)) (i j : ι)
  (hi : i ∈ upper_bounds (range (sigma.fst ∘ x))) (hj : j ∈ upper_bounds (range (sigma.fst ∘ x)))  :
  rel_map R (unify f x i hi) = rel_map R (unify f x j hj) :=
begin
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i j,
  rw [← (f i k ik).map_rel, comp_unify, ← (f j k jk).map_rel, comp_unify],
end

variable [nonempty ι]

lemma exists_unify_eq {α : Type*} [fintype α] {x y : α → (Σ i, G i)} (xy : x ≈ y) :
  ∃ (i : ι) (hx : i ∈ upper_bounds (range (sigma.fst ∘ x)))
    (hy : i ∈ upper_bounds (range (sigma.fst ∘ y))),
  unify f x i hx = unify f y i hy :=
begin
  obtain ⟨i, hi⟩ := fintype.bdd_above_range (sum.elim (λ a, (x a).1) (λ a, (y a).1)),
  rw [sum.elim_range, upper_bounds_union] at hi,
  simp_rw [← function.comp_apply sigma.fst _] at hi,
  exact ⟨i, hi.1, hi.2, funext (λ a, (equiv_iff G f _ _).1 (xy a))⟩,
end

lemma fun_map_equiv_unify {n : ℕ} (F : L.functions n) (x : (fin n) → (Σ i, G i)) (i : ι)
  (hi : i ∈ upper_bounds (range (sigma.fst ∘ x))) :
  @fun_map _ _ (sigma_structure G f) _ F x ≈ ⟨_, fun_map F (unify f x i hi)⟩ :=
fun_map_unify_equiv G f F x (classical.some (fintype.bdd_above_range (λ a, (x a).1))) i _ hi

lemma rel_map_equiv_unify {n : ℕ} (R : L.relations n) (x : (fin n) → (Σ i, G i)) (i : ι)
  (hi : i ∈ upper_bounds (range (sigma.fst ∘ x)))  :
  @rel_map _ _ (sigma_structure G f) _ R x = rel_map R (unify f x i hi) :=
rel_map_unify_equiv G f R x (classical.some (fintype.bdd_above_range (λ a, (x a).1))) i _ hi

/-- The direct limit `setoid` respects the structure `sigma_structure`, so quotienting by it
  gives rise to a valid structure. -/
noncomputable instance prestructure : L.prestructure (direct_limit.setoid G f) :=
{ to_structure := sigma_structure G f,
  fun_equiv := λ n F x y xy, begin
    obtain ⟨i, hx, hy, h⟩ := exists_unify_eq G f xy,
    refine setoid.trans (fun_map_equiv_unify G f F x i hx)
      (setoid.trans _ (setoid.symm (fun_map_equiv_unify G f F y i hy))),
    rw h,
  end,
  rel_equiv := λ n R x y xy, begin
    obtain ⟨i, hx, hy, h⟩ := exists_unify_eq G f xy,
    refine trans (rel_map_equiv_unify G f R x i hx)
      (trans _ (symm (rel_map_equiv_unify G f R y i hy))),
    rw h,
  end }

/-- The `L.Structure` on a direct limit of `L.Structure`s. -/
noncomputable instance Structure : L.Structure (direct_limit G f) := language.quotient_structure

@[simp] lemma fun_map_quotient_mk_sigma_mk {n : ℕ} {F : L.functions n} {i : ι} {x : fin n → G i} :
  fun_map F (λ a, (⟦⟨i, x a⟩⟧ : direct_limit G f)) = ⟦⟨i, fun_map F x⟩⟧ :=
begin
  simp only [function.comp_app, fun_map_quotient_mk, quotient.eq],
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i (classical.some (fintype.bdd_above_range
    (λ (a : fin n), i))),
  refine ⟨k, jk, ik, _⟩,
  simp only [embedding.map_fun, comp_unify],
  refl
end

@[simp] lemma rel_map_quotient_mk_sigma_mk {n : ℕ} {R : L.relations n} {i : ι} {x : fin n → G i} :
  rel_map R (λ a, (⟦⟨i, x a⟩⟧ : direct_limit G f)) = rel_map R x :=
begin
  rw [rel_map_quotient_mk],
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i (classical.some (fintype.bdd_above_range
    (λ (a : fin n), i))),
  rw [rel_map_equiv_unify G f R (λ a, ⟨i, x a⟩) i, unify_sigma_mk_self],
end

lemma exists_quotient_mk_sigma_mk_eq {α : Type*} [fintype α] (x : α → direct_limit G f) :
  ∃ (i : ι) (y : α → G i), x = quotient.mk ∘ (sigma.mk i) ∘ y :=
begin
  obtain ⟨i, hi⟩ := fintype.bdd_above_range (λ a, (x a).out.1),
  refine ⟨i, unify f (quotient.out ∘ x) i hi, _⟩,
  ext a,
  rw [quotient.eq_mk_iff_out, function.comp_app, unify, equiv_iff G f _],
  { simp only [directed_system.map_self] },
  { refl }
end

variables (L ι)

/-- The canonical map from a component to the direct limit. -/
def of (i : ι) : G i ↪[L] direct_limit G f :=
{ to_fun := quotient.mk ∘ sigma.mk i,
  inj' := λ x y h, begin
    simp only [quotient.eq] at h,
    obtain ⟨j, h1, h2, h3⟩ := h,
    exact (f i j h1).injective h3,
  end }

variables {L ι G f}

@[simp] lemma of_apply {i : ι} {x : G i} : of L ι G f i x = ⟦⟨i, x⟩⟧ := rfl

@[simp] lemma of_f {i j : ι} {hij : i ≤ j} {x : G i} :
  (of L ι G f j (f i j hij x)) = of L ι G f i x :=
begin
  simp only [of_apply, quotient.eq],
  refine setoid.symm ⟨j, hij, refl j, _⟩,
  simp only [directed_system.map_self],
end

/-- Every element of the direct limit corresponds to some element in
some component of the directed system. -/
theorem exists_of (z : direct_limit G f) :
  ∃ i x, of L ι G f i x = z :=
⟨z.out.1, z.out.2, by simp⟩

@[elab_as_eliminator]
protected theorem induction_on {C : direct_limit G f → Prop}
  (z : direct_limit G f)
  (ih : ∀ i x, C (of L ι G f i x)) : C z :=
let ⟨i, x, h⟩ := exists_of z in h ▸ ih i x

variables {P : Type u₁} [L.Structure P] (g : Π i, G i ↪[L] P)
variables (Hg : ∀ i j hij x, g j (f i j hij x) = g i x)
include Hg

variables (L ι G f)
/-- The universal property of the direct limit: maps from the components to another module
that respect the directed system structure (i.e. make some diagram commute) give rise
to a unique map out of the direct limit. -/
def lift : direct_limit G f ↪[L] P :=
{ to_fun := quotient.lift (λ (x : Σ i, G i), (g x.1) x.2) (λ x y xy, begin
    simp only,
    obtain ⟨i, hx, hy⟩ := directed_of (≤) x.1 y.1,
    rw [← Hg x.1 i hx, ← Hg y.1 i hy],
    exact congr_arg _ ((equiv_iff _ _ _ _).1 xy),
  end),
  inj' := λ x y xy, begin
    rw [← quotient.out_eq x, ← quotient.out_eq y, quotient.lift_mk, quotient.lift_mk] at xy,
    obtain ⟨i, hx, hy⟩ := directed_of (≤) x.out.1 y.out.1,
    rw [← Hg x.out.1 i hx, ← Hg y.out.1 i hy] at xy,
    rw [← quotient.out_eq x, ← quotient.out_eq y, quotient.eq, equiv_iff G f hx hy],
    exact (g i).injective xy,
  end,
  map_fun' := λ n F x, begin
    obtain ⟨i, y, rfl⟩ := exists_quotient_mk_sigma_mk_eq G f x,
    rw [fun_map_quotient_mk_sigma_mk, ← function.comp.assoc, quotient.lift_comp_mk],
    simp only [quotient.lift_mk, embedding.map_fun],
  end,
  map_rel' := λ n R x, begin
    obtain ⟨i, y, rfl⟩ := exists_quotient_mk_sigma_mk_eq G f x,
    rw [rel_map_quotient_mk_sigma_mk G f, ← (g i).map_rel R y,
      ← function.comp.assoc, quotient.lift_comp_mk],
  end }

variables {L ι G f}

omit Hg

@[simp] lemma lift_quotient_mk_sigma_mk {i} (x : G i) :
  lift L ι G f g Hg (⟦⟨i, x⟩⟧) = (g i) x :=
begin
  change (lift L ι G f g Hg).to_fun (⟦⟨i, x⟩⟧) = _,
  simp only [lift, quotient.lift_mk],
end

lemma lift_of {i} (x : G i) : lift L ι G f g Hg (of L ι G f i x) = g i x :=
by simp

theorem lift_unique (F : direct_limit G f ↪[L] P) (x) :
  F x = lift L ι G f (λ i, F.comp $ of L ι G f i)
    (λ i j hij x, by rw [F.comp_apply, F.comp_apply, of_f]) x :=
direct_limit.induction_on x $ λ i x, by rw lift_of; refl

/-- The direct limit of countably many countably generated structures is countably generated. -/
theorem cg {ι : Type*} [encodable ι] [preorder ι] [is_directed ι (≤)] [nonempty ι]
  {G : ι → Type w} [Π i, L.Structure (G i)]
  (f : Π i j, i ≤ j → G i ↪[L] G j) (h : ∀ i, Structure.cg L (G i))
  [directed_system G (λ i j h, f i j h)] :
  Structure.cg L (direct_limit G f) :=
begin
  refine ⟨⟨⋃ i, direct_limit.of L ι G f i '' (classical.some (h i).out), _, _⟩⟩,
  { exact set.countable_Union (λ i, set.countable.image (classical.some_spec (h i).out).1 _) },
  { rw [eq_top_iff, substructure.closure_Union],
    simp_rw [← embedding.coe_to_hom, substructure.closure_image],
    rw le_supr_iff,
    intros S hS x hx,
    let out := @quotient.out _ (direct_limit.setoid G f),
    refine hS (out x).1 ⟨(out x).2, _, _⟩,
    { rw [(classical.some_spec (h (out x).1).out).2],
      simp only [substructure.coe_top] },
    { simp only [embedding.coe_to_hom, direct_limit.of_apply, sigma.eta, quotient.out_eq] } }
end

instance cg' {ι : Type*} [encodable ι] [preorder ι] [is_directed ι (≤)] [nonempty ι]
  {G : ι → Type w} [Π i, L.Structure (G i)]
  (f : Π i j, i ≤ j → G i ↪[L] G j) [h : ∀ i, Structure.cg L (G i)]
  [directed_system G (λ i j h, f i j h)] :
  Structure.cg L (direct_limit G f) :=
cg f h

end direct_limit

end language
end first_order


/-
Copyright (c) 2020 Alexander Bentkamp, Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.complex.basic
import Mathlib.data.matrix.notation
import Mathlib.field_theory.tower
import Mathlib.linear_algebra.finite_dimensional
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Complex number as a vector space over `ℝ`

This file contains three instances:
* `ℂ` is an `ℝ` algebra;
* any complex vector space is a real vector space;
* any finite dimensional complex vector space is a finite dimesional real vector space;
* the space of `ℝ`-linear maps from a real vector space to a complex vector space is a complex
  vector space.

It also defines three linear maps:

* `complex.linear_map.re`;
* `complex.linear_map.im`;
* `complex.linear_map.of_real`.

They are bundled versions of the real part, the imaginary part, and the embedding of `ℝ` in `ℂ`,
as `ℝ`-linear maps.
-/

namespace complex

protected instance algebra_over_reals : algebra ℝ ℂ := ring_hom.to_algebra of_real

@[simp] theorem coe_algebra_map : ⇑(algebra_map ℝ ℂ) = ⇑of_real := rfl

@[simp] theorem re_smul (a : ℝ) (z : ℂ) : re (a • z) = a * re z := sorry

@[simp] theorem im_smul (a : ℝ) (z : ℂ) : im (a • z) = a * im z := sorry

theorem is_basis_one_I : is_basis ℝ (matrix.vec_cons 1 (matrix.vec_cons I matrix.vec_empty)) :=
  sorry

protected instance finite_dimensional : finite_dimensional ℝ ℂ :=
  finite_dimensional.of_fintype_basis is_basis_one_I

@[simp] theorem findim_real_complex : finite_dimensional.findim ℝ ℂ = bit0 1 := sorry

@[simp] theorem dim_real_complex : vector_space.dim ℝ ℂ = bit0 1 := sorry

theorem dim_real_complex' : cardinal.lift (vector_space.dim ℝ ℂ) = bit0 1 := sorry

end complex

/- Register as an instance (with low priority) the fact that a complex vector space is also a real
vector space. -/

protected instance module.complex_to_real (E : Type u_1) [add_comm_group E] [module ℂ E] :
    module ℝ E :=
  restrict_scalars.semimodule ℝ ℂ E

protected instance module.real_complex_tower (E : Type u_1) [add_comm_group E] [module ℂ E] :
    is_scalar_tower ℝ ℂ E :=
  restrict_scalars.is_scalar_tower ℝ ℂ E

protected instance finite_dimensional.complex_to_real (E : Type u_1) [add_comm_group E] [module ℂ E]
    [finite_dimensional ℂ E] : finite_dimensional ℝ E :=
  finite_dimensional.trans ℝ ℂ E

theorem dim_real_of_complex (E : Type u_1) [add_comm_group E] [module ℂ E] :
    vector_space.dim ℝ E = bit0 1 * vector_space.dim ℂ E :=
  sorry

theorem findim_real_of_complex (E : Type u_1) [add_comm_group E] [module ℂ E] :
    finite_dimensional.findim ℝ E = bit0 1 * finite_dimensional.findim ℂ E :=
  sorry

namespace complex

/-- Linear map version of the real part function, from `ℂ` to `ℝ`. -/
def linear_map.re : linear_map ℝ ℂ ℝ := linear_map.mk (fun (x : ℂ) => re x) add_re re_smul

@[simp] theorem linear_map.coe_re : ⇑linear_map.re = re := rfl

/-- Linear map version of the imaginary part function, from `ℂ` to `ℝ`. -/
def linear_map.im : linear_map ℝ ℂ ℝ := linear_map.mk (fun (x : ℂ) => im x) add_im im_smul

@[simp] theorem linear_map.coe_im : ⇑linear_map.im = im := rfl

/-- Linear map version of the canonical embedding of `ℝ` in `ℂ`. -/
def linear_map.of_real : linear_map ℝ ℝ ℂ := linear_map.mk coe of_real_add sorry

@[simp] theorem linear_map.coe_of_real : ⇑linear_map.of_real = coe := rfl

end Mathlib


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.finset.basic
import data.multiset.fold

/-!
# The fold operation for a commutative associative operation over a finset.
-/

namespace finset
open multiset

variables {α β γ : Type*}

/-! ### fold -/
section fold
variables (op : β → β → β) [hc : is_commutative β op] [ha : is_associative β op]
local notation a * b := op a b
include hc ha

/-- `fold op b f s` folds the commutative associative operation `op` over the
  `f`-image of `s`, i.e. `fold (+) b f {1,2,3} = f 1 + f 2 + f 3 + b`. -/
def fold (b : β) (f : α → β) (s : finset α) : β := (s.1.map f).fold op b

variables {op} {f : α → β} {b : β} {s : finset α} {a : α}

@[simp] theorem fold_empty : (∅ : finset α).fold op b f = b := rfl

@[simp] theorem fold_cons (h : a ∉ s) : (cons a s h).fold op b f = f a * s.fold op b f :=
by { dunfold fold, rw [cons_val, map_cons, fold_cons_left], }

@[simp] theorem fold_insert [decidable_eq α] (h : a ∉ s) :
  (insert a s).fold op b f = f a * s.fold op b f :=
by unfold fold; rw [insert_val, ndinsert_of_not_mem h, map_cons, fold_cons_left]

@[simp] theorem fold_singleton : ({a} : finset α).fold op b f = f a * b := rfl

@[simp]

@[simp] theorem fold_image [decidable_eq α] {g : γ → α} {s : finset γ}
  (H : ∀ (x ∈ s) (y ∈ s), g x = g y → x = y) : (s.image g).fold op b f = s.fold op b (f ∘ g) :=
by simp only [fold, image_val_of_inj_on H, multiset.map_map]

@[congr] theorem fold_congr {g : α → β} (H : ∀ x ∈ s, f x = g x) : s.fold op b f = s.fold op b g :=
by rw [fold, fold, map_congr H]

theorem fold_op_distrib {f g : α → β} {b₁ b₂ : β} :
  s.fold op (b₁ * b₂) (λx, f x * g x) = s.fold op b₁ f * s.fold op b₂ g :=
by simp only [fold, fold_distrib]

theorem fold_hom {op' : γ → γ → γ} [is_commutative γ op'] [is_associative γ op']
  {m : β → γ} (hm : ∀x y, m (op x y) = op' (m x) (m y)) :
  s.fold op' (m b) (λx, m (f x)) = m (s.fold op b f) :=
by rw [fold, fold, ← fold_hom op hm, multiset.map_map]

theorem fold_union_inter [decidable_eq α] {s₁ s₂ : finset α} {b₁ b₂ : β} :
  (s₁ ∪ s₂).fold op b₁ f * (s₁ ∩ s₂).fold op b₂ f = s₁.fold op b₂ f * s₂.fold op b₁ f :=
by unfold fold; rw [← fold_add op, ← multiset.map_add, union_val,
     inter_val, union_add_inter, multiset.map_add, hc.comm, fold_add]

@[simp] theorem fold_insert_idem [decidable_eq α] [hi : is_idempotent β op] :
  (insert a s).fold op b f = f a * s.fold op b f :=
begin
  by_cases (a ∈ s),
  { rw [← insert_erase h], simp [← ha.assoc, hi.idempotent] },
  { apply fold_insert h },
end

theorem fold_image_idem [decidable_eq α] {g : γ → α} {s : finset γ}
  [hi : is_idempotent β op] :
  (image g s).fold op b f = s.fold op b (f ∘ g) :=
begin
  induction s using finset.cons_induction with x xs hx ih,
  { rw [fold_empty, image_empty, fold_empty] },
  { haveI := classical.dec_eq γ,
    rw [fold_cons, cons_eq_insert, image_insert, fold_insert_idem, ih], }
end

lemma fold_op_rel_iff_and
  {r : β → β → Prop} (hr : ∀ {x y z}, r x (op y z) ↔ (r x y ∧ r x z)) {c : β} :
  r c (s.fold op b f) ↔ (r c b ∧ ∀ x∈s, r c (f x)) :=
begin
  classical,
  apply finset.induction_on s, { simp },
  clear s, intros a s ha IH,
  rw [finset.fold_insert ha, hr, IH, ← and_assoc, and_comm (r c (f a)), and_assoc],
  apply and_congr iff.rfl,
  split,
  { rintro ⟨h₁, h₂⟩, intros b hb, rw finset.mem_insert at hb,
    rcases hb with rfl|hb; solve_by_elim },
  { intro h, split,
    { exact h a (finset.mem_insert_self _ _), },
    { intros b hb, apply h b, rw finset.mem_insert, right, exact hb } }
end

lemma fold_op_rel_iff_or
  {r : β → β → Prop} (hr : ∀ {x y z}, r x (op y z) ↔ (r x y ∨ r x z)) {c : β} :
  r c (s.fold op b f) ↔ (r c b ∨ ∃ x∈s, r c (f x)) :=
begin
  classical,
  apply finset.induction_on s, { simp },
  clear s, intros a s ha IH,
  rw [finset.fold_insert ha, hr, IH, ← or_assoc, or_comm (r c (f a)), or_assoc],
  apply or_congr iff.rfl,
  split,
  { rintro (h₁|⟨x, hx, h₂⟩),
    { use a, simp [h₁] },
    { refine ⟨x, by simp [hx], h₂⟩ } },
  { rintro ⟨x, hx, h⟩,
    rw mem_insert at hx, cases hx,
    { left, rwa hx at h },
    { right, exact ⟨x, hx, h⟩ } }
end

omit hc ha

@[simp]
lemma fold_union_empty_singleton [decidable_eq α] (s : finset α) :
  finset.fold (∪) ∅ singleton s = s :=
begin
  apply finset.induction_on s,
  { simp only [fold_empty], },
  { intros a s has ih, rw [fold_insert has, ih, insert_eq], }
end

lemma fold_sup_bot_singleton [decidable_eq α] (s : finset α) :
  finset.fold (⊔) ⊥ singleton s = s :=
fold_union_empty_singleton s

section order
variables [linear_order β] (c : β)

lemma le_fold_min : c ≤ s.fold min b f ↔ (c ≤ b ∧ ∀ x∈s, c ≤ f x) :=
fold_op_rel_iff_and $ λ x y z, le_min_iff

lemma fold_min_le : s.fold min b f ≤ c ↔ (b ≤ c ∨ ∃ x∈s, f x ≤ c) :=
begin
  show _ ≥ _ ↔ _,
  apply fold_op_rel_iff_or,
  intros x y z,
  show _ ≤ _ ↔ _,
  exact min_le_iff
end

lemma lt_fold_min : c < s.fold min b f ↔ (c < b ∧ ∀ x∈s, c < f x) :=
fold_op_rel_iff_and $ λ x y z, lt_min_iff

lemma fold_min_lt : s.fold min b f < c ↔ (b < c ∨ ∃ x∈s, f x < c) :=
begin
  show _ > _ ↔ _,
  apply fold_op_rel_iff_or,
  intros x y z,
  show _ < _ ↔ _,
  exact min_lt_iff
end

lemma fold_max_le : s.fold max b f ≤ c ↔ (b ≤ c ∧ ∀ x∈s, f x ≤ c) :=
begin
  show _ ≥ _ ↔ _,
  apply fold_op_rel_iff_and,
  intros x y z,
  show _ ≤ _ ↔ _,
  exact max_le_iff
end

lemma le_fold_max : c ≤ s.fold max b f ↔ (c ≤ b ∨ ∃ x∈s, c ≤ f x) :=
fold_op_rel_iff_or $ λ x y z, le_max_iff

lemma fold_max_lt : s.fold max b f < c ↔ (b < c ∧ ∀ x∈s, f x < c) :=
begin
  show _ > _ ↔ _,
  apply fold_op_rel_iff_and,
  intros x y z,
  show _ < _ ↔ _,
  exact max_lt_iff
end

lemma lt_fold_max : c < s.fold max b f ↔ (c < b ∨ ∃ x∈s, c < f x) :=
fold_op_rel_iff_or $ λ x y z, lt_max_iff

end order

end fold

end finset


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.logic.function.conjugate
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Iterations of a function

In this file we prove simple properties of `nat.iterate f n` a.k.a. `f^[n]`:

* `iterate_zero`, `iterate_succ`, `iterate_succ'`, `iterate_add`, `iterate_mul`:
  formulas for `f^[0]`, `f^[n+1]` (two versions), `f^[n+m]`, and `f^[n*m]`;

* `iterate_id` : `id^[n]=id`;

* `injective.iterate`, `surjective.iterate`, `bijective.iterate` :
  iterates of an injective/surjective/bijective function belong to the same class;

* `left_inverse.iterate`, `right_inverse.iterate`, `commute.iterate_left`, `comute.iterate_right`,
  `commute.iterate_iterate`:
  some properties of pairs of functions survive under iterations

* `iterate_fixed`, `semiconj.iterate_*`, `semiconj₂.iterate`:
  if `f` fixes a point (resp., semiconjugates unary/binary operarations), then so does `f^[n]`.

-/

namespace function

@[simp] theorem iterate_zero {α : Type u} (f : α → α) : nat.iterate f 0 = id :=
  rfl

theorem iterate_zero_apply {α : Type u} (f : α → α) (x : α) : nat.iterate f 0 x = x :=
  rfl

@[simp] theorem iterate_succ {α : Type u} (f : α → α) (n : ℕ) : nat.iterate f (Nat.succ n) = nat.iterate f n ∘ f :=
  rfl

theorem iterate_succ_apply {α : Type u} (f : α → α) (n : ℕ) (x : α) : nat.iterate f (Nat.succ n) x = nat.iterate f n (f x) :=
  rfl

@[simp] theorem iterate_id {α : Type u} (n : ℕ) : nat.iterate id n = id := sorry

theorem iterate_add {α : Type u} (f : α → α) (m : ℕ) (n : ℕ) : nat.iterate f (m + n) = nat.iterate f m ∘ nat.iterate f n := sorry

theorem iterate_add_apply {α : Type u} (f : α → α) (m : ℕ) (n : ℕ) (x : α) : nat.iterate f (m + n) x = nat.iterate f m (nat.iterate f n x) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat.iterate f (m + n) x = nat.iterate f m (nat.iterate f n x))) (iterate_add f m n)))
    (Eq.refl (comp (nat.iterate f m) (nat.iterate f n) x))

@[simp] theorem iterate_one {α : Type u} (f : α → α) : nat.iterate f 1 = f :=
  funext fun (a : α) => rfl

theorem iterate_mul {α : Type u} (f : α → α) (m : ℕ) (n : ℕ) : nat.iterate f (m * n) = nat.iterate (nat.iterate f m) n := sorry

theorem iterate_fixed {α : Type u} {f : α → α} {x : α} (h : f x = x) (n : ℕ) : nat.iterate f n x = x := sorry

theorem injective.iterate {α : Type u} {f : α → α} (Hinj : injective f) (n : ℕ) : injective (nat.iterate f n) :=
  nat.rec_on n injective_id fun (n : ℕ) (ihn : injective (nat.iterate f n)) => injective.comp ihn Hinj

theorem surjective.iterate {α : Type u} {f : α → α} (Hsurj : surjective f) (n : ℕ) : surjective (nat.iterate f n) :=
  nat.rec_on n surjective_id fun (n : ℕ) (ihn : surjective (nat.iterate f n)) => surjective.comp ihn Hsurj

theorem bijective.iterate {α : Type u} {f : α → α} (Hbij : bijective f) (n : ℕ) : bijective (nat.iterate f n) :=
  { left := injective.iterate (and.left Hbij) n, right := surjective.iterate (and.right Hbij) n }

namespace semiconj

theorem iterate_right {α : Type u} {β : Type v} {f : α → β} {ga : α → α} {gb : β → β} (h : semiconj f ga gb) (n : ℕ) : semiconj f (nat.iterate ga n) (nat.iterate gb n) :=
  nat.rec_on n id_right fun (n : ℕ) (ihn : semiconj f (nat.iterate ga n) (nat.iterate gb n)) => comp_right ihn h

theorem iterate_left {α : Type u} {f : α → α} {g : ℕ → α → α} (H : ∀ (n : ℕ), semiconj f (g n) (g (n + 1))) (n : ℕ) (k : ℕ) : semiconj (nat.iterate f n) (g k) (g (n + k)) := sorry

end semiconj

namespace commute

theorem iterate_right {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (n : ℕ) : commute f (nat.iterate g n) :=
  semiconj.iterate_right h n

theorem iterate_left {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (n : ℕ) : commute (nat.iterate f n) g :=
  symm (iterate_right (symm h) n)

theorem iterate_iterate {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (m : ℕ) (n : ℕ) : commute (nat.iterate f m) (nat.iterate g n) :=
  iterate_right (iterate_left h m) n

theorem iterate_eq_of_map_eq {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (n : ℕ) {x : α} (hx : f x = g x) : nat.iterate f n x = nat.iterate g n x := sorry

theorem comp_iterate {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (n : ℕ) : nat.iterate (f ∘ g) n = nat.iterate f n ∘ nat.iterate g n := sorry

theorem iterate_self {α : Type u} (f : α → α) (n : ℕ) : commute (nat.iterate f n) f :=
  iterate_left (refl f) n

theorem self_iterate {α : Type u} (f : α → α) (n : ℕ) : commute f (nat.iterate f n) :=
  iterate_right (refl f) n

theorem iterate_iterate_self {α : Type u} (f : α → α) (m : ℕ) (n : ℕ) : commute (nat.iterate f m) (nat.iterate f n) :=
  iterate_iterate (refl f) m n

end commute

theorem semiconj₂.iterate {α : Type u} {f : α → α} {op : α → α → α} (hf : semiconj₂ f op op) (n : ℕ) : semiconj₂ (nat.iterate f n) op op :=
  nat.rec_on n (semiconj₂.id_left op) fun (n : ℕ) (ihn : semiconj₂ (nat.iterate f n) op op) => semiconj₂.comp ihn hf

theorem iterate_succ' {α : Type u} (f : α → α) (n : ℕ) : nat.iterate f (Nat.succ n) = f ∘ nat.iterate f n := sorry

theorem iterate_succ_apply' {α : Type u} (f : α → α) (n : ℕ) (x : α) : nat.iterate f (Nat.succ n) x = f (nat.iterate f n x) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat.iterate f (Nat.succ n) x = f (nat.iterate f n x))) (iterate_succ' f n)))
    (Eq.refl (comp f (nat.iterate f n) x))

theorem iterate_pred_comp_of_pos {α : Type u} (f : α → α) {n : ℕ} (hn : 0 < n) : nat.iterate f (Nat.pred n) ∘ f = nat.iterate f n := sorry

theorem comp_iterate_pred_of_pos {α : Type u} (f : α → α) {n : ℕ} (hn : 0 < n) : f ∘ nat.iterate f (Nat.pred n) = nat.iterate f n := sorry

theorem left_inverse.iterate {α : Type u} {f : α → α} {g : α → α} (hg : left_inverse g f) (n : ℕ) : left_inverse (nat.iterate g n) (nat.iterate f n) := sorry

theorem right_inverse.iterate {α : Type u} {f : α → α} {g : α → α} (hg : right_inverse g f) (n : ℕ) : right_inverse (nat.iterate g n) (nat.iterate f n) :=
  left_inverse.iterate hg n


-- El tipo de las listas
-- =====================

import tactic

variable {α : Type}

-- ----------------------------------------------------
-- Ejercicio 1. Definir el tipo Lista con elementos de
-- tipo α con los constructores NIl (para la lista
-- vacía y Cons (para añadir un elemento al principio
-- de una lista).
-- ----------------------------------------------------

inductive Lista (α : Type*)
| Nil  : Lista
| Cons : α → Lista → Lista

-- #print prefix Lista

-- ----------------------------------------------------
-- Ejercicio 2. Abrir el espacio de nombre Lista.
-- ----------------------------------------------------

namespace Lista

-- ----------------------------------------------------
-- Ejercicio 3. Definir la función
--    repr : Lista α → string
-- tal que (repr xs) es la cadena que representa a la
-- lista xs. Por ejemplo,
--     repr (Cons 3 (Cons 7 (Cons 5 Nil)))
--     Da: "(Cons 3 (Cons 7 (Cons 5 Nil)))"
-- ----------------------------------------------------

def repr [has_repr α] : Lista α → string
| Nil         := "Nil"
| (Cons x xs) := "(Cons " ++ has_repr.repr x ++ " " ++ repr xs ++ ")"

-- #eval repr (Cons 3 (Cons 7 (Cons 5 Nil)))
-- Da: "(Cons 3 (Cons 7 (Cons 5 Nil)))"

-- ----------------------------------------------------
-- Ejercicio 4. Declarar repr la función para
-- representar listas. Por ejemplo,
--    #eval Cons 3 (Cons 7 (Cons 5 Nil))
--    Da: (Cons 3 (Cons 7 (Cons 5 Nil)))
-- ----------------------------------------------------

instance [has_repr α] : has_repr (Lista α) := ⟨repr⟩

-- #eval Cons 3 (Cons 7 (Cons 5 Nil))
-- Da: (Cons 3 (Cons 7 (Cons 5 Nil)))

-- ----------------------------------------------------
-- Ejercicio 5. Declarar x como variable sobre
-- elementos de tipo α y xs e ys como variables sobre
-- listas de elementos de tipo α
-- ----------------------------------------------------

variable  (x : α)
variables (xs ys : Lista α)

-- ----------------------------------------------------
-- Ejercicio 6. Definir la función
--    longitud : Lista α → ℕ
-- tal que (longitud xs) es la longitud de la lista
-- xs. Por ejemplo,
--    longitud (Cons 2 (Cons 3 (Cons 5 Nil))) =  3
-- ----------------------------------------------------

def longitud : Lista α → ℕ
| Nil         := 0
| (Cons _ xs) := 1 + longitud xs

-- #eval longitud (Cons 2 (Cons 3 (Cons 5 Nil))) -- =  3

-- ----------------------------------------------------
-- Ejercicio 7. Demostrar los siguientes lemas
-- + longitud_nil :
--      longitud (Nil : Lista α) = 0
-- + longitud_cons :
--     longitud (Cons x xs) = 1 + longitud xs
-- ----------------------------------------------------

@[simp]
lemma longitud_nil :
  longitud (Nil : Lista α) = 0 :=
rfl

@[simp]
lemma longitud_cons :
  longitud (Cons x xs) = 1 + longitud xs :=
rfl

-- ----------------------------------------------------
-- Ejercicio 8. Definir la función
--    conc : Lista α → Lista α → Lista α
-- tal que (conc xs ys) es la concatenación de las
-- listas xs e ys. Por ejemplo,
--    conc (Cons 2 (Cons 3 Nil)) (Cons 7 (Cons 1 Nil))
--    Da: (Cons 2 (Cons 3 (Cons 7 (Cons 1 Nil))))
-- ----------------------------------------------------

def conc : Lista α → Lista α → Lista α
| Nil         ys := ys
| (Cons x xs) ys := Cons x (conc xs ys)

-- #eval conc (Cons 2 (Cons 3 Nil)) (Cons 7 (Cons 1 Nil))
-- Da: (Cons 2 (Cons 3 (Cons 7 (Cons 1 Nil))))

-- ----------------------------------------------------
-- Ejercicio 9. Demostrar los siguientes lemas
-- + conc_nil :
--      conc Nil ys = ys
-- + conc_cons :
--      conc (Cons x xs) ys = Cons x (conc xs ys)
-- ----------------------------------------------------

@[simp]
lemma  conc_nil :
  conc Nil ys = ys :=
rfl

@[simp]
lemma conc_cons :
   conc (Cons x xs) ys = Cons x (conc xs ys) :=
rfl

-- ----------------------------------------------------
-- Ejercicio 11. Demostrar que
--    longitud (conc xs ys) = longitud xs + longitud ys
-- ----------------------------------------------------

-- Para que no use la notación con puntos
set_option pp.structure_projections false

-- 1ª demostración
example :
  longitud (conc xs ys) = longitud xs + longitud ys :=
begin
  induction xs with a as HI,
  { rw conc_nil,
    rw longitud_nil,
    rw nat.zero_add, },
  { rw conc_cons,
    rw longitud_cons,
    rw HI,
    rw longitud_cons,
    rw add_assoc, },
end

-- 2ª demostración
example :
  longitud (conc xs ys) = longitud xs + longitud ys :=
begin
  induction xs with a as HI,
  { simp, },
  { simp [HI, add_assoc], },
end

-- 3ª demostración
example :
  longitud (conc xs ys) = longitud xs + longitud ys :=
begin
  induction xs with a as HI,
  { simp, },
  { finish [HI],},
end

-- 4ª demostración
example :
  longitud (conc xs ys) = longitud xs + longitud ys :=
by induction xs ; finish [*]

-- 5ª demostración
example :
  longitud (conc xs ys) = longitud xs + longitud ys :=
begin
  induction xs with a as HI,
  { calc longitud (conc Nil ys)
         = longitud ys                        : by rw conc_nil
     ... = 0 + longitud ys                    : by rw zero_add
     ... = longitud Nil + longitud ys         : by rw longitud_nil },
  { calc longitud (conc (Cons a as) ys)
         = longitud (Cons a (conc as ys))     : by rw conc_cons
     ... = 1 + longitud (conc as ys)          : by rw longitud_cons
     ... = 1 + (longitud as + longitud ys)    : by rw HI
     ... = (1 + longitud as) + longitud ys    : by rw add_assoc
     ... = longitud (Cons a as) + longitud ys : by rw longitud_cons, },
end

-- 6ª demostración
example :
  longitud (conc xs ys) = longitud xs + longitud ys :=
Lista.rec_on xs
  ( show longitud (conc Nil ys) = longitud Nil + longitud ys, from
      calc longitud (conc Nil ys)
           = longitud ys                      : by rw conc_nil
       ... = 0 + longitud ys                  : by exact (zero_add (longitud ys)).symm
       ... = longitud Nil + longitud ys       : by rw longitud_nil )
  ( assume a as,
    assume HI : longitud (conc as ys) = longitud as + longitud ys,
    show longitud (conc (Cons a as) ys) = longitud (Cons a as) + longitud ys, from
      calc longitud (conc (Cons a as) ys)
           = longitud (Cons a (conc as ys))     : by rw conc_cons
       ... = 1 + longitud (conc as ys)          : by rw longitud_cons
       ... = 1 + (longitud as + longitud ys)    : by rw HI
       ... = (1 + longitud as) + longitud ys    : by rw add_assoc
       ... = longitud (Cons a as) + longitud ys : by rw longitud_cons)

-- 7ª demostración
example :
  longitud (conc xs ys) = longitud xs + longitud ys :=
Lista.rec_on xs
  ( by simp)
  ( λ a as HI, by simp [HI, add_assoc])

-- 8ª demostración
lemma longitud_conc_1 :
  ∀ xs, longitud (conc xs ys) = longitud xs + longitud ys
| Nil := by calc
    longitud (conc Nil ys)
        = longitud ys                      : by rw conc_nil
    ... = 0 + longitud ys                  : by rw zero_add
    ... = longitud Nil + longitud ys       : by rw longitud_nil
| (Cons a as) := by calc
    longitud (conc (Cons a as) ys)
        = longitud (Cons a (conc as ys))     : by rw conc_cons
    ... = 1 + longitud (conc as ys)          : by rw longitud_cons
    ... = 1 + (longitud as + longitud ys)    : by rw longitud_conc_1
    ... = (1 + longitud as ) + longitud ys   : by rw add_assoc
    ... = longitud (Cons a as) + longitud ys : by rw longitud_cons

-- 9ª demostración
lemma longitud_conc_2 :
  ∀ xs, longitud (conc xs ys) = longitud xs + longitud ys
| Nil         := by simp
| (Cons a as) := by simp [longitud_conc_2 as, add_assoc]

-- ----------------------------------------------------
-- Ejercicio 12. Cerrar el espacio de nombre Lista.
-- ----------------------------------------------------

end Lista