/-
Copyright (c) 2020 Ruben Van de Velde. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ruben Van de Velde
-/

import algebra.algebra.restrict_scalars
import data.complex.is_R_or_C

/-!
# Extending a continuous `ℝ`-linear map to a continuous `𝕜`-linear map

In this file we provide a way to extend a continuous `ℝ`-linear map to a continuous `𝕜`-linear map
in a way that bounds the norm by the norm of the original map, when `𝕜` is either `ℝ` (the
extension is trivial) or `ℂ`. We formulate the extension uniformly, by assuming `is_R_or_C 𝕜`.

We motivate the form of the extension as follows. Note that `fc : F →ₗ[𝕜] 𝕜` is determined fully by
`Re fc`: for all `x : F`, `fc (I • x) = I * fc x`, so `Im (fc x) = -Re (fc (I • x))`. Therefore,
given an `fr : F →ₗ[ℝ] ℝ`, we define `fc x = fr x - fr (I • x) * I`.

## Main definitions

* `linear_map.extend_to_𝕜`
* `continuous_linear_map.extend_to_𝕜`

## Implementation details

For convenience, the main definitions above operate in terms of `restrict_scalars ℝ 𝕜 F`.
Alternate forms which operate on `[is_scalar_tower ℝ 𝕜 F]` instead are provided with a primed name.

-/

open is_R_or_C

variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [semi_normed_group F] [semi_normed_space 𝕜 F]
local notation `abs𝕜` := @is_R_or_C.abs 𝕜 _

/-- Extend `fr : F →ₗ[ℝ] ℝ` to `F →ₗ[𝕜] 𝕜` in a way that will also be continuous and have its norm
bounded by `∥fr∥` if `fr` is continuous. -/
noncomputable def linear_map.extend_to_𝕜'
  [module ℝ F] [is_scalar_tower ℝ 𝕜 F] (fr : F →ₗ[ℝ] ℝ) : F →ₗ[𝕜] 𝕜 :=
begin
  let fc : F → 𝕜 := λ x, (fr x : 𝕜) - (I : 𝕜) * (fr ((I : 𝕜) • x)),
  have add : ∀ x y : F, fc (x + y) = fc x + fc y,
  { assume x y,
    simp only [fc],
    simp only [smul_add, linear_map.map_add, of_real_add],
    rw mul_add,
    abel, },
  have A : ∀ (c : ℝ) (x : F), (fr ((c : 𝕜) • x) : 𝕜) = (c : 𝕜) * (fr x : 𝕜),
  { assume c x,
    rw [← of_real_mul],
    congr' 1,
    rw [is_R_or_C.of_real_alg, smul_assoc, fr.map_smul, algebra.id.smul_eq_mul, one_smul] },
  have smul_ℝ : ∀ (c : ℝ) (x : F), fc ((c : 𝕜) • x) = (c : 𝕜) * fc x,
  { assume c x,
    simp only [fc, A],
    rw A c x,
    rw [smul_smul, mul_comm I (c : 𝕜), ← smul_smul, A, mul_sub],
    ring },
  have smul_I : ∀ x : F, fc ((I : 𝕜) • x) = (I : 𝕜) * fc x,
  { assume x,
    simp only [fc],
    cases @I_mul_I_ax 𝕜 _ with h h, { simp [h] },
    rw [mul_sub, ← mul_assoc, smul_smul, h],
    simp only [neg_mul_eq_neg_mul_symm, linear_map.map_neg, one_mul, one_smul,
      mul_neg_eq_neg_mul_symm, of_real_neg, neg_smul, sub_neg_eq_add, add_comm] },
  have smul_𝕜 : ∀ (c : 𝕜) (x : F), fc (c • x) = c • fc x,
  { assume c x,
    rw [← re_add_im c, add_smul, add_smul, add, smul_ℝ, ← smul_smul, smul_ℝ, smul_I, ← mul_assoc],
    refl },
  exact { to_fun := fc, map_add' := add, map_smul' := smul_𝕜 }
end

lemma linear_map.extend_to_𝕜'_apply [module ℝ F] [is_scalar_tower ℝ 𝕜 F]
  (fr : F →ₗ[ℝ] ℝ) (x : F) :
  fr.extend_to_𝕜' x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl

