/-
Copyright (c) 2021 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Eric Wieser
-/
import ring_theory.ideal.basic
import ring_theory.ideal.operations
import linear_algebra.finsupp
import ring_theory.graded_algebra.basic
/-!
# Homogeneous ideals of a graded algebra

This file defines homogeneous ideals of `graded_algebra 𝒜` where `𝒜 : ι → submodule R A` and
operations on them.

## Main definitions

For any `I : ideal A`:
* `ideal.is_homogeneous 𝒜 I`: The property that an ideal is closed under `graded_algebra.proj`.
* `homogeneous_ideal 𝒜`: The structure extending ideals which satisfy `ideal.is_homogeneous`
* `ideal.homogeneous_core I 𝒜`: The largest homogeneous ideal smaller than `I`.
* `ideal.homogeneous_hull I 𝒜`: The smallest homogeneous ideal larger than `I`.

## Main statements

* `homogeneous_ideal.complete_lattice`: `ideal.is_homogeneous` is preserved by `⊥`, `⊤`, `⊔`, `⊓`,
  `⨆`, `⨅`, and so the subtype of homogeneous ideals inherits a complete lattice structure.
* `ideal.homogeneous_core.gi`: `ideal.homogeneous_core` forms a galois insertion with coercion.
* `ideal.homogeneous_hull.gi`: `ideal.homogeneous_hull` forms a galois insertion with coercion.

## Implementation notes

We introduce `ideal.homogeneous_core'` earlier than might be expected so that we can get access
to `ideal.is_homogeneous.iff_exists` as quickly as possible.

## Tags

graded algebra, homogeneous
-/

open set_like direct_sum set
open_locale big_operators pointwise direct_sum

variables {ι R A : Type*}

section homogeneous_def

variables [comm_semiring R] [semiring A] [algebra R A]
variables (𝒜 : ι → submodule R A)
variables [decidable_eq ι] [add_monoid ι] [graded_algebra 𝒜]
variable (I : ideal A)

/--An `I : ideal A` is homogeneous if for every `r ∈ I`, all homogeneous components
  of `r` are in `I`.-/
def ideal.is_homogeneous : Prop :=
∀ (i : ι) ⦃r : A⦄, r ∈ I → (graded_algebra.decompose 𝒜 r i : A) ∈ I

/-- For any `semiring A`, we collect the homogeneous ideals of `A` into a type. -/
structure homogeneous_ideal extends submodule A A :=
(is_homogeneous' : ideal.is_homogeneous 𝒜 to_submodule)

variable {𝒜}
/--Converting a homogeneous ideal to an ideal-/
def homogeneous_ideal.to_ideal (I : homogeneous_ideal 𝒜) : ideal A := I.to_submodule

lemma homogeneous_ideal.is_homogeneous (I : homogeneous_ideal 𝒜) :
  I.to_ideal.is_homogeneous 𝒜 := I.is_homogeneous'

lemma homogeneous_ideal.to_ideal_injective :
  function.injective (homogeneous_ideal.to_ideal : homogeneous_ideal 𝒜 → ideal A) :=
λ ⟨x, hx⟩ ⟨y, hy⟩ (h : x = y), by simp [h]

instance homogeneous_ideal.set_like : set_like (homogeneous_ideal 𝒜) A :=
{ coe := λ I, I.to_ideal,
  coe_injective' := λ I J h, homogeneous_ideal.to_ideal_injective $ set_like.coe_injective h }

@[ext] lemma homogeneous_ideal.ext {I J : homogeneous_ideal 𝒜}
  (h : I.to_ideal = J.to_ideal) : I = J := homogeneous_ideal.to_ideal_injective h

@[simp] lemma homogeneous_ideal.mem_iff {I : homogeneous_ideal 𝒜} {x : A} :
  x ∈ I.to_ideal ↔ x ∈ I := iff.rfl

end homogeneous_def

section homogeneous_core

variables [comm_semiring R] [semiring A] [algebra R A]
variables (𝒜 : ι → submodule R A)
variable (I : ideal A)

/-- For any `I : ideal A`, not necessarily homogeneous, `I.homogeneous_core' 𝒜`
is the largest homogeneous ideal of `A` contained in `I`, as an ideal. -/
def ideal.homogeneous_core' : ideal A :=
ideal.span (coe '' ((coe : subtype (is_homogeneous 𝒜) → A) ⁻¹' I))

lemma ideal.homogeneous_core'_mono : monotone (ideal.homogeneous_core' 𝒜) :=
λ I J I_le_J, ideal.span_mono $ set.image_subset _ $ λ x, @I_le_J _

lemma ideal.homogeneous_core'_le : I.homogeneous_core' 𝒜 ≤ I :=
ideal.span_le.2 $ image_preimage_subset _ _

end homogeneous_core

section is_homogeneous_ideal_defs

variables [comm_semiring R] [semiring A] [algebra R A]
variables (𝒜 : ι → submodule R A)
variables [decidable_eq ι] [add_monoid ι] [graded_algebra 𝒜]
variable (I : ideal A)

lemma ideal.is_homogeneous_iff_forall_subset :
  I.is_homogeneous 𝒜 ↔ ∀ i, (I : set A) ⊆ graded_algebra.proj 𝒜 i ⁻¹' I :=
iff.rfl

lemma ideal.is_homogeneous_iff_subset_Inter :
  I.is_homogeneous 𝒜 ↔ (I : set A) ⊆ ⋂ i, graded_algebra.proj 𝒜 i ⁻¹' ↑I :=
subset_Inter_iff.symm

lemma ideal.mul_homogeneous_element_mem_of_mem
  {I : ideal A} (r x : A) (hx₁ : is_homogeneous 𝒜 x) (hx₂ : x ∈ I) (j : ι) :
  graded_algebra.proj 𝒜 j (r * x) ∈ I :=
begin
  letI : Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0) := λ _ _, classical.dec _,
  rw [←graded_algebra.sum_support_decompose 𝒜 r, finset.sum_mul, linear_map.map_sum],
  apply ideal.sum_mem,
  intros k hk,
  obtain ⟨i, hi⟩ := hx₁,
  have mem₁ : (graded_algebra.decompose 𝒜 r k : A) * x ∈ 𝒜 (k + i) := graded_monoid.mul_mem
    (submodule.coe_mem _) hi,
  erw [graded_algebra.proj_apply, graded_algebra.decompose_of_mem 𝒜 mem₁,
    coe_of_submodule_apply 𝒜, submodule.coe_mk],
  split_ifs,
  { exact I.mul_mem_left _ hx₂ },
  { exact I.zero_mem },
end

lemma ideal.is_homogeneous_span (s : set A) (h : ∀ x ∈ s, is_homogeneous 𝒜 x) :
  (ideal.span s).is_homogeneous 𝒜 :=
begin
  rintros i r hr,
  rw [ideal.span, finsupp.span_eq_range_total] at hr,
  rw linear_map.mem_range at hr,
  obtain ⟨s, rfl⟩ := hr,
  rw [←graded_algebra.proj_apply, finsupp.total_apply, finsupp.sum, linear_map.map_sum],
  refine ideal.sum_mem _ _,
  rintros z hz1,
  rw [smul_eq_mul],
  refine ideal.mul_homogeneous_element_mem_of_mem 𝒜 (s z) z _ _ i,
  { rcases z with ⟨z, hz2⟩,
    apply h _ hz2, },
  { exact ideal.subset_span z.2 },
end

/--For any `I : ideal A`, not necessarily homogeneous, `I.homogeneous_core' 𝒜`
is the largest homogeneous ideal of `A` contained in `I`.-/
def ideal.homogeneous_core : homogeneous_ideal 𝒜 :=
⟨ideal.homogeneous_core' 𝒜 I,
  ideal.is_homogeneous_span _ _ (λ x h, by { rw [subtype.image_preimage_coe] at h, exact h.2 })⟩

lemma ideal.homogeneous_core_mono : monotone (ideal.homogeneous_core 𝒜) :=
ideal.homogeneous_core'_mono 𝒜

lemma ideal.to_ideal_homogeneous_core_le : (I.homogeneous_core 𝒜).to_ideal ≤ I :=
ideal.homogeneous_core'_le 𝒜 I

variables {𝒜 I}

lemma ideal.mem_homogeneous_core_of_is_homogeneous_of_mem {x : A}
  (h : set_like.is_homogeneous 𝒜 x) (hmem : x ∈ I) : x ∈ I.homogeneous_core 𝒜 :=
ideal.subset_span ⟨⟨x, h⟩, hmem, rfl⟩

lemma ideal.is_homogeneous.to_ideal_homogeneous_core_eq_self (h : I.is_homogeneous 𝒜) :
  (I.homogeneous_core 𝒜).to_ideal = I :=
begin
  apply le_antisymm (I.homogeneous_core'_le 𝒜) _,
  intros x hx,
  letI : Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0) := λ _ _, classical.dec _,
  rw ←graded_algebra.sum_support_decompose 𝒜 x,
  exact ideal.sum_mem _ (λ j hj, ideal.subset_span ⟨⟨_, is_homogeneous_coe _⟩, h _ hx, rfl⟩)
end

@[simp] lemma homogeneous_ideal.to_ideal_homogeneous_core_eq_self (I : homogeneous_ideal 𝒜) :
  I.to_ideal.homogeneous_core 𝒜 = I :=
by ext1; convert ideal.is_homogeneous.to_ideal_homogeneous_core_eq_self I.is_homogeneous

variables (𝒜 I)

lemma ideal.is_homogeneous.iff_eq : I.is_homogeneous 𝒜 ↔ (I.homogeneous_core 𝒜).to_ideal = I :=
⟨ λ hI, hI.to_ideal_homogeneous_core_eq_self,
  λ hI, hI ▸ (ideal.homogeneous_core 𝒜 I).2 ⟩

lemma ideal.is_homogeneous.iff_exists :
  I.is_homogeneous 𝒜 ↔ ∃ (S : set (homogeneous_submonoid 𝒜)), I = ideal.span (coe '' S) :=
begin
  rw [ideal.is_homogeneous.iff_eq, eq_comm],
  exact ((set.image_preimage.compose (submodule.gi _ _).gc).exists_eq_l _).symm,
end

end is_homogeneous_ideal_defs

/-! ### Operations

In this section, we show that `ideal.is_homogeneous` is preserved by various notations, then use
these results to provide these notation typeclasses for `homogeneous_ideal`. -/

section operations

section semiring

variables [comm_semiring R] [semiring A] [algebra R A]
variables [decidable_eq ι] [add_monoid ι]
variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]

namespace ideal.is_homogeneous

lemma bot : ideal.is_homogeneous 𝒜 ⊥ := λ i r hr,
begin
  simp only [ideal.mem_bot] at hr,
  rw [hr, alg_equiv.map_zero, zero_apply],
  apply ideal.zero_mem
end

lemma top : ideal.is_homogeneous 𝒜 ⊤ :=
λ i r hr, by simp only [submodule.mem_top]

variables {𝒜}

lemma inf {I J : ideal A} (HI : I.is_homogeneous 𝒜) (HJ : J.is_homogeneous 𝒜) :
  (I ⊓ J).is_homogeneous 𝒜 :=
λ i r hr, ⟨HI _ hr.1, HJ _ hr.2⟩

lemma sup {I J : ideal A} (HI : I.is_homogeneous 𝒜) (HJ : J.is_homogeneous 𝒜) :
  (I ⊔ J).is_homogeneous 𝒜 :=
begin
  rw iff_exists at HI HJ ⊢,
  obtain ⟨⟨s₁, rfl⟩, ⟨s₂, rfl⟩⟩ := ⟨HI, HJ⟩,
  refine ⟨s₁ ∪ s₂, _⟩,
  rw [set.image_union],
  exact (submodule.span_union _ _).symm,
end

protected lemma supr {κ : Sort*} {f : κ → ideal A} (h : ∀ i, (f i).is_homogeneous 𝒜) :
  (⨆ i, f i).is_homogeneous 𝒜 :=
begin
  simp_rw iff_exists at h ⊢,
  choose s hs using h,
  refine ⟨⋃ i, s i, _⟩,
  simp_rw [set.image_Union, ideal.span_Union],
  congr',
  exact funext hs,
end

protected lemma infi {κ : Sort*} {f : κ → ideal A} (h : ∀ i, (f i).is_homogeneous 𝒜) :
  (⨅ i, f i).is_homogeneous 𝒜 :=
begin
  intros i x hx,
  simp only [ideal.mem_infi] at ⊢ hx,
  exact λ j, h _ _ (hx j),
end

lemma supr₂ {κ : Sort*} {κ' : κ → Sort*} {f : Π i, κ' i → ideal A}
  (h : ∀ i j, (f i j).is_homogeneous 𝒜) :
  (⨆ i j, f i j).is_homogeneous 𝒜 :=
is_homogeneous.supr $ λ i, is_homogeneous.supr $ h i

lemma infi₂ {κ : Sort*} {κ' : κ → Sort*} {f : Π i, κ' i → ideal A}
  (h : ∀ i j, (f i j).is_homogeneous 𝒜) :
  (⨅ i j, f i j).is_homogeneous 𝒜 :=
is_homogeneous.infi $ λ i, is_homogeneous.infi $ h i

lemma Sup {ℐ : set (ideal A)} (h : ∀ I ∈ ℐ, ideal.is_homogeneous 𝒜 I) :
  (Sup ℐ).is_homogeneous 𝒜 :=
by { rw Sup_eq_supr, exact supr₂ h }

lemma Inf {ℐ : set (ideal A)} (h : ∀ I ∈ ℐ, ideal.is_homogeneous 𝒜 I) :
  (Inf ℐ).is_homogeneous 𝒜 :=
by { rw Inf_eq_infi, exact infi₂ h }

end ideal.is_homogeneous

variables {𝒜}

namespace homogeneous_ideal

instance : partial_order (homogeneous_ideal 𝒜) := set_like.partial_order

instance : has_top (homogeneous_ideal 𝒜) := ⟨⟨⊤, ideal.is_homogeneous.top 𝒜⟩⟩
instance : has_bot (homogeneous_ideal 𝒜) := ⟨⟨⊥, ideal.is_homogeneous.bot 𝒜⟩⟩
instance : has_sup (homogeneous_ideal 𝒜) := ⟨λ I J, ⟨_, I.is_homogeneous.sup J.is_homogeneous⟩⟩
instance : has_inf (homogeneous_ideal 𝒜) := ⟨λ I J, ⟨_, I.is_homogeneous.inf J.is_homogeneous⟩⟩
instance : has_Sup (homogeneous_ideal 𝒜) :=
⟨λ S, ⟨⨆ s ∈ S, to_ideal s, ideal.is_homogeneous.supr₂ $ λ s _, s.is_homogeneous⟩⟩
instance : has_Inf (homogeneous_ideal 𝒜) :=
⟨λ S, ⟨⨅ s ∈ S, to_ideal s, ideal.is_homogeneous.infi₂ $ λ s _, s.is_homogeneous⟩⟩

@[simp] lemma coe_top : ((⊤ : homogeneous_ideal 𝒜) : set A) = univ := rfl
@[simp] lemma coe_bot : ((⊥ : homogeneous_ideal 𝒜) : set A) = 0 := rfl
@[simp] lemma coe_sup (I J : homogeneous_ideal 𝒜) : ↑(I ⊔ J) = (I + J : set A) :=
submodule.coe_sup _ _
@[simp] lemma coe_inf (I J : homogeneous_ideal 𝒜) : (↑(I ⊓ J) : set A) = I ∩ J := rfl

@[simp] lemma to_ideal_top : (⊤ : homogeneous_ideal 𝒜).to_ideal = (⊤ : ideal A) := rfl
@[simp] lemma to_ideal_bot : (⊥ : homogeneous_ideal 𝒜).to_ideal = (⊥ : ideal A) := rfl

@[simp] lemma to_ideal_sup (I J : homogeneous_ideal 𝒜) :
  (I ⊔ J).to_ideal = I.to_ideal ⊔ J.to_ideal := rfl

@[simp] lemma to_ideal_inf (I J : homogeneous_ideal 𝒜) :
  (I ⊓ J).to_ideal = I.to_ideal ⊓ J.to_ideal := rfl

@[simp] lemma to_ideal_Sup (ℐ : set (homogeneous_ideal 𝒜)) :
  (Sup ℐ).to_ideal = ⨆ s ∈ ℐ, to_ideal s := rfl

@[simp] lemma to_ideal_Inf (ℐ : set (homogeneous_ideal 𝒜)) :
  (Inf ℐ).to_ideal = ⨅ s ∈ ℐ, to_ideal s := rfl

@[simp] lemma to_ideal_supr {κ : Sort*} (s : κ → homogeneous_ideal 𝒜) :
  (⨆ i, s i).to_ideal = ⨆ i, (s i).to_ideal :=
by rw [supr, to_ideal_Sup, supr_range]

@[simp] lemma to_ideal_infi {κ : Sort*} (s : κ → homogeneous_ideal 𝒜) :
  (⨅ i, s i).to_ideal = ⨅ i, (s i).to_ideal :=
by rw [infi, to_ideal_Inf, infi_range]

@[simp] lemma to_ideal_supr₂ {κ : Sort*} {κ' : κ → Sort*} (s : Π i, κ' i → homogeneous_ideal 𝒜) :
  (⨆ i j, s i j).to_ideal = ⨆ i j, (s i j).to_ideal :=
by simp_rw to_ideal_supr

@[simp] lemma to_ideal_infi₂ {κ : Sort*} {κ' : κ → Sort*} (s : Π i, κ' i → homogeneous_ideal 𝒜) :
  (⨅ i j, s i j).to_ideal = ⨅ i j, (s i j).to_ideal :=
by simp_rw to_ideal_infi

@[simp] lemma eq_top_iff (I : homogeneous_ideal 𝒜) : I = ⊤ ↔ I.to_ideal = ⊤ :=
to_ideal_injective.eq_iff.symm

@[simp] lemma eq_bot_iff (I : homogeneous_ideal 𝒜) : I = ⊥ ↔ I.to_ideal = ⊥ :=
to_ideal_injective.eq_iff.symm

instance : complete_lattice (homogeneous_ideal 𝒜) :=
to_ideal_injective.complete_lattice _ to_ideal_sup to_ideal_inf to_ideal_Sup to_ideal_Inf
  to_ideal_top to_ideal_bot

instance : has_add (homogeneous_ideal 𝒜) := ⟨(⊔)⟩

@[simp] lemma to_ideal_add (I J : homogeneous_ideal 𝒜) :
  (I + J).to_ideal = I.to_ideal + J.to_ideal := rfl

instance : inhabited (homogeneous_ideal 𝒜) := { default := ⊥ }

end homogeneous_ideal

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A] [algebra R A]
variables [decidable_eq ι] [add_monoid ι]
variables {𝒜 : ι → submodule R A} [graded_algebra 𝒜]
variable (I : ideal A)

