import misc.prop

namespace set

universes u v

open inhabited
open classical
open subtype
open list

/-
  Useful set theortic operations not inculded in the standard libary that are needed to prove results about
  commuative rings and toplogical spaces.
-/

-- This result was for some dumb reson a protected lemma in the subtype file.

lemma val_injective {X : Type u} {S : set X} : ∀ {a1 a2 : subtype S}, val a1 = val a2 → a1 = a2
| ⟨x, h1⟩ ⟨.(x), h2⟩ rfl := rfl

@[reducible]
def choice_function {X : Type u} (f : {S : set X // ∃ x : X, x ∈ S} → X ) : Prop := ∀ S, f S ∈ S.val

@[reducible]
def sInter {α : Type u} (s : set (set α)) : set α := {t | ∀ a ∈ s, t ∈ a}
prefix `⋂₀`:110 := sInter

@[reducible]
def pre_image {X : Type u} {Y : Type v} (f : X → Y) (U_Y : set Y) : set X := λ x : X, f x ∈ U_Y

@[reducible]
def include_subset {X : Type u} {S : set X} : set (subtype S) → set X
  := λ s, λ x : X, (∃ y : subtype S, y ∈ s ∧ y.val = x)

@[reducible]
def ghost_subset {X : Type u} (S : set X) : set X → set (subtype S)
  := λ T : set X, λ s : subtype S, ∃ x : X, x ∈ T ∧ s.val = x

@[reducible]
def list_to_set {X : Type u} : list X → set X := λ xs, λ t, t ∈ xs

@[reducible]
def set_singleton {X: Type u} (x : X) : set X := λ a, a = x
/-
  Proof that there is a choice function.
-/

lemma there_is_choice_function {X : Type u} : ∃ f : {S : set X //  ∃ x : X, x ∈ S} → X, choice_function f :=
begin
  let fdat := λ S : {S : set X // ∃ x : X, x ∈ S}, subtype.mk (some S.property) (some_spec S.property),
  existsi (λ S, (fdat S).val),
  intro S,
  exact (fdat S).property,
end

lemma pre_image_prevs_subset {X : Type u} {Y : Type v} {A₁ A₂ : set Y} (f : X → Y)
  (hA₁A₂ : A₁ ⊆ A₂) : (pre_image f A₁) ⊆ (pre_image f A₂) :=
begin
  intros x hx,
  apply hA₁A₂,
  exact hx,
end

/-
  Some trival results about subsets and set eqaulity so I'm not alway having to apply funext/propext
  to every lemma.
-/

theorem setext {X : Type u} {A B : set X} : (∀ x : X, (x ∈ A → x ∈ B) ∧ (x ∈ B → x ∈ A)) → A = B :=
begin
    intro h,
    apply funext,
    intro x,
    apply propext,
    exact ⟨and.left (h x), and.right (h x)⟩,
end

theorem subset_reflexive {X : Type u} {A : set X} : A ⊆ A := λ x ha, ha

theorem subset_antisymmetric {X : Type u} {A B : set X} : A ⊆ B ∧ B ⊆ A → A = B :=
begin
  intro h,
  cases h with hAinB hBinA,
  apply setext,
  intro x,
  exact ⟨λ ha, hAinB ha, λ hb, hBinA hb⟩,
end

theorem subset_transitive {X : Type u} {A B C: set X} : (A ⊆ B) → (B ⊆ C) → A ⊆ C :=
begin
  intros hAinB hBinC,
  intros x h,
  exact hBinC (hAinB h),
end

theorem empty_set_subset {X : Type u} {A : set X} : ∅ ⊆ A :=
begin
  intros x hx,
  exact false.elim hx,
end

theorem set_subset_of_univ {X : Type u} {A : set X} : A ⊆ univ :=
begin
  intros a ha,
  trivial,
end

theorem not_empty_set_has_element {X : Type u} {S : set X} : S ≠ ∅ → ∃ x : X, x ∈ S :=
begin
  intro nS,
  by_contradiction hraw,
  let h := forall_not_of_not_exists hraw,
  have eS : S = ∅,
  apply setext,
  intro x,
  split,
  intro hx,
  exact (h x) hx,
  intro ab,
  exact false.elim ab,
  exact nS eS,
end

/-
  A couple of simple results about singletons
-/

theorem single_value_in_singleton {X : Type u} {x : X} : ∀ a : X, a ∈ set_singleton x → a = x :=
  λ a ha, ha

theorem nonempty_subset_singleton_equality {X : Type u} {x : X} : ∀ S : set X, S ⊆ set_singleton x ∧ S ≠ ∅ → S = set_singleton x :=
begin
  intros S hS,
  cases hS with hS nS,
  apply subset_antisymmetric,
  split,
  exact hS,
  let a := some (not_empty_set_has_element nS),
  let ha : a ∈ S := some_spec (not_empty_set_has_element nS),
  let hx : a = x := single_value_in_singleton a (hS ha),
  rw hx at ha,
  intros b hb,
  let hbisx : b = x := single_value_in_singleton b hb,
  rw ← hbisx at ha,
  exact ha,
end

/-
  Simple results involving the intersection and union operators.
-/

private lemma half_intersection_commuative {X : Type u} (A B : set X) : A ∩ B ⊆ B ∩ A :=
begin
  intros x hx,
  cases hx with hxinA hxinB,
  exact ⟨hxinB,hxinA⟩,
end

private lemma half_union_commuative {X : Type u} (A B : set X) : A ∪ B ⊆ B ∪ A :=
begin
  intros x hx,
  cases hx,
  right,
  exact hx,
  left,
  exact hx,
end

theorem intersection_commuative {X : Type u} (A B : set X) : A ∩ B = B ∩ A :=
begin
  apply subset_antisymmetric,
  exact ⟨half_intersection_commuative A B, half_intersection_commuative B A⟩,
end

theorem union_commuative {X : Type u} {A B : set X} : A ∪ B = B ∪ A :=
begin
  apply subset_antisymmetric,
  exact ⟨half_union_commuative A B, half_union_commuative B A⟩,
end

theorem intersection_in_set {X : Type u} {A B : set X} : A ∩ B ⊆ A :=
begin
  intros x hx,
  cases hx with hxinA hxinB,
  exact hxinA,
end

theorem bound_in_bounded_intersection {X : Type u} {α : set (set X)} {V : set X} : (∀ U : set X, U ∈ α → V ⊆ U) → V ⊆ ⋂₀ α :=
begin
  intros h x hx U hU,
  exact h U hU hx,
end

theorem intersection_lower_bound {X : Type u} {α : set (set X)} : ∀ U : set X, U ∈ α → ⋂₀ α ⊆ U :=
begin
  intros U hU x hx,
  exact hx U hU,
end

theorem set_in_union {X : Type u} {A B : set X} : A ⊆ A ∪ B :=
begin
  intros x hx,
  left,
  exact hx,
end

theorem bounded_union_in_bound {X : Type u} {α : set (set X)} {V : set X}
  : (∀ U : set X, U ∈ α → U ⊆ V) → ⋃₀ α ⊆ V :=
begin
  intros h x hx,
  cases hx with U hU,
  cases hU with hU hx,
  exact h U hU hx,
end

theorem union_upper_bound {X : Type u} {α : set (set X)}
  : ∀ U : set X, U ∈ α → U ⊆ ⋃₀ α :=
begin
  intros U hUinα x hxinU,
  existsi U,
  existsi hUinα,
  exact hxinU,
end

theorem intersection_subset {X : Type u} {A B : set X} : A ⊆ B → B ∩ A = A :=
begin
  intro h,
  rw intersection_commuative,
  apply subset_antisymmetric,
  split,
  apply intersection_in_set,
  intros x hx,
  exact ⟨hx,h hx⟩,
end

theorem intersection_empty_set {X : Type u} {A : set X} : ∅ ∩ A = ∅ :=
begin
  rw intersection_commuative,
  apply intersection_subset empty_set_subset,
end

theorem empty_intersection {X : Type u} : ⋂₀ (∅ : set (set X)) = univ :=
begin
  apply subset_antisymmetric,
  split,
  apply set_subset_of_univ,
  intros x trv,
  intros A hA,
  apply false.elim,
  exact hA,
end

theorem empty_union {X : Type u} : ⋃₀ (∅ : set (set X)) = ∅ :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with A hA,
  cases hA with ab _,
  exact ab,
  apply empty_set_subset,
end

theorem union_subset {X : Type u} {A B : set X} : A ⊆ B → B ∪ A = B :=
begin
  intro h,
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx,
  exact hx,
  exact h hx,
  apply set_in_union,
end

lemma image_membership {X : Type u} {Y : Type v} {f : X → Y} {s : set X} : ∀ {x}, x ∈ s → f x ∈ image (λ y, f y) s :=
begin
  intros x hx,
  split,
  split,
  exact hx,
  refl,
end

lemma not_empty_image_not_empty {X : Type u} {Y : Type v} (f : X → Y) {s : set X} (ns : s ≠ ∅)
  : (image f s) ≠ ∅ :=
begin
  let x := some (not_empty_set_has_element ns),
  have hx : x ∈ s := some_spec (not_empty_set_has_element ns),
  have hfx : f x ∈ image f s,
    existsi x,
    exact ⟨hx,rfl⟩,
  intro ab,
  rw ab at hfx,
  assumption,
end

theorem intersection_dis_over_union {X : Type u} (C : set (set X)) (A : set X) : (⋃₀ C) ∩ A = ⋃₀ (image (λ B, B ∩ A) C) :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with hxinU hxinA,
  cases hxinU with W hW,
  have hWinC := some hW,
  have hxinW := some_spec hW,
  split,
  have hxinI : x ∈ W ∩ A,
    split,
    exact hxinW,
    exact hxinA,
  have hWinim : W ∩ A ∈ image (λ B, B ∩ A) C,
    apply image_membership,
    exact hWinC,
  existsi hWinim,
  exact hxinI,
  intros x hx,
  cases hx with D hD,
  cases hD with hDinim hxinD,
  cases hDinim with B hB,
  cases hB with hBinC hBAisD,
  rw ← hBAisD at hxinD,
  cases hxinD with hxinB hxinA,
  split,
  split,
  existsi hBinC,
  exact hxinB,
  exact hxinA,
end

theorem set_int_set_set {X : Type u} (A : set X) : A ∩ A = A :=
begin
  apply subset_antisymmetric,
  split,
  apply intersection_in_set,
  intros a ha,
  exact ⟨ha,ha⟩,
end

theorem intersection_assoc {X : Type u} (A B C : set X) : A ∩ (B ∩ C) = (A ∩ B) ∩ C :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with hxinA hxinAB,
  cases hxinAB with hxinB hxinC,
  exact ⟨⟨hxinA, hxinB⟩,hxinC⟩,
  intros x hx,
  cases hx with hxinAB hxinC,
  cases hxinAB with hxinA hxinB,
  exact ⟨hxinA,hxinB,hxinC⟩,
end

theorem list_to_set_pair_mem {X : Type u} (A B : set X) : A ∈ list_to_set [A,B] ∧ B ∈ list_to_set [A,B] :=
begin
  split,
  have trvA : A ∈ [A,B],
    simp,
  exact trvA,
  have trvB : B ∈ [A,B],
    simp,
  exact trvB,
end

@[simp]
theorem list_to_set_nil (X : Type u) : list_to_set nil = (∅ :set X) := rfl

@[simp]
theorem image_of_empty {A : Type u} {B : Type v} (f : A → B) : image f ∅ = ∅ :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with a ha,
  cases ha,
  apply false.elim,
  exact ha_left,
  apply empty_set_subset,
end

theorem image_dis_over_union {A : Type u} {B : Type v} (f : A → B) {A₁ A₂ : set A} : image f (A₁ ∪ A₂) = (image f A₁) ∪ (image f A₂) :=
begin
  apply subset_antisymmetric,
  split,
  intros b hb,
  cases hb with a ha,
  cases ha with ha hrw,
  rw ← hrw,
  cases ha,
  left,
  apply image_membership,
  exact ha,
  right,
  apply image_membership,
  exact ha,
  intros b hb,
  cases hb,
  cases hb with a ha,
  cases ha with ha hrw,
  rw ← hrw,
  apply image_membership,
  left,
  exact ha,
  cases hb with a ha,
  cases ha with ha hrw,
  rw ← hrw,
  apply image_membership,
  right,
  exact ha,
end

theorem image_of_singleton {A : Type u} {B : Type v} (f : A → B) (a : A)
  : image f (λ x, x = a) = (λ x, x = f a) :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with y hy,
  cases hy with hy₁ hy₂,
  have trv : y = a := hy₁,
  rw trv at hy₂,
  exact symm hy₂,
  intros x hx,
  have trv : x = f a := hx,
  rw trv,
  apply image_membership,
  split,
end

@[simp]
theorem list_to_set_cons {A : Type u} (a : A) (l : list A) : list_to_set (a :: l) = (λ x, x = a) ∪ (list_to_set l) := rfl

theorem image_of_list_to_set {A : Type u} {B : Type v} (f : A → B) (l: list A)
  : image f (list_to_set l) = list_to_set (map f l) :=
begin
  induction l with a l hl,
  simp,
  simp [map],
  rw [image_dis_over_union,hl],
  rw image_of_singleton,
end

theorem sunion_to_union {X : Type u} {A B : set X} : ⋃₀ (list_to_set [A,B]) = A ∪ B :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with S hS,
  cases hS with hSlist hxinS,
  cases hSlist,
  left,
  rw ← hSlist,
  exact hxinS,
  cases hSlist,
  right,
  rw hSlist at hxinS,
  exact hxinS,
  apply false.elim,
  exact hSlist,
  intros x hx,
  cases hx,
  existsi A,
  existsi and.left (list_to_set_pair_mem A B),
  exact hx,
  existsi B,
  existsi and.right (list_to_set_pair_mem A B),
  exact hx,
end

theorem sinter_to_inter {X : Type u} {A B : set X} : ⋂₀ (list_to_set [A,B]) = A ∩ B :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  have trvA : x ∈ A,
    apply intersection_lower_bound,
    exact and.left (list_to_set_pair_mem A B),
    exact hx,
  have trvB : x ∈ B,
    apply intersection_lower_bound,
    exact and.right (list_to_set_pair_mem A B),
    exact hx,
  exact ⟨trvA,trvB⟩,
  intros x hx,
  cases hx with hxinA hxinB,
  intros S hS,
  cases hS,
  rw hS,
  exact hxinA,
  cases hS,
  rw hS,
  exact hxinB,
  apply false.elim,
  exact hS,
end

/-
  Results about set theoretic difference.
-/

theorem difference_in_numerator {X : Type u} (A : set X) (B : set X) : A \ B ⊆ A :=
begin
  intros x hx,
  cases hx,
  exact hx_left,
end

theorem single_element_diff_nonempty {X : Type u} {A : set X} {B : set X} {x : X} : x ∈ A ∧ x ∉ B → A \ B ≠ ∅ :=
begin
  intro h,
  cases h with h1 h2,
  have hx : x ∈ A \ B,
  split,
  exact h1,
  exact h2,
  intro hc,
  rw hc at hx,
  exact hx,
end

theorem not_equal_in_terms_of_comp {X : Type u} {A : set X} {B : set X} : A ≠ B → (A \ B ≠ ∅ ) ∨ (B \ A ≠ ∅) :=
begin
  intro nAB,
  by_contradiction,
  have h1 := not_or_and_not h,
  cases h1 with hAraw hBraw,
  have hA := not_not hAraw,
  have hB := not_not hBraw,
  have ab : A = B,
  apply subset_antisymmetric,
  split,
  intros a hainA,
  by_contradiction haninB,
  have ha : a ∈ A \ B,
  exact ⟨hainA, haninB⟩,
  rw hA at ha,
  exact ha,
  intros b hbinB,
  by_contradiction hbninA,
  have hb : b ∈ B \ A,
  exact ⟨hbinB,hbninA⟩,
  rw hB at hb,
  exact hb,
  exact nAB ab,
end

theorem empty_diff_implies_subset {X : Type u} {A : set X} {B : set X} : A \ B = ∅ → A ⊆ B :=
begin
  intros h1 a ha,
  by_contradiction,
  have ab : a ∈ A \ B,
  exact ⟨ha,h⟩,
  rw h1 at ab,
  exact ab
end

theorem diff_of_univ_empty {X : Type u} (A : set X) : (A \ univ) = ∅ :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx,
  apply false.elim,
  apply hx_right,
  trivial,
  apply empty_set_subset,
end

theorem diff_by_subset_superset {X : Type u} {A : set X} {B : set X} {B' : set X} (hB'B : B' ⊆ B) : A \ B ⊆ A \ B' :=
begin
  intros x hx,
  cases hx with hxinA hxninB,
  split,
  exact hxinA,
  by_contradiction,
  apply hxninB,
  apply hB'B,
  exact h,
end

theorem empty_set_diff {X : Type u} (A : set X) : A \ ∅ = A :=
begin
  apply subset_antisymmetric,
  split,
  apply difference_in_numerator,
  intros a ha,
  split,
  assumption,
  simp,
  intro ab,
  exact ab,
end

theorem not_in_union {X : Type u} {A₁ A₂ : set X} {x : X} : x ∉ (A₁ ∪ A₂) → x ∉ A₁ ∧ x ∉ A₂ :=
begin
  intro h,
  split,
  intro ab,
  apply h,
  left,
  exact ab,
  intro ab,
  apply h,
  right,
  exact ab,
end

theorem not_subset_some_element_in_diff {X : Type u} {A₁ A₂ : set X} (hns : ¬ (A₁ ⊆ A₂))
  : ∃ x, x ∈ A₁ ∧ x ∉ A₂ :=
begin
  by_contradiction,
  have h₁ := forall_not_of_not_exists h,
  apply hns,
  intros a ha,
  cases not_and_or_not (h₁ a) with h₂,
  apply false.elim,
  apply h₂,
  assumption,
  apply not_not,
  assumption,
end

theorem deMorgenUnion {X : Type u} (C : set (set X)) :  univ \ (⋃₀ C) = ⋂₀ image (λ A, univ \ A) C :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with trv nxinU,
  have nxinAinC : ∀ A, A ∈ C → x ∉ A,
     have int : ∀ A, ¬ (∃ h : A ∈ C, x ∈ A):= (forall_not_of_not_exists nxinU),
    intro a,
    apply forall_not_of_not_exists,
    exact int a,
  intros S hS,
  cases hS with A hA,
  cases hA with hAinC hrw,
  rw ← hrw,
  simp,
  split,
  trivial,
  apply nxinAinC,
  exact hAinC,
  intros x hx,
  split,
  trivial,
  intro hxinU,
  cases hxinU with A hA,
  cases hA with hAinC hxinA,
  have hcon : x ∈ univ \ A,
    apply intersection_lower_bound,
    have int: univ \ A ∈ image (λ B, univ \ B) C,
      apply image_membership,
      exact hAinC,
    exact int,
    exact hx,
  cases hcon,
  apply hcon_right,
  exact hxinA,
end

theorem deMorgenInter {X : Type u} (C : set (set X)) :  univ \ (⋂₀ C) = ⋃₀ image (λ A, univ \ A) C :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with trv₁ nxinI,
  have h₁ := exists_not_of_not_exists nxinI,
  simp at h₁,
  cases h₁ with A hA,
  rw not_implies at hA,
  cases hA with hAinC hxninA,
  existsi univ \ A,
  split,
  existsi A,
  split,
  exact hAinC,
  refl,
  split,
  trivial,
  exact hxninA,
  intros x hx,
  cases hx with A hA,
  cases hA with hAdiff hxinA,
  cases hAdiff with B hB,
  cases hB with hBinC hB,
  simp at hB,
  rw ← hB at hxinA,
  split,
  trivial,
  simp,
  intro hx,
  have hcon : x ∈ B,
    apply hx,
    exact hBinC,
  cases hxinA with h₁ h₂,
  apply h₂,
  exact hcon,
end

/-
  Various technical results about the inculde_subset and subset_ghost functions.
-/

lemma include_empty_is_empty {X : Type u} {S : set X} : @include_subset X S ∅ = ∅ :=
begin
  apply subset_antisymmetric,
  split,
  intros s hs,
  cases hs with sg hsg,
  exact false.elim (and.left hsg),
  apply empty_set_subset,
end

lemma ghost_empty_is_empty {X : Type u} {S : set X} : @ghost_subset X S ∅ = ∅ :=
begin
  apply subset_antisymmetric,
  split,
  intros a ha,
  cases ha with x hx,
  exact false.elim (and.left hx),
  apply empty_set_subset,
end

lemma include_set_in_set {X : Type u} {S : set X} {t : set (subtype S)} : include_subset t ⊆ S :=
begin
  intros x h,
  cases h with xin hxin,
  cases hxin,
  let h₀ := xin.property,
  rw hxin_right at h₀,
  exact h₀,
end

lemma include_univ_is_set {X : Type u} {S : set X} : @include_subset X S univ = S :=
begin
  apply subset_antisymmetric,
  split,
  apply include_set_in_set,
  intros s hs,
  existsi subtype.mk s hs,
  split,
  trivial,
  refl,
end

lemma ghost_set_is_univ {X : Type u} {S : set X} : ghost_subset S S = univ :=
begin
  apply subset_antisymmetric,
  split,
  apply set_subset_of_univ,
  intros x trv,
  existsi x.val,
  split,
  exact x.property,
  refl,
end

lemma include_set_prevs_subset {X : Type u} {S : set X} {α β : set (subtype S)} : α ⊆ β → include_subset α ⊆ include_subset β :=
begin
  intros h s hs,
  cases hs with gs hgs,
  existsi gs,
  exact ⟨h (and.left hgs), and.right hgs⟩,
end

lemma ghost_subset_prev_subset {X : Type u} {S T₁ T₂ : set X} : T₁ ⊆ T₂ → ghost_subset  S T₁ ⊆ ghost_subset S T₂ :=
begin
  intros h s hs,
  cases hs with x hx,
  existsi x,
  exact ⟨h (and.left hx), and.right hx⟩,
end

lemma include_ghost_id {X : Type u} {S : set X} {α : set (subtype S)} : ghost_subset S (include_subset α) = α :=
begin
  apply subset_antisymmetric,
  split,
  intros s hs,
  cases hs with x hx,
  cases hx with hx svalx,
  cases hx with t ht,
  cases ht with htinα tvalx,
  have hts : t = s,
  apply val_injective,
  rw ← svalx at tvalx,
  exact tvalx,
  rw ← hts,
  exact htinα,
  intros a ha,
  existsi a.val,
  split,
  existsi a,
  exact ⟨ha,rfl⟩,
  refl,
end

lemma ghost_include_id {X : Type u} {S : set X} {T : set X} : T ⊆ S → include_subset (ghost_subset S T) = T :=
begin
  intro h,
  apply subset_antisymmetric,
  split,
  intros y hy,
  cases hy with s hs,
  cases hs with hs svaly,
  cases hs with x hx,
  cases hx with hxinT svalx,
  rw svaly at svalx,
  rw svalx,
  exact hxinT,
  intros x hx,
  existsi subtype.mk x (h hx),
  split,
  existsi x,
  exact ⟨hx, rfl⟩,
  refl,
end

lemma include_set_prevs_union {X : Type u} {S : set X} (β : set (set (subtype S))) : ⋃₀ (image include_subset β) = include_subset (⋃₀ β) :=
begin
  apply subset_antisymmetric,
  split,
  apply bounded_union_in_bound,
  intros U hU,
  cases hU with V hV,
  cases hV with hVinβ hVincU,
  rw ← hVincU,
  apply include_set_prevs_subset,
  apply union_upper_bound,
  exact hVinβ,
  intros x hx,
  cases hx with t ht,
  cases ht with ht tvalx,
  cases ht with s hs,
  cases hs with hsinβ htins,
  existsi include_subset s,
  split,
  existsi s,
  exact ⟨hsinβ,rfl⟩,
  existsi t,
  exact ⟨htins, tvalx⟩,
end

lemma include_set_prevs_pair_intersection {X : Type u} {S : set X} (A : set (subtype S)) (B : set (subtype S))
  : include_subset (A ∩ B) = (include_subset A) ∩ (include_subset B) :=
begin
  apply subset_antisymmetric,
  split,
  intros x hx,
  cases hx with xg hxg,
  cases hxg with hxginint hxgisx,
  cases hxginint with hxginA hxginB,
  split,
  existsi xg,
  exact ⟨hxginA,hxgisx⟩,
  existsi xg,
  exact ⟨hxginB,hxgisx⟩,
  intros x hx,
  cases hx with hxinAinc hxinBinc,
  cases hxinAinc with xg1 hxg1,
  cases hxinBinc with xg2 hxg2,
  cases hxg1 with hxg1inA xg1val,
  cases hxg2 with hxg2inB xg2val,
  have hrw : xg1 = xg2,
    apply val_injective,
    rw [xg1val,xg2val],
  existsi xg1,
  split,
  split,
  exact hxg1inA,
  rw ← hrw at hxg2inB,
  exact hxg2inB,
  exact xg1val,
end

end set


import tactic
#check dvd_mul_right

-- BEGIN
example {m n k : ℕ} (h : m ∣ n ∨ m ∣ k) : m ∣ n * k :=
begin
  rcases h with ⟨a, rfl⟩ | ⟨b, rfl⟩,
    /- rfl expects the hypothesis to be h : a = b, and calls on the
    hypothesis, which has the effect of replacing b with a everywhere
    or vice versa. -/
  { rw mul_assoc,
    apply dvd_mul_right },
  rw mul_comm,
  rw mul_assoc,
  apply dvd_mul_right,
end

/- Using the cases tactic -/
example {m n k : ℕ} (h : m ∣ n ∨ m ∣ k) : m ∣ n * k :=
begin
  cases h with hmn hmk,
  cases hmn with a ha,
    rw ha,
    rw mul_assoc,
    apply dvd_mul_right,
  cases hmk with b hb,
    rw hb,
    rw mul_comm,
    rw mul_assoc,
  apply dvd_mul_right,
end

-- END


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Sébastien Gouëzel, Yury Kudryashov
-/
import dynamics.ergodic.measure_preserving
import linear_algebra.determinant
import linear_algebra.matrix.diagonal
import linear_algebra.matrix.transvection
import measure_theory.constructions.pi
import measure_theory.measure.stieltjes
import measure_theory.measure.haar_of_basis

/-!
# Lebesgue measure on the real line and on `ℝⁿ`

We show that the Lebesgue measure on the real line (constructed as a particular case of additive
Haar measure on inner product spaces) coincides with the Stieltjes measure associated
to the function `x ↦ x`. We deduce properties of this measure on `ℝ`, and then of the product
Lebesgue measure on `ℝⁿ`. In particular, we prove that they are translation invariant.

We show that, on `ℝⁿ`, a linear map acts on Lebesgue measure by rescaling it through the absolute
value of its determinant, in `real.map_linear_map_volume_pi_eq_smul_volume_pi`.

More properties of the Lebesgue measure are deduced from this in `haar_lebesgue.lean`, where they
are proved more generally for any additive Haar measure on a finite-dimensional real vector space.
-/

noncomputable theory
open classical set filter measure_theory measure_theory.measure topological_space
open ennreal (of_real)
open_locale big_operators ennreal nnreal topology

/-!
### Definition of the Lebesgue measure and lengths of intervals
-/

namespace real

variables {ι : Type*} [fintype ι]

/-- The volume on the real line (as a particular case of the volume on a finite-dimensional
inner product space) coincides with the Stieltjes measure coming from the identity function. -/
lemma volume_eq_stieltjes_id : (volume : measure ℝ) = stieltjes_function.id.measure :=
begin
  haveI : is_add_left_invariant stieltjes_function.id.measure :=
  ⟨λ a, eq.symm $ real.measure_ext_Ioo_rat $ λ p q,
    by simp only [measure.map_apply (measurable_const_add a) measurable_set_Ioo,
      sub_sub_sub_cancel_right, stieltjes_function.measure_Ioo, stieltjes_function.id_left_lim,
      stieltjes_function.id_apply, id.def, preimage_const_add_Ioo]⟩,
  have A : stieltjes_function.id.measure (std_orthonormal_basis ℝ ℝ).to_basis.parallelepiped = 1,
  { change stieltjes_function.id.measure (parallelepiped (std_orthonormal_basis ℝ ℝ)) = 1,
    rcases parallelepiped_orthonormal_basis_one_dim (std_orthonormal_basis ℝ ℝ) with H|H;
    simp only [H, stieltjes_function.measure_Icc, stieltjes_function.id_apply, id.def, tsub_zero,
      stieltjes_function.id_left_lim, sub_neg_eq_add, zero_add, ennreal.of_real_one] },
  conv_rhs { rw [add_haar_measure_unique stieltjes_function.id.measure
    (std_orthonormal_basis ℝ ℝ).to_basis.parallelepiped, A] },
  simp only [volume, basis.add_haar, one_smul],
end

theorem volume_val (s) : volume s = stieltjes_function.id.measure s :=
by simp [volume_eq_stieltjes_id]

@[simp] lemma volume_Ico {a b : ℝ} : volume (Ico a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Icc {a b : ℝ} : volume (Icc a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Ioo {a b : ℝ} : volume (Ioo a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Ioc {a b : ℝ} : volume (Ioc a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_singleton {a : ℝ} : volume ({a} : set ℝ) = 0 :=
by simp [volume_val]

@[simp] lemma volume_univ : volume (univ : set ℝ) = ∞ :=
ennreal.eq_top_of_forall_nnreal_le $ λ r,
  calc (r : ℝ≥0∞) = volume (Icc (0 : ℝ) r) : by simp
              ... ≤ volume univ            : measure_mono (subset_univ _)

@[simp] lemma volume_ball (a r : ℝ) :
  volume (metric.ball a r) = of_real (2 * r) :=
by rw [ball_eq_Ioo, volume_Ioo, ← sub_add, add_sub_cancel', two_mul]

@[simp] lemma volume_closed_ball (a r : ℝ) :
  volume (metric.closed_ball a r) = of_real (2 * r) :=
by rw [closed_ball_eq_Icc, volume_Icc, ← sub_add, add_sub_cancel', two_mul]

@[simp] lemma volume_emetric_ball (a : ℝ) (r : ℝ≥0∞) :
  volume (emetric.ball a r) = 2 * r :=
begin
  rcases eq_or_ne r ∞ with rfl|hr,
  { rw [metric.emetric_ball_top, volume_univ, two_mul, _root_.top_add] },
  { lift r to ℝ≥0 using hr,
    rw [metric.emetric_ball_nnreal, volume_ball, two_mul, ← nnreal.coe_add,
      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
end

@[simp] lemma volume_emetric_closed_ball (a : ℝ) (r : ℝ≥0∞) :
  volume (emetric.closed_ball a r) = 2 * r :=
begin
  rcases eq_or_ne r ∞ with rfl|hr,
  { rw [emetric.closed_ball_top, volume_univ, two_mul, _root_.top_add] },
  { lift r to ℝ≥0 using hr,
    rw [metric.emetric_closed_ball_nnreal, volume_closed_ball, two_mul, ← nnreal.coe_add,
      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
end

instance has_no_atoms_volume : has_no_atoms (volume : measure ℝ) :=
⟨λ x, volume_singleton⟩

@[simp] lemma volume_interval {a b : ℝ} : volume (uIcc a b) = of_real (|b - a|) :=
by rw [←Icc_min_max, volume_Icc, max_sub_min_eq_abs]

@[simp] lemma volume_Ioi {a : ℝ} : volume (Ioi a) = ∞ :=
top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
calc (n : ℝ≥0∞) = volume (Ioo a (a + n)) : by simp
... ≤ volume (Ioi a) : measure_mono Ioo_subset_Ioi_self

@[simp] lemma volume_Ici {a : ℝ} : volume (Ici a) = ∞ :=
by simp [← measure_congr Ioi_ae_eq_Ici]

@[simp] lemma volume_Iio {a : ℝ} : volume (Iio a) = ∞ :=
top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
calc (n : ℝ≥0∞) = volume (Ioo (a - n) a) : by simp
... ≤ volume (Iio a) : measure_mono Ioo_subset_Iio_self

@[simp] lemma volume_Iic {a : ℝ} : volume (Iic a) = ∞ :=
by simp [← measure_congr Iio_ae_eq_Iic]

instance locally_finite_volume : is_locally_finite_measure (volume : measure ℝ) :=
⟨λ x, ⟨Ioo (x - 1) (x + 1),
  is_open.mem_nhds is_open_Ioo ⟨sub_lt_self _ zero_lt_one, lt_add_of_pos_right _ zero_lt_one⟩,
  by simp only [real.volume_Ioo, ennreal.of_real_lt_top]⟩⟩

instance is_finite_measure_restrict_Icc (x y : ℝ) : is_finite_measure (volume.restrict (Icc x y)) :=
⟨by simp⟩

instance is_finite_measure_restrict_Ico (x y : ℝ) : is_finite_measure (volume.restrict (Ico x y)) :=
⟨by simp⟩

instance is_finite_measure_restrict_Ioc (x y : ℝ) : is_finite_measure (volume.restrict (Ioc x y)) :=
 ⟨by simp⟩

instance is_finite_measure_restrict_Ioo (x y : ℝ) : is_finite_measure (volume.restrict (Ioo x y)) :=
⟨by simp⟩

lemma volume_le_diam (s : set ℝ) : volume s ≤ emetric.diam s :=
begin
  by_cases hs : metric.bounded s,
  { rw [real.ediam_eq hs, ← volume_Icc],
    exact volume.mono (real.subset_Icc_Inf_Sup_of_bounded hs) },
  { rw metric.ediam_of_unbounded hs, exact le_top }
end

lemma _root_.filter.eventually.volume_pos_of_nhds_real
  {p : ℝ → Prop} {a : ℝ} (h : ∀ᶠ x in 𝓝 a, p x) :
  (0 : ℝ≥0∞) < volume {x | p x} :=
begin
  rcases h.exists_Ioo_subset with ⟨l, u, hx, hs⟩,
  refine lt_of_lt_of_le _ (measure_mono hs),
  simpa [-mem_Ioo] using hx.1.trans hx.2
end

/-!
### Volume of a box in `ℝⁿ`
-/

lemma volume_Icc_pi {a b : ι → ℝ} : volume (Icc a b) = ∏ i, ennreal.of_real (b i - a i) :=
begin
  rw [← pi_univ_Icc, volume_pi_pi],
  simp only [real.volume_Icc]
end

@[simp] lemma volume_Icc_pi_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (Icc a b)).to_real = ∏ i, (b i - a i) :=
by simp only [volume_Icc_pi, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ioo {a b : ι → ℝ} :
  volume (pi univ (λ i, Ioo (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ioo_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ioo_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ioo (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ioo, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ioc {a b : ι → ℝ} :
  volume (pi univ (λ i, Ioc (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ioc_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ioc_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ioc (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ioc, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ico {a b : ι → ℝ} :
  volume (pi univ (λ i, Ico (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ico_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ico_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ico (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ico, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

@[simp] lemma volume_pi_ball (a : ι → ℝ) {r : ℝ} (hr : 0 < r) :
  volume (metric.ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
begin
  simp only [volume_pi_ball a hr, volume_ball, finset.prod_const],
  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr.le) _).symm
end

@[simp] lemma volume_pi_closed_ball (a : ι → ℝ) {r : ℝ} (hr : 0 ≤ r) :
  volume (metric.closed_ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
begin
  simp only [volume_pi_closed_ball a hr, volume_closed_ball, finset.prod_const],
  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr) _).symm
end

lemma volume_pi_le_prod_diam (s : set (ι → ℝ)) :
  volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :=
calc volume s ≤ volume (pi univ (λ i, closure (function.eval i '' s))) :
  volume.mono $ subset.trans (subset_pi_eval_image univ s) $ pi_mono $ λ i hi, subset_closure
          ... = ∏ i, volume (closure $ function.eval i '' s) :
  volume_pi_pi _
          ... ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :
  finset.prod_le_prod' $ λ i hi, (volume_le_diam _).trans_eq (emetric.diam_closure _)

lemma volume_pi_le_diam_pow (s : set (ι → ℝ)) :
  volume s ≤ emetric.diam s ^ fintype.card ι :=
calc volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) : volume_pi_le_prod_diam s
          ... ≤ ∏ i : ι, (1 : ℝ≥0) * emetric.diam s                      :
  finset.prod_le_prod' $ λ i hi, (lipschitz_with.eval i).ediam_image_le s
          ... = emetric.diam s ^ fintype.card ι              :
  by simp only [ennreal.coe_one, one_mul, finset.prod_const, fintype.card]

/-!
### Images of the Lebesgue measure under multiplication in ℝ
-/

lemma smul_map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
  ennreal.of_real (|a|) • measure.map ((*) a) volume = volume :=
begin
  refine (real.measure_ext_Ioo_rat $ λ p q, _).symm,
  cases lt_or_gt_of_ne h with h h,
  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt $ neg_pos.2 h),
      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, neg_sub_neg,
      neg_mul, preimage_const_mul_Ioo_of_neg _ _ h, abs_of_neg h, mul_sub, smul_eq_mul,
      mul_div_cancel' _ (ne_of_lt h)] },
  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt h),
      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, preimage_const_mul_Ioo _ _ h,
      abs_of_pos h, mul_sub, mul_div_cancel' _ (ne_of_gt h), smul_eq_mul] }
end

lemma map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
  measure.map ((*) a) volume = ennreal.of_real (|a⁻¹|) • volume :=
by conv_rhs { rw [← real.smul_map_volume_mul_left h, smul_smul,
  ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel h, abs_one, ennreal.of_real_one,
  one_smul] }

@[simp] lemma volume_preimage_mul_left {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
  volume (((*) a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
calc volume (((*) a) ⁻¹' s) = measure.map ((*) a) volume s :
  ((homeomorph.mul_left₀ a h).to_measurable_equiv.map_apply s).symm
... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_left h, refl }

lemma smul_map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
  ennreal.of_real (|a|) • measure.map (* a) volume = volume :=
by simpa only [mul_comm] using real.smul_map_volume_mul_left h

lemma map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
  measure.map (* a) volume = ennreal.of_real (|a⁻¹|) • volume :=
by simpa only [mul_comm] using real.map_volume_mul_left h

@[simp] lemma volume_preimage_mul_right {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
  volume ((* a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
calc volume ((* a) ⁻¹' s) = measure.map (* a) volume s :
  ((homeomorph.mul_right₀ a h).to_measurable_equiv.map_apply s).symm
... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_right h, refl }

/-!
### Images of the Lebesgue measure under translation/linear maps in ℝⁿ
-/

open matrix

/-- A diagonal matrix rescales Lebesgue according to its determinant. This is a special case of
`real.map_matrix_volume_pi_eq_smul_volume_pi`, that one should use instead (and whose proof
uses this particular case). -/
lemma smul_map_diagonal_volume_pi [decidable_eq ι] {D : ι → ℝ} (h : det (diagonal D) ≠ 0) :
  ennreal.of_real (abs (det (diagonal D))) • measure.map ((diagonal D).to_lin') volume = volume :=
begin
  refine (measure.pi_eq (λ s hs, _)).symm,
  simp only [det_diagonal, measure.coe_smul, algebra.id.smul_eq_mul, pi.smul_apply],
  rw [measure.map_apply _ (measurable_set.univ_pi hs)],
  swap, { exact continuous.measurable (linear_map.continuous_on_pi _) },
  have : (matrix.to_lin' (diagonal D)) ⁻¹' (set.pi set.univ (λ (i : ι), s i))
    = set.pi set.univ (λ (i : ι), ((*) (D i)) ⁻¹' (s i)),
  { ext f,
    simp only [linear_map.coe_proj, algebra.id.smul_eq_mul, linear_map.smul_apply, mem_univ_pi,
      mem_preimage, linear_map.pi_apply, diagonal_to_lin'] },
  have B : ∀ i, of_real (abs (D i)) * volume (has_mul.mul (D i) ⁻¹' s i) = volume (s i),
  { assume i,
    have A : D i ≠ 0,
    { simp only [det_diagonal, ne.def] at h,
      exact finset.prod_ne_zero_iff.1 h i (finset.mem_univ i) },
    rw [volume_preimage_mul_left A, ← mul_assoc, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul,
      mul_inv_cancel A, abs_one, ennreal.of_real_one, one_mul] },
  rw [this, volume_pi_pi, finset.abs_prod,
    ennreal.of_real_prod_of_nonneg (λ i hi, abs_nonneg (D i)), ← finset.prod_mul_distrib],
  simp only [B]
end

/-- A transvection preserves Lebesgue measure. -/
lemma volume_preserving_transvection_struct [decidable_eq ι] (t : transvection_struct ι ℝ) :
  measure_preserving (t.to_matrix.to_lin') :=
begin
  /- We separate the coordinate along which there is a shearing from the other ones, and apply
  Fubini. Along this coordinate (and when all the other coordinates are fixed), it acts like a
  translation, and therefore preserves Lebesgue. -/
  let p : ι → Prop := λ i, i ≠ t.i,
  let α : Type* := {x // p x},
  let β : Type* := {x // ¬ (p x)},
  let g : (α → ℝ) → (β → ℝ) → (β → ℝ) := λ a b, (λ x, t.c * a ⟨t.j, t.hij.symm⟩) + b,
  let F : (α → ℝ) × (β → ℝ) → (α → ℝ) × (β → ℝ) :=
    λ p, (id p.1, g p.1 p.2),
  let e : (ι → ℝ) ≃ᵐ (α → ℝ) × (β → ℝ) := measurable_equiv.pi_equiv_pi_subtype_prod (λ i : ι, ℝ) p,
  have : (t.to_matrix.to_lin' : (ι → ℝ) → (ι → ℝ)) = e.symm ∘ F ∘ e,
  { cases t,
    ext f k,
    simp only [linear_equiv.map_smul, dite_eq_ite, linear_map.id_coe, p, ite_not,
      algebra.id.smul_eq_mul, one_mul, dot_product, std_basis_matrix,
      measurable_equiv.pi_equiv_pi_subtype_prod_symm_apply, id.def, transvection,
      pi.add_apply, zero_mul, linear_map.smul_apply, function.comp_app,
      measurable_equiv.pi_equiv_pi_subtype_prod_apply, matrix.transvection_struct.to_matrix_mk,
      matrix.mul_vec, linear_equiv.map_add, ite_mul, e, matrix.to_lin'_apply,
      pi.smul_apply, subtype.coe_mk, g, linear_map.add_apply, finset.sum_congr, matrix.to_lin'_one],
    by_cases h : t_i = k,
    { simp only [h, true_and, finset.mem_univ, if_true, eq_self_iff_true, finset.sum_ite_eq,
        one_apply, boole_mul, add_comm], },
    { simp only [h, ne.symm h, add_zero, if_false, finset.sum_const_zero, false_and, mul_zero] } },
  rw this,
  have A : measure_preserving e,
  { convert volume_preserving_pi_equiv_pi_subtype_prod (λ i : ι, ℝ) p },
  have B : measure_preserving F,
  { have g_meas : measurable (function.uncurry g),
    { have : measurable (λ (c : (α → ℝ)), c ⟨t.j, t.hij.symm⟩) :=
        measurable_pi_apply ⟨t.j, t.hij.symm⟩,
      refine (measurable_pi_lambda _ (λ i, measurable.const_mul _ _)).add measurable_snd,
      exact this.comp measurable_fst },
    exact (measure_preserving.id _).skew_product g_meas
      (eventually_of_forall (λ a, map_add_left_eq_self _ _)) },
  exact ((A.symm e).comp B).comp A,
end

/-- Any invertible matrix rescales Lebesgue measure through the absolute value of its
determinant. -/
lemma map_matrix_volume_pi_eq_smul_volume_pi [decidable_eq ι] {M : matrix ι ι ℝ} (hM : det M ≠ 0) :
  measure.map M.to_lin' volume = ennreal.of_real (abs (det M)⁻¹) • volume :=
begin
  -- This follows from the cases we have already proved, of diagonal matrices and transvections,
  -- as these matrices generate all invertible matrices.
  apply diagonal_transvection_induction_of_det_ne_zero _ M hM (λ D hD, _) (λ t, _)
    (λ A B hA hB IHA IHB, _),
  { conv_rhs { rw [← smul_map_diagonal_volume_pi hD] },
    rw [smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel hD, abs_one,
      ennreal.of_real_one, one_smul] },
  { simp only [matrix.transvection_struct.det, ennreal.of_real_one,
      (volume_preserving_transvection_struct _).map_eq, one_smul, _root_.inv_one, abs_one] },
  { rw [to_lin'_mul, det_mul, linear_map.coe_comp, ← measure.map_map, IHB, measure.map_smul,
      IHA, smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, mul_comm, mul_inv],
    { apply continuous.measurable,
      apply linear_map.continuous_on_pi },
    { apply continuous.measurable,
      apply linear_map.continuous_on_pi } }
end

/-- Any invertible linear map rescales Lebesgue measure through the absolute value of its
determinant. -/
lemma map_linear_map_volume_pi_eq_smul_volume_pi {f : (ι → ℝ) →ₗ[ℝ] (ι → ℝ)} (hf : f.det ≠ 0) :
  measure.map f volume = ennreal.of_real (abs (f.det)⁻¹) • volume :=
begin
  -- this is deduced from the matrix case
  classical,
  let M := f.to_matrix',
  have A : f.det = det M, by simp only [linear_map.det_to_matrix'],
  have B : f = M.to_lin', by simp only [to_lin'_to_matrix'],
  rw [A, B],
  apply map_matrix_volume_pi_eq_smul_volume_pi,
  rwa A at hf
end

end real

section region_between

variable {α : Type*}

/-- The region between two real-valued functions on an arbitrary set. -/
def region_between (f g : α → ℝ) (s : set α) : set (α × ℝ) :=
{p : α × ℝ | p.1 ∈ s ∧ p.2 ∈ Ioo (f p.1) (g p.1)}

lemma region_between_subset (f g : α → ℝ) (s : set α) : region_between f g s ⊆ s ×ˢ univ :=
by simpa only [prod_univ, region_between, set.preimage, set_of_subset_set_of] using λ a, and.left

variables [measurable_space α] {μ : measure α} {f g : α → ℝ} {s : set α}

/-- The region between two measurable functions on a measurable set is measurable. -/
lemma measurable_set_region_between
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  measurable_set (region_between f g s) :=
begin
  dsimp only [region_between, Ioo, mem_set_of_eq, set_of_and],
  refine measurable_set.inter _ ((measurable_set_lt (hf.comp measurable_fst) measurable_snd).inter
    (measurable_set_lt measurable_snd (hg.comp measurable_fst))),
  exact measurable_fst hs
end

/-- The region between two measurable functions on a measurable set is measurable;
a version for the region together with the graph of the upper function. -/
lemma measurable_set_region_between_oc
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  measurable_set {p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Ioc (f p.fst) (g p.fst)} :=
begin
  dsimp only [region_between, Ioc, mem_set_of_eq, set_of_and],
  refine measurable_set.inter _ ((measurable_set_lt (hf.comp measurable_fst) measurable_snd).inter
    (measurable_set_le measurable_snd (hg.comp measurable_fst))),
  exact measurable_fst hs,
end

/-- The region between two measurable functions on a measurable set is measurable;
a version for the region together with the graph of the lower function. -/
lemma measurable_set_region_between_co
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  measurable_set {p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Ico (f p.fst) (g p.fst)} :=
begin
  dsimp only [region_between, Ico, mem_set_of_eq, set_of_and],
  refine measurable_set.inter _ ((measurable_set_le (hf.comp measurable_fst) measurable_snd).inter
    (measurable_set_lt measurable_snd (hg.comp measurable_fst))),
  exact measurable_fst hs,
end

/-- The region between two measurable functions on a measurable set is measurable;
a version for the region together with the graphs of both functions. -/
lemma measurable_set_region_between_cc
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  measurable_set {p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Icc (f p.fst) (g p.fst)} :=
begin
  dsimp only [region_between, Icc, mem_set_of_eq, set_of_and],
  refine measurable_set.inter _ ((measurable_set_le (hf.comp measurable_fst) measurable_snd).inter
    (measurable_set_le measurable_snd (hg.comp measurable_fst))),
  exact measurable_fst hs,
end

/-- The graph of a measurable function is a measurable set. -/
lemma measurable_set_graph (hf : measurable f) :
  measurable_set {p : α × ℝ | p.snd = f p.fst} :=
by simpa using measurable_set_region_between_cc hf hf measurable_set.univ

theorem volume_region_between_eq_lintegral'
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
begin
  classical,
  rw measure.prod_apply,
  { have h : (λ x, volume {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)})
            = s.indicator (λ x, ennreal.of_real (g x - f x)),
    { funext x,
      rw indicator_apply,
      split_ifs,
      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = Ioo (f x) (g x) := by simp [h, Ioo],
        simp only [hx, real.volume_Ioo, sub_zero] },
      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = ∅ := by simp [h],
        simp only [hx, measure_empty] } },
    dsimp only [region_between, preimage_set_of_eq],
    rw [h, lintegral_indicator];
    simp only [hs, pi.sub_apply] },
  { exact measurable_set_region_between hf hg hs },
end

/-- The volume of the region between two almost everywhere measurable functions on a measurable set
    can be represented as a Lebesgue integral. -/
theorem volume_region_between_eq_lintegral [sigma_finite μ]
  (hf : ae_measurable f (μ.restrict s)) (hg : ae_measurable g (μ.restrict s))
  (hs : measurable_set s) :
  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
begin
  have h₁ : (λ y, ennreal.of_real ((g - f) y))
          =ᵐ[μ.restrict s]
              λ y, ennreal.of_real ((ae_measurable.mk g hg - ae_measurable.mk f hf) y) :=
    (hg.ae_eq_mk.sub hf.ae_eq_mk).fun_comp _,
  have h₂ : (μ.restrict s).prod volume (region_between f g s) =
    (μ.restrict s).prod volume (region_between (ae_measurable.mk f hf) (ae_measurable.mk g hg) s),
  { apply measure_congr,
    apply eventually_eq.rfl.inter,
    exact ((quasi_measure_preserving_fst.ae_eq_comp hf.ae_eq_mk).comp₂ _ eventually_eq.rfl).inter
      (eventually_eq.rfl.comp₂ _ $ quasi_measure_preserving_fst.ae_eq_comp hg.ae_eq_mk) },
  rw [lintegral_congr_ae h₁,
      ← volume_region_between_eq_lintegral' hf.measurable_mk hg.measurable_mk hs],
  convert h₂ using 1,
  { rw measure.restrict_prod_eq_prod_univ,
    exact (measure.restrict_eq_self _ (region_between_subset f g s)).symm, },
  { rw measure.restrict_prod_eq_prod_univ,
    exact (measure.restrict_eq_self _
      (region_between_subset (ae_measurable.mk f hf) (ae_measurable.mk g hg) s)).symm },
end

theorem volume_region_between_eq_integral' [sigma_finite μ]
  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
  (hs : measurable_set s) (hfg : f ≤ᵐ[μ.restrict s] g ) :
  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
begin
  have h : g - f =ᵐ[μ.restrict s] (λ x, real.to_nnreal (g x - f x)),
    from hfg.mono (λ x hx, (real.coe_to_nnreal _ $ sub_nonneg.2 hx).symm),
  rw [volume_region_between_eq_lintegral f_int.ae_measurable g_int.ae_measurable hs,
    integral_congr_ae h, lintegral_congr_ae,
    lintegral_coe_eq_integral _ ((integrable_congr h).mp (g_int.sub f_int))],
  simpa only,
end

/-- If two functions are integrable on a measurable set, and one function is less than
    or equal to the other on that set, then the volume of the region
    between the two functions can be represented as an integral. -/
theorem volume_region_between_eq_integral [sigma_finite μ]
  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
  (hs : measurable_set s) (hfg : ∀ x ∈ s, f x ≤ g x) :
  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
volume_region_between_eq_integral' f_int g_int hs
  ((ae_restrict_iff' hs).mpr (eventually_of_forall hfg))

end region_between

/-- Consider a real set `s`. If a property is true almost everywhere in `s ∩ (a, b)` for
all `a, b ∈ s`, then it is true almost everywhere in `s`. Formulated with `μ.restrict`.
See also `ae_of_mem_of_ae_of_mem_inter_Ioo`. -/
lemma ae_restrict_of_ae_restrict_inter_Ioo
  {μ : measure ℝ} [has_no_atoms μ] {s : set ℝ} {p : ℝ → Prop}
  (h : ∀ a b, a ∈ s → b ∈ s → a < b → ∀ᵐ x ∂(μ.restrict (s ∩ Ioo a b)), p x) :
  ∀ᵐ x ∂(μ.restrict s), p x :=
begin
  /- By second-countability, we cover `s` by countably many intervals `(a, b)` (except maybe for
  two endpoints, which don't matter since `μ` does not have any atom). -/
  let T : s × s → set ℝ := λ p, Ioo p.1 p.2,
  let u := ⋃ (i : ↥s × ↥s), T i,
  have hfinite : (s \ u).finite := s.finite_diff_Union_Ioo',
  obtain ⟨A, A_count, hA⟩ :
    ∃ (A : set (↥s × ↥s)), A.countable ∧ (⋃ (i ∈ A), T i) = ⋃ (i : ↥s × ↥s), T i :=
    is_open_Union_countable _ (λ p, is_open_Ioo),
  have : s ⊆ (s \ u) ∪ (⋃ p ∈ A, s ∩ T p),
  { assume x hx,
    by_cases h'x : x ∈ ⋃ (i : ↥s × ↥s), T i,
    { rw ← hA at h'x,
      obtain ⟨p, pA, xp⟩ : ∃ (p : ↥s × ↥s), p ∈ A ∧ x ∈ T p,
        by simpa only [mem_Union, exists_prop, set_coe.exists, exists_and_distrib_right] using h'x,
      right,
      exact mem_bUnion pA ⟨hx, xp⟩ },
    { exact or.inl ⟨hx, h'x⟩ } },
  apply ae_restrict_of_ae_restrict_of_subset this,
  rw [ae_restrict_union_iff, ae_restrict_bUnion_iff _ A_count],
  split,
  { have : μ.restrict (s \ u) = 0, by simp only [restrict_eq_zero, hfinite.measure_zero],
    simp only [this, ae_zero] },
  { rintros ⟨⟨a, as⟩, ⟨b, bs⟩⟩ -,
    dsimp [T],
    rcases le_or_lt b a with hba|hab,
    { simp only [Ioo_eq_empty_of_le hba, inter_empty, restrict_empty, ae_zero] },
    { exact h a b as bs hab } }
end

/-- Consider a real set `s`. If a property is true almost everywhere in `s ∩ (a, b)` for
all `a, b ∈ s`, then it is true almost everywhere in `s`. Formulated with bare membership.
See also `ae_restrict_of_ae_restrict_inter_Ioo`. -/
lemma ae_of_mem_of_ae_of_mem_inter_Ioo
  {μ : measure ℝ} [has_no_atoms μ] {s : set ℝ} {p : ℝ → Prop}
  (h : ∀ a b, a ∈ s → b ∈ s → a < b → ∀ᵐ x ∂μ, x ∈ s ∩ Ioo a b → p x) :
  ∀ᵐ x ∂μ, x ∈ s → p x :=
begin
  /- By second-countability, we cover `s` by countably many intervals `(a, b)` (except maybe for
  two endpoints, which don't matter since `μ` does not have any atom). -/
  let T : s × s → set ℝ := λ p, Ioo p.1 p.2,
  let u := ⋃ (i : ↥s × ↥s), T i,
  have hfinite : (s \ u).finite := s.finite_diff_Union_Ioo',
  obtain ⟨A, A_count, hA⟩ :
    ∃ (A : set (↥s × ↥s)), A.countable ∧ (⋃ (i ∈ A), T i) = ⋃ (i : ↥s × ↥s), T i :=
    is_open_Union_countable _ (λ p, is_open_Ioo),
  have M : ∀ᵐ x ∂μ, x ∉ s \ u, from hfinite.countable.ae_not_mem _,
  have M' : ∀ᵐ x ∂μ, ∀ (i : ↥s × ↥s) (H : i ∈ A), x ∈ s ∩ T i → p x,
  { rw ae_ball_iff A_count,
    rintros ⟨⟨a, as⟩, ⟨b, bs⟩⟩ -,
    change ∀ᵐ (x : ℝ) ∂μ, x ∈ s ∩ Ioo a b → p x,
    rcases le_or_lt b a with hba|hab,
    { simp only [Ioo_eq_empty_of_le hba, inter_empty, is_empty.forall_iff, eventually_true,
        mem_empty_iff_false], },
    { exact h a b as bs hab } },
  filter_upwards [M, M'] with x hx h'x,
  assume xs,
  by_cases Hx : x ∈ ⋃ (i : ↥s × ↥s), T i,
  { rw ← hA at Hx,
    obtain ⟨p, pA, xp⟩ : ∃ (p : ↥s × ↥s), p ∈ A ∧ x ∈ T p,
      by simpa only [mem_Union, exists_prop, set_coe.exists, exists_and_distrib_right] using Hx,
    apply h'x p pA ⟨xs, xp⟩ },
  { exact false.elim (hx ⟨xs, Hx⟩) }
end

section summable_norm_Icc

open continuous_map

/- The following lemma is a minor variation on `integrable_of_summable_norm_restrict` in
`measure_theory.integral.set_integral`, but it is placed here because it needs to know that
`Icc a b` has volume `b - a`. -/

/-- If the sequence with `n`-th term the the sup norm of `λ x, f (x + n)` on the interval `Icc 0 1`,
for `n ∈ ℤ`, is summable, then `f` is integrable on `ℝ`. -/
lemma real.integrable_of_summable_norm_Icc {E : Type*} [normed_add_comm_group E] {f : C(ℝ, E)}
  (hf : summable (λ n : ℤ, ‖(f.comp $ continuous_map.add_right n).restrict (Icc 0 1)‖)) :
  integrable f :=
begin
  refine integrable_of_summable_norm_restrict (summable_of_nonneg_of_le
    (λ n : ℤ, mul_nonneg (norm_nonneg (f.restrict (⟨Icc n (n + 1), is_compact_Icc⟩ : compacts ℝ)))
    ennreal.to_real_nonneg) (λ n, _) hf) (Union_Icc_int_cast ℝ),
  simp only [compacts.coe_mk, real.volume_Icc, add_sub_cancel', ennreal.to_real_of_real zero_le_one,
    mul_one, norm_le _ (norm_nonneg _)],
  intro x,
  have := ((f.comp $ continuous_map.add_right n).restrict (Icc 0 1)).norm_coe_le_norm
    ⟨x - n, ⟨sub_nonneg.mpr x.2.1, sub_le_iff_le_add'.mpr x.2.2⟩⟩,
  simpa only [continuous_map.restrict_apply, comp_apply, coe_add_right, subtype.coe_mk,
    sub_add_cancel]
    using this,
end

end summable_norm_Icc


/-
Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
-/
import model_theory.basic
/-!
# Language Maps
Maps between first-order languages in the style of the
[Flypitch project](https://flypitch.github.io/), as well as several important maps between
structures.

## Main Definitions
* A `first_order.language.Lhom`, denoted `L →ᴸ L'`, is a map between languages, sending the symbols
  of one to symbols of the same kind and arity in the other.
* A `first_order.language.Lequiv`, denoted `L ≃ᴸ L'`, is an invertible language homomorphism.
* `first_order.language.with_constants` is defined so that if `M` is an `L.Structure` and
  `A : set M`, `L.with_constants A`, denoted `L[[A]]`, is a language which adds constant symbols for
  elements of `A` to `L`.

## References
For the Flypitch project:
- [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
[flypitch_cpp]
- [J. Han, F. van Doorn, *A formalization of forcing and the unprovability of
the continuum hypothesis*][flypitch_itp]

-/

universes u v u' v' w

namespace first_order
namespace language
open Structure

variables (L : language.{u v}) (L' : language.{u' v'}) {M : Type w} [L.Structure M]

/-- A language homomorphism maps the symbols of one language to symbols of another. -/
structure Lhom :=
(on_function : ∀{n}, L.functions n → L'.functions n)
(on_relation : ∀{n}, L.relations n → L'.relations n)

infix ` →ᴸ `:10 := Lhom -- \^L

variables {L L'}

namespace Lhom

/-- Defines a map between languages defined with `language.mk₂`. -/
protected def mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  (φ₀ : c → L'.constants) (φ₁ : f₁ → L'.functions 1) (φ₂ : f₂ → L'.functions 2)
  (φ₁' : r₁ → L'.relations 1) (φ₂' : r₂ → L'.relations 2) :
  language.mk₂ c f₁ f₂ r₁ r₂ →ᴸ L' :=
⟨λ n, nat.cases_on n φ₀ (λ n, nat.cases_on n φ₁ (λ n, nat.cases_on n φ₂ (λ _, pempty.elim))),
  λ n, nat.cases_on n pempty.elim
    (λ n, nat.cases_on n φ₁' (λ n, nat.cases_on n φ₂' (λ _, pempty.elim)))⟩

variables (ϕ : L →ᴸ L')

/-- The identity language homomorphism. -/
@[simps] protected def id (L : language) : L →ᴸ L :=
⟨λn, id, λ n, id⟩

instance : inhabited (L →ᴸ L) := ⟨Lhom.id L⟩

/-- The inclusion of the left factor into the sum of two languages. -/
@[simps] protected def sum_inl : L →ᴸ L.sum L' :=
⟨λn, sum.inl, λ n, sum.inl⟩

/-- The inclusion of the right factor into the sum of two languages. -/
@[simps] protected def sum_inr : L' →ᴸ L.sum L' :=
⟨λn, sum.inr, λ n, sum.inr⟩

variables (L L')

/-- The inclusion of an empty language into any other language. -/
@[simps] protected def of_is_empty [L.is_algebraic] [L.is_relational] : L →ᴸ L' :=
⟨λ n, (is_relational.empty_functions n).elim, λ n, (is_algebraic.empty_relations n).elim⟩

variables {L L'} {L'' : language}

@[ext] protected lemma funext {F G : L →ᴸ L'} (h_fun : F.on_function = G.on_function )
  (h_rel : F.on_relation = G.on_relation ) : F = G :=
by {cases F with Ff Fr, cases G with Gf Gr, simp only *, exact and.intro h_fun h_rel}

instance [L.is_algebraic] [L.is_relational] : unique (L →ᴸ L') :=
⟨⟨Lhom.of_is_empty L L'⟩, λ _, Lhom.funext (subsingleton.elim _ _) (subsingleton.elim _ _)⟩

lemma mk₂_funext {c f₁ f₂ : Type u} {r₁ r₂ : Type v} {F G : language.mk₂ c f₁ f₂ r₁ r₂ →ᴸ L'}
  (h0 : ∀ (c : (language.mk₂ c f₁ f₂ r₁ r₂).constants), F.on_function c = G.on_function c)
  (h1 : ∀ (f : (language.mk₂ c f₁ f₂ r₁ r₂).functions 1), F.on_function f = G.on_function f)
  (h2 : ∀ (f : (language.mk₂ c f₁ f₂ r₁ r₂).functions 2), F.on_function f = G.on_function f)
  (h1' : ∀ (r : (language.mk₂ c f₁ f₂ r₁ r₂).relations 1), F.on_relation r = G.on_relation r)
  (h2' : ∀ (r : (language.mk₂ c f₁ f₂ r₁ r₂).relations 2), F.on_relation r = G.on_relation r) :
  F = G :=
Lhom.funext (funext (λ n, nat.cases_on n (funext h0) (λ n, nat.cases_on n (funext h1)
      (λ n, nat.cases_on n (funext h2) (λ n, funext (λ f, pempty.elim f))))))
      (funext (λ n, nat.cases_on n (funext (λ r, pempty.elim r)) (λ n, nat.cases_on n (funext h1')
      (λ n, nat.cases_on n (funext h2') (λ n, funext (λ r, pempty.elim r))))))

/-- The composition of two language homomorphisms. -/
@[simps] def comp (g : L' →ᴸ L'') (f : L →ᴸ L') : L →ᴸ L'' :=
⟨λ n F, g.1 (f.1 F), λ _ R, g.2 (f.2 R)⟩

local infix ` ∘ `:60 := Lhom.comp

@[simp] lemma id_comp (F : L →ᴸ L') : (Lhom.id L') ∘ F = F :=
by {cases F, refl}

@[simp] lemma comp_id (F : L →ᴸ L') : F ∘ (Lhom.id L) = F :=
by {cases F, refl}

lemma comp_assoc {L3 : language} (F: L'' →ᴸ L3) (G : L' →ᴸ L'') (H : L →ᴸ L') :
  (F ∘ G) ∘ H = F ∘ (G ∘ H) :=
rfl

section sum_elim

variables (ψ : L'' →ᴸ L')

/-- A language map defined on two factors of a sum. -/
@[simps] protected def sum_elim : L.sum L'' →ᴸ L' :=
{ on_function := λ n, sum.elim (λ f, ϕ.on_function f) (λ f, ψ.on_function f),
  on_relation := λ n, sum.elim (λ f, ϕ.on_relation f) (λ f, ψ.on_relation f) }

lemma sum_elim_comp_inl (ψ : L'' →ᴸ L') :
  (ϕ.sum_elim ψ) ∘ Lhom.sum_inl = ϕ :=
Lhom.funext (funext (λ _, rfl)) (funext (λ _, rfl))

lemma sum_elim_comp_inr (ψ : L'' →ᴸ L') :
  (ϕ.sum_elim ψ) ∘ Lhom.sum_inr = ψ :=
Lhom.funext (funext (λ _, rfl)) (funext (λ _, rfl))

theorem sum_elim_inl_inr :
  (Lhom.sum_inl).sum_elim (Lhom.sum_inr) = Lhom.id (L.sum L') :=
Lhom.funext (funext (λ _, sum.elim_inl_inr)) (funext (λ _, sum.elim_inl_inr))

theorem comp_sum_elim {L3 : language} (θ : L' →ᴸ L3) :
  θ ∘ (ϕ.sum_elim ψ) = (θ ∘ ϕ).sum_elim (θ ∘ ψ) :=
Lhom.funext (funext (λ n, sum.comp_elim _ _ _)) (funext (λ n, sum.comp_elim _ _ _))

end sum_elim

section sum_map

variables {L₁ L₂ : language} (ψ : L₁ →ᴸ L₂)

/-- The map between two sum-languages induced by maps on the two factors. -/
@[simps] def sum_map : L.sum L₁ →ᴸ L'.sum L₂ :=
{ on_function := λ n, sum.map (λ f, ϕ.on_function f) (λ f, ψ.on_function f),
  on_relation := λ n, sum.map (λ f, ϕ.on_relation f) (λ f, ψ.on_relation f) }

@[simp] lemma sum_map_comp_inl :
  (ϕ.sum_map ψ) ∘ Lhom.sum_inl = Lhom.sum_inl ∘ ϕ :=
Lhom.funext (funext (λ _, rfl)) (funext (λ _, rfl))

@[simp] lemma sum_map_comp_inr :
  (ϕ.sum_map ψ) ∘ Lhom.sum_inr = Lhom.sum_inr ∘ ψ :=
Lhom.funext (funext (λ _, rfl)) (funext (λ _, rfl))

end sum_map

/-- A language homomorphism is injective when all the maps between symbol types are. -/
protected structure injective : Prop :=
(on_function {n} : function.injective (on_function ϕ : L.functions n → L'.functions n))
(on_relation {n} : function.injective (on_relation ϕ : L.relations n → L'.relations n))

/-- A language homomorphism is an expansion on a structure if it commutes with the interpretation of
all symbols on that structure. -/
class is_expansion_on (M : Type*) [L.Structure M] [L'.Structure M] : Prop :=
(map_on_function : ∀ {n} (f : L.functions n) (x : fin n → M),
  fun_map (ϕ.on_function f) x = fun_map f x)
(map_on_relation : ∀ {n} (R : L.relations n) (x : fin n → M),
  rel_map (ϕ.on_relation R) x = rel_map R x)

attribute [simp] is_expansion_on.map_on_function is_expansion_on.map_on_relation

instance id_is_expansion_on (M : Type*) [L.Structure M] : is_expansion_on (Lhom.id L) M :=
⟨λ _ _ _, rfl, λ _ _ _, rfl⟩

instance of_is_empty_is_expansion_on (M : Type*) [L.Structure M] [L'.Structure M]
  [L.is_algebraic] [L.is_relational] :
  is_expansion_on (Lhom.of_is_empty L L') M :=
⟨λ n, (is_relational.empty_functions n).elim, λ n, (is_algebraic.empty_relations n).elim⟩

instance sum_elim_is_expansion_on {L'' : language} (ψ : L'' →ᴸ L') (M : Type*)
  [L.Structure M] [L'.Structure M] [L''.Structure M]
  [ϕ.is_expansion_on M] [ψ.is_expansion_on M] :
  (ϕ.sum_elim ψ).is_expansion_on M :=
⟨λ _ f _, sum.cases_on f (by simp) (by simp), λ _ R _, sum.cases_on R (by simp) (by simp)⟩

instance sum_map_is_expansion_on {L₁ L₂ : language} (ψ : L₁ →ᴸ L₂) (M : Type*)
  [L.Structure M] [L'.Structure M] [L₁.Structure M] [L₂.Structure M]
  [ϕ.is_expansion_on M] [ψ.is_expansion_on M] :
  (ϕ.sum_map ψ).is_expansion_on M :=
⟨λ _ f _, sum.cases_on f (by simp) (by simp), λ _ R _, sum.cases_on R (by simp) (by simp)⟩

end Lhom

/-- A language equivalence maps the symbols of one language to symbols of another bijectively. -/
structure Lequiv (L L' : language) :=
(to_Lhom : L →ᴸ L')
(inv_Lhom : L' →ᴸ L)
(left_inv : inv_Lhom.comp to_Lhom = Lhom.id L)
(right_inv : to_Lhom.comp inv_Lhom = Lhom.id L')

infix ` ≃ᴸ `:10 := Lequiv -- \^L

namespace Lequiv

variable (L)

/-- The identity equivalence from a first-order language to itself. -/
@[simps] protected def refl : L ≃ᴸ L :=
⟨Lhom.id L, Lhom.id L, Lhom.id_comp _, Lhom.id_comp _⟩

variable {L}

instance : inhabited (L ≃ᴸ L) := ⟨Lequiv.refl L⟩

variables {L'' : language} (e' : L' ≃ᴸ L'') (e : L ≃ᴸ L')

/-- The inverse of an equivalence of first-order languages. -/
@[simps] protected def symm : L' ≃ᴸ L :=
⟨e.inv_Lhom, e.to_Lhom, e.right_inv, e.left_inv⟩

/-- The composition of equivalences of first-order languages. -/
@[simps, trans] protected def trans (e : L ≃ᴸ L') (e' : L' ≃ᴸ L'') : L ≃ᴸ L'' :=
⟨e'.to_Lhom.comp e.to_Lhom, e.inv_Lhom.comp e'.inv_Lhom,
  by rw [Lhom.comp_assoc, ← Lhom.comp_assoc e'.inv_Lhom, e'.left_inv, Lhom.id_comp, e.left_inv],
  by rw [Lhom.comp_assoc, ← Lhom.comp_assoc e.to_Lhom, e.right_inv, Lhom.id_comp, e'.right_inv]⟩

end Lequiv

section constants_on
variables (α : Type u')

/-- The function symbols of a language with constants indexed by a type. -/
def constants_on_functions : ℕ → Type u'
| 0 := α
| _ := pempty

instance [h : inhabited α] : inhabited (constants_on_functions α 0) := h

/-- A language with constants indexed by a type. -/
def constants_on : language.{u' 0} := ⟨constants_on_functions α, λ _, pempty⟩

variables {α}

@[simp] lemma constants_on_constants : (constants_on α).constants = α := rfl

instance is_algebraic_constants_on : is_algebraic (constants_on α) :=
language.is_algebraic_of_empty_relations

instance is_relational_constants_on [ie : is_empty α] : is_relational (constants_on α) :=
⟨λ n, nat.cases_on n ie (λ _, pempty.is_empty)⟩

/-- Gives a `constants_on α` structure to a type by assigning each constant a value. -/
def constants_on.Structure (f : α → M) : (constants_on α).Structure M :=
{ fun_map := λ n, nat.cases_on n (λ a _, f a) (λ _, pempty.elim),
  rel_map := λ _, pempty.elim }

variables {β : Type v'}

/-- A map between index types induces a map between constant languages. -/
def Lhom.constants_on_map (f : α → β) : (constants_on α) →ᴸ (constants_on β) :=
⟨λ n, nat.cases_on n f (λ _, pempty.elim), λ n, pempty.elim⟩

lemma constants_on_map_is_expansion_on {f : α → β} {fα : α → M} {fβ : β → M}
  (h : fβ ∘ f = fα) :
  @Lhom.is_expansion_on _ _ (Lhom.constants_on_map f) M
    (constants_on.Structure fα) (constants_on.Structure fβ) :=
begin
  letI := constants_on.Structure fα,
  letI := constants_on.Structure fβ,
  exact ⟨λ n, nat.cases_on n (λ F x, (congr_fun h F : _)) (λ n F, pempty.elim F),
    λ _ R, pempty.elim R⟩,
end

end constants_on

section with_constants

variable (L)

section
variables (α : Type w)

/-- Extends a language with a constant for each element of a parameter set in `M`. -/
def with_constants : language.{(max u w) v} := L.sum (constants_on α)

localized "notation L`[[`:95 α`]]`:90 := L.with_constants α" in first_order

/-- The language map adding constants.  -/
@[simps] def Lhom_with_constants : L →ᴸ L[[α]] := Lhom.sum_inl

variables {α}

/-- The constant symbol indexed by a particular element. -/
protected def con (a : α) : L[[α]].constants := sum.inr a

variables {L} (α)

/-- Adds constants to a language map.  -/
def Lhom.add_constants {L' : language} (φ : L →ᴸ L') :
  L[[α]] →ᴸ L'[[α]] := φ.sum_map (Lhom.id _)

instance params_Structure (A : set α) : (constants_on A).Structure α := constants_on.Structure coe

variables (L) (α)

/-- The language map removing an empty constant set.  -/
@[simps] def Lequiv.add_empty_constants [ie : is_empty α] : L ≃ᴸ L[[α]] :=
{ to_Lhom := Lhom_with_constants L α,
  inv_Lhom := Lhom.sum_elim (Lhom.id L) (Lhom.of_is_empty (constants_on α) L),
  left_inv := by rw [Lhom_with_constants, Lhom.sum_elim_comp_inl],
  right_inv := by { simp only [Lhom.comp_sum_elim, Lhom_with_constants, Lhom.comp_id],
    exact trans (congr rfl (subsingleton.elim _ _)) Lhom.sum_elim_inl_inr } }

variables {α} {β : Type*}

/-- The language map extending the constant set.  -/
def Lhom_with_constants_map (f : α → β) : L[[α]] →ᴸ L[[β]] :=
Lhom.sum_map (Lhom.id L) (Lhom.constants_on_map f)

@[simp] lemma Lhom.map_constants_comp_sum_inl {f : α → β} :
  (L.Lhom_with_constants_map f).comp (Lhom.sum_inl) = L.Lhom_with_constants β :=
by ext n f R; refl

end

open_locale first_order
variables (A : set M)

instance with_constants_Structure : L[[A]].Structure M :=
language.sum_Structure _ _ _

instance with_constants_expansion : (L.Lhom_with_constants A).is_expansion_on M :=
⟨λ _ _ _, rfl, λ _ _ _, rfl⟩

instance add_empty_constants_is_expansion_on' :
  (Lequiv.add_empty_constants L (∅ : set M)).to_Lhom.is_expansion_on M :=
L.with_constants_expansion _

instance add_empty_constants_symm_is_expansion_on :
  (Lequiv.add_empty_constants L (∅ : set M)).symm.to_Lhom.is_expansion_on M :=
Lhom.sum_elim_is_expansion_on _ _ _

instance add_constants_expansion {L' : language} [L'.Structure M] (φ : L →ᴸ L')
  [φ.is_expansion_on M] :
  (φ.add_constants A).is_expansion_on M :=
Lhom.sum_map_is_expansion_on _ _ M

@[simp] lemma coe_con {a : A} : ((L.con a) : M) = a := rfl

variables {A} {B : set M} (h : A ⊆ B)

instance constants_on_map_inclusion_is_expansion_on :
  (Lhom.constants_on_map (set.inclusion h)).is_expansion_on M :=
constants_on_map_is_expansion_on rfl

instance map_constants_inclusion_is_expansion_on :
  (L.Lhom_with_constants_map (set.inclusion h)).is_expansion_on M :=
Lhom.sum_map_is_expansion_on _ _ _

end with_constants
end language
end first_order


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Ken Lee, Chris Hughes
-/
import tactic.ring
import group_theory.group_action.units

/-!
# Coprime elements of a ring

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

## Main definitions

* `is_coprime x y`: that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
that `a * x + b * y = 1`. Note that elements with no common divisors are not necessarily coprime,
e.g., the multivariate polynomials `x₁` and `x₂` are not coprime.

See also `ring_theory.coprime.lemmas` for further development of coprime elements.
-/

open_locale classical

universes u v

section comm_semiring

variables {R : Type u} [comm_semiring R] (x y z : R)

/-- The proposition that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
that `a * x + b * y = 1`. Note that elements with no common divisors are not necessarily coprime,
e.g., the multivariate polynomials `x₁` and `x₂` are not coprime. -/
@[simp] def is_coprime : Prop :=
∃ a b, a * x + b * y = 1

variables {x y z}

theorem is_coprime.symm (H : is_coprime x y) : is_coprime y x :=
let ⟨a, b, H⟩ := H in ⟨b, a, by rw [add_comm, H]⟩

theorem is_coprime_comm : is_coprime x y ↔ is_coprime y x :=
⟨is_coprime.symm, is_coprime.symm⟩

theorem is_coprime_self : is_coprime x x ↔ is_unit x :=
⟨λ ⟨a, b, h⟩, is_unit_of_mul_eq_one x (a + b) $ by rwa [mul_comm, add_mul],
λ h, let ⟨b, hb⟩ := is_unit_iff_exists_inv'.1 h in ⟨b, 0, by rwa [zero_mul, add_zero]⟩⟩

theorem is_coprime_zero_left : is_coprime 0 x ↔ is_unit x :=
⟨λ ⟨a, b, H⟩, is_unit_of_mul_eq_one x b $ by rwa [mul_zero, zero_add, mul_comm] at H,
λ H, let ⟨b, hb⟩ := is_unit_iff_exists_inv'.1 H in ⟨1, b, by rwa [one_mul, zero_add]⟩⟩

theorem is_coprime_zero_right : is_coprime x 0 ↔ is_unit x :=
is_coprime_comm.trans is_coprime_zero_left

lemma not_coprime_zero_zero [nontrivial R] : ¬ is_coprime (0 : R) 0 :=
mt is_coprime_zero_right.mp not_is_unit_zero

/-- If a 2-vector `p` satisfies `is_coprime (p 0) (p 1)`, then `p ≠ 0`. -/
lemma is_coprime.ne_zero [nontrivial R] {p : fin 2 → R} (h : is_coprime (p 0) (p 1)) : p ≠ 0 :=
by { rintro rfl, exact not_coprime_zero_zero h }

theorem is_coprime_one_left : is_coprime 1 x :=
⟨1, 0, by rw [one_mul, zero_mul, add_zero]⟩

theorem is_coprime_one_right : is_coprime x 1 :=
⟨0, 1, by rw [one_mul, zero_mul, zero_add]⟩

theorem is_coprime.dvd_of_dvd_mul_right (H1 : is_coprime x z) (H2 : x ∣ y * z) : x ∣ y :=
let ⟨a, b, H⟩ := H1 in by { rw [← mul_one y, ← H, mul_add, ← mul_assoc, mul_left_comm],
exact dvd_add (dvd_mul_left _ _) (H2.mul_left _) }

theorem is_coprime.dvd_of_dvd_mul_left (H1 : is_coprime x y) (H2 : x ∣ y * z) : x ∣ z :=
let ⟨a, b, H⟩ := H1 in by { rw [← one_mul z, ← H, add_mul, mul_right_comm, mul_assoc b],
exact dvd_add (dvd_mul_left _ _) (H2.mul_left _) }

theorem is_coprime.mul_left (H1 : is_coprime x z) (H2 : is_coprime y z) : is_coprime (x * y) z :=
let ⟨a, b, h1⟩ := H1, ⟨c, d, h2⟩ := H2 in
⟨a * c, a * x * d + b * c * y + b * d * z,
calc  a * c * (x * y) + (a * x * d + b * c * y + b * d * z) * z
    = (a * x + b * z) * (c * y + d * z) : by ring
... = 1 : by rw [h1, h2, mul_one]⟩

theorem is_coprime.mul_right (H1 : is_coprime x y) (H2 : is_coprime x z) : is_coprime x (y * z) :=
by { rw is_coprime_comm at H1 H2 ⊢, exact H1.mul_left H2 }

theorem is_coprime.mul_dvd (H : is_coprime x y) (H1 : x ∣ z) (H2 : y ∣ z) : x * y ∣ z :=
begin
  obtain ⟨a, b, h⟩ := H,
  rw [← mul_one z, ← h, mul_add],
  apply dvd_add,
  { rw [mul_comm z, mul_assoc],
    exact (mul_dvd_mul_left _ H2).mul_left _ },
  { rw [mul_comm b, ← mul_assoc],
    exact (mul_dvd_mul_right H1 _).mul_right _ }
end

theorem is_coprime.of_mul_left_left (H : is_coprime (x * y) z) : is_coprime x z :=
let ⟨a, b, h⟩ := H in ⟨a * y, b, by rwa [mul_right_comm, mul_assoc]⟩

theorem is_coprime.of_mul_left_right (H : is_coprime (x * y) z) : is_coprime y z :=
by { rw mul_comm at H, exact H.of_mul_left_left }

theorem is_coprime.of_mul_right_left (H : is_coprime x (y * z)) : is_coprime x y :=
by { rw is_coprime_comm at H ⊢, exact H.of_mul_left_left }

theorem is_coprime.of_mul_right_right (H : is_coprime x (y * z)) : is_coprime x z :=
by { rw mul_comm at H, exact H.of_mul_right_left }

theorem is_coprime.mul_left_iff : is_coprime (x * y) z ↔ is_coprime x z ∧ is_coprime y z :=
⟨λ H, ⟨H.of_mul_left_left, H.of_mul_left_right⟩, λ ⟨H1, H2⟩, H1.mul_left H2⟩

theorem is_coprime.mul_right_iff : is_coprime x (y * z) ↔ is_coprime x y ∧ is_coprime x z :=
by rw [is_coprime_comm, is_coprime.mul_left_iff, is_coprime_comm, @is_coprime_comm _ _ z]

theorem is_coprime.of_coprime_of_dvd_left (h : is_coprime y z) (hdvd : x ∣ y) : is_coprime x z :=
begin
  obtain ⟨d, rfl⟩ := hdvd,
  exact is_coprime.of_mul_left_left h
end

theorem is_coprime.of_coprime_of_dvd_right (h : is_coprime z y) (hdvd : x ∣ y) : is_coprime z x :=
(h.symm.of_coprime_of_dvd_left hdvd).symm

theorem is_coprime.is_unit_of_dvd (H : is_coprime x y) (d : x ∣ y) : is_unit x :=
let ⟨k, hk⟩ := d in is_coprime_self.1 $ is_coprime.of_mul_right_left $
show is_coprime x (x * k), from hk ▸ H

theorem is_coprime.is_unit_of_dvd' {a b x : R} (h : is_coprime a b) (ha : x ∣ a) (hb : x ∣ b) :
  is_unit x :=
(h.of_coprime_of_dvd_left ha).is_unit_of_dvd hb

theorem is_coprime.map (H : is_coprime x y) {S : Type v} [comm_semiring S] (f : R →+* S) :
  is_coprime (f x) (f y) :=
let ⟨a, b, h⟩ := H in ⟨f a, f b, by rw [← f.map_mul, ← f.map_mul, ← f.map_add, h, f.map_one]⟩

variables {x y z}

lemma is_coprime.of_add_mul_left_left (h : is_coprime (x + y * z) y) : is_coprime x y :=
let ⟨a, b, H⟩ := h in ⟨a, a * z + b, by simpa only [add_mul, mul_add,
    add_assoc, add_comm, add_left_comm, mul_assoc, mul_comm, mul_left_comm] using H⟩

lemma is_coprime.of_add_mul_right_left (h : is_coprime (x + z * y) y) : is_coprime x y :=
by { rw mul_comm at h, exact h.of_add_mul_left_left }

lemma is_coprime.of_add_mul_left_right (h : is_coprime x (y + x * z)) : is_coprime x y :=
by { rw is_coprime_comm at h ⊢, exact h.of_add_mul_left_left }

lemma is_coprime.of_add_mul_right_right (h : is_coprime x (y + z * x)) : is_coprime x y :=
by { rw mul_comm at h, exact h.of_add_mul_left_right }

lemma is_coprime.of_mul_add_left_left (h : is_coprime (y * z + x) y) : is_coprime x y :=
by { rw add_comm at h, exact h.of_add_mul_left_left }

lemma is_coprime.of_mul_add_right_left (h : is_coprime (z * y + x) y) : is_coprime x y :=
by { rw add_comm at h, exact h.of_add_mul_right_left }

lemma is_coprime.of_mul_add_left_right (h : is_coprime x (x * z + y)) : is_coprime x y :=
by { rw add_comm at h, exact h.of_add_mul_left_right }

lemma is_coprime.of_mul_add_right_right (h : is_coprime x (z * x + y)) : is_coprime x y :=
by { rw add_comm at h, exact h.of_add_mul_right_right }

end comm_semiring

section scalar_tower
variables {R G : Type*} [comm_semiring R] [group G] [mul_action G R] [smul_comm_class G R R]
  [is_scalar_tower G R R] (x : G) (y z : R)

lemma is_coprime_group_smul_left : is_coprime (x • y) z ↔ is_coprime y z :=
⟨λ ⟨a, b, h⟩, ⟨x • a, b, by rwa [smul_mul_assoc, ←mul_smul_comm]⟩,
  λ ⟨a, b, h⟩, ⟨x⁻¹ • a, b, by rwa [smul_mul_smul, inv_mul_self, one_smul]⟩⟩

lemma is_coprime_group_smul_right : is_coprime y (x • z) ↔ is_coprime y z :=
is_coprime_comm.trans $ (is_coprime_group_smul_left x z y).trans is_coprime_comm

lemma is_coprime_group_smul : is_coprime (x • y) (x • z) ↔ is_coprime y z :=
(is_coprime_group_smul_left x y (x • z)).trans (is_coprime_group_smul_right x y z)

end scalar_tower

section comm_semiring_unit
variables {R : Type*} [comm_semiring R] {x : R} (hu : is_unit x) (y z : R)

lemma is_coprime_mul_unit_left_left : is_coprime (x * y) z ↔ is_coprime y z :=
let ⟨u, hu⟩ := hu in hu ▸ is_coprime_group_smul_left u y z

lemma is_coprime_mul_unit_left_right : is_coprime y (x * z) ↔ is_coprime y z :=
let ⟨u, hu⟩ := hu in hu ▸ is_coprime_group_smul_right u y z

lemma is_coprime_mul_unit_left : is_coprime (x * y) (x * z) ↔ is_coprime y z :=
(is_coprime_mul_unit_left_left hu y (x * z)).trans (is_coprime_mul_unit_left_right hu y z)

lemma is_coprime_mul_unit_right_left : is_coprime (y * x) z ↔ is_coprime y z :=
mul_comm x y ▸ is_coprime_mul_unit_left_left hu y z

lemma is_coprime_mul_unit_right_right : is_coprime y (z * x) ↔ is_coprime y z :=
mul_comm x z ▸ is_coprime_mul_unit_left_right hu y z

lemma is_coprime_mul_unit_right : is_coprime (y * x) (z * x) ↔ is_coprime y z :=
(is_coprime_mul_unit_right_left hu y (z * x)).trans (is_coprime_mul_unit_right_right hu y z)

end comm_semiring_unit

namespace is_coprime

section comm_ring

variables {R : Type u} [comm_ring R]

lemma add_mul_left_left {x y : R} (h : is_coprime x y) (z : R) : is_coprime (x + y * z) y :=
@of_add_mul_left_left R _ _ _ (-z) $
by simpa only [mul_neg, add_neg_cancel_right] using h

lemma add_mul_right_left {x y : R} (h : is_coprime x y) (z : R) : is_coprime (x + z * y) y :=
by { rw mul_comm, exact h.add_mul_left_left z }

lemma add_mul_left_right {x y : R} (h : is_coprime x y) (z : R) : is_coprime x (y + x * z) :=
by { rw is_coprime_comm, exact h.symm.add_mul_left_left z }

lemma add_mul_right_right {x y : R} (h : is_coprime x y) (z : R) : is_coprime x (y + z * x) :=
by { rw is_coprime_comm, exact h.symm.add_mul_right_left z }

lemma mul_add_left_left {x y : R} (h : is_coprime x y) (z : R) : is_coprime (y * z + x) y :=
by { rw add_comm, exact h.add_mul_left_left z }

lemma mul_add_right_left {x y : R} (h : is_coprime x y) (z : R) : is_coprime (z * y + x) y :=
by { rw add_comm, exact h.add_mul_right_left z }

lemma mul_add_left_right {x y : R} (h : is_coprime x y) (z : R) : is_coprime x (x * z + y) :=
by { rw add_comm, exact h.add_mul_left_right z }

lemma mul_add_right_right {x y : R} (h : is_coprime x y) (z : R) : is_coprime x (z * x + y) :=
by { rw add_comm, exact h.add_mul_right_right z }

lemma add_mul_left_left_iff {x y z : R} : is_coprime (x + y * z) y ↔ is_coprime x y :=
⟨of_add_mul_left_left, λ h, h.add_mul_left_left z⟩

lemma add_mul_right_left_iff {x y z : R} : is_coprime (x + z * y) y ↔ is_coprime x y :=
⟨of_add_mul_right_left, λ h, h.add_mul_right_left z⟩

lemma add_mul_left_right_iff {x y z : R} : is_coprime x (y + x * z) ↔ is_coprime x y :=
⟨of_add_mul_left_right, λ h, h.add_mul_left_right z⟩

lemma add_mul_right_right_iff {x y z : R} : is_coprime x (y + z * x) ↔ is_coprime x y :=
⟨of_add_mul_right_right, λ h, h.add_mul_right_right z⟩

lemma mul_add_left_left_iff {x y z : R} : is_coprime (y * z + x) y ↔ is_coprime x y :=
⟨of_mul_add_left_left, λ h, h.mul_add_left_left z⟩

lemma mul_add_right_left_iff {x y z : R} : is_coprime (z * y + x) y ↔ is_coprime x y :=
⟨of_mul_add_right_left, λ h, h.mul_add_right_left z⟩

lemma mul_add_left_right_iff {x y z : R} : is_coprime x (x * z + y) ↔ is_coprime x y :=
⟨of_mul_add_left_right, λ h, h.mul_add_left_right z⟩

lemma mul_add_right_right_iff {x y z : R} : is_coprime x (z * x + y) ↔ is_coprime x y :=
⟨of_mul_add_right_right, λ h, h.mul_add_right_right z⟩

lemma neg_left {x y : R} (h : is_coprime x y) : is_coprime (-x) y :=
begin
  obtain ⟨a, b, h⟩ := h,
  use [-a, b],
  rwa neg_mul_neg,
end

lemma neg_left_iff (x y : R) : is_coprime (-x) y ↔ is_coprime x y :=
⟨λ h, neg_neg x ▸ h.neg_left, neg_left⟩

lemma neg_right {x y : R} (h : is_coprime x y) : is_coprime x (-y) :=
h.symm.neg_left.symm

lemma neg_right_iff (x y : R) : is_coprime x (-y) ↔ is_coprime x y :=
⟨λ h, neg_neg y ▸ h.neg_right, neg_right⟩

lemma neg_neg {x y : R} (h : is_coprime x y) : is_coprime (-x) (-y) :=
h.neg_left.neg_right

lemma neg_neg_iff (x y : R) : is_coprime (-x) (-y) ↔ is_coprime x y :=
(neg_left_iff _ _).trans (neg_right_iff _ _)

end comm_ring

lemma sq_add_sq_ne_zero {R : Type*} [linear_ordered_comm_ring R] {a b : R} (h : is_coprime a b) :
  a ^ 2 + b ^ 2 ≠ 0 :=
begin
  intros h',
  obtain ⟨ha, hb⟩ := (add_eq_zero_iff' (sq_nonneg a) (sq_nonneg b)).mp h',
  obtain rfl := pow_eq_zero ha,
  obtain rfl := pow_eq_zero hb,
  exact not_coprime_zero_zero h
end

end is_coprime


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

/-!
# Intervals in ℕ as multisets

For now this only covers `Ico n m`, the "closed-open" interval containing `[n, ..., m-1]`.
-/

namespace multiset
open list

/-! ### Ico -/

/-- `Ico n m` is the multiset lifted from the list `Ico n m`, e.g. the set `{n, n+1, ..., m-1}`. -/
def Ico (n m : ℕ) : multiset ℕ := Ico n m

namespace Ico

theorem map_add (n m k : ℕ) : (Ico n m).map ((+) k) = Ico (n + k) (m + k) :=
congr_arg coe $ list.Ico.map_add _ _ _

theorem map_sub (n m k : ℕ) (h : k ≤ n) : (Ico n m).map (λ x, x - k) = Ico (n - k) (m - k) :=
congr_arg coe $ list.Ico.map_sub _ _ _ h

theorem zero_bot (n : ℕ) : Ico 0 n = range n :=
congr_arg coe $ list.Ico.zero_bot _

@[simp] theorem card (n m : ℕ) : (Ico n m).card = m - n :=
list.Ico.length _ _

theorem nodup (n m : ℕ) : nodup (Ico n m) := Ico.nodup _ _

@[simp] theorem mem {n m l : ℕ} : l ∈ Ico n m ↔ n ≤ l ∧ l < m :=
list.Ico.mem

theorem eq_zero_of_le {n m : ℕ} (h : m ≤ n) : Ico n m = 0 :=
congr_arg coe $ list.Ico.eq_nil_of_le h

@[simp] theorem self_eq_zero {n : ℕ} : Ico n n = 0 :=
eq_zero_of_le $ le_refl n

@[simp] theorem eq_zero_iff {n m : ℕ} : Ico n m = 0 ↔ m ≤ n :=
iff.trans (coe_eq_zero _) list.Ico.eq_empty_iff

lemma add_consecutive {n m l : ℕ} (hnm : n ≤ m) (hml : m ≤ l) :
  Ico n m + Ico m l = Ico n l :=
congr_arg coe $ list.Ico.append_consecutive hnm hml

@[simp] lemma inter_consecutive (n m l : ℕ) : Ico n m ∩ Ico m l = 0 :=
congr_arg coe $ list.Ico.bag_inter_consecutive n m l

@[simp] theorem succ_singleton {n : ℕ} : Ico n (n+1) = {n} :=
congr_arg coe $ list.Ico.succ_singleton

theorem succ_top {n m : ℕ} (h : n ≤ m) : Ico n (m + 1) = m ::ₘ Ico n m :=
by rw [Ico, list.Ico.succ_top h, ← coe_add, add_comm]; refl

theorem eq_cons {n m : ℕ} (h : n < m) : Ico n m = n ::ₘ Ico (n + 1) m :=
congr_arg coe $ list.Ico.eq_cons h

@[simp] theorem pred_singleton {m : ℕ} (h : 0 < m) : Ico (m - 1) m = {m - 1} :=
congr_arg coe $ list.Ico.pred_singleton h

@[simp] theorem not_mem_top {n m : ℕ} : m ∉ Ico n m :=
list.Ico.not_mem_top

lemma filter_lt_of_top_le {n m l : ℕ} (hml : m ≤ l) : (Ico n m).filter (λ x, x < l) = Ico n m :=
congr_arg coe $ list.Ico.filter_lt_of_top_le hml

lemma filter_lt_of_le_bot {n m l : ℕ} (hln : l ≤ n) : (Ico n m).filter (λ x, x < l) = ∅ :=
congr_arg coe $ list.Ico.filter_lt_of_le_bot hln

lemma filter_le_of_bot {n m : ℕ} (hnm : n < m) : (Ico n m).filter (λ x, x ≤ n) = {n} :=
congr_arg coe $ list.Ico.filter_le_of_bot hnm

lemma filter_lt_of_ge {n m l : ℕ} (hlm : l ≤ m) : (Ico n m).filter (λ x, x < l) = Ico n l :=
congr_arg coe $ list.Ico.filter_lt_of_ge hlm

@[simp] lemma filter_lt (n m l : ℕ) : (Ico n m).filter (λ x, x < l) = Ico n (min m l) :=
congr_arg coe $ list.Ico.filter_lt n m l

lemma filter_le_of_le_bot {n m l : ℕ} (hln : l ≤ n) : (Ico n m).filter (λ x, l ≤ x) = Ico n m :=
congr_arg coe $ list.Ico.filter_le_of_le_bot hln

lemma filter_le_of_top_le {n m l : ℕ} (hml : m ≤ l) : (Ico n m).filter (λ x, l ≤ x) = ∅ :=
congr_arg coe $ list.Ico.filter_le_of_top_le hml

lemma filter_le_of_le {n m l : ℕ} (hnl : n ≤ l) : (Ico n m).filter (λ x, l ≤ x) = Ico l m :=
congr_arg coe $ list.Ico.filter_le_of_le hnl

@[simp] lemma filter_le (n m l : ℕ) : (Ico n m).filter (λ x, l ≤ x) = Ico (max n l) m :=
congr_arg coe $ list.Ico.filter_le n m l

end Ico
end multiset


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import algebra.group_power.basic
import algebra.hom.ring

/-!
# Power operations on monoids with zero, semirings, and rings

This file provides additional lemmas about the natural power operator on rings and semirings.
Further lemmas about ordered semirings and rings can be found in `algebra.group_power.lemmas`.

-/

variables {R S M : Type*}

section monoid_with_zero
variables [monoid_with_zero M]

lemma zero_pow : ∀ {n : ℕ}, 0 < n → (0 : M) ^ n = 0
| (n+1) _ := by rw [pow_succ, zero_mul]

@[simp] lemma zero_pow' : ∀ n : ℕ, n ≠ 0 → (0 : M) ^ n = 0
| 0     h := absurd rfl h
| (k+1) h := by { rw [pow_succ], exact zero_mul _ }

lemma zero_pow_eq (n : ℕ) : (0 : M)^n = if n = 0 then 1 else 0 :=
begin
  split_ifs with h,
  { rw [h, pow_zero], },
  { rw [zero_pow (nat.pos_of_ne_zero h)] },
end

lemma pow_eq_zero_of_le {x : M} {n m : ℕ}
  (hn : n ≤ m) (hx : x^n = 0) : x^m = 0 :=
by rw [← tsub_add_cancel_of_le hn, pow_add, hx, mul_zero]

theorem pow_eq_zero [no_zero_divisors M] {x : M} {n : ℕ} (H : x^n = 0) :
  x = 0 :=
begin
  induction n with n ih,
  { rw pow_zero at H,
    rw [← mul_one x, H, mul_zero] },
  { rw pow_succ at H,
    exact or.cases_on (mul_eq_zero.1 H) id ih }
end

@[simp] lemma pow_eq_zero_iff [no_zero_divisors M]
  {a : M} {n : ℕ} (hn : 0 < n) :
  a ^ n = 0 ↔ a = 0 :=
begin
  refine ⟨pow_eq_zero, _⟩,
  rintros rfl,
  exact zero_pow hn,
end

lemma pow_eq_zero_iff' [no_zero_divisors M] [nontrivial M]
  {a : M} {n : ℕ} :
  a ^ n = 0 ↔ a = 0 ∧ n ≠ 0 :=
by cases (zero_le n).eq_or_gt; simp [*, ne_of_gt]

lemma pow_ne_zero_iff [no_zero_divisors M] {a : M} {n : ℕ} (hn : 0 < n) :
  a ^ n ≠ 0 ↔ a ≠ 0 :=
(pow_eq_zero_iff hn).not

lemma ne_zero_pow {a : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≠ 0 → a ≠ 0 :=
by { contrapose!, rintro rfl, exact zero_pow' n hn }

@[field_simps] theorem pow_ne_zero [no_zero_divisors M]
  {a : M} (n : ℕ) (h : a ≠ 0) : a ^ n ≠ 0 :=
mt pow_eq_zero h

theorem sq_eq_zero_iff [no_zero_divisors M] {a : M} : a ^ 2 = 0 ↔ a = 0 :=
pow_eq_zero_iff two_pos

@[simp] lemma zero_pow_eq_zero [nontrivial M] {n : ℕ} : (0 : M) ^ n = 0 ↔ 0 < n :=
begin
  split; intro h,
  { rw [pos_iff_ne_zero], rintro rfl, simpa using h },
  { exact zero_pow' n h.ne.symm }
end

lemma ring.inverse_pow (r : M) : ∀ (n : ℕ), ring.inverse r ^ n = ring.inverse (r ^ n)
| 0 := by rw [pow_zero, pow_zero, ring.inverse_one]
| (n + 1) := by rw [pow_succ, pow_succ', ring.mul_inverse_rev' ((commute.refl r).pow_left n),
                    ring.inverse_pow]

end monoid_with_zero

section comm_monoid_with_zero
variables [comm_monoid_with_zero M] {n : ℕ} (hn : 0 < n)
include M hn

/-- We define `x ↦ x^n` (for positive `n : ℕ`) as a `monoid_with_zero_hom` -/
def pow_monoid_with_zero_hom : M →*₀ M :=
{ map_zero' := zero_pow hn,
  ..pow_monoid_hom n }

@[simp]
lemma coe_pow_monoid_with_zero_hom : (pow_monoid_with_zero_hom hn : M → M) = (^ n) := rfl

@[simp]
lemma pow_monoid_with_zero_hom_apply (a : M) : pow_monoid_with_zero_hom hn a = a ^ n := rfl

end comm_monoid_with_zero

lemma pow_dvd_pow_iff [cancel_comm_monoid_with_zero R]
  {x : R} {n m : ℕ} (h0 : x ≠ 0) (h1 : ¬ is_unit x) :
  x ^ n ∣ x ^ m ↔ n ≤ m :=
begin
  split,
  { intro h, rw [← not_lt], intro hmn, apply h1,
    have : x ^ m * x ∣ x ^ m * 1,
    { rw [← pow_succ', mul_one], exact (pow_dvd_pow _ (nat.succ_le_of_lt hmn)).trans h },
    rwa [mul_dvd_mul_iff_left, ← is_unit_iff_dvd_one] at this, apply pow_ne_zero m h0 },
  { apply pow_dvd_pow }
end

section semiring
variables [semiring R] [semiring S]

protected lemma ring_hom.map_pow (f : R →+* S) (a) :
  ∀ n : ℕ, f (a ^ n) = (f a) ^ n :=
map_pow f a

lemma min_pow_dvd_add {n m : ℕ} {a b c : R} (ha : c ^ n ∣ a) (hb : c ^ m ∣ b) :
  c ^ (min n m) ∣ a + b :=
begin
  replace ha := (pow_dvd_pow c (min_le_left n m)).trans ha,
  replace hb := (pow_dvd_pow c (min_le_right n m)).trans hb,
  exact dvd_add ha hb
end

end semiring

section comm_semiring
variables [comm_semiring R]

lemma add_sq (a b : R) : (a + b) ^ 2 = a ^ 2 + 2 * a * b + b ^ 2 :=
by simp only [sq, add_mul_self_eq]

lemma add_sq' (a b : R) : (a + b) ^ 2 = a ^ 2 + b ^ 2 + 2 * a * b :=
by rw [add_sq, add_assoc, add_comm _ (b ^ 2), add_assoc]

alias add_sq ← add_pow_two

end comm_semiring

section has_distrib_neg
variables [monoid R] [has_distrib_neg R]

variables (R)
theorem neg_one_pow_eq_or : ∀ n : ℕ, (-1 : R)^n = 1 ∨ (-1 : R)^n = -1
| 0     := or.inl (pow_zero _)
| (n+1) := (neg_one_pow_eq_or n).swap.imp
  (λ h, by rw [pow_succ, h, neg_one_mul, neg_neg])
  (λ h, by rw [pow_succ, h, mul_one])
variables {R}

theorem neg_pow (a : R) (n : ℕ) : (- a) ^ n = (-1) ^ n * a ^ n :=
(neg_one_mul a) ▸ (commute.neg_one_left a).mul_pow n

@[simp] theorem neg_pow_bit0 (a : R) (n : ℕ) : (- a) ^ (bit0 n) = a ^ (bit0 n) :=
by rw [pow_bit0', neg_mul_neg, pow_bit0']

@[simp] theorem neg_pow_bit1 (a : R) (n : ℕ) : (- a) ^ (bit1 n) = - a ^ (bit1 n) :=
by simp only [bit1, pow_succ, neg_pow_bit0, neg_mul_eq_neg_mul]

@[simp] lemma neg_sq (a : R) : (-a) ^ 2 = a ^ 2 := by simp [sq]
@[simp] lemma neg_one_sq : (-1 : R) ^ 2 = 1 := by rw [neg_sq, one_pow]

alias neg_sq ← neg_pow_two
alias neg_one_sq ← neg_one_pow_two

end has_distrib_neg

section ring
variables [ring R] {a b : R}

protected lemma commute.sq_sub_sq (h : commute a b) : a ^ 2 - b ^ 2 = (a + b) * (a - b) :=
by rw [sq, sq, h.mul_self_sub_mul_self_eq]

@[simp]
lemma neg_one_pow_mul_eq_zero_iff {n : ℕ} {r : R} : (-1)^n * r = 0 ↔ r = 0 :=
by rcases neg_one_pow_eq_or R n; simp [h]

@[simp]
lemma mul_neg_one_pow_eq_zero_iff {n : ℕ} {r : R} : r * (-1)^n = 0 ↔ r = 0 :=
by rcases neg_one_pow_eq_or R n; simp [h]

variables [no_zero_divisors R]

protected lemma commute.sq_eq_sq_iff_eq_or_eq_neg (h : commute a b) :
  a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b :=
by rw [←sub_eq_zero, h.sq_sub_sq, mul_eq_zero, add_eq_zero_iff_eq_neg, sub_eq_zero, or_comm]

@[simp] lemma sq_eq_one_iff : a^2 = 1 ↔ a = 1 ∨ a = -1 :=
by rw [←(commute.one_right a).sq_eq_sq_iff_eq_or_eq_neg, one_pow]

lemma sq_ne_one_iff : a^2 ≠ 1 ↔ a ≠ 1 ∧ a ≠ -1 := sq_eq_one_iff.not.trans not_or_distrib

end ring

section comm_ring
variables [comm_ring R]

lemma sq_sub_sq (a b : R) : a ^ 2 - b ^ 2 = (a + b) * (a - b) := (commute.all a b).sq_sub_sq

alias sq_sub_sq ← pow_two_sub_pow_two

lemma sub_sq (a b : R) : (a - b) ^ 2 = a ^ 2 - 2 * a * b + b ^ 2 :=
by rw [sub_eq_add_neg, add_sq, neg_sq, mul_neg, ← sub_eq_add_neg]

alias sub_sq ← sub_pow_two

lemma sub_sq' (a b : R) : (a - b) ^ 2 = a ^ 2 + b ^ 2 - 2 * a * b :=
by rw [sub_eq_add_neg, add_sq', neg_sq, mul_neg, ← sub_eq_add_neg]

variables [no_zero_divisors R] {a b : R}

lemma sq_eq_sq_iff_eq_or_eq_neg : a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b :=
(commute.all a b).sq_eq_sq_iff_eq_or_eq_neg

lemma eq_or_eq_neg_of_sq_eq_sq (a b : R) : a ^ 2 = b ^ 2 → a = b ∨ a = -b :=
sq_eq_sq_iff_eq_or_eq_neg.1

/- Copies of the above comm_ring lemmas for `units R`. -/
namespace units

protected lemma sq_eq_sq_iff_eq_or_eq_neg {a b : Rˣ} : a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b :=
by simp_rw [ext_iff, coe_pow, sq_eq_sq_iff_eq_or_eq_neg, units.coe_neg]

protected lemma eq_or_eq_neg_of_sq_eq_sq (a b : Rˣ) (h : a ^ 2 = b ^ 2) : a = b ∨ a = -b :=
units.sq_eq_sq_iff_eq_or_eq_neg.1 h

end units

end comm_ring