/-- The norm of the extension is bounded by `∥fr∥`. -/
lemma norm_bound [semi_normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F] (fr : F →L[ℝ] ℝ) (x : F) :
  ∥(fr.to_linear_map.extend_to_𝕜' x : 𝕜)∥ ≤ ∥fr∥ * ∥x∥ :=
begin
  let lm : F →ₗ[𝕜] 𝕜 := fr.to_linear_map.extend_to_𝕜',
  -- We aim to find a `t : 𝕜` such that
  -- * `lm (t • x) = fr (t • x)` (so `lm (t • x) = t * lm x ∈ ℝ`)
  -- * `∥lm x∥ = ∥lm (t • x)∥` (so `t.abs` must be 1)
  -- If `lm x ≠ 0`, `(lm x)⁻¹` satisfies the first requirement, and after normalizing, it
  -- satisfies the second.
  -- (If `lm x = 0`, the goal is trivial.)
  classical,
  by_cases h : lm x = 0,
  { rw [h, norm_zero],
    apply mul_nonneg; exact norm_nonneg _ },
  let fx := (lm x)⁻¹,
  let t := fx / (abs𝕜 fx : 𝕜),
  have ht : abs𝕜 t = 1, by field_simp [abs_of_real, of_real_inv, is_R_or_C.abs_inv,
    is_R_or_C.abs_div, is_R_or_C.abs_abs, h],
  have h1 : (fr (t • x) : 𝕜) = lm (t • x),
  { apply ext,
    { simp only [lm, of_real_re, linear_map.extend_to_𝕜'_apply, mul_re, I_re, of_real_im, zero_mul,
        add_monoid_hom.map_sub, sub_zero, mul_zero],
      refl },
    { symmetry,
      calc im (lm (t • x))
          = im (t * lm x) : by rw [lm.map_smul, smul_eq_mul]
      ... = im ((lm x)⁻¹ / (abs𝕜 (lm x)⁻¹) * lm x) : rfl
      ... = im (1 / (abs𝕜 (lm x)⁻¹ : 𝕜)) : by rw [div_mul_eq_mul_div, inv_mul_cancel h]
      ... = 0 : by rw [← of_real_one, ← of_real_div, of_real_im]
      ... = im (fr (t • x) : 𝕜) : by rw [of_real_im] } },
  calc ∥lm x∥ = abs𝕜 t * ∥lm x∥ : by rw [ht, one_mul]
  ... = ∥t * lm x∥ : by rw [← norm_eq_abs, normed_field.norm_mul]
  ... = ∥lm (t • x)∥ : by rw [←smul_eq_mul, lm.map_smul]
  ... = ∥(fr (t • x) : 𝕜)∥ : by rw h1
  ... = ∥fr (t • x)∥ : by rw [norm_eq_abs, abs_of_real, norm_eq_abs, abs_to_real]
  ... ≤ ∥fr∥ * ∥t • x∥ : continuous_linear_map.le_op_norm _ _
  ... = ∥fr∥ * (∥t∥ * ∥x∥) : by rw norm_smul
  ... ≤ ∥fr∥ * ∥x∥ : by rw [norm_eq_abs, ht, one_mul]
end

/-- Extend `fr : F →L[ℝ] ℝ` to `F →L[𝕜] 𝕜`. -/
noncomputable def continuous_linear_map.extend_to_𝕜' [semi_normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F]
  (fr : F →L[ℝ] ℝ) :
  F →L[𝕜] 𝕜 :=
linear_map.mk_continuous _ (∥fr∥) (norm_bound _)

lemma continuous_linear_map.extend_to_𝕜'_apply [semi_normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F]
  (fr : F →L[ℝ] ℝ) (x : F) :
  fr.extend_to_𝕜' x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl

/-- Extend `fr : restrict_scalars ℝ 𝕜 F →ₗ[ℝ] ℝ` to `F →ₗ[𝕜] 𝕜`. -/
noncomputable def linear_map.extend_to_𝕜 (fr : (restrict_scalars ℝ 𝕜 F) →ₗ[ℝ] ℝ) : F →ₗ[𝕜] 𝕜 :=
fr.extend_to_𝕜'

lemma linear_map.extend_to_𝕜_apply (fr : (restrict_scalars ℝ 𝕜 F) →ₗ[ℝ] ℝ) (x : F) :
  fr.extend_to_𝕜 x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl

/-- Extend `fr : restrict_scalars ℝ 𝕜 F →L[ℝ] ℝ` to `F →L[𝕜] 𝕜`. -/
noncomputable def continuous_linear_map.extend_to_𝕜 (fr : (restrict_scalars ℝ 𝕜 F) →L[ℝ] ℝ) :
  F →L[𝕜] 𝕜 :=
fr.extend_to_𝕜'

lemma continuous_linear_map.extend_to_𝕜_apply (fr : (restrict_scalars ℝ 𝕜 F) →L[ℝ] ℝ) (x : F) :
  fr.extend_to_𝕜 x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl


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

! This file was ported from Lean 3 source module data.set.intervals.pi
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Intervals.Basic
import Mathlib.Data.Set.Lattice

/-!
# Intervals in `pi`-space

In this we prove various simple lemmas about intervals in `Π i, α i`. Closed intervals (`Ici x`,
`Iic x`, `Icc x y`) are equal to products of their projections to `α i`, while (semi-)open intervals
usually include the corresponding products as proper subsets.
-/

variable {ι : Type _} {α : ι → Type _}

namespace Set

section PiPreorder

variable [∀ i, Preorder (α i)] (x y : ∀ i, α i)

@[simp]
theorem pi_univ_Ici : (pi univ fun i ↦ Ici (x i)) = Ici x :=
  ext fun y ↦ by simp [Pi.le_def]
#align set.pi_univ_Ici Set.pi_univ_Ici

@[simp]
theorem pi_univ_Iic : (pi univ fun i ↦ Iic (x i)) = Iic x :=
  ext fun y ↦ by simp [Pi.le_def]
#align set.pi_univ_Iic Set.pi_univ_Iic

@[simp]
theorem pi_univ_Icc : (pi univ fun i ↦ Icc (x i) (y i)) = Icc x y :=
  ext fun y ↦ by simp [Pi.le_def, forall_and]
#align set.pi_univ_Icc Set.pi_univ_Icc

theorem piecewise_mem_Icc {s : Set ι} [∀ j, Decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : ∀ i, α i}
    (h₁ : ∀ i ∈ s, f₁ i ∈ Icc (g₁ i) (g₂ i)) (h₂ : ∀ (i) (_ : i ∉ s), f₂ i ∈ Icc (g₁ i) (g₂ i)) :
    s.piecewise f₁ f₂ ∈ Icc g₁ g₂ :=
  ⟨le_piecewise (fun i hi ↦ (h₁ i hi).1) fun i hi ↦ (h₂ i hi).1,
    piecewise_le (fun i hi ↦ (h₁ i hi).2) fun i hi ↦ (h₂ i hi).2⟩
#align set.piecewise_mem_Icc Set.piecewise_mem_Icc

theorem piecewise_mem_Icc' {s : Set ι} [∀ j, Decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : ∀ i, α i}
    (h₁ : f₁ ∈ Icc g₁ g₂) (h₂ : f₂ ∈ Icc g₁ g₂) : s.piecewise f₁ f₂ ∈ Icc g₁ g₂ :=
  piecewise_mem_Icc (fun _ _ ↦ ⟨h₁.1 _, h₁.2 _⟩) fun _ _ ↦ ⟨h₂.1 _, h₂.2 _⟩
#align set.piecewise_mem_Icc' Set.piecewise_mem_Icc'

section Nonempty

variable [Nonempty ι]

theorem pi_univ_Ioi_subset : (pi univ fun i ↦ Ioi (x i)) ⊆ Ioi x := fun z hz ↦
  ⟨fun i ↦ le_of_lt <| hz i trivial, fun h ↦
    (Nonempty.elim ‹Nonempty ι›) fun i ↦ not_lt_of_le (h i) (hz i trivial)⟩
#align set.pi_univ_Ioi_subset Set.pi_univ_Ioi_subset

theorem pi_univ_Iio_subset : (pi univ fun i ↦ Iio (x i)) ⊆ Iio x :=
  @pi_univ_Ioi_subset ι (fun i ↦ (α i)ᵒᵈ) _ x _
#align set.pi_univ_Iio_subset Set.pi_univ_Iio_subset

theorem pi_univ_Ioo_subset : (pi univ fun i ↦ Ioo (x i) (y i)) ⊆ Ioo x y := fun _ hx ↦
  ⟨(pi_univ_Ioi_subset _) fun i hi ↦ (hx i hi).1, (pi_univ_Iio_subset _) fun i hi ↦ (hx i hi).2⟩
#align set.pi_univ_Ioo_subset Set.pi_univ_Ioo_subset

theorem pi_univ_Ioc_subset : (pi univ fun i ↦ Ioc (x i) (y i)) ⊆ Ioc x y := fun _ hx ↦
  ⟨(pi_univ_Ioi_subset _) fun i hi ↦ (hx i hi).1, fun i ↦ (hx i trivial).2⟩
#align set.pi_univ_Ioc_subset Set.pi_univ_Ioc_subset

theorem pi_univ_Ico_subset : (pi univ fun i ↦ Ico (x i) (y i)) ⊆ Ico x y := fun _ hx ↦
  ⟨fun i ↦ (hx i trivial).1, (pi_univ_Iio_subset _) fun i hi ↦ (hx i hi).2⟩
#align set.pi_univ_Ico_subset Set.pi_univ_Ico_subset

end Nonempty

variable [DecidableEq ι]

open Function (update)

theorem pi_univ_Ioc_update_left {x y : ∀ i, α i} {i₀ : ι} {m : α i₀} (hm : x i₀ ≤ m) :
    (pi univ fun i ↦ Ioc (update x i₀ m i) (y i)) =
      { z | m < z i₀ } ∩ pi univ fun i ↦ Ioc (x i) (y i) := by
  have : Ioc m (y i₀) = Ioi m ∩ Ioc (x i₀) (y i₀) := by
    rw [← Ioi_inter_Iic, ← Ioi_inter_Iic, ← inter_assoc,
      inter_eq_self_of_subset_left (Ioi_subset_Ioi hm)]
  simp_rw [univ_pi_update i₀ _ _ fun i z ↦ Ioc z (y i), ← pi_inter_compl ({i₀} : Set ι),
    singleton_pi', ← inter_assoc, this]
  rfl
#align set.pi_univ_Ioc_update_left Set.pi_univ_Ioc_update_left

theorem pi_univ_Ioc_update_right {x y : ∀ i, α i} {i₀ : ι} {m : α i₀} (hm : m ≤ y i₀) :
    (pi univ fun i ↦ Ioc (x i) (update y i₀ m i)) =
      { z | z i₀ ≤ m } ∩ pi univ fun i ↦ Ioc (x i) (y i) := by
  have : Ioc (x i₀) m = Iic m ∩ Ioc (x i₀) (y i₀) := by
    rw [← Ioi_inter_Iic, ← Ioi_inter_Iic, inter_left_comm,
      inter_eq_self_of_subset_left (Iic_subset_Iic.2 hm)]
  simp_rw [univ_pi_update i₀ y m fun i z ↦ Ioc (x i) z, ← pi_inter_compl ({i₀} : Set ι),
    singleton_pi', ← inter_assoc, this]
  rfl
#align set.pi_univ_Ioc_update_right Set.pi_univ_Ioc_update_right

theorem disjoint_pi_univ_Ioc_update_left_right {x y : ∀ i, α i} {i₀ : ι} {m : α i₀} :
    Disjoint (pi univ fun i ↦ Ioc (x i) (update y i₀ m i))
      (pi univ fun i ↦ Ioc (update x i₀ m i) (y i)) :=
  by
  rw [disjoint_left]
  rintro z h₁ h₂
  refine' (h₁ i₀ (mem_univ _)).2.not_lt _
  simpa only [Function.update_same] using (h₂ i₀ (mem_univ _)).1
#align set.disjoint_pi_univ_Ioc_update_left_right Set.disjoint_pi_univ_Ioc_update_left_right

end PiPreorder

variable [DecidableEq ι] [∀ i, LinearOrder (α i)]

open Function (update)

theorem pi_univ_Ioc_update_union (x y : ∀ i, α i) (i₀ : ι) (m : α i₀) (hm : m ∈ Icc (x i₀) (y i₀)) :
    ((pi univ fun i ↦ Ioc (x i) (update y i₀ m i)) ∪
        pi univ fun i ↦ Ioc (update x i₀ m i) (y i)) =
      pi univ fun i ↦ Ioc (x i) (y i) := by
  simp_rw [pi_univ_Ioc_update_left hm.1, pi_univ_Ioc_update_right hm.2, ← union_inter_distrib_right,
    ← setOf_or, le_or_lt, setOf_true, univ_inter]
#align set.pi_univ_Ioc_update_union Set.pi_univ_Ioc_update_union

/-- If `x`, `y`, `x'`, and `y'` are functions `Π i : ι, α i`, then
the set difference between the box `[x, y]` and the product of the open intervals `(x' i, y' i)`
is covered by the union of the following boxes: for each `i : ι`, we take
`[x, update y i (x' i)]` and `[update x i (y' i), y]`.

E.g., if `x' = x` and `y' = y`, then this lemma states that the difference between a closed box
`[x, y]` and the corresponding open box `{z | ∀ i, x i < z i < y i}` is covered by the union
of the faces of `[x, y]`. -/
theorem Icc_diff_pi_univ_Ioo_subset (x y x' y' : ∀ i, α i) :
    (Icc x y \ pi univ fun i ↦ Ioo (x' i) (y' i)) ⊆
      (⋃ i : ι, Icc x (update y i (x' i))) ∪ ⋃ i : ι, Icc (update x i (y' i)) y :=
  by
  rintro a ⟨⟨hxa, hay⟩, ha'⟩
  simp at ha'
  simp [le_update_iff, update_le_iff, hxa, hay, hxa _, hay _, ← exists_or]
  rcases ha' with ⟨w, hw⟩
  apply Exists.intro w
  cases lt_or_le (x' w) (a w) <;> simp_all

#align set.Icc_diff_pi_univ_Ioo_subset Set.Icc_diff_pi_univ_Ioo_subset

/-- If `x`, `y`, `z` are functions `Π i : ι, α i`, then
the set difference between the box `[x, z]` and the product of the intervals `(y i, z i]`
is covered by the union of the boxes `[x, update z i (y i)]`.

E.g., if `x = y`, then this lemma states that the difference between a closed box
`[x, y]` and the product of half-open intervals `{z | ∀ i, x i < z i ≤ y i}` is covered by the union
of the faces of `[x, y]` adjacent to `x`. -/
theorem Icc_diff_pi_univ_Ioc_subset (x y z : ∀ i, α i) :
    (Icc x z \ pi univ fun i ↦ Ioc (y i) (z i)) ⊆ ⋃ i : ι, Icc x (update z i (y i)) := by
  rintro a ⟨⟨hax, haz⟩, hay⟩
  simpa [not_and_or, hax, le_update_iff, haz _] using hay
#align set.Icc_diff_pi_univ_Ioc_subset Set.Icc_diff_pi_univ_Ioc_subset

end Set


import ..lin2Kcoord.lin2kcoord
import algebra.direct_sum.module

universes u
variables
(K : Type u)
[field K]
[inhabited K]

/-
We represent primitive points and vectors constituting a 1-D affine
space with a field K by as elements of a 2-D linear space over K. We
represent the 1-D affine point, p, with coordinate x : K, as a pair,
(1 : K, x), and a 1-D (affine space) vector, v, with coordinate, x : K,
as a pair (0 : K, x).

We prove the following properties

- vector-vector addition
- scalar-vector multiplication
- vector negation
- vector subtraction
- zero vector

- piont-point subtraction
- point-vector addition

- vectors act on points by point-vector addition
- subtraction of points yields vectors in a specific way
- etc. need to explain proof in structured English to make it comprehensible
- ...

SULLIVAN: Can we now do away with the lin2K stuff and just
use Lean's type system to distinguish single-coordinate pts
from single-coordinate vecs?
-/

/-
Objects:
- pt, point in a 1-D affine space over field K
- vec, vector in a 1-D affine space over field K
-/
@[ext]
structure pt := (coord : K)

@[ext]
structure vec := (coord : K)

@[simp]
def mk_pt (k : K) : pt K  := ⟨k⟩             -- exported

@[simp]
def mk_vec (k : K) : vec K := ⟨k⟩            -- exported

/-
    *******************************
    *** Vector space operations ***
    *******************************
-/

@[simp]
def add_vec_vec (v1 v2 : vec K) : vec K := ⟨v1.coord + v2.coord⟩

@[simp]
def smul_vec (k : K) (v : vec K) : vec K := ⟨k*v.coord⟩

@[simp]
def neg_vec (v : vec K) : vec K := ⟨-v.coord⟩

@[simp]
def sub_vec_vec (v2 v1 : vec K) : vec K := add_vec_vec K v2 (neg_vec K v1)  -- v2-v1

@[simp]
def vec_zero  := mk_vec K 0

instance : has_zero (vec K) := ⟨vec_zero K⟩
instance : has_neg (vec K) := ⟨neg_vec K⟩

/-
    *******************************
    *** Affine space operations ***
    *******************************
-/

@[simp]
def sub_pt_pt (p1 p2 : pt K) : vec K := ⟨p1.coord - p2.coord⟩

@[simp]
def add_pt_vec (p : pt K) (v : vec K) : pt K := ⟨p.coord + v.coord⟩

@[simp]
def add_vec_pt (v : vec K) (p : pt K) : pt K := ⟨p.coord + v.coord⟩
-- add affine combination operation here

@[simp]
def aff_vec_group_action := add_vec_pt K

@[simp]
def aff_pt_group_sub := sub_pt_pt K

instance : has_vadd (vec K) (pt K) := ⟨aff_vec_group_action K⟩
instance : has_vsub (vec K) (pt K) := ⟨ aff_pt_group_sub K ⟩

open_locale affine

@[simp]
def nsmul_vec : ℕ → (vec K) → (vec K)
| nat.zero v := vec_zero K
| (nat.succ n) v := (add_vec_vec _) v (nsmul_vec n v)

@[simp]
def gsmul_vec : ℤ → (vec K) → (vec K)
| (int.of_nat i) v := nsmul_vec K i v
| (int.neg_succ_of_nat i) v := (-(nsmul_vec K i v))

instance : has_add (vec K) := ⟨add_vec_vec K⟩

instance : add_comm_monoid (vec K) :=
⟨
    add_vec_vec K,
    begin
        intros,
        --dsimp [has_add.add, add_vec_vec, mk_vec', distrib.add, ring.add, division_ring.add, field.add],
        cases a,
        cases b,
        cases c,
        simp *,
        cc
    end,
    vec_zero K,
    begin
        intros,
        ext,
        exact zero_add _
    end,
    begin
        intros,
        ext,
        exact add_zero _,
    end,
    nsmul_vec K,
    begin
        simp [auto_param],
        dsimp [0, vec_zero K],
        ext,
        cc,
    end,
    begin
        simp [auto_param],
        intros,
        ext,
        simp *,
        cc,
    end,
    begin
        intros,
        ext,
        exact add_comm _ _,
    end,
⟩

instance : add_monoid (vec K) :=
⟨
add_vec_vec K,
begin
    intros,
    dsimp [has_add.add, add_vec_vec, distrib.add, ring.add, division_ring.add, field.add],
    cases a,
    cases b,
    cases c,
    simp *,
    cc
end,
vec_zero K,
begin
    intros,

    ext,
    exact zero_add _,
end,
begin
    intros,

    ext,
    exact add_zero _,
end,
nsmul_vec K
⟩

instance : sub_neg_monoid (vec K) := {
neg := (neg_vec K),
..(show add_monoid (vec K), by apply_instance),

}

--#check neg

instance : add_group (vec K) := {
add_left_neg := begin
    intros,
    --let h0 : (-a + a).to_prod = (-a).to_prod + a.to_prod := rfl,
    --let h1 : (0 : vec K).to_prod.fst = 0 := rfl,
    /-let h2 : (-a).to_prod = -a.to_prod := begin
        ext,
        simp *,
        let h3 : a.to_prod.fst = 0 := by exact a.inv,
        let h4 : (-a.to_prod.fst) = 0 := begin
            rw h3,
            exact neg_zero,
        end,
        rw h4,
        exact (-a).inv,
        cases a,
        simp *,
        dsimp [has_neg.neg, sub_neg_monoid.neg, add_group.neg],
        let h5 : add_comm_group.neg 1 * a__to_prod.snd = -a__to_prod.snd := by exact neg_one_mul _,
        simp [h5],
        trivial
    end,
    -/
    /-ext,
    rw [h0],
    rw h1,
    rw h2,
    simp *,
    rw [h0],
    rw h2,
    simp *,
    let h6 : (0 : vec K).to_prod.snd = 0 := rfl,
    simp *,-/
    ext,
    let h0 : (-a + a).coord = (-a).coord + a.coord := rfl,
    simp *,
    dsimp [has_neg.neg, sub_neg_monoid.neg, add_group.neg],
    exact neg_add_self _,
end,
..(show sub_neg_monoid (vec K), by apply_instance),
}

instance : add_comm_group (vec K) :={
    add_comm := begin
        intros,
        ext,
        exact add_comm _ _,
    end,
..(show add_group (vec K), by apply_instance)
}

instance : has_scalar K (vec K) := ⟨ smul_vec K ⟩

instance : mul_action K (vec K) :=
⟨
begin
    intros,
    cases b,
    ext,
    exact one_mul _,
end,
begin
    intros,
    cases b,
    ext,
    exact mul_assoc x y _,
end,
⟩

lemma left_distrib_K_vecK : ∀ (r : K) (x y : vec K), r • (x + y) = r • x + r • y := begin
intros,
        ext,
        exact left_distrib _ _ _,
end

instance : distrib_mul_action K (vec K) :=
⟨
    begin
        exact left_distrib_K_vecK K,
    end,
    begin
    intros, ext, exact mul_zero _,
    end
⟩

lemma right_distrib_K_vecK : ∀ (r s : K) (x : vec K), (r + s) • x = r • x + s • x := begin
  intros,
  ext,
  exact right_distrib _ _ _,

end

instance : module K (vec K) := ⟨
begin
    exact right_distrib_K_vecK K
end,
begin
    intros,
    ext,
    exact zero_mul _,
end
⟩

lemma pt_sub_add_cancel : ∀ (p1 p2 : pt K), p1 -ᵥ p2 +ᵥ p2 = p1 :=
begin
    intros,
    ext,
    dsimp [has_vsub.vsub, has_vadd.vadd],

    suffices s1 : 0 + p1.coord + (p2.coord - p1.coord) = 0 + p2.coord,
    from begin
        simp *,
    end,
    exact add_add_sub_cancel 0 p2.coord p1.coord,
end

lemma zero_vec_vadd'_a1 : ∀ p : pt K, (0 : vec K) +ᵥ p = p :=
begin
    intros,
    ext,
    exact add_zero _,
end

#check add_assoc
instance : add_action (vec K) (pt K) :=
⟨
begin
    exact zero_vec_vadd'_a1 K
end,
begin
    intros,
    ext,
    dsimp [has_vadd.vadd],--, has_add.add],

    let : (g₁ + g₂).coord = g₁.coord + g₂.coord := rfl,
    simp *,
    let s1 : p.coord + g₂.coord + g₁.coord = p.coord + (g₁.coord + g₂.coord) :=
    begin
        let t1 : _:=  add_assoc p.coord g₂.coord g₁.coord,
        let t2 : g₂.coord + g₁.coord = g₁.coord + g₂.coord := by cc,
        rw t2.symm,
        exact t1,
    end,
    simp [s1],
end
⟩

instance : nonempty (pt K) := ⟨mk_pt K 1⟩

instance vecK_ptK_affine_space : affine_space (vec K) (pt K) := ⟨
    pt_sub_add_cancel K,
    begin
        intros,
        ext,
        simp [has_vadd.vadd, has_vsub.vsub],
    end,
⟩


/-
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.metric_space.hausdorff_distance
import Mathlib.analysis.specific_limits
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Closed subsets

This file defines the metric and emetric space structure on the types of closed subsets and nonempty compact
subsets of a metric or emetric space.

The Hausdorff distance induces an emetric space structure on the type of closed subsets
of an emetric space, called `closeds`. Its completeness, resp. compactness, resp.
second-countability, follow from the corresponding properties of the original space.

In a metric space, the type of nonempty compact subsets (called `nonempty_compacts`) also
inherits a metric space structure from the Hausdorff distance, as the Hausdorff edistance is
always finite in this context.
-/

namespace emetric

/-- In emetric spaces, the Hausdorff edistance defines an emetric space structure
on the type of closed subsets -/
protected instance closeds.emetric_space {α : Type u} [emetric_space α] :
    emetric_space (topological_space.closeds α) :=
  emetric_space.mk sorry sorry sorry sorry
    (uniform_space_of_edist
      (fun (s t : topological_space.closeds α) => Hausdorff_edist (subtype.val s) (subtype.val t))
      sorry sorry sorry)

/-- The edistance to a closed set depends continuously on the point and the set -/
theorem continuous_inf_edist_Hausdorff_edist {α : Type u} [emetric_space α] :
    continuous
        fun (p : α × topological_space.closeds α) =>
          inf_edist (prod.fst p) (subtype.val (prod.snd p)) :=
  sorry

/-- Subsets of a given closed subset form a closed set -/
theorem is_closed_subsets_of_is_closed {α : Type u} [emetric_space α] {s : set α}
    (hs : is_closed s) :
    is_closed (set_of fun (t : topological_space.closeds α) => subtype.val t ⊆ s) :=
  sorry

/-- By definition, the edistance on `closeds α` is given by the Hausdorff edistance -/
theorem closeds.edist_eq {α : Type u} [emetric_space α] {s : topological_space.closeds α}
    {t : topological_space.closeds α} :
    edist s t = Hausdorff_edist (subtype.val s) (subtype.val t) :=
  rfl

/-- In a complete space, the type of closed subsets is complete for the
Hausdorff edistance. -/
protected instance closeds.complete_space {α : Type u} [emetric_space α] [complete_space α] :
    complete_space (topological_space.closeds α) :=
  sorry

/-- In a compact space, the type of closed subsets is compact. -/
protected instance closeds.compact_space {α : Type u} [emetric_space α] [compact_space α] :
    compact_space (topological_space.closeds α) :=
  sorry

/-- In an emetric space, the type of non-empty compact subsets is an emetric space,
where the edistance is the Hausdorff edistance -/
protected instance nonempty_compacts.emetric_space {α : Type u} [emetric_space α] :
    emetric_space (topological_space.nonempty_compacts α) :=
  emetric_space.mk sorry sorry sorry sorry
    (uniform_space_of_edist
      (fun (s t : topological_space.nonempty_compacts α) =>
        Hausdorff_edist (subtype.val s) (subtype.val t))
      sorry sorry sorry)

/-- `nonempty_compacts.to_closeds` is a uniform embedding (as it is an isometry) -/
theorem nonempty_compacts.to_closeds.uniform_embedding {α : Type u} [emetric_space α] :
    uniform_embedding topological_space.nonempty_compacts.to_closeds :=
  isometry.uniform_embedding fun (x y : topological_space.nonempty_compacts α) => rfl

/-- The range of `nonempty_compacts.to_closeds` is closed in a complete space -/
theorem nonempty_compacts.is_closed_in_closeds {α : Type u} [emetric_space α] [complete_space α] :
    is_closed (set.range topological_space.nonempty_compacts.to_closeds) :=
  sorry

/-- In a complete space, the type of nonempty compact subsets is complete. This follows
from the same statement for closed subsets -/
protected instance nonempty_compacts.complete_space {α : Type u} [emetric_space α]
    [complete_space α] : complete_space (topological_space.nonempty_compacts α) :=
  iff.mpr (complete_space_iff_is_complete_range nonempty_compacts.to_closeds.uniform_embedding)
    (is_closed.is_complete nonempty_compacts.is_closed_in_closeds)

/-- In a compact space, the type of nonempty compact subsets is compact. This follows from
the same statement for closed subsets -/
protected instance nonempty_compacts.compact_space {α : Type u} [emetric_space α]
    [compact_space α] : compact_space (topological_space.nonempty_compacts α) :=
  compact_space.mk
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (is_compact set.univ))
          (propext
            (embedding.compact_iff_compact_image
              (uniform_embedding.embedding nonempty_compacts.to_closeds.uniform_embedding)))))
      (eq.mpr
        (id
          (Eq._oldrec
            (Eq.refl (is_compact (topological_space.nonempty_compacts.to_closeds '' set.univ)))
            set.image_univ))
        (is_closed.compact nonempty_compacts.is_closed_in_closeds)))

/-- In a second countable space, the type of nonempty compact subsets is second countable -/
protected instance nonempty_compacts.second_countable_topology {α : Type u} [emetric_space α]
    [topological_space.second_countable_topology α] :
    topological_space.second_countable_topology (topological_space.nonempty_compacts α) :=
  second_countable_of_separable (topological_space.nonempty_compacts α)

namespace metric

/-- `nonempty_compacts α` inherits a metric space structure, as the Hausdorff
edistance between two such sets is finite. -/
protected instance Mathlib.metric.nonempty_compacts.metric_space {α : Type u} [metric_space α] :
    metric_space (topological_space.nonempty_compacts α) :=
  emetric_space.to_metric_space sorry

/-- The distance on `nonempty_compacts α` is the Hausdorff distance, by construction -/
theorem Mathlib.metric.nonempty_compacts.dist_eq {α : Type u} [metric_space α]
    {x : topological_space.nonempty_compacts α} {y : topological_space.nonempty_compacts α} :
    dist x y = metric.Hausdorff_dist (subtype.val x) (subtype.val y) :=
  rfl

theorem Mathlib.metric.lipschitz_inf_dist_set {α : Type u} [metric_space α] (x : α) :
    lipschitz_with 1
        fun (s : topological_space.nonempty_compacts α) => metric.inf_dist x (subtype.val s) :=
  sorry

theorem Mathlib.metric.lipschitz_inf_dist {α : Type u} [metric_space α] :
    lipschitz_with (bit0 1)
        fun (p : α × topological_space.nonempty_compacts α) =>
          metric.inf_dist (prod.fst p) (subtype.val (prod.snd p)) :=
  lipschitz_with.uncurry
    (fun (s : topological_space.nonempty_compacts α) =>
      metric.lipschitz_inf_dist_pt (subtype.val s))
    metric.lipschitz_inf_dist_set

theorem Mathlib.metric.uniform_continuous_inf_dist_Hausdorff_dist {α : Type u} [metric_space α] :
    uniform_continuous
        fun (p : α × topological_space.nonempty_compacts α) =>
          metric.inf_dist (prod.fst p) (subtype.val (prod.snd p)) :=
  lipschitz_with.uniform_continuous metric.lipschitz_inf_dist

end Mathlib


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import ring_theory.polynomial.scale_roots
import ring_theory.localization

/-!
# Rational root theorem and integral root theorem

This file contains the rational root theorem and integral root theorem.
The rational root theorem for a unique factorization domain `A`
with localization `S`, states that the roots of `p : polynomial A` in `A`'s
field of fractions are of the form `x / y` with `x y : A`, `x ∣ p.coeff 0` and
`y ∣ p.leading_coeff`.
The corollary is the integral root theorem `is_integer_of_is_root_of_monic`:
if `p` is monic, its roots must be integers.
Finally, we use this to show unique factorization domains are integrally closed.

## References

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

section scale_roots

variables {A K R S : Type*} [integral_domain A] [field K] [comm_ring R] [comm_ring S]
variables {M : submonoid A} {f : localization_map M S} {g : fraction_map A K}

open finsupp polynomial

lemma scale_roots_aeval_eq_zero_of_aeval_mk'_eq_zero {p : polynomial A} {r : A} {s : M}
  (hr : @aeval A f.codomain _ _ _ (f.mk' r s) p = 0) :
  @aeval A f.codomain _ _ _ (f.to_map r) (scale_roots p s) = 0 :=
begin
  convert scale_roots_eval₂_eq_zero f.to_map hr,
  rw aeval_def,
  congr,
  apply (f.mk'_spec' r s).symm
end

lemma num_is_root_scale_roots_of_aeval_eq_zero
  [unique_factorization_monoid A] (g : fraction_map A K)
  {p : polynomial A} {x : g.codomain} (hr : aeval x p = 0) :
  is_root (scale_roots p (g.denom x)) (g.num x) :=
begin
  apply is_root_of_eval₂_map_eq_zero g.injective,
  refine scale_roots_aeval_eq_zero_of_aeval_mk'_eq_zero _,
  rw g.mk'_num_denom,
  exact hr
end

end scale_roots

section rational_root_theorem

variables {A K : Type*} [integral_domain A] [unique_factorization_monoid A] [field K]
variables {f : fraction_map A K}

open polynomial unique_factorization_monoid

/-- Rational root theorem part 1:
if `r : f.codomain` is a root of a polynomial over the ufd `A`,
then the numerator of `r` divides the constant coefficient -/
theorem num_dvd_of_is_root {p : polynomial A} {r : f.codomain} (hr : aeval r p = 0) :
  f.num r ∣ p.coeff 0 :=
begin
  suffices : f.num r ∣ (scale_roots p (f.denom r)).coeff 0,
  { simp only [coeff_scale_roots, nat.sub_zero] at this,
    haveI := classical.prop_decidable,
    by_cases hr : f.num r = 0,
    { obtain ⟨u, hu⟩ := (f.is_unit_denom_of_num_eq_zero hr).pow p.nat_degree,
      rw ←hu at this,
      exact units.dvd_mul_right.mp this },
    { refine dvd_of_dvd_mul_left_of_no_prime_factors hr _ this,
      intros q dvd_num dvd_denom_pow hq,
      apply hq.not_unit,
      exact f.num_denom_reduced r dvd_num (hq.dvd_of_dvd_pow dvd_denom_pow) } },
  convert dvd_term_of_is_root_of_dvd_terms 0 (num_is_root_scale_roots_of_aeval_eq_zero f hr) _,
  { rw [pow_zero, mul_one] },
  intros j hj,
  apply dvd_mul_of_dvd_right,
  convert pow_dvd_pow (f.num r) (nat.succ_le_of_lt (bot_lt_iff_ne_bot.mpr hj)),
  exact (pow_one _).symm
end

/-- Rational root theorem part 2:
if `r : f.codomain` is a root of a polynomial over the ufd `A`,
then the denominator of `r` divides the leading coefficient -/
theorem denom_dvd_of_is_root {p : polynomial A} {r : f.codomain} (hr : aeval r p = 0) :
  (f.denom r : A) ∣ p.leading_coeff :=
begin
  suffices : (f.denom r : A) ∣ p.leading_coeff * f.num r ^ p.nat_degree,
  { refine dvd_of_dvd_mul_left_of_no_prime_factors
      (mem_non_zero_divisors_iff_ne_zero.mp (f.denom r).2) _ this,
    intros q dvd_denom dvd_num_pow hq,
    apply hq.not_unit,
    exact f.num_denom_reduced r (hq.dvd_of_dvd_pow dvd_num_pow) dvd_denom },
  rw ←coeff_scale_roots_nat_degree,
  apply dvd_term_of_is_root_of_dvd_terms _ (num_is_root_scale_roots_of_aeval_eq_zero f hr),
  intros j hj,
  by_cases h : j < p.nat_degree,
  { rw coeff_scale_roots,
    refine dvd_mul_of_dvd_left (dvd_mul_of_dvd_right _ _) _,
    convert pow_dvd_pow _ (nat.succ_le_iff.mpr (nat.lt_sub_left_of_add_lt _)),
    { exact (pow_one _).symm },
    simpa using h },
  rw [←nat_degree_scale_roots p (f.denom r)] at *,
  rw [coeff_eq_zero_of_nat_degree_lt (lt_of_le_of_ne (le_of_not_gt h) hj.symm), zero_mul],
  exact dvd_zero _
end

/-- Integral root theorem:
if `r : f.codomain` is a root of a monic polynomial over the ufd `A`,
then `r` is an integer -/
theorem is_integer_of_is_root_of_monic {p : polynomial A} (hp : monic p) {r : f.codomain}
  (hr : aeval r p = 0) : f.is_integer r :=
f.is_integer_of_is_unit_denom (is_unit_of_dvd_one _ (hp ▸ denom_dvd_of_is_root hr))

namespace unique_factorization_monoid

lemma integer_of_integral {x : f.codomain} :
  is_integral A x → f.is_integer x :=
λ ⟨p, hp, hx⟩, is_integer_of_is_root_of_monic hp hx

lemma integrally_closed : integral_closure A f.codomain = ⊥ :=
eq_bot_iff.mpr (λ x hx, algebra.mem_bot.mpr (integer_of_integral hx))

end unique_factorization_monoid

end rational_root_theorem


universe u

structure is_magical {α : Type u} (f : α → α → α) :=
  (left : ∀ x y, f (f x y) y = x)
  (right : ∀ x y, f y (f y x) = x)

-- the proof: ab = (b(ba))b = (b(ba))((b(ba))(ba)) = ba
theorem magic_is_comm {α : Type u} (f : α → α → α) (hf : is_magical f) :
  is_commutative α f :=
⟨λ a b, by { conv {
  to_lhs, congr,
  rw ←hf.right a b, skip,
  rw ←hf.left b (f b a),
}, rw hf.right }⟩


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

! This file was ported from Lean 3 source module category_theory.groupoid.basic
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Groupoid
import Mathbin.Combinatorics.Quiver.Basic

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

This file defines a few basic properties of groupoids.
-/

namespace CategoryTheory

namespace Groupoid

variable (C : Type _) [Groupoid C]

section Thin

/- warning: category_theory.groupoid.is_thin_iff -> CategoryTheory.Groupoid.isThin_iff is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u1}) [_inst_1 : CategoryTheory.Groupoid.{u2, u1} C], Iff (Quiver.IsThin.{u1, succ u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1)))) (forall (c : C), Subsingleton.{succ u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c))
but is expected to have type
  forall (C : Type.{u2}) [_inst_1 : CategoryTheory.Groupoid.{u1, u2} C], Iff (Quiver.IsThin.{u2, succ u1} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1)))) (forall (c : C), Subsingleton.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1))) c c))