lemma ideal.is_homogeneous.mul {I J : ideal A}
  (HI : I.is_homogeneous 𝒜) (HJ : J.is_homogeneous 𝒜) : (I * J).is_homogeneous 𝒜 :=
begin
  rw ideal.is_homogeneous.iff_exists at HI HJ ⊢,
  obtain ⟨⟨s₁, rfl⟩, ⟨s₂, rfl⟩⟩ := ⟨HI, HJ⟩,
  rw ideal.span_mul_span',
  exact ⟨s₁ * s₂, congr_arg _ $ (set.image_mul (homogeneous_submonoid 𝒜).subtype).symm⟩,
end

variables {𝒜}

instance : has_mul (homogeneous_ideal 𝒜) :=
{ mul := λ I J, ⟨I.to_ideal * J.to_ideal, I.is_homogeneous.mul J.is_homogeneous⟩ }

@[simp] lemma homogeneous_ideal.to_ideal_mul (I J : homogeneous_ideal 𝒜) :
  (I * J).to_ideal = I.to_ideal * J.to_ideal := rfl

end comm_semiring

end operations

/-! ### Homogeneous core

Note that many results about the homogeneous core came earlier in this file, as they are helpful
for building the lattice structure. -/

section homogeneous_core

open homogeneous_ideal

variables [comm_semiring R] [semiring A]
variables [algebra R A] [decidable_eq ι] [add_monoid ι]
variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
variable (I : ideal A)

lemma ideal.homogeneous_core.gc : galois_connection to_ideal (ideal.homogeneous_core 𝒜) :=
λ I J, ⟨
  λ H, I.to_ideal_homogeneous_core_eq_self ▸ ideal.homogeneous_core_mono 𝒜 H,
  λ H, le_trans H (ideal.homogeneous_core'_le _ _)⟩

/--`to_ideal : homogeneous_ideal 𝒜 → ideal A` and `ideal.homogeneous_core 𝒜` forms a galois
coinsertion-/
def ideal.homogeneous_core.gi : galois_coinsertion to_ideal (ideal.homogeneous_core 𝒜) :=
{ choice := λ I HI,
    ⟨I, le_antisymm (I.to_ideal_homogeneous_core_le 𝒜) HI ▸ homogeneous_ideal.is_homogeneous _⟩,
  gc := ideal.homogeneous_core.gc 𝒜,
  u_l_le := λ I, ideal.homogeneous_core'_le _ _,
  choice_eq := λ I H, le_antisymm H (I.to_ideal_homogeneous_core_le _) }

lemma ideal.homogeneous_core_eq_Sup :
  I.homogeneous_core 𝒜 = Sup {J : homogeneous_ideal 𝒜 | J.to_ideal ≤ I} :=
eq.symm $ is_lub.Sup_eq $ (ideal.homogeneous_core.gc 𝒜).is_greatest_u.is_lub

lemma ideal.homogeneous_core'_eq_Sup :
  I.homogeneous_core' 𝒜 = Sup {J : ideal A | J.is_homogeneous 𝒜 ∧ J ≤ I} :=
begin
  refine (is_lub.Sup_eq _).symm,
  apply is_greatest.is_lub,
  have coe_mono : monotone (to_ideal : homogeneous_ideal 𝒜 → ideal A) := λ x y, id,
  convert coe_mono.map_is_greatest (ideal.homogeneous_core.gc 𝒜).is_greatest_u using 1,
  ext,
  rw [mem_image, mem_set_of_eq],
  refine ⟨λ hI, ⟨⟨x, hI.1⟩, ⟨hI.2, rfl⟩⟩, by rintro ⟨x, ⟨hx, rfl⟩⟩; exact ⟨x.is_homogeneous, hx⟩⟩,
end

end homogeneous_core

/-! ### Homogeneous hulls -/

section homogeneous_hull

open homogeneous_ideal

variables [comm_semiring R] [semiring A]
variables [algebra R A] [decidable_eq ι] [add_monoid ι]
variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
variable (I : ideal A)

/--For any `I : ideal A`, not necessarily homogeneous, `I.homogeneous_hull 𝒜` is
the smallest homogeneous ideal containing `I`. -/
def ideal.homogeneous_hull : homogeneous_ideal 𝒜 :=
⟨ideal.span {r : A | ∃ (i : ι) (x : I), (graded_algebra.decompose 𝒜 x i : A) = r}, begin
  refine ideal.is_homogeneous_span _ _ (λ x hx, _),
  obtain ⟨i, x, rfl⟩ := hx,
  apply set_like.is_homogeneous_coe
end⟩

lemma ideal.le_to_ideal_homogeneous_hull :
  I ≤ (ideal.homogeneous_hull 𝒜 I).to_ideal :=
begin
  intros r hr,
  letI : Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0) := λ _ _, classical.dec _,
  rw [←graded_algebra.sum_support_decompose 𝒜 r],
  refine ideal.sum_mem _ _, intros j hj,
  apply ideal.subset_span, use j, use ⟨r, hr⟩, refl,
end

lemma ideal.homogeneous_hull_mono : monotone (ideal.homogeneous_hull 𝒜) := λ I J I_le_J,
begin
  apply ideal.span_mono,
  rintros r ⟨hr1, ⟨x, hx⟩, rfl⟩,
  refine ⟨hr1, ⟨⟨x, I_le_J hx⟩, rfl⟩⟩,
end

variables {I 𝒜}

lemma ideal.is_homogeneous.to_ideal_homogeneous_hull_eq_self (h : I.is_homogeneous 𝒜) :
  (ideal.homogeneous_hull 𝒜 I).to_ideal = I :=
begin
  apply le_antisymm _ (ideal.le_to_ideal_homogeneous_hull _ _),
  apply (ideal.span_le).2,
  rintros _ ⟨i, x, rfl⟩,
  exact h _ x.prop,
end

@[simp] lemma homogeneous_ideal.homogeneous_hull_to_ideal_eq_self (I : homogeneous_ideal 𝒜) :
  I.to_ideal.homogeneous_hull 𝒜 = I :=
homogeneous_ideal.to_ideal_injective $ I.is_homogeneous.to_ideal_homogeneous_hull_eq_self

variables (I 𝒜)

lemma ideal.to_ideal_homogeneous_hull_eq_supr :
  (I.homogeneous_hull 𝒜).to_ideal = ⨆ i, ideal.span (graded_algebra.proj 𝒜 i '' I) :=
begin
  rw ←ideal.span_Union,
  apply congr_arg ideal.span _,
  ext1,
  simp only [set.mem_Union, set.mem_image, mem_set_of_eq, graded_algebra.proj_apply,
    set_like.exists, exists_prop, subtype.coe_mk, set_like.mem_coe],
end

lemma ideal.homogeneous_hull_eq_supr :
  (I.homogeneous_hull 𝒜) =
  ⨆ i, ⟨ideal.span (graded_algebra.proj 𝒜 i '' I), ideal.is_homogeneous_span 𝒜 _
    (by {rintros _ ⟨x, -, rfl⟩, apply set_like.is_homogeneous_coe})⟩ :=
by { ext1, rw [ideal.to_ideal_homogeneous_hull_eq_supr, to_ideal_supr], refl }

end homogeneous_hull

section galois_connection

open homogeneous_ideal

variables [comm_semiring R] [semiring A]
variables [algebra R A] [decidable_eq ι] [add_monoid ι]
variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]

lemma ideal.homogeneous_hull.gc : galois_connection (ideal.homogeneous_hull 𝒜) to_ideal :=
λ I J, ⟨
  le_trans (ideal.le_to_ideal_homogeneous_hull _ _),
  λ H, J.homogeneous_hull_to_ideal_eq_self ▸ ideal.homogeneous_hull_mono 𝒜 H⟩

/-- `ideal.homogeneous_hull 𝒜` and `to_ideal : homogeneous_ideal 𝒜 → ideal A` form a galois
insertion-/
def ideal.homogeneous_hull.gi : galois_insertion (ideal.homogeneous_hull 𝒜) to_ideal :=
{ choice := λ I H, ⟨I, le_antisymm H (I.le_to_ideal_homogeneous_hull 𝒜) ▸ is_homogeneous _⟩,
  gc := ideal.homogeneous_hull.gc 𝒜,
  le_l_u := λ I, ideal.le_to_ideal_homogeneous_hull _ _,
  choice_eq := λ I H, le_antisymm (I.le_to_ideal_homogeneous_hull 𝒜) H}

lemma ideal.homogeneous_hull_eq_Inf (I : ideal A) :
  ideal.homogeneous_hull 𝒜 I = Inf { J : homogeneous_ideal 𝒜 | I ≤ J.to_ideal } :=
eq.symm $ is_glb.Inf_eq $ (ideal.homogeneous_hull.gc 𝒜).is_least_l.is_glb

end galois_connection

section irrelevant_ideal

variables [comm_semiring R] [semiring A]
variables [algebra R A] [decidable_eq ι]
variables [canonically_ordered_add_monoid ι]
variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]

open graded_algebra set_like.graded_monoid direct_sum

/--
For a graded ring `⨁ᵢ 𝒜ᵢ` graded by a `canonically_ordered_add_monoid ι`, the irrelevant ideal
refers to `⨁_{i>0} 𝒜ᵢ`, or equivalently `{a | a₀ = 0}`. This definition is used in `Proj`
construction where `ι` is always `ℕ` so the irrelevant ideal is simply elements with `0` as
0-th coordinate.

# Future work
Here in the definition, `ι` is assumed to be `canonically_ordered_add_monoid`. However, the notion
of irrelevant ideal makes sense in a more general setting by defining it as the ideal of elements
with `0` as i-th coordinate for all `i ≤ 0`, i.e. `{a | ∀ (i : ι), i ≤ 0 → aᵢ = 0}`.
-/
def homogeneous_ideal.irrelevant : homogeneous_ideal 𝒜 :=
⟨(graded_algebra.proj_zero_ring_hom 𝒜).ker, λ i r (hr : (decompose 𝒜 r 0 : A) = 0), begin
  change (decompose 𝒜 (decompose 𝒜 r _) 0 : A) = 0,
  by_cases h : i = 0,
  { rw [h, hr, map_zero, zero_apply, submodule.coe_zero] },
  { rw [decompose_of_mem_ne 𝒜 (submodule.coe_mem _) h] }