Case conversion may be inaccurate. Consider using '#align category_theory.groupoid.is_thin_iff CategoryTheory.Groupoid.isThin_iffₓ'. -/
theorem isThin_iff : Quiver.IsThin C ↔ ∀ c : C, Subsingleton (c ⟶ c) :=
  by
  refine' ⟨fun h c => h c c, fun h c d => Subsingleton.intro fun f g => _⟩
  haveI := h d
  calc
    f = f ≫ inv g ≫ g := by simp only [inv_eq_inv, is_iso.inv_hom_id, category.comp_id]
    _ = f ≫ inv f ≫ g := by congr
    _ = g := by simp only [inv_eq_inv, is_iso.hom_inv_id_assoc]

#align category_theory.groupoid.is_thin_iff CategoryTheory.Groupoid.isThin_iff

end Thin

section Disconnected

#print CategoryTheory.Groupoid.IsTotallyDisconnected /-
/-- A subgroupoid is totally disconnected if it only has loops. -/
def IsTotallyDisconnected :=
  ∀ c d : C, (c ⟶ d) → c = d
#align category_theory.groupoid.is_totally_disconnected CategoryTheory.Groupoid.IsTotallyDisconnected
-/

end Disconnected

end Groupoid

end CategoryTheory


example : ∀ Q, true ∨ Q :=
    λ Q,
        or.inl true.intro

#check @or.elim

example : ∀ P, false ∨ P ↔ P :=
begin
    assume P,
    apply iff.intro,
        assume forp,
        cases forp with pff pfp,
            show P, from false.elim pff,
            assumption,

        apply or.inr
end


import group_theory.quotient_group
import .subgroup

instance quotient.subsingleton {α : Type*} [subsingleton α] (s : setoid α) :
  subsingleton (quotient s) :=
⟨λ a b, quotient.induction_on₂ a b $ λ x y, by rw subsingleton.elim x y⟩

open subgroup monoid_hom

namespace quotient_group

variables {G : Type*} [group G]

@[to_additive]
lemma subsingleton_of_subgroup_quotient_subsingleton {N : subgroup G} :
  subsingleton N → subsingleton (quotient N) → subsingleton G :=
λ hN hqN, @equiv.subsingleton G (quotient N × N) group_equiv_quotient_times_subgroup
  (@subsingleton.prod _ _ hqN hN)

@[to_additive]
lemma mk'_surjective (N : subgroup G) [N.normal] : function.surjective (mk' N) :=
surjective_quot_mk _

@[to_additive]
def quotient_bot : quotient (⊥ : subgroup G) ≃* G :=
{ to_fun := lift ⊥ (id G) (λ x hx, (mem_bot.mp hx).symm ▸ rfl), inv_fun := mk' ⊥,
  left_inv := λ x, x.induction_on' $ by { intro a, simp only [lift_mk', id_apply], refl },
  right_inv := λ x, show (lift ⊥ (id G) _) (quotient_group.mk x) = x, by simp,
  map_mul' := λ x y, map_mul _ x y }