end⟩

@[simp] lemma homogeneous_ideal.mem_irrelevant_iff (a : A) :
  a ∈ homogeneous_ideal.irrelevant 𝒜 ↔ proj 𝒜 0 a = 0 := iff.rfl

@[simp] lemma homogeneous_ideal.to_ideal_irrelevant :
  (homogeneous_ideal.irrelevant 𝒜).to_ideal = (graded_algebra.proj_zero_ring_hom 𝒜).ker := rfl

end irrelevant_ideal


import finitary data.fin.misc
universe u

class fintype (α : Type u) :=
  (size : ℕ)
  (finitary : finitary α size)

namespace fintype
variables {α : Type u}[fintype α]

@[reducible]
def enum : α → fin (size α) := (finitary α).map
@[reducible]
def index : fin (size α) → α := (finitary α).bijection.inv

def elems : list α := list.map (@index α _) (fin.elems (size α))
theorem mem_elems : ∀ a : α, a ∈ (elems : list α) :=
  begin
    intro a,
    assert H : index (enum a) ∈ (elems : list α),
      {
          simp [elems],
          apply list.mem_map,
          apply fin.mem_elems
      },
    simp [enum,index] at H,
    rw (finitary α).bijection.left_inverse_of_inv at H,
    assumption
  end

end fintype