variables {N : subgroup G} [normal N]

@[to_additive]
lemma map_mk'_normal {K : subgroup G} [hK : normal K] (h : N ≤ K) : normal (K.map (mk' N)) :=
⟨begin
  intros n hn, rcases mem_map.mp hn with ⟨k, hk, rfl⟩,
  intro g', apply quotient.induction_on' g', intro g, simp,
  use [g * k * g⁻¹, hK.conj_mem k hk g], simp, refl,
end⟩

@[to_additive]
lemma map_mk'_eq_top {K : subgroup G} (hNK : N ≤ K) : K.map (mk' N) = ⊤ ↔ K = ⊤ :=
⟨λ h, le_antisymm le_top (λ g _,
  have hg : (mk' N) g ∈ K.map (mk' N) := h.symm ▸ mem_top ((mk' N) g),
  exists.elim hg $ λ g' ⟨hg', (hg : ↑g' = ↑g)⟩, begin
    rw quotient_group.eq at hg,
    convert_to g' * (g'⁻¹ * g) ∈ K, { simp },
    exact mul_mem K hg' (hNK hg),
  end),
λ h, set_like.ext' $ h.symm ▸ set.image_univ_of_surjective (surjective_quot_mk _)⟩

@[to_additive]
lemma le_comap_mk' {K : subgroup (quotient N)} : N ≤ comap (mk' N) K :=
by conv_lhs { rw ←ker_mk N }; exact ker_le_comap

@[simp, to_additive]
lemma mk'_eq_one (x : G) : (mk' N) x = 1 ↔ x ∈ N :=
by rw [←mem_ker, ker_mk]