def fsubtype {α : Type u}{l : list α} (prop : list.nodup l) := { a : α // a ∈ l }

namespace fsubtype
variables {α : Type u}[decidable_eq α]{l : list α} {prop : list.nodup l}
def index : fsubtype prop → fin l.length :=
  take ⟨a, hmem⟩, fin.left_index hmem
def enum : fin l.length → fsubtype prop :=
  take i, ⟨fin.nth l i, fin.mem_nth _ _⟩

def enum_index_inverse : function.left_inverse enum (@index _ _ _ prop) :=
  take ⟨a, hmem⟩, subtype.eq $ fin.nth_left_index_left_inverse hmem

def index_enum_inverse : function.right_inverse enum (@index _ _ _ prop) :=
  take i, fin.left_index_mem_nth_left_inverse_of_nodup prop i

end fsubtype

instance {α : Type u}[decidable_eq α]{l : list α} {prop : list.nodup l} : fintype (fsubtype prop) :=
{
  size := l.length,
  finitary := {
    map := fsubtype.index,
    bijection := {
      inv := fsubtype.enum,
      left_inverse_of_inv := fsubtype.enum_index_inverse,
      right_inverse_of_inv := fsubtype.index_enum_inverse
    }
  }
}


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

import analysis.special_functions.pow
import data.is_R_or_C.lemmas
import measure_theory.constructions.borel_space

/-!
# Measurability of real and complex functions

We show that most standard real and complex functions are measurable, notably `exp`, `cos`, `sin`,
`cosh`, `sinh`, `log`, `pow`, `arcsin`, `arccos`.

See also `measure_theory.function.special_functions.arctan` and
`measure_theory.function.special_functions.inner`, which have been split off to minimize imports.
-/

noncomputable theory
open_locale nnreal ennreal

namespace real

@[measurability] lemma measurable_exp : measurable exp := continuous_exp.measurable

@[measurability] lemma measurable_log : measurable log :=
measurable_of_measurable_on_compl_singleton 0 $ continuous.measurable $
  continuous_on_iff_continuous_restrict.1 continuous_on_log

@[measurability] lemma measurable_sin : measurable sin := continuous_sin.measurable

@[measurability] lemma measurable_cos : measurable cos := continuous_cos.measurable

@[measurability] lemma measurable_sinh : measurable sinh := continuous_sinh.measurable

@[measurability] lemma measurable_cosh : measurable cosh := continuous_cosh.measurable

@[measurability] lemma measurable_arcsin : measurable arcsin := continuous_arcsin.measurable

@[measurability] lemma measurable_arccos : measurable arccos := continuous_arccos.measurable

end real

namespace complex

@[measurability] lemma measurable_re : measurable re := continuous_re.measurable

@[measurability] lemma measurable_im : measurable im := continuous_im.measurable

@[measurability] lemma measurable_of_real : measurable (coe : ℝ → ℂ) :=
continuous_of_real.measurable

@[measurability] lemma measurable_exp : measurable exp := continuous_exp.measurable

@[measurability] lemma measurable_sin : measurable sin := continuous_sin.measurable

@[measurability] lemma measurable_cos : measurable cos := continuous_cos.measurable

@[measurability] lemma measurable_sinh : measurable sinh := continuous_sinh.measurable

@[measurability] lemma measurable_cosh : measurable cosh := continuous_cosh.measurable

@[measurability] lemma measurable_arg : measurable arg :=
have A : measurable (λ x : ℂ, real.arcsin (x.im / x.abs)),
  from real.measurable_arcsin.comp (measurable_im.div measurable_norm),
have B : measurable (λ x : ℂ, real.arcsin ((-x).im / x.abs)),
  from real.measurable_arcsin.comp ((measurable_im.comp measurable_neg).div measurable_norm),
measurable.ite (is_closed_le continuous_const continuous_re).measurable_set A $
  measurable.ite (is_closed_le continuous_const continuous_im).measurable_set
    (B.add_const _) (B.sub_const _)

@[measurability] lemma measurable_log : measurable log :=
(measurable_of_real.comp $ real.measurable_log.comp measurable_norm).add $
  (measurable_of_real.comp measurable_arg).mul_const I

end complex

namespace is_R_or_C

variables {𝕜 : Type*} [is_R_or_C 𝕜]

@[measurability] lemma measurable_re : measurable (re : 𝕜 → ℝ) := continuous_re.measurable

@[measurability] lemma measurable_im : measurable (im : 𝕜 → ℝ) := continuous_im.measurable

end is_R_or_C

section real_composition
open real
variables {α : Type*} {m : measurable_space α} {f : α → ℝ} (hf : measurable f)

@[measurability] lemma measurable.exp : measurable (λ x, real.exp (f x)) :=
real.measurable_exp.comp hf

@[measurability] lemma measurable.log : measurable (λ x, log (f x)) :=
measurable_log.comp hf

@[measurability] lemma measurable.cos : measurable (λ x, real.cos (f x)) :=
real.measurable_cos.comp hf

@[measurability] lemma measurable.sin : measurable (λ x, real.sin (f x)) :=
real.measurable_sin.comp hf

@[measurability] lemma measurable.cosh : measurable (λ x, real.cosh (f x)) :=
real.measurable_cosh.comp hf

@[measurability] lemma measurable.sinh : measurable (λ x, real.sinh (f x)) :=
real.measurable_sinh.comp hf

@[measurability] lemma measurable.sqrt : measurable (λ x, sqrt (f x)) :=
continuous_sqrt.measurable.comp hf

end real_composition

section complex_composition
open complex
variables {α : Type*} {m : measurable_space α} {f : α → ℂ} (hf : measurable f)

@[measurability] lemma measurable.cexp : measurable (λ x, complex.exp (f x)) :=
complex.measurable_exp.comp hf

@[measurability] lemma measurable.ccos : measurable (λ x, complex.cos (f x)) :=
complex.measurable_cos.comp hf

@[measurability] lemma measurable.csin : measurable (λ x, complex.sin (f x)) :=
complex.measurable_sin.comp hf

@[measurability] lemma measurable.ccosh : measurable (λ x, complex.cosh (f x)) :=
complex.measurable_cosh.comp hf

@[measurability] lemma measurable.csinh : measurable (λ x, complex.sinh (f x)) :=
complex.measurable_sinh.comp hf

@[measurability] lemma measurable.carg : measurable (λ x, arg (f x)) :=
measurable_arg.comp hf

@[measurability] lemma measurable.clog : measurable (λ x, log (f x)) :=
measurable_log.comp hf

end complex_composition

section is_R_or_C_composition

variables {α 𝕜 : Type*} [is_R_or_C 𝕜] {m : measurable_space α}
  {f : α → 𝕜} {μ : measure_theory.measure α}

include m

@[measurability] lemma measurable.re (hf : measurable f) : measurable (λ x, is_R_or_C.re (f x)) :=
is_R_or_C.measurable_re.comp hf

@[measurability] lemma ae_measurable.re (hf : ae_measurable f μ) :
  ae_measurable (λ x, is_R_or_C.re (f x)) μ :=
is_R_or_C.measurable_re.comp_ae_measurable hf

@[measurability] lemma measurable.im (hf : measurable f) : measurable (λ x, is_R_or_C.im (f x)) :=
is_R_or_C.measurable_im.comp hf

@[measurability] lemma ae_measurable.im (hf : ae_measurable f μ) :
  ae_measurable (λ x, is_R_or_C.im (f x)) μ :=
is_R_or_C.measurable_im.comp_ae_measurable hf

omit m

end is_R_or_C_composition

section

variables {α 𝕜 : Type*} [is_R_or_C 𝕜] [measurable_space α]
  {f : α → 𝕜} {μ : measure_theory.measure α}

@[measurability] lemma is_R_or_C.measurable_of_real : measurable (coe : ℝ → 𝕜) :=
is_R_or_C.continuous_of_real.measurable

lemma measurable_of_re_im
  (hre : measurable (λ x, is_R_or_C.re (f x)))
  (him : measurable (λ x, is_R_or_C.im (f x))) : measurable f :=
begin
  convert (is_R_or_C.measurable_of_real.comp hre).add
    ((is_R_or_C.measurable_of_real.comp him).mul_const is_R_or_C.I),
  { ext1 x,
    exact (is_R_or_C.re_add_im _).symm },
  all_goals { apply_instance },
end

lemma ae_measurable_of_re_im
  (hre : ae_measurable (λ x, is_R_or_C.re (f x)) μ)
  (him : ae_measurable (λ x, is_R_or_C.im (f x)) μ) : ae_measurable f μ :=
begin
  convert (is_R_or_C.measurable_of_real.comp_ae_measurable hre).add
    ((is_R_or_C.measurable_of_real.comp_ae_measurable him).mul_const is_R_or_C.I),
  { ext1 x,
    exact (is_R_or_C.re_add_im _).symm },
  all_goals { apply_instance },
end

end

section pow_instances

instance complex.has_measurable_pow : has_measurable_pow ℂ ℂ :=
⟨measurable.ite (measurable_fst (measurable_set_singleton 0))
  (measurable.ite (measurable_snd (measurable_set_singleton 0)) measurable_one measurable_zero)
  (measurable_fst.clog.mul measurable_snd).cexp⟩

instance real.has_measurable_pow : has_measurable_pow ℝ ℝ :=
⟨complex.measurable_re.comp $ ((complex.measurable_of_real.comp measurable_fst).pow
  (complex.measurable_of_real.comp measurable_snd))⟩

instance nnreal.has_measurable_pow : has_measurable_pow ℝ≥0 ℝ :=
⟨(measurable_fst.coe_nnreal_real.pow measurable_snd).subtype_mk⟩

instance ennreal.has_measurable_pow : has_measurable_pow ℝ≥0∞ ℝ :=
begin
  refine ⟨ennreal.measurable_of_measurable_nnreal_prod _ _⟩,
  { simp_rw ennreal.coe_rpow_def,
    refine measurable.ite _ measurable_const
      (measurable_fst.pow measurable_snd).coe_nnreal_ennreal,
    exact measurable_set.inter (measurable_fst (measurable_set_singleton 0))
      (measurable_snd measurable_set_Iio), },
  { simp_rw ennreal.top_rpow_def,
    refine measurable.ite measurable_set_Ioi measurable_const _,
    exact measurable.ite (measurable_set_singleton 0) measurable_const measurable_const, },
end

end pow_instances

-- Guard against import creep:
assert_not_exists inner_product_space
assert_not_exists real.arctan


import tactic.find algebra.group_power tactic.ring data.set.finite data.zmod.basic
universes u v
variables {α : Type u} {β : Type v}
open nat finset equiv int.modeq nat int
local attribute [instance, priority 0] classical.prop_decidable

lemma nat.div_mul_le (a) {b} (hb : 0 < b) : a / b * b ≤ a :=
have h : 0 + a / b * b ≤ a % b + a / b * b := add_le_add (nat.zero_le _) (le_refl _),
by rwa [zero_add, mul_comm, nat.mod_add_div, mul_comm] at h

lemma int.dvd_of_pow_dvd_pow {a b : ℤ} {n : ℕ} (hn : 0 < n) (h : a ^ n ∣ b ^ n) : a ∣ b :=
begin
  rw [← nat_abs_dvd, ← dvd_nat_abs, int.nat_abs_pow, int.nat_abs_pow, int.coe_nat_dvd] at h,
  rw [← nat_abs_dvd, ← dvd_nat_abs, int.coe_nat_dvd],
  exact (nat.pow_dvd_pow_iff hn).1 h
end

lemma nat.cast_div [division_ring α] [char_zero α] {n m : ℕ} (h : n ∣ m) (hn : n ≠ 0) :
    ((m / n : ℕ) : α) = (m : α) / n :=
eq.symm ((div_eq_iff_mul_eq (by rwa nat.cast_ne_zero)).2 (by rw [← nat.cast_mul, nat.div_mul_cancel h]))

lemma nat.cast_div_le [linear_ordered_field α] {n m : ℕ} (hm : 0 < m) : ((n / m : ℕ) : α) ≤ (n / m : α) :=
le_of_mul_le_mul_right
  (calc ((n / m : ℕ) : α) * m ≤ n : by rw [← nat.cast_mul, nat.cast_le]; exact nat.div_mul_le _ hm
    ... =  (n / m : α) * m : (div_mul_cancel (n : α) (ne_of_lt (nat.cast_lt.2 hm)).symm).symm)
  (nat.cast_lt.2 hm)

lemma nat.prime.odd_iff_ge_three {p : ℕ} (hp : prime p) : p % 2 = 1 ↔ 3 ≤ p :=
⟨λ hpo, succ_le_of_lt (lt_of_le_of_ne hp.1 (λ h, by rw ← h at hpo; exact absurd hpo dec_trivial)),
λ hp3, or.cases_on (nat.mod_two_eq_zero_or_one p)
  (λ h, or.cases_on (hp.2 _ (nat.dvd_of_mod_eq_zero h)) (λ h2, absurd h2 dec_trivial)
    (λ h1, by rw ← h1 at hp3; exact absurd hp3 dec_trivial)) id⟩

lemma int.cast_div [division_ring α] [char_zero α] {i j : ℤ} (h : j ∣ i) (hj : j ≠ 0) :
  ((i / j : ℤ) : α) = (i : α) / j :=
eq.symm ((div_eq_iff_mul_eq (by rwa int.cast_ne_zero)).2 (by rw [← int.cast_mul, int.div_mul_cancel h]))

lemma int.add_div {i j : ℤ} (k : ℤ) (h : j ∣ i) (hk : j ≠ 0) :
  i / j + k / j = (i + k) / j :=
(domain.mul_left_inj hk).1
(let ⟨m, hm⟩ := exists_eq_mul_left_of_dvd h in
by rw [hm, mul_add, add_comm _ k, int.add_mul_div_right _ _ hk,
    int.mul_div_cancel _ hk, mul_add, add_comm])

lemma modeq_two_square_self (a : ℤ) : a * a ≡ a [ZMOD 2] :=
or.cases_on (int.mod_two_eq_zero_or_one a)
  (λ h, have h' : a ≡ 0 [ZMOD 2] := h,
    ((show a * a ≡ 0 * 0 [ZMOD 2], from modeq_mul h' h').trans h'.symm))
  (λ h, @eq.subst _ (λ b, a * a ≡ b [ZMOD 2]) _ _ (mul_one a)
    (int.modeq.modeq_mul rfl h))

lemma sum_two_squares_of_sum_two_squares_two_mul {n a b : ℤ} (h : a * a + b * b = 2 * n) :
    ∃ c d : ℤ, c * c + d * d = n :=
have hs : a * a + b * b ≡ 0 [ZMOD 2] := int.modeq.modeq_zero_iff.2 (h.symm ▸ dvd_mul_right _ _),
have hadd : (2 : ℤ) ∣ a + b := int.modeq.modeq_zero_iff.1 (int.modeq.trans
    (int.modeq.modeq_add (modeq_two_square_self _).symm (modeq_two_square_self _).symm) hs),
have hsub : (2 : ℤ) ∣ a - b :=
begin
  have : a - b = (a + b) + 2 * -b := by ring,
  rw this,
  exact dvd_add hadd (dvd_mul_right _ _),
end,
have h2 : (2 : ℤ) ≠ 0 := by norm_num,
⟨(a + b) / 2, (a - b) / 2,
  (domain.mul_left_inj h2).1
    (calc 2 * (((a + b) / 2) * ((a + b) / 2) + (a - b) / 2 * ((a - b) / 2))
        = (a + b) * ((a + b) / 2) + (a - b) * ((a - b) / 2) :
          by rw [mul_add (2 : ℤ), ← mul_assoc, ← mul_assoc, int.mul_div_cancel' hadd,
           int.mul_div_cancel' hsub]
    ... = a * a + b * b :
      (domain.mul_right_inj h2).1
        (by simp only [add_mul, mul_assoc _ _ (2 : ℤ), int.div_mul_cancel hadd,
              int.div_mul_cancel hsub]; ring)
    ... = 2 * n : h ▸ by simp [nat.pow_succ, int.coe_nat_mul, int.coe_nat_add])⟩

open finset function

private def mod_sub_half (n m : ℤ) : ℤ := if ((n % m : ℤ) : ℚ) ≤ m / 2 then (n : ℤ) % m else n % m - m

private lemma mod_sub_half_modeq {n m : ℤ} (hm : 0 < m) : mod_sub_half n m ≡ n [ZMOD m] :=
or.cases_on (classical.em (((n % m : ℤ) : ℚ) ≤ m / 2)) (λ h, begin
  rw [mod_sub_half, if_pos h],
  exact int.mod_mod _ _,
end)
(λ h, begin
  rw [mod_sub_half, if_neg h],
  conv {to_rhs, skip, rw ← sub_zero (n : ℤ)},
  exact int.modeq.modeq_sub (int.mod_mod _ _) (int.modeq.modeq_zero_iff.2 (dvd_refl _)),
end)

private lemma mod_sub_half_square {n m : ℤ} (hm : 0 < m) : mod_sub_half n m * mod_sub_half n m ≡ n * n [ZMOD m] :=
int.modeq.modeq_mul (mod_sub_half_modeq hm) (mod_sub_half_modeq hm)

private lemma mod_sub_half_eq_zero {n m : ℤ} (hm : 0 < m) (h : mod_sub_half n m * mod_sub_half n m = 0) :
    n * n ≡ 0 [ZMOD (m * m)] :=
have h : _ := eq_zero_of_mul_self_eq_zero h,
modeq_zero_iff.2 (mul_dvd_mul
  (modeq_zero_iff.1 (h ▸ (mod_sub_half_modeq hm).symm))
  (modeq_zero_iff.1 (h ▸ (mod_sub_half_modeq hm).symm)))

private lemma mod_sub_half_le {n m : ℤ} (hm : 0 < m) : ((abs (mod_sub_half n m) : ℤ) : ℚ) ≤ m / 2 :=
have hm0 : (m : ℤ) ≠ 0 := (ne_of_lt hm).symm,
begin
  cases classical.em (((n % m : ℤ) : ℚ) ≤ m / 2) with h h,
  { rwa [mod_sub_half, if_pos h, abs_of_nonneg (int.mod_nonneg (n : ℤ) hm0)] },
  { have hmn : (n : ℤ) % m - m < 0 := sub_neg_of_lt (trans_rel_left _
      (int.mod_lt _ hm0) (abs_of_pos hm)),
    rw [mod_sub_half, if_neg h, abs_of_neg hmn, neg_sub, int.cast_sub,
      sub_le_iff_le_add, ← sub_le_iff_le_add', sub_half],
    exact le_of_lt (lt_of_not_ge h) }
end

private lemma mod_sub_half_square_le {n m : ℤ} (hm : 0 < m) :
  ((mod_sub_half n m * mod_sub_half n m : ℤ) : ℚ) ≤ ((m * m) / 4) :=
calc ((mod_sub_half n m * mod_sub_half n m : ℤ) : ℚ) =
  ((abs (mod_sub_half n m) : ℤ) : ℚ) * ((abs (mod_sub_half n m) : ℤ) : ℚ) :
      by rw [← int.cast_mul, ← abs_mul, abs_mul_self]
   ... ≤ (m / 2) * (m / 2) : mul_self_le_mul_self (int.cast_nonneg.2 (abs_nonneg _)) (mod_sub_half_le hm)
   ... = m * m / 4 : by rw [_root_.div_mul_div, (show (2 : ℚ) * 2 = 4, from rfl)]

private lemma mod_sub_half_lt_of_odd {n m : ℤ} (hm : 0 < m) (hmo : m % 2 = 1) :
  ((abs (mod_sub_half n m) : ℤ) : ℚ) < m / 2 :=
let h := (@int.cast_nonneg ℚ _ _).2 (abs_nonneg (mod_sub_half n m)) in
have h2 : (2 : ℚ) ≠ 0 := by norm_num,
lt_of_le_of_ne (mod_sub_half_le hm)
(λ h, begin
  rw [← domain.mul_left_inj h2, mul_div_cancel' _ h2, (show (2 : ℚ) = ((2 : ℤ) : ℚ), from rfl),
    ← int.cast_mul, int.cast_inj] at h,
  have h2m : 2 ∣ m := h ▸ dvd_mul_right _ _,
  exact absurd ((int.mod_eq_zero_of_dvd h2m).symm.trans hmo) dec_trivial
end)

lemma four_squares_mul_four_squares {α : Type*} [comm_ring α] (a b c d w x y z : α) :
  (a * a + b * b +  c * c + d * d)  * (w * w + x * x +  y * y + z * z)  =
  (a * x - w * b + (d * y - z * c)) * (a * x - w * b + (d * y - z * c)) +
  (a * y - w * c + (b * z - x * d)) * (a * y - w * c + (b * z - x * d)) +
  (a * z - w * d + (c * x - y * b)) * (a * z - w * d + (c * x - y * b)) +
  (a * w + b * x +  c * y + d * z)  * (a * w + b * x +  c * y + d * z)  :=
by ring

lemma dvd_mul_sub_add_mul_sub {m a b c d w x y z : ℤ}
  (haw : w ≡ a [ZMOD m]) (hbx : x ≡ b [ZMOD m])
  (hcy : y ≡ c [ZMOD m]) (hdz : z ≡ d [ZMOD m]) :
  m ∣ (a * x - w * b + (d * y - z * c)) :=
dvd_add (modeq_iff_dvd.1 (modeq_mul haw hbx.symm)) (modeq_iff_dvd.1 (modeq_mul hdz hcy.symm))

lemma int.even_add_even {a b : ℤ} (ha : a % 2 = 0) (hb : b % 2 = 0) : (a + b) % 2 = 0 :=
show a + b ≡ 0 + 0 [ZMOD 2], from int.modeq.modeq_add ha hb

lemma int.odd_add_odd {a b : ℤ} (ha : a % 2 = 1) (hb : b % 2 = 1) : (a + b) % 2 = 0 :=
show a + b ≡ 1 + 1 [ZMOD 2], from int.modeq.modeq_add ha hb

lemma even_sum_four_squares {n a b c d : ℤ}
  (H : a * a + b * b + c * c + d * d = 2 * n) :
  ∃ w x y z, w * w + x * x + y * y + z * z = 2 * n ∧
  w * w + x * x ≡ 0 [ZMOD 2] ∧ y * y + z * z ≡ 0 [ZMOD 2] :=
have h' : a * a + b * b + c * c + d * d ≡ 0 [ZMOD 2] :=
  modeq_zero_iff.2 (H.symm ▸ dvd_mul_right _ _),
or.cases_on (int.mod_two_eq_zero_or_one (a * a))
  (λ ha, or.cases_on (int.mod_two_eq_zero_or_one (b * b))
    (λ hb, ⟨a, b, c, d, H, int.even_add_even ha hb,
      modeq_add_cancel_left (show a * a + b * b ≡ 0 [ZMOD 2], from int.even_add_even ha hb)
        (int.modeq.trans (by simp) h')⟩)
    (λ hb, or.cases_on (int.mod_two_eq_zero_or_one (c * c))
      (λ hc, ⟨a, c, b, d, by simp [H.symm], int.even_add_even ha hc,
        modeq_add_cancel_left (show a * a + c * c ≡ 0 [ZMOD 2], from int.even_add_even ha hc)
          (int.modeq.trans (by simp) h')⟩)
      (λ hc, ⟨a, d, b, c, by simp [H.symm],
        modeq_add_cancel_left (show b * b + c * c ≡ 0 [ZMOD 2], from int.odd_add_odd hb hc)
          (int.modeq.trans (by simp) h'),
        int.odd_add_odd hb hc⟩)))
  (λ ha, or.cases_on (int.mod_two_eq_zero_or_one (b * b))
    (λ hb, or.cases_on (int.mod_two_eq_zero_or_one (c * c))
      (λ hc, ⟨b, c, a, d, by simp [H.symm], int.even_add_even hb hc,
        modeq_add_cancel_left (show b * b + c * c ≡ 0 [ZMOD 2], from int.even_add_even hb hc)
          (int.modeq.trans (by simp) h')⟩)
      (λ hc, ⟨a, c, b, d, by simp [H.symm], int.odd_add_odd ha hc,
        modeq_add_cancel_left (show a * a + c * c ≡ 0 [ZMOD 2], from int.odd_add_odd ha hc)
          (int.modeq.trans (by simp) h')⟩))
    (λ hb, ⟨a, b, c, d, by simp [H.symm], int.odd_add_odd ha hb,
      modeq_add_cancel_left (show a * a + b * b ≡ 0 [ZMOD 2], from int.odd_add_odd ha hb)
        (int.modeq.trans (by simp) h')⟩))

private lemma sum_four_squares_of_sum_four_squares_two_mul {n a b c d : ℤ}
  (h : a * a + b * b + c * c + d * d = 2 * n) :
  ∃ a' b' c' d', a' * a' + b' * b' + c' * c' + d' * d' = n :=
let ⟨a, b, c, d, h, hab, hcd⟩ := even_sum_four_squares h in
let ⟨k, hk⟩ := exists_eq_mul_right_of_dvd (modeq_zero_iff.1 hab) in
let ⟨l, hl⟩ := exists_eq_mul_right_of_dvd (modeq_zero_iff.1 hcd) in
let ⟨a', b', hab'⟩ := sum_two_squares_of_sum_two_squares_two_mul hk in
let ⟨c', d', hcd'⟩ := sum_two_squares_of_sum_two_squares_two_mul hl in
⟨a', b', c', d', (domain.mul_left_inj (show (2 : ℤ) ≠ 0, by norm_num)).1
  (h ▸ by rw [add_assoc, hab', hcd', mul_add, ← hk, ← hl, ← add_assoc])⟩

section odd_primes
variables {p : ℕ} (hp : prime p) (hpo : p % 2 = 1)
include hp hpo

lemma bla14 {p : ℕ} (hp : prime p) (hpo : p % 2 = 1) {a b : fin (succ (p / 2))} :
  a.1 * a.1 + b.1 * b.1 + 1 < p * p :=
have hf : ∀ {a : fin (succ (p / 2))}, (a.1 : ℚ) ≤ p / 2 := λ a,
  calc (a.1 : ℚ) ≤ ((p / 2 : ℕ) : ℚ) : nat.cast_le.2 (le_of_lt_succ a.2)
           ... ≤ (p / 2 : ℚ) : nat.cast_div_le dec_trivial,
have hp2 : 0 ≤ (p : ℚ) / 2 := div_nonneg (nat.cast_nonneg _) (by norm_num),
have h20 : (2 : ℚ) ≠ 0 := by norm_num,
(@nat.cast_lt ℚ _ _ _).1 $
calc ((a.1 * a.1 + b.1 * b.1 + 1 : ℕ) : ℚ) = (a.1 : ℚ) * a.1 + b.1 * b.1 + 1 :
      by simp [nat.cast_mul, nat.cast_add]
  ... ≤ (p / 2) * (p / 2) + (p / 2) * (p / 2) + 1 : add_le_add (add_le_add
      (mul_le_mul hf hf (nat.cast_nonneg _) hp2)
      (mul_le_mul hf hf (nat.cast_nonneg _) hp2)) (le_refl _)
  ... = ((p : ℚ) * p) / 2 + 1 : by rw [div_mul_div, div_add_div_same, ← mul_two, mul_div_mul_right _ h20 h20]
  ... < ((p * p : ℕ) : ℚ) : add_lt_of_lt_sub_left
    (begin
      rw [nat.cast_mul, sub_half, one_lt_div_iff_lt (show (0 : ℚ) < 2, by norm_num)],
      exact calc (2 : ℚ) < 3 * 3 : by norm_num
        ... ≤ (p : ℚ) * (p : ℚ) : mul_self_le_mul_self (by norm_num) (nat.cast_le.2 (hp.odd_iff_ge_three.1 hpo)),
    end)

private lemma exists_sum_four_squares_dvd_prime :
  ∃ (m : ℕ) (a b c d : ℤ), a * a + b * b + c * c + d * d = m * p ∧ m < p ∧ 0 < m :=
let ⟨a, b, hab⟩ := bla12 hp hpo in
  let ⟨m, hm⟩ := exists_eq_mul_left_of_dvd hab in
  ⟨m, a.1, b.1, 1, 0,
    by rw [← int.coe_nat_mul m, ← hm];
      simp,
    lt_of_mul_lt_mul_right
      (by rw ← hm; exact bla14 hp hpo)
      (nat.zero_le p),
    pos_of_mul_pos_right
    (by rw [← hm, add_assoc]; exact succ_pos _)
    (nat.zero_le p)⟩

private lemma sum_four_squares_odd_prime :
  ∃ a b c d : ℤ, a * a + b * b + c * c + d * d = p :=
let h := exists_sum_four_squares_dvd_prime hp hpo in
let m := nat.find h in
let ⟨a, b, c, d, (habcd : (_ : ℤ) = (↑m : ℤ) * p), (hmp : m < p), (hm0 : 0 < m)⟩ :=
    nat.find_spec h in
have hm0' : (0 : ℤ) < m := int.coe_nat_lt.2 hm0,
have h₂ : ∃ r : ℤ, mod_sub_half a m * mod_sub_half a m + mod_sub_half b m * mod_sub_half b m +
    mod_sub_half c m * mod_sub_half c m + mod_sub_half d m * mod_sub_half d m = m * r :=
  exists_eq_mul_right_of_dvd (modeq_zero_iff.1 $
    int.modeq.trans (show _ ≡ m * p [ZMOD m], from
      by rw ← habcd; exact modeq_add (modeq_add (modeq_add
      (mod_sub_half_square hm0') (mod_sub_half_square hm0')) (mod_sub_half_square hm0'))
      (mod_sub_half_square hm0'))
    (show (m : ℤ) * p ≡ 0 [ZMOD m], from modeq_zero_iff.2 (dvd_mul_right m p))),
let ⟨r', hr'⟩ := h₂ in
have hr0 : (0 : ℤ) ≤ r' := @nonneg_of_mul_nonneg_left _ _ (↑m : ℤ) r'
  (hr' ▸ add_nonneg (add_nonneg (add_nonneg (mul_self_nonneg _) (mul_self_nonneg _))
    (mul_self_nonneg _)) (mul_self_nonneg _))
  hm0',
let r := r'.nat_abs in
have hr : mod_sub_half a ↑m * mod_sub_half a ↑m + mod_sub_half b ↑m *
  mod_sub_half b ↑m + mod_sub_half c ↑m * mod_sub_half c ↑m +
  mod_sub_half d ↑m * mod_sub_half d ↑m = ((m * r : ℕ) : ℤ) :=
  show _ = ((_ * r'.nat_abs : ℕ) : ℤ), by rwa [int.coe_nat_mul, int.nat_abs_of_nonneg hr0],
have h₁ : m = 1 := by_contradiction $ λ h₁,
  or.cases_on (nat.mod_two_eq_zero_or_one m)
    (λ hm2, let ⟨k, hk⟩ := exists_eq_mul_right_of_dvd (dvd_of_mod_eq_zero hm2) in
      have hk0 : 0 < k := pos_of_mul_pos_left (show 0 < 2 * k, from hk ▸ hm0)
        (nat.zero_le _),
      have hkm : k < m := hk.symm ▸ (lt_mul_iff_one_lt_left hk0).2 (lt_succ_self _),
      begin
        rw [hk, int.coe_nat_mul, mul_assoc] at habcd,
        rcases sum_four_squares_of_sum_four_squares_two_mul habcd with ⟨a', b', c', d', habcd'⟩,
        exact nat.find_min h hkm ⟨a', b', c', d', habcd', lt_trans hkm hmp, hk0⟩,
      end)
    (λ hm2, have hm2' : (m : ℤ) % (2 : ℕ) = 1 :=
        by rw [← int.coe_nat_mod, hm2, int.coe_nat_one],
      have add_quarters : ∀ q : ℚ, q = q / 4 + q / 4 + q / 4 + q / 4 := λ q,
        by rw [← (show ((2 : ℚ) * 2 = 4), by norm_num), ← div_div_eq_div_mul,
          add_halves, add_assoc, add_halves, add_halves],
      have hrm : r < m := lt_of_mul_lt_mul_left
        (begin
          rw [← int.coe_nat_lt, ← hr, ← @int.cast_lt ℚ],
          simp only [int.cast_add, int.cast_coe_nat, nat.cast_mul, nat.cast_add],
          rw [add_quarters ((m : ℚ) * m)],
          refine add_lt_add_of_lt_of_le (add_lt_add_of_lt_of_le
            (add_lt_add_of_lt_of_le _ (mod_sub_half_square_le hm0'))
            (mod_sub_half_square_le hm0')) (mod_sub_half_square_le hm0'),
          rw [← (show (2 : ℚ) * 2 = 4, by norm_num), ← _root_.div_mul_div, ← abs_mul_self, abs_mul, int.cast_mul],
          exact mul_self_lt_mul_self (int.cast_nonneg.2 (abs_nonneg _)) (mod_sub_half_lt_of_odd hm0' hm2'),
        end)
        (nat.zero_le m),
      have hmodeq : mod_sub_half a m * mod_sub_half a m + mod_sub_half b m * mod_sub_half b m
          + mod_sub_half c m * mod_sub_half c m + mod_sub_half d m * mod_sub_half d m ≡
          a * a + b * b + c * c + d * d [ZMOD m] :=
        modeq_add (modeq_add (modeq_add (mod_sub_half_square hm0') (mod_sub_half_square hm0'))
          (mod_sub_half_square hm0')) (mod_sub_half_square hm0'),
      have hdvd : (m : ℤ) ∣ a * a + b * b + c * c + d * d := habcd.symm ▸ dvd_mul_right _ _,
      have hdvd₁ : (m : ℤ) ∣ _ := modeq_zero_iff.1 ((modeq.trans hmodeq) (modeq_zero_iff.2 hdvd)),
      have hr0 : r ≠ 0 := λ h, begin
        rw [h, mul_zero, int.coe_nat_zero] at hr,
        simp only [int.nat_abs_mul_self.symm, (int.coe_nat_add _ _).symm] at hr,
        have hd := eq_zero_of_add_eq_zero (int.coe_nat_inj hr),
        have hc := eq_zero_of_add_eq_zero hd.1,
        have hab := eq_zero_of_add_eq_zero hc.1,
        simp only [(int.coe_nat_eq_coe_nat_iff _ _).symm, int.nat_abs_mul_self] at hab hc hd,
        have h : a * a + b * b + c * c + d * d ≡ 0 + 0 + 0 + 0 [ZMOD (m * m)] :=
          modeq_add (modeq_add (modeq_add (mod_sub_half_eq_zero hm0' hab.1)
            (mod_sub_half_eq_zero hm0' hab.2))
            (mod_sub_half_eq_zero hm0' hc.2)) (mod_sub_half_eq_zero hm0' hd.2),
        have : m ∣ p := dvd_of_mul_dvd_mul_left hm0
          (by rw [← int.coe_nat_dvd, int.coe_nat_mul, int.coe_nat_mul, ← habcd];
            exact modeq_zero_iff.1 h),
        cases hp.2 _ this with he he,
        { contradiction },
        { rw he at hmp,
          exact lt_irrefl _ hmp }
      end,
      have hk : _ := four_squares_mul_four_squares a b c d (mod_sub_half a m)
        (mod_sub_half b m) (mod_sub_half c m) (mod_sub_half d m),
      have ha : _ := @mod_sub_half_modeq a _ hm0',
      have hb : _ := @mod_sub_half_modeq b _ hm0',
      have hc : _ := @mod_sub_half_modeq c _ hm0',
      have hd : _ := @mod_sub_half_modeq d _ hm0',
      let ⟨a', ha'⟩ := exists_eq_mul_right_of_dvd
          (dvd_mul_sub_add_mul_sub ha hb hc hd) in
      let ⟨b', hb'⟩ := exists_eq_mul_right_of_dvd
          (dvd_mul_sub_add_mul_sub ha hc hd hb) in
      let ⟨c', hc'⟩ := exists_eq_mul_right_of_dvd
          (dvd_mul_sub_add_mul_sub ha hd hb hc) in
      have hm4 : ∀ i j : ℤ, (m : ℤ) * i * (m * j) = (m * m) * (i * j) :=
        λ i j, by simp [mul_comm, mul_assoc, mul_left_comm],
      begin
        rw [hr, habcd, ha', hb', hc', int.coe_nat_mul, hm4, hm4, hm4, hm4,
          ← mul_add, ← mul_add] at hk,
        have hk' := sub_eq_iff_eq_add'.2 hk,
        have hd₁ : (m : ℤ) * m ∣ ((a * mod_sub_half a ↑m + b * mod_sub_half b ↑m +
          c * mod_sub_half c ↑m + d * mod_sub_half d ↑m).nat_abs *
            (a * mod_sub_half a ↑m + b * mod_sub_half b ↑m +
            c * mod_sub_half c ↑m + d * mod_sub_half d ↑m).nat_abs : ℕ) :=
          by rw [int.nat_abs_mul_self, ← hk', ← mul_sub];
          exact dvd_mul_right _ _,
        have hd' : (m : ℤ) ∣ (a * mod_sub_half a ↑m + b * mod_sub_half b ↑m +
            c * mod_sub_half c ↑m + d * mod_sub_half d ↑m) :=
          dvd_nat_abs.1 (int.coe_nat_dvd.2 begin
            rw [← int.coe_nat_mul, ← nat.pow_two, ← nat.pow_two, int.coe_nat_dvd] at hd₁,
            exact (nat.pow_dvd_pow_iff dec_trivial).1 hd₁,
          end),
        cases exists_eq_mul_right_of_dvd hd' with d' hd',
        have habcd' : a' * a' + b' * b' + c' * c' + d' * d' = ↑r * ↑p :=
          (domain.mul_left_inj (ne_of_lt (mul_pos hm0' hm0')).symm).1 begin
            rw [mul_comm (r : ℤ), hk, hd'],
            ring,
          end,
        exact nat.find_min h hrm ⟨a', b', c', d', habcd', lt_trans hrm hmp,
          nat.pos_of_ne_zero (λ h, by rw h at hr0; contradiction)⟩,
      end),
⟨a, b, c, d, by rw [habcd, h₁]; simp⟩

end odd_primes

lemma sum_four_squares_int : ∀ n : ℕ, ∃ a b c d : ℤ, a * a + b * b + c * c + d * d = n
| 0 := ⟨0, 0, 0, 0, rfl⟩
| 1 := ⟨1, 0, 0, 0, rfl⟩
| n@(k+2) :=
have hm : prime (min_fac n) := min_fac_prime dec_trivial,
have n / min_fac n < n := factors_lemma,
let ⟨a, b, c, d, h₁⟩ := show ∃ a b c d : ℤ, a * a + b * b + c * c + d * d = min_fac n,
  from or.cases_on hm.eq_two_or_odd
    (λ h2, h2.symm ▸ ⟨1, 1, 0, 0, rfl⟩)
    (sum_four_squares_odd_prime hm) in
let ⟨w, x, y, z, h₂⟩ := sum_four_squares_int (n / min_fac n) in
⟨a * x - w * b + (d * y - z * c),
 a * y - w * c + (b * z - x * d),
 a * z - w * d + (c * x - y * b),
 a * w + b * x +  c * y + d * z,
  by rw [← four_squares_mul_four_squares, h₁, h₂, ← int.coe_nat_mul,
      int.coe_nat_eq_coe_nat_iff, nat.mul_div_cancel' (min_fac_dvd _)]⟩

lemma sum_four_squares (n : ℕ) : ∃ a b c d : ℕ, a * a + b * b + c * c + d * d = n :=
let ⟨a, b, c, d, h⟩ := sum_four_squares_int n in
⟨a.nat_abs, b.nat_abs, c.nat_abs, d.nat_abs,
  int.coe_nat_inj (h ▸ by simp only [int.coe_nat_add, int.nat_abs_mul_self])⟩


theorem Nat.matrixLinearIndex_bound {i j w h : Nat} (ih : i < h) (jh : j < w) : i * w + j < w * h := by
  apply Nat.le_trans (m := i * w + w)
  · apply Nat.add_lt_add_left
    assumption
  · conv =>
      lhs
      rhs
      rw [← Nat.one_mul w]
    show i * w + 1 * w ≤ w * h
    rw [← Nat.right_distrib, Nat.mul_comm, Nat.add_one]
    apply Nat.mul_le_mul_left w
    assumption


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.algebra.ordered
import Mathlib.data.set.intervals.proj_Icc
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Projection onto a closed interval

In this file we prove that the projection `set.proj_Icc f a b h` is a quotient map, and use it
to show that `Icc_extend h f` is continuous if and only if `f` is continuous.
-/

theorem continuous_proj_Icc {α : Type u_1} [topological_space α] [linear_order α] [order_topology α] {a : α} {b : α} {h : a ≤ b} : continuous (set.proj_Icc a b h) :=
  continuous_subtype_mk (fun (x : α) => set.proj_Icc._proof_1 a b h x)
    (continuous.max continuous_const (continuous.min continuous_const continuous_id))

theorem quotient_map_proj_Icc {α : Type u_1} [topological_space α] [linear_order α] [order_topology α] {a : α} {b : α} {h : a ≤ b} : quotient_map (set.proj_Icc a b h) := sorry

@[simp] theorem continuous_Icc_extend_iff {α : Type u_1} {β : Type u_2} [topological_space α] [linear_order α] [order_topology α] [topological_space β] {a : α} {b : α} {h : a ≤ b} {f : ↥(set.Icc a b) → β} : continuous (set.Icc_extend h f) ↔ continuous f :=
  iff.symm (quotient_map.continuous_iff quotient_map_proj_Icc)

theorem continuous.Icc_extend {α : Type u_1} {β : Type u_2} [topological_space α] [linear_order α] [order_topology α] [topological_space β] {a : α} {b : α} {h : a ≤ b} {f : ↥(set.Icc a b) → β} (hf : continuous f) : continuous (set.Icc_extend h f) :=
  continuous.comp hf continuous_proj_Icc


/-
Copyright (c) 2023 Paul Reichert. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Paul Reichert, Yaël Dillies

! This file was ported from Lean 3 source module analysis.convex.intrinsic
! leanprover-community/mathlib commit 9f26ebf297c6a5ca26573a970411e606bb2ebe63
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.AddTorsorBases
import Mathbin.Analysis.NormedSpace.LinearIsometry

/-!
# Intrinsic frontier and interior

This file defines the intrinsic frontier, interior and closure of a set in a normed additive torsor.
These are also known as relative frontier, interior, closure.

The intrinsic frontier/interior/closure of a set `s` is the frontier/interior/closure of `s`
considered as a set in its affine span.

The intrinsic interior is in general greater than the topological interior, the intrinsic frontier
in general less than the topological frontier, and the intrinsic closure in cases of interest the
same as the topological closure.

## Definitions

* `intrinsic_interior`: Intrinsic interior
* `intrinsic_frontier`: Intrinsic frontier
* `intrinsic_closure`: Intrinsic closure

## Results

The main results are:
* `affine_isometry.image_intrinsic_interior`/`affine_isometry.image_intrinsic_frontier`/
  `affine_isometry.image_intrinsic_closure`: Intrinsic interiors/frontiers/closures commute with
  taking the image under an affine isometry.
* `set.nonempty.intrinsic_interior`: The intrinsic interior of a nonempty convex set is nonempty.

## References

* Chapter 8 of [Barry Simon, *Convexity*][simon2011]
* Chapter 1 of [Rolf Schneider, *Convex Bodies: The Brunn-Minkowski theory*][schneider2013].

## TODO

* `is_closed s → is_extreme 𝕜 s (intrinsic_frontier 𝕜 s)`
* `x ∈ s → y ∈ intrinsic_interior 𝕜 s → open_segment 𝕜 x y ⊆ intrinsic_interior 𝕜 s`
-/

open AffineSubspace Set

open Pointwise

variable {𝕜 V W Q P : Type _}

section AddTorsor

variable (𝕜) [Ring 𝕜] [AddCommGroup V] [Module 𝕜 V] [TopologicalSpace P] [AddTorsor V P]
  {s t : Set P} {x : P}

include V

/-- The intrinsic interior of a set is its interior considered as a set in its affine span. -/
def intrinsicInterior (s : Set P) : Set P :=
  coe '' interior (coe ⁻¹' s : Set <| affineSpan 𝕜 s)
#align intrinsic_interior intrinsicInterior

/-- The intrinsic frontier of a set is its frontier considered as a set in its affine span. -/
def intrinsicFrontier (s : Set P) : Set P :=
  coe '' frontier (coe ⁻¹' s : Set <| affineSpan 𝕜 s)
#align intrinsic_frontier intrinsicFrontier

/-- The intrinsic closure of a set is its closure considered as a set in its affine span. -/
def intrinsicClosure (s : Set P) : Set P :=
  coe '' closure (coe ⁻¹' s : Set <| affineSpan 𝕜 s)
#align intrinsic_closure intrinsicClosure

variable {𝕜}

@[simp]
theorem mem_intrinsicInterior :
    x ∈ intrinsicInterior 𝕜 s ↔ ∃ y, y ∈ interior (coe ⁻¹' s : Set <| affineSpan 𝕜 s) ∧ ↑y = x :=
  mem_image _ _ _
#align mem_intrinsic_interior mem_intrinsicInterior

@[simp]
theorem mem_intrinsicFrontier :
    x ∈ intrinsicFrontier 𝕜 s ↔ ∃ y, y ∈ frontier (coe ⁻¹' s : Set <| affineSpan 𝕜 s) ∧ ↑y = x :=
  mem_image _ _ _
#align mem_intrinsic_frontier mem_intrinsicFrontier

@[simp]
theorem mem_intrinsicClosure :
    x ∈ intrinsicClosure 𝕜 s ↔ ∃ y, y ∈ closure (coe ⁻¹' s : Set <| affineSpan 𝕜 s) ∧ ↑y = x :=
  mem_image _ _ _
#align mem_intrinsic_closure mem_intrinsicClosure

theorem intrinsicInterior_subset : intrinsicInterior 𝕜 s ⊆ s :=
  image_subset_iff.2 interior_subset
#align intrinsic_interior_subset intrinsicInterior_subset

theorem intrinsicFrontier_subset (hs : IsClosed s) : intrinsicFrontier 𝕜 s ⊆ s :=
  image_subset_iff.2 (hs.Preimage continuous_induced_dom).frontier_subset
#align intrinsic_frontier_subset intrinsicFrontier_subset

theorem intrinsicFrontier_subset_intrinsicClosure : intrinsicFrontier 𝕜 s ⊆ intrinsicClosure 𝕜 s :=
  image_subset _ frontier_subset_closure
#align intrinsic_frontier_subset_intrinsic_closure intrinsicFrontier_subset_intrinsicClosure

theorem subset_intrinsicClosure : s ⊆ intrinsicClosure 𝕜 s := fun x hx =>
  ⟨⟨x, subset_affineSpan _ _ hx⟩, subset_closure hx, rfl⟩
#align subset_intrinsic_closure subset_intrinsicClosure

@[simp]
theorem intrinsicInterior_empty : intrinsicInterior 𝕜 (∅ : Set P) = ∅ := by simp [intrinsicInterior]
#align intrinsic_interior_empty intrinsicInterior_empty

@[simp]
theorem intrinsicFrontier_empty : intrinsicFrontier 𝕜 (∅ : Set P) = ∅ := by simp [intrinsicFrontier]
#align intrinsic_frontier_empty intrinsicFrontier_empty

@[simp]
theorem intrinsicClosure_empty : intrinsicClosure 𝕜 (∅ : Set P) = ∅ := by simp [intrinsicClosure]
#align intrinsic_closure_empty intrinsicClosure_empty

@[simp]
theorem intrinsicClosure_nonempty : (intrinsicClosure 𝕜 s).Nonempty ↔ s.Nonempty :=
  ⟨by
    simp_rw [nonempty_iff_ne_empty]
    rintro h rfl
    exact h intrinsicClosure_empty, Nonempty.mono subset_intrinsicClosure⟩
#align intrinsic_closure_nonempty intrinsicClosure_nonempty

alias intrinsicClosure_nonempty ↔ Set.Nonempty.of_intrinsicClosure Set.Nonempty.intrinsicClosure
#align set.nonempty.of_intrinsic_closure Set.Nonempty.of_intrinsicClosure
#align set.nonempty.intrinsic_closure Set.Nonempty.intrinsicClosure

attribute [protected] Set.Nonempty.intrinsicClosure

@[simp]
theorem intrinsicInterior_singleton (x : P) : intrinsicInterior 𝕜 ({x} : Set P) = {x} := by
  simpa only [intrinsicInterior, preimage_coe_affine_span_singleton, interior_univ, image_univ,
    Subtype.range_coe] using coe_affine_span_singleton _ _ _
#align intrinsic_interior_singleton intrinsicInterior_singleton

@[simp]
theorem intrinsicFrontier_singleton (x : P) : intrinsicFrontier 𝕜 ({x} : Set P) = ∅ := by
  rw [intrinsicFrontier, preimage_coe_affine_span_singleton, frontier_univ, image_empty]
#align intrinsic_frontier_singleton intrinsicFrontier_singleton

@[simp]
theorem intrinsicClosure_singleton (x : P) : intrinsicClosure 𝕜 ({x} : Set P) = {x} := by
  simpa only [intrinsicClosure, preimage_coe_affine_span_singleton, closure_univ, image_univ,
    Subtype.range_coe] using coe_affine_span_singleton _ _ _
#align intrinsic_closure_singleton intrinsicClosure_singleton

/-!
Note that neither `intrinsic_interior` nor `intrinsic_frontier` is monotone.
-/

theorem intrinsicClosure_mono (h : s ⊆ t) : intrinsicClosure 𝕜 s ⊆ intrinsicClosure 𝕜 t :=
  by
  refine'
    image_subset_iff.2 fun x hx =>
      ⟨Set.inclusion (affineSpan_mono _ h) x,
        (continuous_inclusion _).closure_preimage_subset _ <| closure_mono _ hx, rfl⟩
  exact fun y hy => h hy
#align intrinsic_closure_mono intrinsicClosure_mono

theorem interior_subset_intrinsicInterior : interior s ⊆ intrinsicInterior 𝕜 s := fun x hx =>
  ⟨⟨x, subset_affineSpan _ _ <| interior_subset hx⟩,
    preimage_interior_subset_interior_preimage continuous_subtype_val hx, rfl⟩
#align interior_subset_intrinsic_interior interior_subset_intrinsicInterior

theorem intrinsicClosure_subset_closure : intrinsicClosure 𝕜 s ⊆ closure s :=
  image_subset_iff.2 <| continuous_subtype_val.closure_preimage_subset _
#align intrinsic_closure_subset_closure intrinsicClosure_subset_closure

theorem intrinsicFrontier_subset_frontier : intrinsicFrontier 𝕜 s ⊆ frontier s :=
  image_subset_iff.2 <| continuous_subtype_val.frontier_preimage_subset _
#align intrinsic_frontier_subset_frontier intrinsicFrontier_subset_frontier

theorem intrinsicClosure_subset_affineSpan : intrinsicClosure 𝕜 s ⊆ affineSpan 𝕜 s :=
  (image_subset_range _ _).trans Subtype.range_coe.Subset
#align intrinsic_closure_subset_affine_span intrinsicClosure_subset_affineSpan

@[simp]
theorem intrinsicClosure_diff_intrinsicFrontier (s : Set P) :
    intrinsicClosure 𝕜 s \ intrinsicFrontier 𝕜 s = intrinsicInterior 𝕜 s :=
  (image_diff Subtype.coe_injective _ _).symm.trans <| by
    rw [closure_diff_frontier, intrinsicInterior]
#align intrinsic_closure_diff_intrinsic_frontier intrinsicClosure_diff_intrinsicFrontier

@[simp]
theorem intrinsicClosure_diff_intrinsicInterior (s : Set P) :
    intrinsicClosure 𝕜 s \ intrinsicInterior 𝕜 s = intrinsicFrontier 𝕜 s :=
  (image_diff Subtype.coe_injective _ _).symm
#align intrinsic_closure_diff_intrinsic_interior intrinsicClosure_diff_intrinsicInterior

@[simp]
theorem intrinsicInterior_union_intrinsicFrontier (s : Set P) :
    intrinsicInterior 𝕜 s ∪ intrinsicFrontier 𝕜 s = intrinsicClosure 𝕜 s := by
  simp [intrinsicClosure, intrinsicInterior, intrinsicFrontier, closure_eq_interior_union_frontier,
    image_union]
#align intrinsic_interior_union_intrinsic_frontier intrinsicInterior_union_intrinsicFrontier

@[simp]
theorem intrinsicFrontier_union_intrinsicInterior (s : Set P) :
    intrinsicFrontier 𝕜 s ∪ intrinsicInterior 𝕜 s = intrinsicClosure 𝕜 s := by
  rw [union_comm, intrinsicInterior_union_intrinsicFrontier]
#align intrinsic_frontier_union_intrinsic_interior intrinsicFrontier_union_intrinsicInterior

theorem isClosed_intrinsicClosure (hs : IsClosed (affineSpan 𝕜 s : Set P)) :
    IsClosed (intrinsicClosure 𝕜 s) :=
  (closedEmbedding_subtype_val hs).IsClosedMap _ isClosed_closure
#align is_closed_intrinsic_closure isClosed_intrinsicClosure

theorem isClosed_intrinsicFrontier (hs : IsClosed (affineSpan 𝕜 s : Set P)) :
    IsClosed (intrinsicFrontier 𝕜 s) :=
  (closedEmbedding_subtype_val hs).IsClosedMap _ isClosed_frontier
#align is_closed_intrinsic_frontier isClosed_intrinsicFrontier

@[simp]
theorem affineSpan_intrinsicClosure (s : Set P) :
    affineSpan 𝕜 (intrinsicClosure 𝕜 s) = affineSpan 𝕜 s :=
  (affineSpan_le.2 intrinsicClosure_subset_affineSpan).antisymm <|
    affineSpan_mono _ subset_intrinsicClosure
#align affine_span_intrinsic_closure affineSpan_intrinsicClosure

protected theorem IsClosed.intrinsicClosure (hs : IsClosed (coe ⁻¹' s : Set <| affineSpan 𝕜 s)) :
    intrinsicClosure 𝕜 s = s :=
  by
  rw [intrinsicClosure, hs.closure_eq, image_preimage_eq_of_subset]
  exact (subset_affineSpan _ _).trans subtype.range_coe.superset
#align is_closed.intrinsic_closure IsClosed.intrinsicClosure

@[simp]
theorem intrinsicClosure_idem (s : Set P) :
    intrinsicClosure 𝕜 (intrinsicClosure 𝕜 s) = intrinsicClosure 𝕜 s :=
  by
  refine' IsClosed.intrinsicClosure _
  set t := affineSpan 𝕜 (intrinsicClosure 𝕜 s) with ht
  clear_value t
  obtain rfl := ht.trans (affineSpan_intrinsicClosure _)
  rw [intrinsicClosure, preimage_image_eq _ Subtype.coe_injective]
  exact isClosed_closure
#align intrinsic_closure_idem intrinsicClosure_idem

end AddTorsor

namespace AffineIsometry

variable [NormedField 𝕜] [SeminormedAddCommGroup V] [SeminormedAddCommGroup W] [NormedSpace 𝕜 V]
  [NormedSpace 𝕜 W] [MetricSpace P] [PseudoMetricSpace Q] [NormedAddTorsor V P]
  [NormedAddTorsor W Q]

include V W

attribute [local instance, local nolint fails_quickly]
  AffineSubspace.toNormedAddTorsor AffineSubspace.nonempty_map

@[simp]
theorem image_intrinsicInterior (φ : P →ᵃⁱ[𝕜] Q) (s : Set P) :
    intrinsicInterior 𝕜 (φ '' s) = φ '' intrinsicInterior 𝕜 s :=
  by
  obtain rfl | hs := s.eq_empty_or_nonempty
  · simp only [intrinsicInterior_empty, image_empty]
  haveI : Nonempty s := hs.to_subtype
  let f := ((affineSpan 𝕜 s).isometryEquivMap φ).toHomeomorph
  have : φ.to_affine_map ∘ coe ∘ f.symm = coe := funext isometry_equiv_map.apply_symm_apply
  rw [intrinsicInterior, intrinsicInterior, ← φ.coe_to_affine_map, ← map_span φ.to_affine_map s, ←
    this, ← Function.comp.assoc, image_comp, image_comp, f.symm.image_interior, f.image_symm, ←
    preimage_comp, Function.comp.assoc, f.symm_comp_self, AffineIsometry.coe_toAffineMap,
    Function.comp.right_id, preimage_comp, φ.injective.preimage_image]
#align affine_isometry.image_intrinsic_interior AffineIsometry.image_intrinsicInterior

@[simp]
theorem image_intrinsicFrontier (φ : P →ᵃⁱ[𝕜] Q) (s : Set P) :
    intrinsicFrontier 𝕜 (φ '' s) = φ '' intrinsicFrontier 𝕜 s :=
  by
  obtain rfl | hs := s.eq_empty_or_nonempty
  · simp
  haveI : Nonempty s := hs.to_subtype
  let f := ((affineSpan 𝕜 s).isometryEquivMap φ).toHomeomorph
  have : φ.to_affine_map ∘ coe ∘ f.symm = coe := funext isometry_equiv_map.apply_symm_apply
  rw [intrinsicFrontier, intrinsicFrontier, ← φ.coe_to_affine_map, ← map_span φ.to_affine_map s, ←
    this, ← Function.comp.assoc, image_comp, image_comp, f.symm.image_frontier, f.image_symm, ←
    preimage_comp, Function.comp.assoc, f.symm_comp_self, AffineIsometry.coe_toAffineMap,
    Function.comp.right_id, preimage_comp, φ.injective.preimage_image]
#align affine_isometry.image_intrinsic_frontier AffineIsometry.image_intrinsicFrontier

@[simp]
theorem image_intrinsicClosure (φ : P →ᵃⁱ[𝕜] Q) (s : Set P) :
    intrinsicClosure 𝕜 (φ '' s) = φ '' intrinsicClosure 𝕜 s :=
  by
  obtain rfl | hs := s.eq_empty_or_nonempty
  · simp
  haveI : Nonempty s := hs.to_subtype
  let f := ((affineSpan 𝕜 s).isometryEquivMap φ).toHomeomorph
  have : φ.to_affine_map ∘ coe ∘ f.symm = coe := funext isometry_equiv_map.apply_symm_apply
  rw [intrinsicClosure, intrinsicClosure, ← φ.coe_to_affine_map, ← map_span φ.to_affine_map s, ←
    this, ← Function.comp.assoc, image_comp, image_comp, f.symm.image_closure, f.image_symm, ←
    preimage_comp, Function.comp.assoc, f.symm_comp_self, AffineIsometry.coe_toAffineMap,
    Function.comp.right_id, preimage_comp, φ.injective.preimage_image]
#align affine_isometry.image_intrinsic_closure AffineIsometry.image_intrinsicClosure

end AffineIsometry

section NormedAddTorsor

variable (𝕜) [NontriviallyNormedField 𝕜] [CompleteSpace 𝕜] [NormedAddCommGroup V] [NormedSpace 𝕜 V]
  [FiniteDimensional 𝕜 V] [MetricSpace P] [NormedAddTorsor V P] (s : Set P)

include V

@[simp]
theorem intrinsicClosure_eq_closure : intrinsicClosure 𝕜 s = closure s :=
  by
  ext x
  simp only [mem_closure_iff, mem_intrinsicClosure]
  refine' ⟨_, fun h => ⟨⟨x, _⟩, _, Subtype.coe_mk _ _⟩⟩
  · rintro ⟨x, h, rfl⟩ t ht hx
    obtain ⟨z, hz₁, hz₂⟩ := h _ (continuous_induced_dom.is_open_preimage t ht) hx
    exact ⟨z, hz₁, hz₂⟩
  · by_contra hc
    obtain ⟨z, hz₁, hz₂⟩ := h _ (affineSpan 𝕜 s).closed_of_finiteDimensional.isOpen_compl hc
    exact hz₁ (subset_affineSpan 𝕜 s hz₂)
  · rintro _ ⟨t, ht, rfl⟩ hx
    obtain ⟨y, hyt, hys⟩ := h _ ht hx
    exact ⟨⟨_, subset_affineSpan 𝕜 s hys⟩, hyt, hys⟩
#align intrinsic_closure_eq_closure intrinsicClosure_eq_closure

variable {𝕜}

@[simp]
theorem closure_diff_intrinsicInterior (s : Set P) :
    closure s \ intrinsicInterior 𝕜 s = intrinsicFrontier 𝕜 s :=
  intrinsicClosure_eq_closure 𝕜 s ▸ intrinsicClosure_diff_intrinsicInterior s
#align closure_diff_intrinsic_interior closure_diff_intrinsicInterior

@[simp]
theorem closure_diff_intrinsicFrontier (s : Set P) :
    closure s \ intrinsicFrontier 𝕜 s = intrinsicInterior 𝕜 s :=
  intrinsicClosure_eq_closure 𝕜 s ▸ intrinsicClosure_diff_intrinsicFrontier s
#align closure_diff_intrinsic_frontier closure_diff_intrinsicFrontier

end NormedAddTorsor

private theorem aux {α β : Type _} [TopologicalSpace α] [TopologicalSpace β] (φ : α ≃ₜ β)
    (s : Set β) : (interior s).Nonempty ↔ (interior (φ ⁻¹' s)).Nonempty := by
  rw [← φ.image_symm, ← φ.symm.image_interior, nonempty_image_iff]
#align aux aux

variable [NormedAddCommGroup V] [NormedSpace ℝ V] [FiniteDimensional ℝ V] {s : Set V}

/-- The intrinsic interior of a nonempty convex set is nonempty. -/
protected theorem Set.Nonempty.intrinsicInterior (hscv : Convex ℝ s) (hsne : s.Nonempty) :
    (intrinsicInterior ℝ s).Nonempty :=
  by
  haveI := hsne.coe_sort
  obtain ⟨p, hp⟩ := hsne
  let p' : affineSpan ℝ s := ⟨p, subset_affineSpan _ _ hp⟩
  rw [intrinsicInterior, nonempty_image_iff,
    aux (AffineIsometryEquiv.constVsub ℝ p').symm.toHomeomorph,
    Convex.interior_nonempty_iff_affineSpan_eq_top, AffineIsometryEquiv.coe_toHomeomorph, ←
    AffineIsometryEquiv.coe_toAffineEquiv, ← comap_span, affineSpan_coe_preimage_eq_top, comap_top]
  exact
    hscv.affine_preimage
      ((affineSpan ℝ s).Subtype.comp
        (AffineIsometryEquiv.constVsub ℝ p').symm.toAffineEquiv.toAffineMap)
#align set.nonempty.intrinsic_interior Set.Nonempty.intrinsicInterior

theorem intrinsicInterior_nonempty (hs : Convex ℝ s) :
    (intrinsicInterior ℝ s).Nonempty ↔ s.Nonempty :=
  ⟨by
    simp_rw [nonempty_iff_ne_empty]
    rintro h rfl
    exact h intrinsicInterior_empty, Set.Nonempty.intrinsicInterior hs⟩
#align intrinsic_interior_nonempty intrinsicInterior_nonempty


/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jannis Limperg
-/
namespace Std
universe u
namespace BinomialHeapImp

structure HeapNodeAux (α : Type u) (h : Type u) where
  val : α
  rank : Nat
  children : List h

-- A `Heap` is a forest of binomial trees.
inductive Heap (α : Type u) : Type u where
  | heap (ns : List (HeapNodeAux α (Heap α))) : Heap α
  deriving Inhabited

open Heap

-- A `HeapNode` is a binomial tree. If a `HeapNode` has rank `k`, its children
-- have ranks between `0` and `k - 1`. They are ordered by rank. Additionally,
-- the value of each child must be less than or equal to the value of its
-- parent node.
abbrev HeapNode α := HeapNodeAux α (Heap α)

variable {α : Type u}

def hRank : List (HeapNode α) → Nat
  | []   => 0
  | h::_ => h.rank

def isEmpty : Heap α → Bool
  | heap [] => true
  | _       => false

def empty : Heap α :=
  heap []

def singleton (a : α) : Heap α :=
  heap [{ val := a, rank := 1, children := [] }]

-- Combine two binomial trees of rank `r`, creating a binomial tree of rank
-- `r + 1`.
@[specialize] def combine (le : α → α → Bool) (n₁ n₂ : HeapNode α) : HeapNode α :=
  if le n₂.val n₁.val then
     { n₂ with rank := n₂.rank + 1, children := n₂.children ++ [heap [n₁]] }
  else
     { n₁ with rank := n₁.rank + 1, children := n₁.children ++ [heap [n₂]] }

-- Merge two forests of binomial trees. The forests are assumed to be ordered
-- by rank and `mergeNodes` maintains this invariant.
@[specialize] partial def mergeNodes (le : α → α → Bool) : List (HeapNode α) → List (HeapNode α) → List (HeapNode α)
  | [], h  => h
  | h,  [] => h
  | f@(h₁ :: t₁), s@(h₂ :: t₂) =>
    if h₁.rank < h₂.rank then h₁ :: mergeNodes le t₁ s
    else if h₂.rank < h₁.rank then h₂ :: mergeNodes le t₂ f
    else
      let merged := combine le h₁ h₂
      let r      := merged.rank
      if r != hRank t₁ then
        if r != hRank t₂ then merged :: mergeNodes le t₁ t₂ else mergeNodes le (merged :: t₁) t₂
      else
        if r != hRank t₂ then mergeNodes le t₁ (merged :: t₂) else merged :: mergeNodes le t₁ t₂

@[specialize] def merge (le : α → α → Bool) : Heap α → Heap α → Heap α
  | heap h₁, heap h₂ => heap (mergeNodes le h₁ h₂)

@[specialize] def head? (le : α → α → Bool) : Heap α → Option α
  | heap []      => none
  | heap (h::hs) => some $
    hs.foldl (init := h.val) fun r n => if le r n.val then r else n.val

@[inline] def head [Inhabited α] (le : α → α → Bool) (h : Heap α) : α :=
  head? le h |>.getD default

@[specialize] def findMin (le : α → α → Bool) : List (HeapNode α) → Nat → HeapNode α × Nat → HeapNode α × Nat
  | [],    _,   r          => r
  | h::hs, idx, (h', idx') => if le h'.val h.val then findMin le hs (idx+1) (h', idx') else findMin le hs (idx+1) (h, idx)
    -- It is important that we check `le h'.val h.val` here, not the other way
    -- around. This ensures that head? and findMin find the same element even
    -- when we have `le h'.val h.val` and `le h.val h'.val` (i.e. le is not
    -- irreflexive).

def deleteMin (le : α → α → Bool) : Heap α → Option (α × Heap α)
  | heap [] => none
  | heap [h] =>
    let tail :=
      match h.children with
      | [] => empty
      | (h::hs) => hs.foldl (merge le) h
    some (h.val, tail)
  | heap hhs@(h::hs) =>
    let (min, minIdx) := findMin le hs 1 (h, 0)
    let rest          := hhs.eraseIdx minIdx
    let tail          := min.children.foldl (merge le) (heap rest)
    some (min.val, tail)

@[inline] def tail? (le : α → α → Bool) (h : Heap α) : Option (Heap α) :=
  deleteMin le h |>.map (·.snd)

@[inline] def tail (le : α → α → Bool) (h : Heap α) : Heap α :=
  tail? le h |>.getD empty

partial def toList (le : α → α → Bool) (h : Heap α) : List α :=
  match deleteMin le h with
  | none          => []
  | some (hd, tl) => hd :: toList le tl

partial def toArray (le : α → α → Bool) (h : Heap α) : Array α :=
  go #[] h
  where
    go (acc : Array α) (h : Heap α) : Array α :=
      match deleteMin le h with
      | none => acc
      | some (hd, tl) => go (acc.push hd) tl

partial def toListUnordered : Heap α → List α
  | heap ns => ns.bind fun n => n.val :: n.children.bind toListUnordered

partial def toArrayUnordered (h : Heap α) : Array α :=
  go #[] h
  where
    go (acc : Array α) : Heap α → Array α
      | heap ns => Id.run <| do
        let mut acc := acc
        for n in ns do
          acc := acc.push n.val
          for h in n.children do
            acc := go acc h
        return acc

inductive WellFormed (le : α → α → Bool) : Heap α → Prop where
  | empty                : WellFormed le empty
  | singleton (a)        : WellFormed le (singleton a)
  | merge (h₁ h₂)        : WellFormed le h₁ → WellFormed le h₂ → WellFormed le (merge le h₁ h₂)
  | deleteMin (a) (h tl) : WellFormed le h → deleteMin le h = some (a, tl) → WellFormed le tl

theorem WellFormed.tail? {le} (h tl : Heap α) (hwf : WellFormed le h) (eq : tail? le h = some tl) : WellFormed le tl := by
  simp only [BinomialHeapImp.tail?] at eq
  match eq₂: BinomialHeapImp.deleteMin le h with
    | none =>
      rw [eq₂] at eq; cases eq
    | some (a, tl) =>
      rw [eq₂] at eq; cases eq
      exact deleteMin _ _ _ hwf eq₂

theorem WellFormed.tail {le} (h : Heap α) (hwf : WellFormed le h) : WellFormed le (tail le h) := by
  simp only [BinomialHeapImp.tail]
  match eq: BinomialHeapImp.tail? le h with
    | none => exact empty
    | some tl => exact tail? _ _ hwf eq

end BinomialHeapImp

open BinomialHeapImp

def BinomialHeap (α : Type u) (le : α → α → Bool) := { h : Heap α // WellFormed le h }

@[inline] def mkBinomialHeap (α : Type u) (le : α → α → Bool) : BinomialHeap α le :=
  ⟨empty, WellFormed.empty⟩

namespace BinomialHeap
variable {α : Type u} {le : α → α → Bool}

@[inline] def empty : BinomialHeap α le :=
  mkBinomialHeap α le

@[inline] def isEmpty : BinomialHeap α le → Bool
  | ⟨b, _⟩ => BinomialHeapImp.isEmpty b

/- O(1) -/
@[inline] def singleton (a : α) : BinomialHeap α le :=
  ⟨BinomialHeapImp.singleton a, WellFormed.singleton a⟩

/- O(log n) -/
@[inline] def merge : BinomialHeap α le → BinomialHeap α le → BinomialHeap α le
  | ⟨b₁, h₁⟩, ⟨b₂, h₂⟩ => ⟨BinomialHeapImp.merge le b₁ b₂, WellFormed.merge b₁ b₂ h₁ h₂⟩

/- O(log n) -/
@[inline] def insert (a : α) (h : BinomialHeap α le) : BinomialHeap α le :=
  merge (singleton a) h

/- O(n log n) -/
def ofList (le : α → α → Bool) (as : List α) : BinomialHeap α le :=
  as.foldl (flip insert) empty

/- O(n log n) -/
def ofArray (le : α → α → Bool) (as : Array α) : BinomialHeap α le :=
  as.foldl (flip insert) empty

/- O(log n) -/
@[inline] def deleteMin : BinomialHeap α le → Option (α × BinomialHeap α le)
  | ⟨b, h⟩ =>
    match eq: BinomialHeapImp.deleteMin le b with
    | none => none
    | some (a, tl) => some (a, ⟨tl, WellFormed.deleteMin a b tl h eq⟩)

/- O(log n) -/
@[inline] def head [Inhabited α] : BinomialHeap α le → α
  | ⟨b, _⟩ => BinomialHeapImp.head le b

/- O(log n) -/
@[inline] def head? : BinomialHeap α le → Option α
  | ⟨b, _⟩ => BinomialHeapImp.head? le b

/- O(log n) -/
@[inline] def tail? : BinomialHeap α le → Option (BinomialHeap α le)
  | ⟨b, h⟩ =>
    match eq: BinomialHeapImp.tail? le b with
    | none => none
    | some tl => some ⟨tl, WellFormed.tail? b tl h eq⟩

/- O(log n) -/
@[inline] def tail : BinomialHeap α le → BinomialHeap α le
  | ⟨b, h⟩ => ⟨BinomialHeapImp.tail le b, WellFormed.tail b h⟩

/- O(n log n) -/
@[inline] def toList : BinomialHeap α le → List α
  | ⟨b, _⟩ => BinomialHeapImp.toList le b

/- O(n log n) -/
@[inline] def toArray : BinomialHeap α le → Array α
  | ⟨b, _⟩ => BinomialHeapImp.toArray le b

/- O(n) -/
@[inline] def toListUnordered : BinomialHeap α le → List α
  | ⟨b, _⟩ => BinomialHeapImp.toListUnordered b

/- O(n) -/
@[inline] def toArrayUnordered : BinomialHeap α le → Array α
  | ⟨b, _⟩ => BinomialHeapImp.toArrayUnordered b

end BinomialHeap
end Std


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

! This file was ported from Lean 3 source module linear_algebra.affine_space.matrix
! leanprover-community/mathlib commit 2de9c37fa71dde2f1c6feff19876dd6a7b1519f0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.AffineSpace.Basis
import Mathbin.LinearAlgebra.Determinant

/-!
# Matrix results for barycentric co-ordinates

Results about the matrix of barycentric co-ordinates for a family of points in an affine space, with
respect to some affine basis.
-/

open Affine BigOperators Matrix

open Set

universe u₁ u₂ u₃ u₄

variable {ι : Type u₁} {k : Type u₂} {V : Type u₃} {P : Type u₄}

variable [AddCommGroup V] [affine_space V P]

namespace AffineBasis

section Ring

variable [Ring k] [Module k V] (b : AffineBasis ι k P)

/-- Given an affine basis `p`, and a family of points `q : ι' → P`, this is the matrix whose
rows are the barycentric coordinates of `q` with respect to `p`.

It is an affine equivalent of `basis.to_matrix`. -/
noncomputable def toMatrix {ι' : Type _} (q : ι' → P) : Matrix ι' ι k := fun i j => b.Coord j (q i)
#align affine_basis.to_matrix AffineBasis.toMatrix

@[simp]
theorem toMatrix_apply {ι' : Type _} (q : ι' → P) (i : ι') (j : ι) :
    b.toMatrix q i j = b.Coord j (q i) :=
  rfl
#align affine_basis.to_matrix_apply AffineBasis.toMatrix_apply

@[simp]
theorem toMatrix_self [DecidableEq ι] : b.toMatrix b = (1 : Matrix ι ι k) :=
  by
  ext (i j)
  rw [to_matrix_apply, coord_apply, Matrix.one_eq_pi_single, Pi.single_apply]
#align affine_basis.to_matrix_self AffineBasis.toMatrix_self

variable {ι' : Type _} [Fintype ι'] [Fintype ι] (b₂ : AffineBasis ι k P)

theorem toMatrix_row_sum_one {ι' : Type _} (q : ι' → P) (i : ι') : (∑ j, b.toMatrix q i j) = 1 := by
  simp
#align affine_basis.to_matrix_row_sum_one AffineBasis.toMatrix_row_sum_one

/-- Given a family of points `p : ι' → P` and an affine basis `b`, if the matrix whose rows are the
coordinates of `p` with respect `b` has a right inverse, then `p` is affine independent. -/
theorem affineIndependent_of_toMatrix_right_inv [DecidableEq ι'] (p : ι' → P) {A : Matrix ι ι' k}
    (hA : b.toMatrix p ⬝ A = 1) : AffineIndependent k p :=
  by
  rw [affineIndependent_iff_eq_of_fintype_affineCombination_eq]
  intro w₁ w₂ hw₁ hw₂ hweq
  have hweq' : (b.to_matrix p).vecMul w₁ = (b.to_matrix p).vecMul w₂ :=
    by
    ext j
    change (∑ i, w₁ i • b.coord j (p i)) = ∑ i, w₂ i • b.coord j (p i)
    rw [← finset.univ.affine_combination_eq_linear_combination _ _ hw₁, ←
      finset.univ.affine_combination_eq_linear_combination _ _ hw₂, ←
      finset.univ.map_affine_combination p w₁ hw₁, ← finset.univ.map_affine_combination p w₂ hw₂,
      hweq]
  replace hweq' := congr_arg (fun w => A.vec_mul w) hweq'
  simpa only [Matrix.vecMul_vecMul, ← Matrix.mul_eq_mul, hA, Matrix.vecMul_one] using hweq'
#align affine_basis.affine_independent_of_to_matrix_right_inv AffineBasis.affineIndependent_of_toMatrix_right_inv

/-- Given a family of points `p : ι' → P` and an affine basis `b`, if the matrix whose rows are the
coordinates of `p` with respect `b` has a left inverse, then `p` spans the entire space. -/
theorem affineSpan_eq_top_of_toMatrix_left_inv [DecidableEq ι] [Nontrivial k] (p : ι' → P)
    {A : Matrix ι ι' k} (hA : A ⬝ b.toMatrix p = 1) : affineSpan k (range p) = ⊤ :=
  by
  suffices ∀ i, b i ∈ affineSpan k (range p)
    by
    rw [eq_top_iff, ← b.tot, affineSpan_le]
    rintro q ⟨i, rfl⟩
    exact this i
  intro i
  have hAi : (∑ j, A i j) = 1 := by
    calc
      (∑ j, A i j) = ∑ j, A i j * ∑ l, b.to_matrix p j l := by simp
      _ = ∑ j, ∑ l, A i j * b.to_matrix p j l := by simp_rw [Finset.mul_sum]
      _ = ∑ l, ∑ j, A i j * b.to_matrix p j l := by rw [Finset.sum_comm]
      _ = ∑ l, (A ⬝ b.to_matrix p) i l := rfl
      _ = 1 := by simp [hA, Matrix.one_apply, Finset.filter_eq]

  have hbi : b i = finset.univ.affine_combination k p (A i) :=
    by
    apply b.ext_elem
    intro j
    rw [b.coord_apply, finset.univ.map_affine_combination _ _ hAi,
      finset.univ.affine_combination_eq_linear_combination _ _ hAi]
    change _ = (A ⬝ b.to_matrix p) i j
    simp_rw [hA, Matrix.one_apply, @eq_comm _ i j]
  rw [hbi]
  exact affineCombination_mem_affineSpan hAi p
#align affine_basis.affine_span_eq_top_of_to_matrix_left_inv AffineBasis.affineSpan_eq_top_of_toMatrix_left_inv

/-- A change of basis formula for barycentric coordinates.

See also `affine_basis.to_matrix_inv_mul_affine_basis_to_matrix`. -/
@[simp]
theorem toMatrix_vecMul_coords (x : P) : (b.toMatrix b₂).vecMul (b₂.coords x) = b.coords x :=
  by
  ext j
  change _ = b.coord j x
  conv_rhs => rw [← b₂.affine_combination_coord_eq_self x]
  rw [Finset.map_affineCombination _ _ _ (b₂.sum_coord_apply_eq_one x)]
  simp [Matrix.vecMul, Matrix.dotProduct, to_matrix_apply, coords]
#align affine_basis.to_matrix_vec_mul_coords AffineBasis.toMatrix_vecMul_coords

variable [DecidableEq ι]

theorem toMatrix_mul_toMatrix : b.toMatrix b₂ ⬝ b₂.toMatrix b = 1 :=
  by
  ext (l m)
  change (b₂.to_matrix b).vecMul (b.coords (b₂ l)) m = _
  rw [to_matrix_vec_mul_coords, coords_apply, ← to_matrix_apply, to_matrix_self]
#align affine_basis.to_matrix_mul_to_matrix AffineBasis.toMatrix_mul_toMatrix

theorem isUnit_toMatrix : IsUnit (b.toMatrix b₂) :=
  ⟨{  val := b.toMatrix b₂
      inv := b₂.toMatrix b
      val_inv := b.toMatrix_mul_toMatrix b₂
      inv_val := b₂.toMatrix_mul_toMatrix b }, rfl⟩
#align affine_basis.is_unit_to_matrix AffineBasis.isUnit_toMatrix

theorem isUnit_toMatrix_iff [Nontrivial k] (p : ι → P) :
    IsUnit (b.toMatrix p) ↔ AffineIndependent k p ∧ affineSpan k (range p) = ⊤ :=
  by
  constructor
  · rintro ⟨⟨B, A, hA, hA'⟩, rfl : B = b.to_matrix p⟩
    rw [Matrix.mul_eq_mul] at hA hA'
    exact
      ⟨b.affine_independent_of_to_matrix_right_inv p hA,
        b.affine_span_eq_top_of_to_matrix_left_inv p hA'⟩
  · rintro ⟨h_tot, h_ind⟩
    let b' : AffineBasis ι k P := ⟨p, h_tot, h_ind⟩
    change IsUnit (b.to_matrix b')
    exact b.is_unit_to_matrix b'
#align affine_basis.is_unit_to_matrix_iff AffineBasis.isUnit_toMatrix_iff

end Ring

section CommRing

variable [CommRing k] [Module k V] [DecidableEq ι] [Fintype ι]

variable (b b₂ : AffineBasis ι k P)

/-- A change of basis formula for barycentric coordinates.

See also `affine_basis.to_matrix_vec_mul_coords`. -/
@[simp]
theorem toMatrix_inv_vecMul_toMatrix (x : P) :
    (b.toMatrix b₂)⁻¹.vecMul (b.coords x) = b₂.coords x :=
  by
  have hu := b.is_unit_to_matrix b₂
  rw [Matrix.isUnit_iff_isUnit_det] at hu
  rw [← b.to_matrix_vec_mul_coords b₂, Matrix.vecMul_vecMul, Matrix.mul_nonsing_inv _ hu,
    Matrix.vecMul_one]
#align affine_basis.to_matrix_inv_vec_mul_to_matrix AffineBasis.toMatrix_inv_vecMul_toMatrix

/-- If we fix a background affine basis `b`, then for any other basis `b₂`, we can characterise
the barycentric coordinates provided by `b₂` in terms of determinants relative to `b`. -/
theorem det_smul_coords_eq_cramer_coords (x : P) :
    (b.toMatrix b₂).det • b₂.coords x = (b.toMatrix b₂)ᵀ.cramer (b.coords x) :=
  by
  have hu := b.is_unit_to_matrix b₂
  rw [Matrix.isUnit_iff_isUnit_det] at hu
  rw [← b.to_matrix_inv_vec_mul_to_matrix, Matrix.det_smul_inv_vecMul_eq_cramer_transpose _ _ hu]
#align affine_basis.det_smul_coords_eq_cramer_coords AffineBasis.det_smul_coords_eq_cramer_coords

end CommRing

end AffineBasis


def f (x : α) := x

theorem ex1 (a : α) (b : List α) : f (a::b = []) = False :=
  by simp [f]

def length : List α → Nat
  | []    => 0
  | a::as => length as + 1

theorem ex2 (a b c : α) (as : List α) : length (a :: b :: as) > length as := by
  simp [length]
  apply Nat.lt.step
  apply Nat.lt_succ_self

def fact : Nat → Nat
  | 0 => 1
  | x+1 => (x+1) * fact x

theorem ex3 : fact x > 0 := by
  induction x with
  | zero => decide
  | succ x ih =>
    simp [fact]
    apply Nat.mul_pos
    apply Nat.zero_lt_succ
    apply ih

def head [Inhabited α] : List α → α
  | []   => default
  | a::_ => a

theorem ex4 [Inhabited α] (a : α) (as : List α) : head (a::as) = a :=
  by simp [head]

def foo := 10

theorem ex5 (x : Nat) : foo + x = 10 + x := by
  simp [foo]
  done

def g (x : Nat) : Nat := Id.run <| do
  let x := x
  return x

theorem ex6 : g x = x := by
  simp [g, bind, pure]
  rfl

def f1 : StateM Nat Unit := do
  modify fun x => g x

def f2 : StateM Nat Unit := do
  let s ← get
  set <| g s

theorem ex7 : f1 = f2 := by
  simp [f1, f2, bind, StateT.bind, get, getThe, MonadStateOf.get, StateT.get, pure, set, StateT.set, modify, modifyGet, MonadStateOf.modifyGet, StateT.modifyGet]

def h (x : Nat) : Sum (Nat × Nat) Nat := Sum.inl (x, x)

def bla (x : Nat) :=
  match h x with
  | Sum.inl (y, z) => y + z
  | Sum.inr _ => 0

theorem ex8 (x : Nat) : bla x = x + x := by
  simp [bla, h]