@[to_additive]
lemma subsingleton_quotient_iff : subsingleton (quotient N) ↔ N = ⊤ :=
⟨λ h, le_antisymm le_top (λ x _, ker_mk N ▸
  show mk' N x = 1, from @subsingleton.elim _ h (mk' N x) 1),
λ h, ⟨λ a b, quotient.induction_on₂' a b $ λ x y,
  show ↑x = ↑y, from quotient_group.eq.mpr $ by { rw h, trivial }⟩⟩

variables {H : Type*} [group H]
@[to_additive]
def equiv_quotient_of_equiv (e : G ≃* H) : quotient N ≃* quotient (N.map e.to_monoid_hom) :=
{ to_fun := lift _ ((mk' $ N.map e.to_monoid_hom).comp e.to_monoid_hom) (by simp),
  inv_fun := lift _ ((mk' N).comp e.symm.to_monoid_hom) (by simp),
  left_inv := λ x, by
    { apply x.induction_on', intro a, simp,
      change (lift _ _ _) (quotient.mk' (e a)) = _, simp, refl },
  right_inv := λ x, by
    { apply x.induction_on', intro a, simp,
      change (lift _ _ _) (quotient.mk' (e.symm a)) = _, simp, refl },
  map_mul' := by simp }

end quotient_group