/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under MIT license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.algebra.operations

/-! # Filtrations of an `algebra` -/

namespace algebra

/-- A filtration is an indexed family of submodules such that `i ≤ j → S i ≤ S j` and `S i * S j = S (i + j)` -/
structure filtration (R : Type*) (A : Type*) (ι : Type*) [preorder ι] [has_add ι] [comm_semiring R] [semiring A] [algebra R A] :=
(to_fun : ι → submodule R A)
(mono' : monotone to_fun)
(complete' : ∀ x, ∃ i, x ∈ to_fun i)
(map_add' : ∀ n m, to_fun (n + m) = to_fun n * to_fun m)

namespace filtration

variables {R : Type*} {A : Type*} {ι : Type*} [preorder ι] [has_add ι] [comm_semiring R] [semiring A] [algebra R A]

instance : has_coe_to_fun (filtration R A ι) (λ _, ι → submodule R A) := ⟨to_fun⟩

variables (f : filtration R A ι)

-- the normal bundled function tricks, to hide the `to_fun`
@[simp] lemma to_fun_eq_coe : f.to_fun = f := rfl
@[simp] lemma mk_coe (f : ι → submodule R A) (h1 h2 h3) : ⇑(filtration.mk f h1 h2 h3) = f := rfl
lemma mono : monotone f := f.mono'
lemma map_add {n m} : f (n + m) = f n * f m := f.map_add' n m
lemma complete : ∀ x, ∃ i, x ∈ f i := f.complete'

lemma supr_eq_top (x : A) : supr f = ⊤ :=
begin
  rw submodule.supr_eq_span,
  suffices : (⋃ (i : ι), (f i : set A)) = ⊤,
  { simp [this] },
  refine set.eq_univ_of_forall (λ x, _),
  simp only [set.mem_Union, set_like.mem_coe],
  exact f.complete' x,
end

end filtration

end algebra


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.nat.basic
import data.nat.cast.defs
import algebra.group.pi
import tactic.pi_instances

/-!
# Cast of natural numbers (additional theorems)

This file proves additional properties about the *canonical* homomorphism from
the natural numbers into an additive monoid with a one (`nat.cast`).

## Main declarations

* `cast_add_monoid_hom`: `cast` bundled as an `add_monoid_hom`.
* `cast_ring_hom`: `cast` bundled as a `ring_hom`.
-/

namespace nat
variables {α : Type*}

/-- `coe : ℕ → α` as an `add_monoid_hom`. -/
def cast_add_monoid_hom (α : Type*) [add_monoid_with_one α] : ℕ →+ α :=
{ to_fun := coe,
  map_add' := cast_add,
  map_zero' := cast_zero }

@[simp] lemma coe_cast_add_monoid_hom [add_monoid_with_one α] :
  (cast_add_monoid_hom α : ℕ → α) = coe := rfl

@[simp, norm_cast] theorem cast_mul [non_assoc_semiring α] (m n : ℕ) :
  ((m * n : ℕ) : α) = m * n :=
by induction n; simp [mul_succ, mul_add, *]

/-- `coe : ℕ → α` as a `ring_hom` -/
def cast_ring_hom (α : Type*) [non_assoc_semiring α] : ℕ →+* α :=
{ to_fun := coe,
  map_one' := cast_one,
  map_mul' := cast_mul,
  .. cast_add_monoid_hom α }

@[simp] lemma coe_cast_ring_hom [non_assoc_semiring α] : (cast_ring_hom α : ℕ → α) = coe := rfl

lemma cast_commute [non_assoc_semiring α] (n : ℕ) (x : α) : commute ↑n x :=
nat.rec_on n (by rw [cast_zero]; exact commute.zero_left x) $
λ n ihn, by rw [cast_succ]; exact ihn.add_left (commute.one_left x)

lemma cast_comm [non_assoc_semiring α] (n : ℕ) (x : α) : (n : α) * x = x * n :=
(cast_commute n x).eq

lemma commute_cast [non_assoc_semiring α] (x : α) (n : ℕ) : commute x n :=
(n.cast_commute x).symm

section

variables [ordered_semiring α]

@[mono] theorem mono_cast : monotone (coe : ℕ → α) :=
monotone_nat_of_le_succ $ λ n, by rw [nat.cast_succ]; exact le_add_of_nonneg_right zero_le_one

@[simp] theorem cast_nonneg (n : ℕ) : 0 ≤ (n : α) :=
@nat.cast_zero α _ ▸ mono_cast (nat.zero_le n)

variable [nontrivial α]

@[simp, norm_cast] theorem cast_le {m n : ℕ} :
  (m : α) ≤ n ↔ m ≤ n :=
strict_mono_cast.le_iff_le

@[simp, norm_cast, mono] theorem cast_lt {m n : ℕ} : (m : α) < n ↔ m < n :=
strict_mono_cast.lt_iff_lt

@[simp] theorem cast_pos {n : ℕ} : (0 : α) < n ↔ 0 < n :=
by rw [← cast_zero, cast_lt]

lemma cast_add_one_pos (n : ℕ) : 0 < (n : α) + 1 :=
  add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one

@[simp, norm_cast] theorem one_lt_cast {n : ℕ} : 1 < (n : α) ↔ 1 < n :=
by rw [← cast_one, cast_lt]

@[simp, norm_cast] theorem one_le_cast {n : ℕ} : 1 ≤ (n : α) ↔ 1 ≤ n :=
by rw [← cast_one, cast_le]

@[simp, norm_cast] theorem cast_lt_one {n : ℕ} : (n : α) < 1 ↔ n = 0 :=
by rw [← cast_one, cast_lt, lt_succ_iff, le_zero_iff]

@[simp, norm_cast] theorem cast_le_one {n : ℕ} : (n : α) ≤ 1 ↔ n ≤ 1 :=
by rw [← cast_one, cast_le]

end

@[simp, norm_cast] theorem cast_min [linear_ordered_semiring α] {a b : ℕ} :
  (↑(min a b) : α) = min a b :=
(@mono_cast α _).map_min

@[simp, norm_cast] theorem cast_max [linear_ordered_semiring α] {a b : ℕ} :
  (↑(max a b) : α) = max a b :=
(@mono_cast α _).map_max

@[simp, norm_cast] theorem abs_cast [linear_ordered_ring α] (a : ℕ) :
  |(a : α)| = a :=
abs_of_nonneg (cast_nonneg a)

lemma coe_nat_dvd [semiring α] {m n : ℕ} (h : m ∣ n) : (m : α) ∣ (n : α) :=
map_dvd (nat.cast_ring_hom α) h

alias coe_nat_dvd ← has_dvd.dvd.nat_cast

end nat

namespace prod

variables {α : Type*} {β : Type*} [add_monoid_with_one α] [add_monoid_with_one β]

instance : add_monoid_with_one (α × β) :=
{ nat_cast := λ n, (n, n),
  nat_cast_zero := congr_arg2 prod.mk nat.cast_zero nat.cast_zero,
  nat_cast_succ := λ n, congr_arg2 prod.mk (nat.cast_succ _) (nat.cast_succ _),
  .. prod.add_monoid, .. prod.has_one }

@[simp] lemma fst_nat_cast (n : ℕ) : (n : α × β).fst = n :=
by induction n; simp *

@[simp] lemma snd_nat_cast (n : ℕ) : (n : α × β).snd = n :=
by induction n; simp *

end prod

section add_monoid_hom_class

variables {A B F : Type*} [add_monoid_with_one B]

lemma ext_nat' [add_monoid A] [add_monoid_hom_class F ℕ A] (f g : F) (h : f 1 = g 1) : f = g :=
fun_like.ext f g $ begin
  apply nat.rec,
  { simp only [nat.nat_zero_eq_zero, map_zero] },
  simp [nat.succ_eq_add_one, h] {contextual := tt}
end

@[ext] lemma add_monoid_hom.ext_nat [add_monoid A] : ∀ {f g : ℕ →+ A}, ∀ h : f 1 = g 1, f = g :=
ext_nat'

variable [add_monoid_with_one A]

-- these versions are primed so that the `ring_hom_class` versions aren't
lemma eq_nat_cast' [add_monoid_hom_class F ℕ A] (f : F) (h1 : f 1 = 1) :
  ∀ n : ℕ, f n = n
| 0     := by simp
| (n+1) := by rw [map_add, h1, eq_nat_cast' n, nat.cast_add_one]

lemma map_nat_cast' {A} [add_monoid_with_one A] [add_monoid_hom_class F A B]
                    (f : F) (h : f 1 = 1) : ∀ (n : ℕ), f n = n
| 0     := by simp
| (n+1) := by rw [nat.cast_add, map_add, nat.cast_add, map_nat_cast', nat.cast_one, h, nat.cast_one]

end add_monoid_hom_class

section monoid_with_zero_hom_class

variables {A F : Type*} [mul_zero_one_class A]

/-- If two `monoid_with_zero_hom`s agree on the positive naturals they are equal. -/
theorem ext_nat'' [monoid_with_zero_hom_class F ℕ A] (f g : F)
  (h_pos : ∀ {n : ℕ}, 0 < n → f n = g n) : f = g :=
begin
  apply fun_like.ext,
  rintro (_|n),
  { simp },
  exact h_pos n.succ_pos
end

@[ext] theorem monoid_with_zero_hom.ext_nat :
  ∀ {f g : ℕ →*₀ A}, (∀ {n : ℕ}, 0 < n → f n = g n) → f = g := ext_nat''

end monoid_with_zero_hom_class

section ring_hom_class

variables {R S F : Type*} [non_assoc_semiring R] [non_assoc_semiring S]

@[simp] lemma eq_nat_cast [ring_hom_class F ℕ R] (f : F) : ∀ n, f n = n :=
eq_nat_cast' f $ map_one f

@[simp] lemma map_nat_cast [ring_hom_class F R S] (f : F) : ∀ n : ℕ, f (n : R) = n :=
map_nat_cast' f $ map_one f

lemma ext_nat [ring_hom_class F ℕ R] (f g : F) : f = g :=
ext_nat' f g $ by simp only [map_one]

end ring_hom_class

namespace ring_hom

/-- This is primed to match `ring_hom.eq_int_cast'`. -/
lemma eq_nat_cast' {R} [non_assoc_semiring R] (f : ℕ →+* R) : f = nat.cast_ring_hom R :=
ring_hom.ext $ eq_nat_cast f

end ring_hom

@[simp, norm_cast] theorem nat.cast_id (n : ℕ) : ↑n = n :=
rfl

@[simp] lemma nat.cast_ring_hom_nat : nat.cast_ring_hom ℕ = ring_hom.id ℕ := rfl

@[simp] theorem nat.cast_with_bot (n : ℕ) :
  @coe ℕ (with_bot ℕ) (@coe_to_lift _ _ nat.cast_coe) n = n := rfl

-- I don't think `ring_hom_class` is good here, because of the `subsingleton` TC slowness
instance nat.unique_ring_hom {R : Type*} [non_assoc_semiring R] : unique (ℕ →+* R) :=
{ default := nat.cast_ring_hom R, uniq := ring_hom.eq_nat_cast' }

namespace mul_opposite

variables {α : Type*} [add_monoid_with_one α]

@[simp, norm_cast] lemma op_nat_cast (n : ℕ) : op (n : α) = n := rfl

@[simp, norm_cast] lemma unop_nat_cast (n : ℕ) : unop (n : αᵐᵒᵖ) = n := rfl

end mul_opposite

namespace with_top
variables {α : Type*}

variables [add_monoid_with_one α]

@[simp, norm_cast] lemma coe_nat : ∀ (n : ℕ), ((n : α) : with_top α) = n
| 0     := rfl
| (n+1) := by { push_cast, rw [coe_nat n] }

@[simp] lemma nat_ne_top (n : nat) : (n : with_top α) ≠ ⊤ :=
by { rw [←coe_nat n], apply coe_ne_top }

@[simp] lemma top_ne_nat (n : nat) : (⊤ : with_top α) ≠ n :=
by { rw [←coe_nat n], apply top_ne_coe }

lemma add_one_le_of_lt {i n : with_top ℕ} (h : i < n) : i + 1 ≤ n :=
begin
  cases n, { exact le_top },
  cases i, { exact (not_le_of_lt h le_top).elim },
  exact with_top.coe_le_coe.2 (with_top.coe_lt_coe.1 h)
end

lemma one_le_iff_pos {n : with_top ℕ} : 1 ≤ n ↔ 0 < n :=
⟨lt_of_lt_of_le (coe_lt_coe.mpr zero_lt_one),
  λ h, by simpa only [zero_add] using add_one_le_of_lt h⟩

@[elab_as_eliminator]
lemma nat_induction {P : with_top ℕ → Prop} (a : with_top ℕ)
  (h0 : P 0) (hsuc : ∀n:ℕ, P n → P n.succ) (htop : (∀n : ℕ, P n) → P ⊤) : P a :=
begin
  have A : ∀n:ℕ, P n := λ n, nat.rec_on n h0 hsuc,
  cases a,
  { exact htop A },
  { exact A a }
end

end with_top

namespace pi
variables {α : Type*} {β : α → Type*} [∀ a, has_nat_cast (β a)]

instance : has_nat_cast (∀ a, β a) :=
by refine_struct { .. }; tactic.pi_instance_derive_field

lemma nat_apply (n : ℕ) (a : α) : (n : ∀ a, β a) a = n := rfl

@[simp] lemma coe_nat (n : ℕ) : (n : ∀ a, β a) = λ _, n := rfl

end pi

namespace pi
variables {α : Type*} {β : α → Type*} [∀ a, add_monoid_with_one (β a)]

instance : add_monoid_with_one (∀ a, β a) :=
by refine_struct { .. }; tactic.pi_instance_derive_field

end pi


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.group.opposite
import group_theory.group_action.defs

/-!
# Scalar actions on and by `Mᵐᵒᵖ`

This file defines the actions on the opposite type `has_smul R Mᵐᵒᵖ`, and actions by the opposite
type, `has_smul Rᵐᵒᵖ M`.

Note that `mul_opposite.has_smul` is provided in an earlier file as it is needed to provide the
`add_monoid.nsmul` and `add_comm_group.gsmul` fields.
-/

variables (α : Type*)

/-! ### Actions _on_ the opposite type

Actions on the opposite type just act on the underlying type.
-/

namespace mul_opposite

@[to_additive] instance (R : Type*) [monoid R] [mul_action R α] : mul_action R αᵐᵒᵖ :=
{ one_smul := λ x, unop_injective $ one_smul R (unop x),
  mul_smul := λ r₁ r₂ x, unop_injective $ mul_smul r₁ r₂ (unop x),
  .. mul_opposite.has_smul α R }

instance (R : Type*) [monoid R] [add_monoid α] [distrib_mul_action R α] :
  distrib_mul_action R αᵐᵒᵖ :=
{ smul_add := λ r x₁ x₂, unop_injective $ smul_add r (unop x₁) (unop x₂),
  smul_zero := λ r, unop_injective $ smul_zero r,
  .. mul_opposite.mul_action α R }

instance (R : Type*) [monoid R] [monoid α] [mul_distrib_mul_action R α] :
  mul_distrib_mul_action R αᵐᵒᵖ :=
{ smul_mul := λ r x₁ x₂, unop_injective $ smul_mul' r (unop x₂) (unop x₁),
  smul_one := λ r, unop_injective $ smul_one r,
  .. mul_opposite.mul_action α R }

instance {M N} [has_smul M N] [has_smul M α] [has_smul N α] [is_scalar_tower M N α] :
  is_scalar_tower M N αᵐᵒᵖ :=
⟨λ x y z, unop_injective $ smul_assoc _ _ _⟩

@[to_additive] instance {M N} [has_smul M α] [has_smul N α] [smul_comm_class M N α] :
  smul_comm_class M N αᵐᵒᵖ :=
⟨λ x y z, unop_injective $ smul_comm _ _ _⟩

instance (R : Type*) [has_smul R α] [has_smul Rᵐᵒᵖ α] [is_central_scalar R α] :
  is_central_scalar R αᵐᵒᵖ :=
⟨λ r m, unop_injective $ op_smul_eq_smul _ _⟩

lemma op_smul_eq_op_smul_op {R : Type*} [has_smul R α] [has_smul Rᵐᵒᵖ α] [is_central_scalar R α]
  (r : R) (a : α) : op (r • a) = op r • op a :=
(op_smul_eq_smul r (op a)).symm

lemma unop_smul_eq_unop_smul_unop {R : Type*} [has_smul R α] [has_smul Rᵐᵒᵖ α]
  [is_central_scalar R α] (r : Rᵐᵒᵖ) (a : αᵐᵒᵖ) : unop (r • a) = unop r • unop a :=
(unop_smul_eq_smul r (unop a)).symm

end mul_opposite

/-! ### Actions _by_ the opposite type (right actions)

In `has_mul.to_has_smul` in another file, we define the left action `a₁ • a₂ = a₁ * a₂`. For the
multiplicative opposite, we define `mul_opposite.op a₁ • a₂ = a₂ * a₁`, with the multiplication
reversed.
-/

open mul_opposite

/-- Like `has_mul.to_has_smul`, but multiplies on the right.

See also `monoid.to_opposite_mul_action` and `monoid_with_zero.to_opposite_mul_action_with_zero`. -/
@[to_additive] instance has_mul.to_has_opposite_smul [has_mul α] : has_smul αᵐᵒᵖ α :=
{ smul := λ c x, x * c.unop }

@[to_additive] lemma op_smul_eq_mul [has_mul α] {a a' : α} : op a • a' = a' * a := rfl

@[simp, to_additive] lemma mul_opposite.smul_eq_mul_unop [has_mul α] {a : αᵐᵒᵖ} {a' : α} :
  a • a' = a' * a.unop := rfl

/-- The right regular action of a group on itself is transitive. -/
@[to_additive "The right regular action of an additive group on itself is transitive."]
instance mul_action.opposite_regular.is_pretransitive {G : Type*} [group G] :
  mul_action.is_pretransitive Gᵐᵒᵖ G :=
⟨λ x y, ⟨op (x⁻¹ * y), mul_inv_cancel_left _ _⟩⟩

@[to_additive] instance semigroup.opposite_smul_comm_class [semigroup α] :
  smul_comm_class αᵐᵒᵖ α α :=
{ smul_comm := λ x y z, (mul_assoc _ _ _) }

@[to_additive] instance semigroup.opposite_smul_comm_class' [semigroup α] :
  smul_comm_class α αᵐᵒᵖ α :=
smul_comm_class.symm _ _ _

instance comm_semigroup.is_central_scalar [comm_semigroup α] : is_central_scalar α α :=
⟨λ r m, mul_comm _ _⟩

/-- Like `monoid.to_mul_action`, but multiplies on the right. -/
@[to_additive] instance monoid.to_opposite_mul_action [monoid α] : mul_action αᵐᵒᵖ α :=
{ smul := (•),
  one_smul := mul_one,
  mul_smul := λ x y r, (mul_assoc _ _ _).symm }

instance is_scalar_tower.opposite_mid {M N} [has_mul N] [has_smul M N]
  [smul_comm_class M N N] :
  is_scalar_tower M Nᵐᵒᵖ N :=
⟨λ x y z, mul_smul_comm _ _ _⟩

instance smul_comm_class.opposite_mid {M N} [has_mul N] [has_smul M N]
  [is_scalar_tower M N N] :
  smul_comm_class M Nᵐᵒᵖ N :=
⟨λ x y z, by { induction y using mul_opposite.rec, simp [smul_mul_assoc] }⟩

-- The above instance does not create an unwanted diamond, the two paths to
-- `mul_action αᵐᵒᵖ αᵐᵒᵖ` are defeq.
example [monoid α] : monoid.to_mul_action αᵐᵒᵖ = mul_opposite.mul_action α αᵐᵒᵖ := rfl

/-- `monoid.to_opposite_mul_action` is faithful on cancellative monoids. -/
@[to_additive] instance left_cancel_monoid.to_has_faithful_opposite_scalar [left_cancel_monoid α] :
  has_faithful_smul αᵐᵒᵖ α :=
⟨λ x y h, unop_injective $ mul_left_cancel (h 1)⟩

/-- `monoid.to_opposite_mul_action` is faithful on nontrivial cancellative monoids with zero. -/
instance cancel_monoid_with_zero.to_has_faithful_opposite_scalar
  [cancel_monoid_with_zero α] [nontrivial α] : has_faithful_smul αᵐᵒᵖ α :=
⟨λ x y h, unop_injective $ mul_left_cancel₀ one_ne_zero (h 1)⟩


import week_2.kb_solutions.Part_A_groups_solutions

/-!

## Subgroups

We define the structure `subgroup G`, whose terms are subgroups of `G`.
A subgroup of `G` is implemented as a subset of `G` closed under
`1`, `*` and `⁻¹`.

-/

namespace xena

/-- A subgroup of a group G is a subset containing 1
and closed under multiplication and inverse. -/
structure subgroup (G : Type) [group G] :=
(carrier : set G)
(one_mem' : (1 : G) ∈ carrier)
(mul_mem' {x y} : x ∈ carrier → y ∈ carrier → x * y ∈ carrier)
(inv_mem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)

/-

At this point, here's what we have.

A term `H` of type `subgroup G`, written `H : subgroup G`, is a
*quadruple*. To give a term `H : subgroup G` is to give the following four things:
1) `H.carrier` (a subset of `G`),
2) `H.one_mem'` (a proof that `1 ∈ H.carrier`),
3) `H.mul_mem'` (a proof that `H` is closed under multiplication)
4) `H.inv_mem'` (a proof that `H` is closed under inverses).

Note in particular that Lean, being super-pedantic, *distinguishes* between
the subgroup `H` and the subset `H.carrier`. One is a subgroup, one is
a subset. When we get going we will start by setting up some infrastructure
so that this difference will be hard to notice.

Note also that if `x` is in the subgroup `H` of `H` then the _type_ of `x` is still `G`,
and `x ∈ carrier` is a Proposition. Note also that `x : carrier` doesn't
make sense (`carrier` is a term, not a type, rather counterintuitively).

-/

namespace subgroup

open xena.group

-- let G be a group and let H and K be subgroups
variables {G : Type} [group G] (H J K : subgroup G)

/-
This `h ∈ H.carrier` notation kind of stinks. I don't want to write `H.carrier`
everywhere, because I want to be able to identify the subgroup `H` with
its underlying subset `H.carrier`. Note that these things are not _equal_,
firstly because `H` contains the proof that `H.carrier` is a subgroup, and
secondly because these terms have different types! `H` has type `subgroup G`
and `H.carrier` has type `set G`. Let's start by sorting this out.
-/

-- If `x : G` and `H : subgroup G` then let's define the notation
-- `x ∈ H` to mean `x ∈ H.carrier`
instance : has_mem G (subgroup G) := ⟨λ m H, m ∈ H.carrier⟩

-- Let's also define a "coercion", a.k.a. an "invisible map"
-- from subgroups of `G` to subsets of `G`, sending `H` to `H.carrier`.
-- The map is not completely invisible -- it's a little ↑. So
-- if you see `↑H` in the future, it means the subset `H.carrier` by definition.
instance : has_coe (subgroup G) (set G) := ⟨λ H, H.carrier⟩

-- `λ` is just computer science notation for ↦ (mapsto); so
-- `λ H, H.carrier` is the function `H ↦ H.carrier`.

-- Let's check we have this working, and also tell the simplifier that we
-- would rather talk about `g ∈ H` than any other way of saying it.

/-- `g` is in the underlying subset of `H` iff `g ∈ H`. -/
@[simp] lemma mem_carrier {g : G} : g ∈ H.carrier ↔ g ∈ H :=
begin
  -- true by definition
  refl
end

/-- `g` is in `H` considered as a subset of `G`, iff `g` is in `H` considered
as subgroup of `G`. -/
@[simp] lemma mem_coe {g : G} : g ∈ (↑H : set G) ↔ g ∈ H :=
begin
  -- true by definition
  refl
end

-- Now let's define theorems without the `'`s in, which use this
-- more natural notation

/-- A subgroup contains the group's 1. -/
theorem one_mem : (1 : G) ∈ H :=
begin
  apply H.one_mem',
end

/-- A subgroup is closed under multiplication. -/
theorem mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H :=
begin
  apply H.mul_mem',
end

/-- A subgroup is closed under inverse -/
theorem inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H :=
begin
  apply H.inv_mem',
end

/-

So here are the three theorems which you need to remember about subgroups.
Say `H : subgroup G`. Then:

`H.one_mem : (1 : G) ∈ H`
`H.mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H`
`H.inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H`

These now look like the way a mathematician would write things.

Now let's start to prove basic theorems about subgroups (or, as a the computer
scientists would say, make a basic _interface_ or _API_ for subgroups),
using this sensible notation.

Here's an example; let's prove `x ∈ H ↔ x⁻¹ ∈ H`. Let's put the more
complicated expression on the left hand side of the `↔` though, because then
we can make it a `simp` lemma.
-/

-- Remember that `xena.group.inv_inv x` is the statement that `x⁻¹⁻¹ = x`

@[simp] theorem inv_mem_iff {x : G} : x⁻¹ ∈ H ↔ x ∈ H :=
begin
  split,
  { intro h,
    rw ← xena.group.inv_inv x,
    apply H.inv_mem,
    assumption },
  { apply H.inv_mem },
end

-- We could prove a bunch more theorems here. Let's just do one more.
-- Let's show that if x and xy are in H then so is y.

theorem mem_of_mem_mul_mem {x y : G} (hx : x ∈ H) (hxy : x * y ∈ H) : y ∈ H :=
begin
  rw ← inv_mem_iff at hx,
  convert H.mul_mem hx hxy, -- I claim that this proof that x⁻¹ * (x * y) ∈ H is what we want
  -- so now it just remains to prove x⁻¹ * (x * y) = y, which we can do because of Knuth-Bendix
  simp,
end

/-
Subgroups are extensional objects (like most things in mathematics):
two subgroups are equal if they have the same underlying subset,
and also if they have the same underlying elements.
Let's prove variants of this triviality now. The first one is rather
un-mathematical: it takes a subgroup apart into its pieces. I'll see if
you can do the other two!
-/

/-- Two subgroups are equal if the underlying subsets are equal. -/
theorem ext' {H K : subgroup G} (h : H.carrier = K.carrier) : H = K :=
begin
  -- first take H and K apart
  cases H, -- H now broken up into its underlying 3-tuple.
  cases K,
  -- and now it must be obvious, so let's see if the simplifier can do it.
  simp * at *, -- it can!
end

-- here's a variant. You can prove it using `ext'`.

/-- Two subgroups are equal if and only if the underlying subsets are equal. -/
theorem ext'_iff {H K : subgroup G} :
  H.carrier = K.carrier ↔ H = K :=
begin
  split,
  { exact ext' },
  { intro h,
    rw h, }
end

-- to do this next one, first apply the `ext'` theorem we just proved,
-- and then use the `ext` tactic (which works on sets)

/-- Two subgroups are equal if they have the same elements. -/
@[ext] theorem ext {H K : subgroup G} (h : ∀ x, x ∈ H ↔ x ∈ K) : H = K :=
begin
  -- first apply ext' to reduce to checking the carriers are equal
  apply ext',
  -- now use the ext tactic to reduce to checking the elements of
  -- the carriers are equal
  ext,
  -- and now this is by definition what h says
  apply h,
end

/-
We tagged that theorem with `ext`, so now the `ext` tactic works on subgroups
too: if you ever have a goal of proving that two subgroups are equal, you can
use the `ext` tactic to reduce to showing that they have the same elements.
-/

/-

## The lattice structure on subgroups

Subgroups of a group form what is known as a *lattice*.
This is a partially ordered set with a sensible notion of
max and min. We partially order subgroups by saying `H ≤ K` if
`H.carrier ⊆ K.carrier`. Subgroups even have a good notion of an infinite
Sup and Inf (the Inf of a bunch of subgroups is just their intersection;
their Sup is the subgroup generated by their union).

This combinatorial structure (a partially ordered set with good
finite and infinite notions of Sup and Inf) is called a "complete lattice",
and Lean has this structure inbuilt into it. We will construct
a complete lattice structure on `subgroup G`.

We start by defining a relation ≤ on the type of subgroups of a group.
We say H ≤ K iff H.carrier ⊆ K.carrier .
-/

/-- If `H` and `K` are subgroups of `G`, we write `H ≤ K` to
  mean `H.carrier ⊆ K.carrier` -/
instance : has_le (subgroup G) := ⟨λ H K, H.carrier ⊆ K.carrier⟩

-- useful to restate the definition so we can `rw` it
lemma le_def : H ≤ K ↔ H.carrier ⊆ K.carrier :=
begin
  -- true by definition
  refl
end

-- another useful variant
lemma le_iff : H ≤ K ↔ ∀ g, g ∈ H → g ∈ K :=
begin
  -- true by definition
  refl,
end

-- Now let's check the axioms for a partial order.
-- These are not hard, they just reduce immediately to the
-- fact that ⊆ is a partial order
@[refl] lemma le_refl : H ≤ H :=
begin
  rw le_def,
  -- Lean knows ⊆ is reflexive so the sneaky `refl` which Lean tries after `rw`
  -- has closed the goal!
end

lemma le_antisymm : H ≤ K → K ≤ H → H = K :=
begin
  rw [le_def, le_def, ← ext'_iff],
  -- now this is antisymmetry of ⊆, which Lean knows
  exact set.subset.antisymm,
end

@[trans] lemma le_trans : H ≤ J → J ≤ K → H ≤ K :=
begin
  rw [le_def, le_def, le_def],
  -- now this is transitivity of ⊆, which Lean knows
  exact set.subset.trans,
end

-- We've made `subgroup G` into a partial order!
instance : partial_order (subgroup G) :=
{ le := (≤),
  le_refl := le_refl,
  le_antisymm := le_antisymm,
  le_trans := le_trans }

/-

### intersections

Let's prove that the intersection of two subgroups is a subgroup. In Lean
this is a definition: given two subgroups, we define a new subgroup whose
underlying subset is the intersection of the subsets, and then prove
the axioms.
-/

/-- The intersection of two subgroups is also a subgroup -/
def inf (H K : subgroup G) : subgroup G :=
{ carrier := H.carrier ∩ K.carrier, -- the carrier is the intersection
  one_mem' :=
  begin
    -- recall that x ∈ Y ∩ Z is _by definition_ x ∈ Y ∧ x ∈ Z, so you can `split` this.
    split,
    { exact H.one_mem },
    { exact K.one_mem },
  end,
  mul_mem' :=
  begin
    intros x y hx hy,
    cases hx with hxH hxK,
    cases hy with hyH hyK,
    split,
    { exact H.mul_mem hxH hyH },
    { exact K.mul_mem hxK hyK },
  end,
  inv_mem' :=
  begin
    rintro x ⟨hxH, hxK⟩, -- rintro does intro and cases all in one go
    exact ⟨H.inv_mem hxH, K.inv_mem hxK⟩, -- ⟨⟩ instead of split
  end }

-- Note that using "term mode" one can really compactify all this.
def inf_term_mode (H K : subgroup G) : subgroup G :=
{ carrier := H.carrier ∩ K.carrier,
  one_mem' := ⟨H.one_mem, K.one_mem⟩,
  mul_mem' := λ _ _ ⟨hhx, hkx⟩ ⟨hhy, hky⟩,
  ⟨H.mul_mem hhx hhy, K.mul_mem hkx hky⟩,
  inv_mem' := λ x ⟨hhx, hhy⟩,
  ⟨H.inv_mem hhx, K.inv_mem hhy⟩}

-- Notation for `inf` in computer science circles is ⊓ .

instance : has_inf (subgroup G) := ⟨inf⟩

/-- The underlying set of the inf of two subgroups is just their intersection -/
lemma inf_def (H K : subgroup G) : (H ⊓ K : set G) = (H : set G) ∩ K :=
begin
  -- true by definition
  refl
end

/-

## Subgroup generated by a subset.

To do the sup of two subgroups is harder, because we don't just take
the union, we need to then look at the subgroup generated by this union
(e.g. the union of the x and y axes in ℝ² is not a subgroup). So we need
to have a machine to spit out the subgroup of `G` generated by a subset `S : set G`.

There are two completely different ways to do this. The first is a "top-down"
approach. We could define the subgroup generated by `S` to be the intersection of
all the subgroups of `G` that contain `S`. The second is a "bottom-up" approach.
We could define the subgroup generated by `S` "by induction" (or more precisely
by recursion), saying that `S` is in the subgroup, 1 is in the subgroup,
the product of two things in the subgroup is in the subgroup, the
inverse of something in the subgroup is in the subgroup, and that's it.
Both methods come out rather nicely in Lean. Let's do the first one.

We are going to be using a bunch of theorems about "bounded intersections",
a.k.a. `set.bInter`. We will soon get tired of writing `set.blah` so let's
`open set` so that we can skip it.

-/

open set

/-

Here is the API for `set.bInter` (or `bInter`, as we can now call it):

Notation: `⋂` (type with `\I`)

If `X : set (subgroup G)`, i.e. if `X` is a set of subgroups of `G`, then

`⋂ K ∈ X, (K : set G)` means "take the intersection of the underlying subsets".

-- mem_bInter_iff says you're in the intersection iff you're in
-- all the things you're intersecting. Very useful for rewriting.
`mem_bInter_iff : (g ∈ ⋂ (K ∈ S), f K) ↔ (∀ K, K ∈ s → g ∈ f K)`

-- mem_bInter is just the one way implication. Very useful for `apply`ing.
`mem_bInter : (∀ K, K ∈ s → g ∈ f K) → (g ∈ ⋂ (K ∈ S), f K)`

-/
/-
We will consider the closure of a set as the intersect of all subgroups
containing the set
-/

/-- The Inf of a set of subgroups of G is their intersection. -/
def Inf (X : set (subgroup G)) : subgroup G :=
{ carrier := ⋂ K ∈ X, (K : set G), -- carrier is the intersection of the underlying sets
  one_mem' := begin
    apply mem_bInter,
    intros H hH,
    apply H.one_mem,
  end,
  mul_mem' := begin
    intros x y hx hy,
    rw mem_bInter_iff at *,
    intros H hH,
    apply H.mul_mem,
    { apply hx,
      exact hH },
    { exact hy H hH }
  end,
  inv_mem' := begin
    intros x hX,
    rw mem_bInter_iff at *,
    intros H hH,
    exact H.inv_mem (hX H hH),
  end,
}

-- again note that term mode can do this much more quickly
def Inf' (X : set (subgroup G)) : subgroup G :=
{ carrier := ⋂ t ∈ X, (t : set G),
  one_mem' := mem_bInter $ λ i h, i.one_mem,
  mul_mem' := λ x y hx hy, mem_bInter $ λ i h,
    i.mul_mem (by apply mem_bInter_iff.1 hx i h)
    (by apply mem_bInter_iff.1 hy i h),
  inv_mem' := λ x hx, mem_bInter $ λ i h,
    i.inv_mem (by apply mem_bInter_iff.1 hx i h) }

/-- The *closure* of a subset `S` of `G` is the `Inf` of the subgroups of `G`
  which contain `S`. -/
def closure (S : set G) : subgroup G := Inf {H : subgroup G | S ⊆ H}

-- we can restate mem_bInter_iff using our new "closure" language:
lemma mem_closure_iff {S : set G} {x : G} :
  x ∈ closure S ↔ ∀ H : subgroup G, S ⊆ H → x ∈ H := mem_bInter_iff

/-
There is an underlying abstraction here, which you may not know about.
A "closure operator" in mathematics

https://en.wikipedia.org/wiki/Closure_operator

is something mapping subsets of a set X to subsets of X, and satisfying three
axioms:

1) `subset_closure : S ⊆ closure S`
2) `closure_mono : (S ⊆ T) → (closure S ⊆ closure T)`
3) `closure_closure : closure (closure S) = closure S`

It works for closure in topological spaces, and it works here too.
It also works for algebraic closures of fields, and there are several
other places in mathematics where it shows up. This idea, of "abstracting"
and axiomatising a phenomenon which shows up in more than one place,
is really key in Lean.

Let's prove these three lemmas in the case where `X = G` and `closure S`
is the subgroup generated by `S`.

Here are some things you might find helpful.

Remember
`mem_coe : g ∈ ↑H ↔ g ∈ H`
`mem_carrier : g ∈ H.carrier ↔ g ∈ H`

There's
`mem_closure_iff : x ∈ closure S ↔ ∀ (H : subgroup G), S ⊆ ↑H → x ∈ H`
(`closure S` is a subgroup so you might need to use `mem_coe` or `mem_carrier` first)

For subsets there's
`subset.trans : X ⊆ Y → Y ⊆ Z → X ⊆ Z`

You might find `le_antisymm : H ≤ K → K ≤ H → H = K` from above useful
-/

/-
Reminder: X ⊆ Y means `∀ g, g ∈ X → g ∈ Y` and it's definitional,
so you can just start this with `intro g`.
-/
lemma subset_closure (S : set G) : S ⊆ ↑(closure S) :=
begin
  intro g,
  intro hgS,
  rw [mem_coe, mem_closure_iff],
  intros H hH,
  apply hH,
  assumption
end

-- fancy term mode proof
lemma subset_closure' (S : set G) : S ⊆ closure S :=
λ s hs H ⟨y, hy⟩, by {rw [←hy, mem_Inter], exact λ hS, hS hs}

-- It's useful to know `subset.trans : X ⊆ Y → Y ⊆ Z → X ⊆ Z`
lemma closure_mono {S T : set G} (hST : S ⊆ T) : closure S ≤ closure T :=
begin
  intros x hx,
  rw [mem_carrier, mem_closure_iff] at *,
  intros H hTH,
  apply hx,
  exact subset.trans hST hTH,
end

-- not one of the axioms, but sometimes handy
lemma closure_le (S : set G) (H : subgroup G) : closure S ≤ H ↔ S ⊆ ↑H :=
begin
  split,
    { intro hSH,
      exact subset.trans (subset_closure S) hSH },
    { intros hSH g hg,
      rw [mem_carrier, mem_closure_iff] at hg,
      exact hg _ hSH }
end

-- You can start this one by applying `le_antisymm`,
lemma closure_closure (S : set G) : closure S = closure (closure S) :=
begin
  apply le_antisymm,
  { apply subset_closure },
  { rw closure_le,
    intros x hx,
    exact hx },
end

-- This shows that every subgroup is the closure of something, namely its
-- underlying subset.
lemma closure_self {H : subgroup G} : closure ↑H = H :=
begin
  apply le_antisymm,
  { rw le_iff,
    intro g,
    rw mem_closure_iff,
    intro h,
    apply h,
    refl },
  { exact subset_closure H }
end

/-
Recall the second proposed construction of the subgroup closure of a subset `S`;
it is the smallest subgroup `H` of `G` such that `S ⊆ H` and which contains
`1` and is closed under `*` and `⁻¹`. This inductive constuction (which we
did not make) comes with a so-called "recursor": if we have a true/false
statement `p g` attached to each element `g` of G with the following properties:

1) `p s` is true for all `s ∈ S`,
2) `p 1` is true,
3) If `p x` and `p y` then `p (x * y)`,
4) If `p x` then `p x⁻¹`

Then `p` is true on all of `closure S`.

If we had made an inductive definition of `closure S` then this would have been true
by definition! We used another definition, so we will have to prove it
ourselves.
-/

/-- An induction principle for closures. -/
lemma closure_induction {p : G → Prop} {S : set G}
  (HS : ∀ x ∈ S, p x)
  (H1 : p 1)
  (Hmul : ∀ x y, p x → p y → p (x * y))
  (Hinv : ∀ x, p x → p x⁻¹) :
  -- conclusion after colon
  ∀ x, x ∈ closure S → p x :=
begin
  -- the subset of G where `p` is true is a subgroup. Let's call it H
  let H : subgroup G :=
  { carrier := p,
    one_mem' := H1,
    mul_mem' := Hmul,
    inv_mem' := Hinv },
  -- The goal is just that closure S ≤ H, by definition.
  change closure S ≤ H,
  -- Our hypothesis HS is just that S ⊆ ↑H, by definition
  change S ⊆ ↑H at HS,
  -- So this is just closure_le in disguise
  rw closure_le,
  assumption,
end

-- this is even briefer in term mode:
lemma closure_induction' {p : G → Prop} {S : set G}
  (HS : ∀ x ∈ S, p x)
  (H1 : p 1)
  (Hmul : ∀ x y, p x → p y → p (x * y))
  (Hinv : ∀ x, p x → p x⁻¹) :
  ∀ x, x ∈ closure S → p x :=
λ x h, (@closure_le _ _ _ ⟨p, H1, Hmul, Hinv⟩).2 HS h

/-
Finally we prove that the `closure` and `coe` maps form a `galois_insertion`.
This is another abstraction, it generalises `galois_connection`, which is
something that shows up all over the place (algebraic geometry, Galois theory etc).
See

https://en.wikipedia.org/wiki/Galois_connection

A partial order can be considered as a category, with Hom(A,B) having
one element if A ≤ B and no elements otherwise. A Galois connection between
two partial orders is just a pair of adjoint functors between the categories.
Adjointness in our case is `S ⊆ ↑H ↔ closure S ≤ H`.

The reason it's an insertion and not just a connection is that if you start
with a subgroup, take the underlying subset, and then look at the subgroup
generated by that set, you get back to where you started. So it's like one
of the adjoint functors being a forgetful functor.
-/

def gi : galois_insertion (closure : set G → subgroup G) (coe : subgroup G → set G) :=
{ choice := λ S _, closure S,
  gc := closure_le,
  le_l_u := λ H, subset_closure (H : set G),
  choice_eq := λ _ _, rfl }

/-

One use of this abstraction is that now we can pull back the complete
lattice structure on `set G` to get a complete lattice structure on `subgroup G`.
-/

instance : complete_lattice (subgroup G) :=
{.. galois_insertion.lift_complete_lattice gi}

/-

We just proved loads of lemmas about Infs and Sups of subgroups automatically,
and have access to a ton more because the `complete_lattice` structure in
Lean has a big API. See for example

https://leanprover-community.github.io/mathlib_docs/order/complete_lattice.html#complete_lattice

All those theorems are now true for subgroups. None are particularly hard to prove,
but the point is that we don't now have to prove any of them ourselves.
-/
end subgroup

end xena

/-

Further work: `bot` and `top` (would have to explain the
API for `singleton` and `univ`)

-/


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.images
import category_theory.limits.shapes.kernels

/-!
# The morphism from `image f` to `kernel g` when `f ≫ g = 0`

We define the map, as the lift of `image.ι f` to `kernel g`,
and check some basic properties:

* this map is a monomorphism
* given `A --0--> B --g--> C`, where `[mono g]`, this map is an epimorphism
* given `A --f--> B --0--> C`, where `[epi f]`, this map is an epimorphism

In later files, we define the homology of complex as the cokernel of this map,
and say a complex is exact at a point if this map is an epimorphism.
-/

universes v u

open category_theory
open category_theory.limits

variables {V : Type u} [category.{v} V] [has_zero_morphisms V]

namespace category_theory

/-!
At this point we assume that we have all images, and all equalizers.
We need to assume all equalizers, not just kernels, so that
`factor_thru_image` is an epimorphism.
-/
variables [has_images V] [has_equalizers V]
variables {A B C : V} (f : A ⟶ B) (g : B ⟶ C)

/--
The morphism from `image f` to `kernel g` when `f ≫ g = 0`.
-/
noncomputable
abbreviation image_to_kernel_map (w : f ≫ g = 0) :
  image f ⟶ kernel g :=
kernel.lift g (image.ι f) $ (cancel_epi (factor_thru_image f)).1 $ by simp [w]

@[simp]
lemma image_to_kernel_map_zero_left [has_zero_object V] {w} :
  image_to_kernel_map (0 : A ⟶ B) g w = 0 :=
by { delta image_to_kernel_map, simp }

lemma image_to_kernel_map_zero_right {w} :
  image_to_kernel_map f (0 : B ⟶ C) w = image.ι f ≫ inv (kernel.ι (0 : B ⟶ C)) :=
by { ext, simp }

lemma image_to_kernel_map_comp_right {D : V} (h : C ⟶ D) (w : f ≫ g = 0) :
  image_to_kernel_map f (g ≫ h) (by simp [reassoc_of w]) =
    image_to_kernel_map f g w ≫ kernel.lift (g ≫ h) (kernel.ι g) (by simp) :=
by { ext, simp }

lemma image_to_kernel_map_comp_left {Z : V} (h : Z ⟶ A) (w : f ≫ g = 0) :
  image_to_kernel_map (h ≫ f) g (by simp [w]) = image.pre_comp h f ≫ image_to_kernel_map f g w :=
by { ext, simp }

@[simp]
lemma image_to_kernel_map_comp_iso {D : V} (h : C ⟶ D) [is_iso h] (w) :
  image_to_kernel_map f (g ≫ h) w =
  image_to_kernel_map f g ((cancel_mono h).mp (by simpa using w : (f ≫ g) ≫ h = 0 ≫ h)) ≫
    (kernel_comp_mono g h).inv :=
by { ext, simp, }

@[simp]
lemma image_to_kernel_map_iso_comp {Z : V} (h : Z ⟶ A) [is_iso h] (w) :
  image_to_kernel_map (h ≫ f) g w =
  image.pre_comp h f ≫
    image_to_kernel_map f g ((cancel_epi h).mp (by simpa using w : h ≫ f ≫ g = h ≫ 0)) :=
by { ext, simp, }

@[simp]
lemma image_to_kernel_map_comp_hom_inv_comp {Z : V} {i : B ≅ Z} (w) :
  image_to_kernel_map (f ≫ i.hom) (i.inv ≫ g) w =
  (image.comp_iso f i.hom).inv ≫ image_to_kernel_map f g (by simpa using w) ≫
    (kernel_is_iso_comp i.inv g).inv :=
by { ext, simp }

local attribute [instance] has_zero_object.has_zero

/--
`image_to_kernel_map` for `A --0--> B --g--> C`, where `[mono g]` is an epi
(i.e. the sequence is exact at `B`).
-/
lemma image_to_kernel_map_epi_of_zero_of_mono [mono g] [has_zero_object V] :
  epi (image_to_kernel_map (0 : A ⟶ B) g (by simp)) :=
epi_of_target_iso_zero _ (kernel.of_mono g)

/--
`image_to_kernel_map` for `A --f--> B --0--> C`, where `[epi g]` is an epi
(i.e. the sequence is exact at `B`).
-/
lemma image_to_kernel_map_epi_of_epi_of_zero [epi f] :
  epi (image_to_kernel_map f (0 : B ⟶ C) (by simp)) :=
begin
  simp only [image_to_kernel_map_zero_right],
  haveI := epi_image_of_epi f,
  apply epi_comp,
end

end category_theory


/-
Copyright (c) 2022 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import model_theory.elementary_maps

/-!
# Skolem Functions and Downward Löwenheim–Skolem

## Main Definitions
* `first_order.language.skolem₁` is a language consisting of Skolem functions for another language.

## Main Results
* `first_order.language.exists_elementary_substructure_card_eq` is the Downward Löwenheim–Skolem
  theorem: If `s` is a set in an `L`-structure `M` and `κ` an infinite cardinal such that
  `max (# s, L.card) ≤ κ` and `κ ≤ # M`, then `M` has an elementary substructure containing `s` of
  cardinality `κ`.

## TODO
* Use `skolem₁` recursively to construct an actual Skolemization of a language.

-/

universes u v w w'

namespace first_order
namespace language
open Structure cardinal
open_locale cardinal

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

/-- A language consisting of Skolem functions for another language.
Called `skolem₁` because it is the first step in building a Skolemization of a language. -/
@[simps] def skolem₁ : language := ⟨λ n, L.bounded_formula empty (n + 1), λ _, empty⟩

variables {L}

theorem card_functions_sum_skolem₁ :
  # (Σ n, (L.sum L.skolem₁).functions n) = # (Σ n, L.bounded_formula empty (n + 1)) :=
begin
  simp only [card_functions_sum, skolem₁_functions, lift_id', mk_sigma, sum_add_distrib'],
  rw [add_comm, add_eq_max, max_eq_left],
  { refine sum_le_sum _ _ (λ n, _),
    rw [← lift_le, lift_lift, lift_mk_le],
    refine ⟨⟨λ f, (func f default).bd_equal (func f default), λ f g h, _⟩⟩,
    rcases h with ⟨rfl, ⟨rfl⟩⟩,
    refl },
  { rw ← mk_sigma,
    exact infinite_iff.1 (infinite.of_injective (λ n, ⟨n, ⊥⟩) (λ x y xy, (sigma.mk.inj xy).1)) }
end

theorem card_functions_sum_skolem₁_le :
  # (Σ n, (L.sum L.skolem₁).functions n) ≤ max ℵ₀ L.card :=
begin
  rw card_functions_sum_skolem₁,
  transitivity # (Σ n, L.bounded_formula empty n),
  { exact ⟨⟨sigma.map nat.succ (λ _, id), nat.succ_injective.sigma_map
    (λ _, function.injective_id)⟩⟩ },
  { refine trans bounded_formula.card_le (lift_le.1 _),
    simp only [mk_empty, lift_zero, lift_uzero, zero_add] }
end

/-- The structure assigning each function symbol of `L.skolem₁` to a skolem function generated with
choice. -/
noncomputable instance skolem₁_Structure : L.skolem₁.Structure M :=
⟨λ n φ x, classical.epsilon (λ a, φ.realize default (fin.snoc x a : _ → M)), λ _ r, empty.elim r⟩

namespace substructure

lemma skolem₁_reduct_is_elementary (S : (L.sum L.skolem₁).substructure M) :
  (Lhom.sum_inl.substructure_reduct S).is_elementary :=
begin
  apply (Lhom.sum_inl.substructure_reduct S).is_elementary_of_exists,
  intros n φ x a h,
  let φ' : (L.sum L.skolem₁).functions n := (Lhom.sum_inr.on_function φ),
  exact ⟨⟨fun_map φ' (coe ∘ x), S.fun_mem (Lhom.sum_inr.on_function φ) (coe ∘ x) (λ i, (x i).2)⟩,
    classical.epsilon_spec ⟨a, h⟩⟩,
end

/-- Any `L.sum L.skolem₁`-substructure is an elementary `L`-substructure. -/
noncomputable def elementary_skolem₁_reduct (S : (L.sum L.skolem₁).substructure M) :
  L.elementary_substructure M :=
⟨Lhom.sum_inl.substructure_reduct S, S.skolem₁_reduct_is_elementary⟩

lemma coe_sort_elementary_skolem₁_reduct
  (S : (L.sum L.skolem₁).substructure M) :
  (S.elementary_skolem₁_reduct : Type w) = S :=
rfl

end substructure

open substructure

variables (L) (M)

instance : small (⊥ : (L.sum L.skolem₁).substructure M).elementary_skolem₁_reduct :=
begin
  rw [coe_sort_elementary_skolem₁_reduct],
  apply_instance,
end

theorem exists_small_elementary_substructure :
  ∃ (S : L.elementary_substructure M), small.{max u v} S :=
⟨substructure.elementary_skolem₁_reduct ⊥, infer_instance⟩

variables {M}

/-- The Downward Löwenheim–Skolem theorem :
  If `s` is a set in an `L`-structure `M` and `κ` an infinite cardinal such that
  `max (# s, L.card) ≤ κ` and `κ ≤ # M`, then `M` has an elementary substructure containing `s` of
  cardinality `κ`.  -/
theorem exists_elementary_substructure_card_eq (s : set M) (κ : cardinal.{w'})
  (h1 : ℵ₀ ≤ κ)
  (h2 : cardinal.lift.{w'} (# s) ≤ cardinal.lift.{w} κ)
  (h3 : cardinal.lift.{w'} L.card ≤ cardinal.lift.{max u v} κ)
  (h4 : cardinal.lift.{w} κ ≤ cardinal.lift.{w'} (# M)) :
  ∃ (S : L.elementary_substructure M), s ⊆ S ∧
    cardinal.lift.{w'} (# S) = cardinal.lift.{w} κ :=
begin
  obtain ⟨s', hs'⟩ := cardinal.le_mk_iff_exists_set.1 h4,
  rw ← aleph_0_le_lift at h1,
  rw ← hs' at *,
  refine ⟨elementary_skolem₁_reduct (closure (L.sum L.skolem₁)
    (s ∪ (equiv.ulift '' s'))),
    (s.subset_union_left _).trans subset_closure, _⟩,
  have h := mk_image_eq_lift _ s' equiv.ulift.injective,
  rw [lift_umax, lift_id'] at h,
  rw [coe_sort_elementary_skolem₁_reduct, ← h, lift_inj],
  refine le_antisymm (lift_le.1 (lift_card_closure_le.trans _))
    (mk_le_mk_of_subset ((set.subset_union_right _ _).trans subset_closure)),
  rw [max_le_iff, aleph_0_le_lift, ← aleph_0_le_lift, h, add_eq_max, max_le_iff, lift_le],
  refine ⟨h1, (mk_union_le _ _).trans _, (lift_le.2 card_functions_sum_skolem₁_le).trans _⟩,
  { rw [← lift_le, lift_add, h, add_comm, add_eq_max h1],
    exact max_le le_rfl h2 },
  { rw [lift_max, lift_aleph_0, max_le_iff, aleph_0_le_lift, and_comm,
      ← lift_le.{_ w'}, lift_lift, lift_lift, ← aleph_0_le_lift, h],
    refine ⟨_, h1⟩,
    simp only [← lift_lift, lift_umax, lift_umax'],
    rw [lift_lift, ← lift_lift.{w' w} L.card],
    refine trans ((lift_le.{_ w}).2 h3) _,
    rw [lift_lift, ← lift_lift.{w (max u v)}, ← hs', ← h, lift_lift, lift_lift, lift_lift] },
  { refine trans _ (lift_le.2 (mk_le_mk_of_subset (set.subset_union_right _ _))),
    rw [aleph_0_le_lift, ← aleph_0_le_lift, h],
    exact h1 }
end

end language
end first_order


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

! This file was ported from Lean 3 source module measure_theory.measure.sub
! leanprover-community/mathlib commit 562bbf524c595c153470e53d36c57b6f891cc480
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.MeasureSpace

/-!
# Subtraction of measures

In this file we define `μ - ν` to be the least measure `τ` such that `μ ≤ τ + ν`.
It is the equivalent of `(μ - ν) ⊔ 0` if `μ` and `ν` were signed measures.
Compare with `ennreal.has_sub`.
Specifically, note that if you have `α = {1,2}`, and  `μ {1} = 2`, `μ {2} = 0`, and
`ν {2} = 2`, `ν {1} = 0`, then `(μ - ν) {1, 2} = 2`. However, if `μ ≤ ν`, and
`ν univ ≠ ∞`, then `(μ - ν) + ν = μ`.
-/

open Set

namespace MeasureTheory

namespace Measure

/-- The measure `μ - ν` is defined to be the least measure `τ` such that `μ ≤ τ + ν`.
It is the equivalent of `(μ - ν) ⊔ 0` if `μ` and `ν` were signed measures.
Compare with `ennreal.has_sub`.
Specifically, note that if you have `α = {1,2}`, and  `μ {1} = 2`, `μ {2} = 0`, and
`ν {2} = 2`, `ν {1} = 0`, then `(μ - ν) {1, 2} = 2`. However, if `μ ≤ ν`, and
`ν univ ≠ ∞`, then `(μ - ν) + ν = μ`. -/
noncomputable instance hasSub {α : Type _} [MeasurableSpace α] : Sub (Measure α) :=
  ⟨fun μ ν => infₛ { τ | μ ≤ τ + ν }⟩
#align measure_theory.measure.has_sub MeasureTheory.Measure.hasSub

variable {α : Type _} {m : MeasurableSpace α} {μ ν : Measure α} {s : Set α}

theorem sub_def : μ - ν = infₛ { d | μ ≤ d + ν } :=
  rfl
#align measure_theory.measure.sub_def MeasureTheory.Measure.sub_def

theorem sub_le_of_le_add {d} (h : μ ≤ d + ν) : μ - ν ≤ d :=
  infₛ_le h
#align measure_theory.measure.sub_le_of_le_add MeasureTheory.Measure.sub_le_of_le_add

theorem sub_eq_zero_of_le (h : μ ≤ ν) : μ - ν = 0 :=
  nonpos_iff_eq_zero'.1 <| sub_le_of_le_add <| by rwa [zero_add]
#align measure_theory.measure.sub_eq_zero_of_le MeasureTheory.Measure.sub_eq_zero_of_le

theorem sub_le : μ - ν ≤ μ :=
  sub_le_of_le_add <| Measure.le_add_right le_rfl
#align measure_theory.measure.sub_le MeasureTheory.Measure.sub_le

@[simp]
theorem sub_top : μ - ⊤ = 0 :=
  sub_eq_zero_of_le le_top
#align measure_theory.measure.sub_top MeasureTheory.Measure.sub_top

@[simp]
theorem zero_sub : 0 - μ = 0 :=
  sub_eq_zero_of_le μ.zero_le
#align measure_theory.measure.zero_sub MeasureTheory.Measure.zero_sub

@[simp]
theorem sub_self : μ - μ = 0 :=
  sub_eq_zero_of_le le_rfl
#align measure_theory.measure.sub_self MeasureTheory.Measure.sub_self

/-- This application lemma only works in special circumstances. Given knowledge of
when `μ ≤ ν` and `ν ≤ μ`, a more general application lemma can be written. -/
theorem sub_apply [IsFiniteMeasure ν] (h₁ : MeasurableSet s) (h₂ : ν ≤ μ) : (μ - ν) s = μ s - ν s :=
  by
  -- We begin by defining `measure_sub`, which will be equal to `(μ - ν)`.
  let measure_sub : Measure α :=
    @MeasureTheory.Measure.ofMeasurable α _
      (fun (t : Set α) (h_t_measurable_set : MeasurableSet t) => μ t - ν t) (by simp)
      (by
        intro g h_meas h_disj; simp only; rw [ENNReal.tsum_sub]
        repeat' rw [← MeasureTheory.measure_unionᵢ h_disj h_meas]
        exacts[MeasureTheory.measure_ne_top _ _, fun i => h₂ _ (h_meas _)])
  -- Now, we demonstrate `μ - ν = measure_sub`, and apply it.
  · have h_measure_sub_add : ν + measure_sub = μ :=
      by
      ext (t h_t_measurable_set)
      simp only [Pi.add_apply, coe_add]
      rw [MeasureTheory.Measure.ofMeasurable_apply _ h_t_measurable_set, add_comm,
        tsub_add_cancel_of_le (h₂ t h_t_measurable_set)]
    have h_measure_sub_eq : μ - ν = measure_sub :=
      by
      rw [MeasureTheory.Measure.sub_def]
      apply le_antisymm
      · apply @infₛ_le (Measure α) measure.complete_semilattice_Inf
        simp [le_refl, add_comm, h_measure_sub_add]
      apply @le_infₛ (Measure α) measure.complete_semilattice_Inf
      intro d h_d
      rw [← h_measure_sub_add, mem_set_of_eq, add_comm d] at h_d
      apply measure.le_of_add_le_add_left h_d
    rw [h_measure_sub_eq]
    apply measure.of_measurable_apply _ h₁
#align measure_theory.measure.sub_apply MeasureTheory.Measure.sub_apply

theorem sub_add_cancel_of_le [IsFiniteMeasure ν] (h₁ : ν ≤ μ) : μ - ν + ν = μ :=
  by
  ext (s h_s_meas)
  rw [add_apply, sub_apply h_s_meas h₁, tsub_add_cancel_of_le (h₁ s h_s_meas)]
#align measure_theory.measure.sub_add_cancel_of_le MeasureTheory.Measure.sub_add_cancel_of_le

theorem restrict_sub_eq_restrict_sub_restrict (h_meas_s : MeasurableSet s) :
    (μ - ν).restrict s = μ.restrict s - ν.restrict s :=
  by
  repeat' rw [sub_def]
  have h_nonempty : { d | μ ≤ d + ν }.Nonempty := ⟨μ, measure.le_add_right le_rfl⟩
  rw [restrict_Inf_eq_Inf_restrict h_nonempty h_meas_s]
  apply le_antisymm
  · refine' infₛ_le_infₛ_of_forall_exists_le _
    intro ν' h_ν'_in
    rw [mem_set_of_eq] at h_ν'_in
    refine' ⟨ν'.restrict s, _, restrict_le_self⟩
    refine' ⟨ν' + (⊤ : Measure α).restrict (sᶜ), _, _⟩
    · rw [mem_set_of_eq, add_right_comm, measure.le_iff]
      intro t h_meas_t
      repeat' rw [← measure_inter_add_diff t h_meas_s]
      refine' add_le_add _ _
      · rw [add_apply, add_apply]
        apply le_add_right _
        rw [← restrict_eq_self μ (inter_subset_right _ _), ←
          restrict_eq_self ν (inter_subset_right _ _)]
        apply h_ν'_in _ (h_meas_t.inter h_meas_s)
      · rw [add_apply, restrict_apply (h_meas_t.diff h_meas_s), diff_eq, inter_assoc, inter_self, ←
          add_apply]
        have h_mu_le_add_top : μ ≤ ν' + ν + ⊤ := by simp only [add_top, le_top]
        exact measure.le_iff'.1 h_mu_le_add_top _
    · ext1 t h_meas_t
      simp [restrict_apply h_meas_t, restrict_apply (h_meas_t.inter h_meas_s), inter_assoc]
  · refine' infₛ_le_infₛ_of_forall_exists_le _
    refine' ball_image_iff.2 fun t h_t_in => ⟨t.restrict s, _, le_rfl⟩
    rw [Set.mem_setOf_eq, ← restrict_add]
    exact restrict_mono subset.rfl h_t_in
#align measure_theory.measure.restrict_sub_eq_restrict_sub_restrict MeasureTheory.Measure.restrict_sub_eq_restrict_sub_restrict

theorem sub_apply_eq_zero_of_restrict_le_restrict (h_le : μ.restrict s ≤ ν.restrict s)
    (h_meas_s : MeasurableSet s) : (μ - ν) s = 0 := by
  rw [← restrict_apply_self, restrict_sub_eq_restrict_sub_restrict, sub_eq_zero_of_le] <;> simp [*]
#align measure_theory.measure.sub_apply_eq_zero_of_restrict_le_restrict MeasureTheory.Measure.sub_apply_eq_zero_of_restrict_le_restrict

instance isFiniteMeasureSub [IsFiniteMeasure μ] : IsFiniteMeasure (μ - ν) :=
  isFiniteMeasureOfLe μ sub_le
#align measure_theory.measure.is_finite_measure_sub MeasureTheory.Measure.isFiniteMeasureSub

end Measure

end MeasureTheory


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

! This file was ported from Lean 3 source module linear_algebra.projection
! leanprover-community/mathlib commit 6d584f1709bedbed9175bd9350df46599bdd7213
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.LinearAlgebra.Quotient
import Mathlib.LinearAlgebra.Prod

/-!
# Projection to a subspace

In this file we define
* `Submodule.linearProjOfIsCompl (p q : Submodule R E) (h : IsCompl p q)`:
  the projection of a module `E` to a submodule `p` along its complement `q`;
  it is the unique linear map `f : E → p` such that `f x = x` for `x ∈ p` and `f x = 0` for `x ∈ q`.
* `Submodule.isComplEquivProj p`: equivalence between submodules `q`
  such that `IsCompl p q` and projections `f : E → p`, `∀ x ∈ p, f x = x`.

We also provide some lemmas justifying correctness of our definitions.

## Tags

projection, complement subspace
-/

-- Porting note: TODO Erase this line. Needed because we don't have η for classes. (lean4#2074)
attribute [-instance] Ring.toNonAssocRing

noncomputable section Ring

variable {R : Type _} [Ring R] {E : Type _} [AddCommGroup E] [Module R E]
variable {F : Type _} [AddCommGroup F] [Module R F] {G : Type _} [AddCommGroup G] [Module R G]
variable (p q : Submodule R E)
variable {S : Type _} [Semiring S] {M : Type _} [AddCommMonoid M] [Module S M] (m : Submodule S M)

namespace LinearMap

variable {p}

open Submodule

theorem ker_id_sub_eq_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) :
    ker (id - p.subtype.comp f) = p := by
  ext x
  simp only [comp_apply, mem_ker, subtype_apply, sub_apply, id_apply, sub_eq_zero]
  exact ⟨fun h => h.symm ▸ Submodule.coe_mem _, fun hx => by erw [hf ⟨x, hx⟩, Subtype.coe_mk]⟩
#align linear_map.ker_id_sub_eq_of_proj LinearMap.ker_id_sub_eq_of_proj

theorem range_eq_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) : range f = ⊤ :=
  range_eq_top.2 fun x => ⟨x, hf x⟩
#align linear_map.range_eq_of_proj LinearMap.range_eq_of_proj

theorem isCompl_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) : IsCompl p (ker f) := by
  constructor
  · rw [disjoint_iff_inf_le]
    rintro x ⟨hpx, hfx⟩
    erw [SetLike.mem_coe, mem_ker, hf ⟨x, hpx⟩, mk_eq_zero] at hfx
    simp only [hfx, SetLike.mem_coe, zero_mem]
  · rw [codisjoint_iff_le_sup]
    intro x _
    rw [mem_sup']
    refine' ⟨f x, ⟨x - f x, _⟩, add_sub_cancel'_right _ _⟩
    rw [mem_ker, LinearMap.map_sub, hf, sub_self]
#align linear_map.is_compl_of_proj LinearMap.isCompl_of_proj

end LinearMap

namespace Submodule

open LinearMap

/-- If `q` is a complement of `p`, then `M/p ≃ q`. -/
def quotientEquivOfIsCompl (h : IsCompl p q) : (E ⧸ p) ≃ₗ[R] q :=
  LinearEquiv.symm <|
    LinearEquiv.ofBijective (p.mkQ.comp q.subtype)
      ⟨by rw [← ker_eq_bot, ker_comp, ker_mkQ, disjoint_iff_comap_eq_bot.1 h.symm.Disjoint], by
        rw [← range_eq_top, range_comp, range_subtype, map_mkQ_eq_top, h.sup_eq_top]⟩
#align submodule.quotient_equiv_of_is_compl Submodule.quotientEquivOfIsCompl

@[simp]
theorem quotientEquivOfIsCompl_symm_apply (h : IsCompl p q) (x : q) :
    -- Porting note: type ascriptions needed on the RHS
    (quotientEquivOfIsCompl p q h).symm x = (Quotient.mk (x:E) : E ⧸ p) := rfl
#align submodule.quotient_equiv_of_is_compl_symm_apply Submodule.quotientEquivOfIsCompl_symm_apply

@[simp]
theorem quotientEquivOfIsCompl_apply_mk_coe (h : IsCompl p q) (x : q) :
    quotientEquivOfIsCompl p q h (Quotient.mk x) = x :=
  (quotientEquivOfIsCompl p q h).apply_symm_apply x
#align submodule.quotient_equiv_of_is_compl_apply_mk_coe Submodule.quotientEquivOfIsCompl_apply_mk_coe

@[simp]
theorem mk_quotientEquivOfIsCompl_apply (h : IsCompl p q) (x : E ⧸ p) :
    (Quotient.mk (quotientEquivOfIsCompl p q h x) : E ⧸ p) = x :=
  (quotientEquivOfIsCompl p q h).symm_apply_apply x
#align submodule.mk_quotient_equiv_of_is_compl_apply Submodule.mk_quotientEquivOfIsCompl_apply

/-- If `q` is a complement of `p`, then `p × q` is isomorphic to `E`. It is the unique
linear map `f : E → p` such that `f x = x` for `x ∈ p` and `f x = 0` for `x ∈ q`. -/
def prodEquivOfIsCompl (h : IsCompl p q) : (p × q) ≃ₗ[R] E := by
  apply LinearEquiv.ofBijective (p.subtype.coprod q.subtype)
  constructor
  · rw [← ker_eq_bot, ker_coprod_of_disjoint_range, ker_subtype, ker_subtype, prod_bot]
    rw [range_subtype, range_subtype]
    exact h.1
  · rw [← range_eq_top, ← sup_eq_range, h.sup_eq_top]
#align submodule.prod_equiv_of_is_compl Submodule.prodEquivOfIsCompl

@[simp]
theorem coe_prodEquivOfIsCompl (h : IsCompl p q) :
    (prodEquivOfIsCompl p q h : p × q →ₗ[R] E) = p.subtype.coprod q.subtype := rfl
#align submodule.coe_prod_equiv_of_is_compl Submodule.coe_prodEquivOfIsCompl

@[simp]
theorem coe_prodEquivOfIsCompl' (h : IsCompl p q) (x : p × q) :
    prodEquivOfIsCompl p q h x = x.1 + x.2 := rfl
#align submodule.coe_prod_equiv_of_is_compl' Submodule.coe_prodEquivOfIsCompl'

@[simp]
theorem prodEquivOfIsCompl_symm_apply_left (h : IsCompl p q) (x : p) :
    (prodEquivOfIsCompl p q h).symm x = (x, 0) :=
  (prodEquivOfIsCompl p q h).symm_apply_eq.2 <| by simp
#align submodule.prod_equiv_of_is_compl_symm_apply_left Submodule.prodEquivOfIsCompl_symm_apply_left

@[simp]
theorem prodEquivOfIsCompl_symm_apply_right (h : IsCompl p q) (x : q) :
    (prodEquivOfIsCompl p q h).symm x = (0, x) :=
  (prodEquivOfIsCompl p q h).symm_apply_eq.2 <| by simp
#align submodule.prod_equiv_of_is_compl_symm_apply_right Submodule.prodEquivOfIsCompl_symm_apply_right

@[simp]
theorem prodEquivOfIsCompl_symm_apply_fst_eq_zero (h : IsCompl p q) {x : E} :
    ((prodEquivOfIsCompl p q h).symm x).1 = 0 ↔ x ∈ q := by
  conv_rhs => rw [← (prodEquivOfIsCompl p q h).apply_symm_apply x]
  rw [coe_prodEquivOfIsCompl', Submodule.add_mem_iff_left _ (Submodule.coe_mem _),
    mem_right_iff_eq_zero_of_disjoint h.Disjoint]
#align submodule.prod_equiv_of_is_compl_symm_apply_fst_eq_zero Submodule.prodEquivOfIsCompl_symm_apply_fst_eq_zero

@[simp]
theorem prodEquivOfIsCompl_symm_apply_snd_eq_zero (h : IsCompl p q) {x : E} :
    ((prodEquivOfIsCompl p q h).symm x).2 = 0 ↔ x ∈ p := by
  conv_rhs => rw [← (prodEquivOfIsCompl p q h).apply_symm_apply x]
  rw [coe_prodEquivOfIsCompl', Submodule.add_mem_iff_right _ (Submodule.coe_mem _),
    mem_left_iff_eq_zero_of_disjoint h.Disjoint]
#align submodule.prod_equiv_of_is_compl_symm_apply_snd_eq_zero Submodule.prodEquivOfIsCompl_symm_apply_snd_eq_zero

@[simp]
theorem prodComm_trans_prodEquivOfIsCompl (h : IsCompl p q) :
    LinearEquiv.prodComm R q p ≪≫ₗ prodEquivOfIsCompl p q h = prodEquivOfIsCompl q p h.symm :=
  LinearEquiv.ext fun _ => add_comm _ _
#align submodule.prod_comm_trans_prod_equiv_of_is_compl Submodule.prodComm_trans_prodEquivOfIsCompl

/-- Projection to a submodule along its complement. -/
def linearProjOfIsCompl (h : IsCompl p q) : E →ₗ[R] p :=
  LinearMap.fst R p q ∘ₗ ↑(prodEquivOfIsCompl p q h).symm
#align submodule.linear_proj_of_is_compl Submodule.linearProjOfIsCompl

variable {p q}

@[simp]
theorem linearProjOfIsCompl_apply_left (h : IsCompl p q) (x : p) :
    linearProjOfIsCompl p q h x = x := by simp [linearProjOfIsCompl]
#align submodule.linear_proj_of_is_compl_apply_left Submodule.linearProjOfIsCompl_apply_left

@[simp]
theorem linearProjOfIsCompl_range (h : IsCompl p q) : range (linearProjOfIsCompl p q h) = ⊤ :=
  range_eq_of_proj (linearProjOfIsCompl_apply_left h)
#align submodule.linear_proj_of_is_compl_range Submodule.linearProjOfIsCompl_range

@[simp]
theorem linearProjOfIsCompl_apply_eq_zero_iff (h : IsCompl p q) {x : E} :
    linearProjOfIsCompl p q h x = 0 ↔ x ∈ q := by simp [linearProjOfIsCompl]
#align submodule.linear_proj_of_is_compl_apply_eq_zero_iff Submodule.linearProjOfIsCompl_apply_eq_zero_iff

theorem linearProjOfIsCompl_apply_right' (h : IsCompl p q) (x : E) (hx : x ∈ q) :
    linearProjOfIsCompl p q h x = 0 :=
  (linearProjOfIsCompl_apply_eq_zero_iff h).2 hx
#align submodule.linear_proj_of_is_compl_apply_right' Submodule.linearProjOfIsCompl_apply_right'

@[simp]
theorem linearProjOfIsCompl_apply_right (h : IsCompl p q) (x : q) :
    linearProjOfIsCompl p q h x = 0 :=
  linearProjOfIsCompl_apply_right' h x x.2
#align submodule.linear_proj_of_is_compl_apply_right Submodule.linearProjOfIsCompl_apply_right

@[simp]
theorem linearProjOfIsCompl_ker (h : IsCompl p q) : ker (linearProjOfIsCompl p q h) = q :=
  ext fun _ => mem_ker.trans (linearProjOfIsCompl_apply_eq_zero_iff h)
#align submodule.linear_proj_of_is_compl_ker Submodule.linearProjOfIsCompl_ker

theorem linearProjOfIsCompl_comp_subtype (h : IsCompl p q) :
    (linearProjOfIsCompl p q h).comp p.subtype = LinearMap.id :=
  LinearMap.ext <| linearProjOfIsCompl_apply_left h
#align submodule.linear_proj_of_is_compl_comp_subtype Submodule.linearProjOfIsCompl_comp_subtype

theorem linearProjOfIsCompl_idempotent (h : IsCompl p q) (x : E) :
    linearProjOfIsCompl p q h (linearProjOfIsCompl p q h x) = linearProjOfIsCompl p q h x :=
  linearProjOfIsCompl_apply_left h _
#align submodule.linear_proj_of_is_compl_idempotent Submodule.linearProjOfIsCompl_idempotent

theorem existsUnique_add_of_isCompl_prod (hc : IsCompl p q) (x : E) :
    ∃! u : p × q, (u.fst : E) + u.snd = x :=
  (prodEquivOfIsCompl _ _ hc).toEquiv.bijective.existsUnique _
#align submodule.exists_unique_add_of_is_compl_prod Submodule.existsUnique_add_of_isCompl_prod

theorem existsUnique_add_of_isCompl (hc : IsCompl p q) (x : E) :
    ∃ (u : p)(v : q), (u : E) + v = x ∧ ∀ (r : p) (s : q), (r : E) + s = x → r = u ∧ s = v :=
  let ⟨u, hu₁, hu₂⟩ := existsUnique_add_of_isCompl_prod hc x
  ⟨u.1, u.2, hu₁, fun r s hrs => Prod.eq_iff_fst_eq_snd_eq.1 (hu₂ ⟨r, s⟩ hrs)⟩
#align submodule.exists_unique_add_of_is_compl Submodule.existsUnique_add_of_isCompl

theorem linear_proj_add_linearProjOfIsCompl_eq_self (hpq : IsCompl p q) (x : E) :
    (p.linearProjOfIsCompl q hpq x + q.linearProjOfIsCompl p hpq.symm x : E) = x := by
  dsimp only [linearProjOfIsCompl]
  rw [← prodComm_trans_prodEquivOfIsCompl _ _ hpq]
  exact (prodEquivOfIsCompl _ _ hpq).apply_symm_apply x
#align submodule.linear_proj_add_linear_proj_of_is_compl_eq_self Submodule.linear_proj_add_linearProjOfIsCompl_eq_self

end Submodule

namespace LinearMap

open Submodule

/-- Given linear maps `φ` and `ψ` from complement submodules, `LinearMap.ofIsCompl` is
the induced linear map over the entire module. -/
def ofIsCompl {p q : Submodule R E} (h : IsCompl p q) (φ : p →ₗ[R] F) (ψ : q →ₗ[R] F) : E →ₗ[R] F :=
  LinearMap.coprod φ ψ ∘ₗ ↑(Submodule.prodEquivOfIsCompl _ _ h).symm
#align linear_map.of_is_compl LinearMap.ofIsCompl

variable {p q}

@[simp]
theorem ofIsCompl_left_apply (h : IsCompl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (u : p) :
    ofIsCompl h φ ψ (u : E) = φ u := by simp [ofIsCompl]
#align linear_map.of_is_compl_left_apply LinearMap.ofIsCompl_left_apply

@[simp]
theorem ofIsCompl_right_apply (h : IsCompl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (v : q) :
    ofIsCompl h φ ψ (v : E) = ψ v := by simp [ofIsCompl]
#align linear_map.of_is_compl_right_apply LinearMap.ofIsCompl_right_apply

theorem ofIsCompl_eq (h : IsCompl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} {χ : E →ₗ[R] F}
    (hφ : ∀ u, φ u = χ u) (hψ : ∀ u, ψ u = χ u) : ofIsCompl h φ ψ = χ := by
  ext x
  obtain ⟨_, _, rfl, _⟩ := existsUnique_add_of_isCompl h x
  simp [ofIsCompl, hφ, hψ]
#align linear_map.of_is_compl_eq LinearMap.ofIsCompl_eq

theorem ofIsCompl_eq' (h : IsCompl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} {χ : E →ₗ[R] F}
    (hφ : φ = χ.comp p.subtype) (hψ : ψ = χ.comp q.subtype) : ofIsCompl h φ ψ = χ :=
  ofIsCompl_eq h (fun _ => hφ.symm ▸ rfl) fun _ => hψ.symm ▸ rfl
#align linear_map.of_is_compl_eq' LinearMap.ofIsCompl_eq'

@[simp]
theorem ofIsCompl_zero (h : IsCompl p q) : (ofIsCompl h 0 0 : E →ₗ[R] F) = 0 :=
  ofIsCompl_eq _ (fun _ => rfl) fun _ => rfl
#align linear_map.of_is_compl_zero LinearMap.ofIsCompl_zero

@[simp]
theorem ofIsCompl_add (h : IsCompl p q) {φ₁ φ₂ : p →ₗ[R] F} {ψ₁ ψ₂ : q →ₗ[R] F} :
    ofIsCompl h (φ₁ + φ₂) (ψ₁ + ψ₂) = ofIsCompl h φ₁ ψ₁ + ofIsCompl h φ₂ ψ₂ :=
  ofIsCompl_eq _ (by simp) (by simp)
#align linear_map.of_is_compl_add LinearMap.ofIsCompl_add

@[simp]
theorem ofIsCompl_smul {R : Type _} [CommRing R] {E : Type _} [AddCommGroup E] [Module R E]
    {F : Type _} [AddCommGroup F] [Module R F] {p q : Submodule R E} (h : IsCompl p q)
    {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (c : R) : ofIsCompl h (c • φ) (c • ψ) = c • ofIsCompl h φ ψ :=
  ofIsCompl_eq _ (by simp) (by simp)
#align linear_map.of_is_compl_smul LinearMap.ofIsCompl_smul

section

variable {R₁ : Type _} [CommRing R₁] [Module R₁ E] [Module R₁ F]

/-- The linear map from `(p →ₗ[R₁] F) × (q →ₗ[R₁] F)` to `E →ₗ[R₁] F`. -/
def ofIsComplProd {p q : Submodule R₁ E} (h : IsCompl p q) :
    (p →ₗ[R₁] F) × (q →ₗ[R₁] F) →ₗ[R₁] E →ₗ[R₁] F where
  toFun φ := ofIsCompl h φ.1 φ.2
  map_add' := by intro φ ψ; dsimp only; rw [Prod.snd_add, Prod.fst_add, ofIsCompl_add]
  map_smul' := by intro c φ; simp [Prod.smul_snd, Prod.smul_fst, ofIsCompl_smul]
#align linear_map.of_is_compl_prod LinearMap.ofIsComplProd

@[simp]
theorem ofIsComplProd_apply {p q : Submodule R₁ E} (h : IsCompl p q)
    (φ : (p →ₗ[R₁] F) × (q →ₗ[R₁] F)) : ofIsComplProd h φ = ofIsCompl h φ.1 φ.2 :=
  rfl
#align linear_map.of_is_compl_prod_apply LinearMap.ofIsComplProd_apply

/-- The natural linear equivalence between `(p →ₗ[R₁] F) × (q →ₗ[R₁] F)` and `E →ₗ[R₁] F`. -/
def ofIsComplProdEquiv {p q : Submodule R₁ E} (h : IsCompl p q) :
    ((p →ₗ[R₁] F) × (q →ₗ[R₁] F)) ≃ₗ[R₁] E →ₗ[R₁] F :=
  { ofIsComplProd h with
    invFun := fun φ => ⟨φ.domRestrict p, φ.domRestrict q⟩
    left_inv := by
      intro φ; ext x
      · exact ofIsCompl_left_apply h x
      · exact ofIsCompl_right_apply h x
    right_inv := by
      intro φ; ext x
      obtain ⟨a, b, hab, _⟩ := existsUnique_add_of_isCompl h x
      rw [← hab]; simp }
#align linear_map.of_is_compl_prod_equiv LinearMap.ofIsComplProdEquiv

end

@[simp, nolint simpNF] -- Porting note: linter claims that LHS doesn't simplify, but it does
theorem linearProjOfIsCompl_of_proj (f : E →ₗ[R] p) (hf : ∀ x : p, f x = x) :
    p.linearProjOfIsCompl (ker f) (isCompl_of_proj hf) = f := by
  ext x
  have : x ∈ p ⊔ (ker f) := by simp only [(isCompl_of_proj hf).sup_eq_top, mem_top]
  rcases mem_sup'.1 this with ⟨x, y, rfl⟩
  simp [hf]
#align linear_map.linear_proj_of_is_compl_of_proj LinearMap.linearProjOfIsCompl_of_proj

/-- If `f : E →ₗ[R] F` and `g : E →ₗ[R] G` are two surjective linear maps and
their kernels are complement of each other, then `x ↦ (f x, g x)` defines
a linear equivalence `E ≃ₗ[R] F × G`. -/
def equivProdOfSurjectiveOfIsCompl (f : E →ₗ[R] F) (g : E →ₗ[R] G) (hf : range f = ⊤)
    (hg : range g = ⊤) (hfg : IsCompl (ker f) (ker g)) : E ≃ₗ[R] F × G :=
  LinearEquiv.ofBijective (f.prod g)
    ⟨by simp [← ker_eq_bot, hfg.inf_eq_bot], by
      rw [← range_eq_top]
      simp [range_prod_eq hfg.sup_eq_top, *]⟩
#align linear_map.equiv_prod_of_surjective_of_is_compl LinearMap.equivProdOfSurjectiveOfIsCompl

@[simp]
theorem coe_equivProdOfSurjectiveOfIsCompl {f : E →ₗ[R] F} {g : E →ₗ[R] G} (hf : range f = ⊤)
    (hg : range g = ⊤) (hfg : IsCompl (ker f) (ker g)) :
    (equivProdOfSurjectiveOfIsCompl f g hf hg hfg : E →ₗ[R] F × G) = f.prod g := rfl
#align linear_map.coe_equiv_prod_of_surjective_of_is_compl LinearMap.coe_equivProdOfSurjectiveOfIsCompl

@[simp]
theorem equivProdOfSurjectiveOfIsCompl_apply {f : E →ₗ[R] F} {g : E →ₗ[R] G} (hf : range f = ⊤)
    (hg : range g = ⊤) (hfg : IsCompl (ker f) (ker g)) (x : E) :
    equivProdOfSurjectiveOfIsCompl f g hf hg hfg x = (f x, g x) := rfl
#align linear_map.equiv_prod_of_surjective_of_is_compl_apply LinearMap.equivProdOfSurjectiveOfIsCompl_apply

end LinearMap

namespace Submodule

open LinearMap

/-- Equivalence between submodules `q` such that `IsCompl p q` and linear maps `f : E →ₗ[R] p`
such that `∀ x : p, f x = x`. -/
def isComplEquivProj : { q // IsCompl p q } ≃ { f : E →ₗ[R] p // ∀ x : p, f x = x } where
  toFun q := ⟨linearProjOfIsCompl p q q.2, linearProjOfIsCompl_apply_left q.2⟩
  invFun f := ⟨ker (f : E →ₗ[R] p), isCompl_of_proj f.2⟩
  left_inv := fun ⟨q, hq⟩ => by simp only [linearProjOfIsCompl_ker, Subtype.coe_mk]
  right_inv := fun ⟨f, hf⟩ => Subtype.eq <| f.linearProjOfIsCompl_of_proj hf
#align submodule.is_compl_equiv_proj Submodule.isComplEquivProj

@[simp]
theorem coe_isComplEquivProj_apply (q : { q // IsCompl p q }) :
    (p.isComplEquivProj q : E →ₗ[R] p) = linearProjOfIsCompl p q q.2 := rfl
#align submodule.coe_is_compl_equiv_proj_apply Submodule.coe_isComplEquivProj_apply

@[simp]
theorem coe_isComplEquivProj_symm_apply (f : { f : E →ₗ[R] p // ∀ x : p, f x = x }) :
    (p.isComplEquivProj.symm f : Submodule R E) = ker (f : E →ₗ[R] p) := rfl
#align submodule.coe_is_compl_equiv_proj_symm_apply Submodule.coe_isComplEquivProj_symm_apply

end Submodule

namespace LinearMap

open Submodule

/--
A linear endomorphism of a module `E` is a projection onto a submodule `p` if it sends every element
of `E` to `p` and fixes every element of `p`.
The definition allow more generally any `FunLike` type and not just linear maps, so that it can be
used for example with `ContinuousLinearMap` or `Matrix`.
-/
structure IsProj {F : Type _} [FunLike F M fun _ => M] (f : F) : Prop where
  map_mem : ∀ x, f x ∈ m
  map_id : ∀ x ∈ m, f x = x
#align linear_map.is_proj LinearMap.IsProj

theorem isProj_iff_idempotent (f : M →ₗ[S] M) : (∃ p : Submodule S M, IsProj p f) ↔ f ∘ₗ f = f := by
  constructor
  · intro h
    obtain ⟨p, hp⟩ := h
    ext x
    rw [comp_apply]
    exact hp.map_id (f x) (hp.map_mem x)
  · intro h
    use range f
    constructor
    · intro x
      exact mem_range_self f x
    · intro x hx
      obtain ⟨y, hy⟩ := mem_range.1 hx
      rw [← hy, ← comp_apply, h]
#align linear_map.is_proj_iff_idempotent LinearMap.isProj_iff_idempotent

namespace IsProj

variable {p m}

/-- Restriction of the codomain of a projection of onto a subspace `p` to `p` instead of the whole
space.
-/
def codRestrict {f : M →ₗ[S] M} (h : IsProj m f) : M →ₗ[S] m :=
  f.codRestrict m h.map_mem
#align linear_map.is_proj.cod_restrict LinearMap.IsProj.codRestrict

@[simp]
theorem codRestrict_apply {f : M →ₗ[S] M} (h : IsProj m f) (x : M) : ↑(h.codRestrict x) = f x :=
  f.codRestrict_apply m x
#align linear_map.is_proj.cod_restrict_apply LinearMap.IsProj.codRestrict_apply

@[simp]
theorem codRestrict_apply_cod {f : M →ₗ[S] M} (h : IsProj m f) (x : m) : h.codRestrict x = x := by
  ext
  rw [codRestrict_apply]
  exact h.map_id x x.2
#align linear_map.is_proj.cod_restrict_apply_cod LinearMap.IsProj.codRestrict_apply_cod

theorem isCompl {f : E →ₗ[R] E} (h : IsProj p f) : IsCompl p (ker f) := by
  rw [← codRestrict_ker]
  exact isCompl_of_proj h.codRestrict_apply_cod
#align linear_map.is_proj.is_compl LinearMap.IsProj.isCompl

theorem eq_conj_prod_map' {f : E →ₗ[R] E} (h : IsProj p f) :
    f = (p.prodEquivOfIsCompl (ker f) h.isCompl).toLinearMap ∘ₗ
        prodMap id 0 ∘ₗ (p.prodEquivOfIsCompl (ker f) h.isCompl).symm.toLinearMap := by
  refine' (LinearMap.cancel_right (p.prodEquivOfIsCompl (ker f) h.isCompl).surjective).1 _
  ext ⟨x, y⟩
  simp only [coe_comp, LinearEquiv.coe_toLinearMap, coe_inl, Function.comp_apply,
    LinearEquiv.ofTop_apply, LinearEquiv.ofInjective_apply, coprod_apply, Submodule.coeSubtype,
    coe_zero, add_zero, prodEquivOfIsCompl_symm_apply_left, prodMap_apply, id_coe, id.def,
    zero_apply, coe_prodEquivOfIsCompl', h.map_id x x.2,
    map_add, map_coe_ker, prodEquivOfIsCompl_symm_apply_right, Prod.mk_add_mk, zero_add]
#align linear_map.is_proj.eq_conj_prod_map' LinearMap.IsProj.eq_conj_prod_map'

end IsProj

end LinearMap

end Ring

section CommRing

namespace LinearMap

variable {R : Type _} [CommRing R] {E : Type _} [AddCommGroup E] [Module R E] {p : Submodule R E}

theorem IsProj.eq_conj_prodMap {f : E →ₗ[R] E} (h : IsProj p f) :
    f = (p.prodEquivOfIsCompl (ker f) h.isCompl).conj (prodMap id 0) := by
  rw [LinearEquiv.conj_apply]
  exact h.eq_conj_prod_map'
#align linear_map.is_proj.eq_conj_prod_map LinearMap.IsProj.eq_conj_prodMap

end LinearMap

end CommRing


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.nat.order.basic
import algebra.order.monoid.with_top

/-!
# `with_bot ℕ`

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

Lemmas about the type of natural numbers with a bottom element adjoined.
-/

namespace nat

namespace with_bot

lemma add_eq_zero_iff {n m : with_bot ℕ} : n + m = 0 ↔ n = 0 ∧ m = 0 :=
begin
  rcases ⟨n, m⟩ with ⟨_ | _, _ | _⟩,
  any_goals { tautology },
  repeat { erw [with_bot.coe_eq_coe] },
  exact add_eq_zero_iff
end

lemma add_eq_one_iff {n m : with_bot ℕ} : n + m = 1 ↔ n = 0 ∧ m = 1 ∨ n = 1 ∧ m = 0 :=
begin
  rcases ⟨n, m⟩ with ⟨_ | _, _ | _⟩,
  any_goals { tautology },
  repeat { erw [with_bot.coe_eq_coe] },
  exact add_eq_one_iff
end

lemma add_eq_two_iff {n m : with_bot ℕ} :
  n + m = 2 ↔ n = 0 ∧ m = 2 ∨ n = 1 ∧ m = 1 ∨ n = 2 ∧ m = 0 :=
begin
  rcases ⟨n, m⟩ with ⟨_ | _, _ | _⟩,
  any_goals { tautology },
  repeat { erw [with_bot.coe_eq_coe] },
  exact add_eq_two_iff
end

lemma add_eq_three_iff {n m : with_bot ℕ} :
  n + m = 3 ↔ n = 0 ∧ m = 3 ∨ n = 1 ∧ m = 2 ∨ n = 2 ∧ m = 1 ∨ n = 3 ∧ m = 0 :=
begin
  rcases ⟨n, m⟩ with ⟨_ | _, _ | _⟩,
  any_goals { tautology },
  repeat { erw [with_bot.coe_eq_coe] },
  exact add_eq_three_iff
end

lemma coe_nonneg {n : ℕ} : 0 ≤ (n : with_bot ℕ) :=
by { rw [← with_bot.coe_zero, with_bot.coe_le_coe], exact nat.zero_le _ }

@[simp] lemma lt_zero_iff (n : with_bot ℕ) : n < 0 ↔ n = ⊥ :=
option.cases_on n dec_trivial $ λ n, iff_of_false
  (by simp [with_bot.some_eq_coe, coe_nonneg]) (λ h, option.no_confusion h)

lemma one_le_iff_zero_lt {x : with_bot ℕ} : 1 ≤ x ↔ 0 < x :=
begin
  refine ⟨λ h, lt_of_lt_of_le (with_bot.coe_lt_coe.mpr zero_lt_one) h, λ h, _⟩,
  induction x using with_bot.rec_bot_coe,
  { exact (not_lt_bot h).elim },
  { exact with_bot.coe_le_coe.mpr (nat.succ_le_iff.mpr (with_bot.coe_lt_coe.mp h)) }
end

lemma lt_one_iff_le_zero {x : with_bot ℕ} : x < 1 ↔ x ≤ 0 :=
not_iff_not.mp (by simpa using one_le_iff_zero_lt)

end with_bot

end nat


--------------------------------------------------------------------------------
-- File     : PUZ134_1 : TPTP v7.3.0. Released v5.1.0.
-- Domain   : Puzzles
-- Problem  : The Knowheyan Job Puzzle - Jobs
-- Version  : Especial.
-- English  : Five Knowheyans, A, B, C, D, and E, work in Metropolisas Airfoil
--            Technician, Communications Consultant, Space Planner, Lunar Energy
--            Engineer, and Synthetic Food Nutrionist. No two of them are the
--            same age. The Knowheyan interpreter explains about the jobs and
--            ages of these five inhabitants, as follows:
--            1. The Communications Consultant is not younger than any of the
--               other four.
--            2. D is not as old as A and not as young as B, who is not as old
--               as the Lunar Energy Engineer, but not as young as C.
--            3. The Airfoil Technician is not younger than the Space Planner,
--               who is not younger than the Synthetic Food Nutrionist.
--            4. C is not the yougest of the five.
--            What is the job of each of the five Knowheyans?

-- Refs     : [WS+06] Willis et al. (2006), The World's Biggest Book of Brai
-- Source   : [TPTP]
--------------------------------------------------------------------------------
variable knowheyan: Type
variable job: Type
variable age: Type
variable age_of: knowheyan → age
variable job_of: knowheyan → job
variable greater: age × age  → Prop
variable a: knowheyan
variable b: knowheyan
variable c: knowheyan
variable d: knowheyan
variable e: knowheyan

-- axioms
variable a_not_b : a ≠ b

variable a_not_c : a ≠ c

variable a_not_d : a ≠ d

variable a_not_e : a ≠ e

variable b_not_c : b ≠ c

variable b_not_d : b ≠ d

variable b_not_e : b ≠ e

variable c_not_d : c ≠ d

variable c_not_e : c ≠ e

variable d_not_e : d ≠ e

variable airfoil_technician: job

variable communications_consultant: job

variable space_planner: job

variable lunar_energy_engineer: job

variable synthetic_food_nutitionist: job

variable airfoil_technician_not_communications_consultant:
    airfoil_technician ≠ communications_consultant

variable airfoil_technician_not_space_planner:
    airfoil_technician ≠ space_planner

variable airfoil_technician_not_lunar_energy_engineer:
    airfoil_technician ≠ lunar_energy_engineer

variable airfoil_technician_not_synthetic_food_nutitionist:
    airfoil_technician ≠ synthetic_food_nutitionist

variable communications_consultant_not_space_planner:
    communications_consultant ≠ space_planner

variable communications_consultant_not_lunar_energy_engineer:
    communications_consultant ≠ lunar_energy_engineer

variable communications_consultant_not_synthetic_food_nutitionist:
    communications_consultant ≠ synthetic_food_nutitionist

variable space_planner_not_lunar_energy_engineer:
    space_planner ≠ lunar_energy_engineer

variable space_planner_not_synthetic_food_nutitionist:
    space_planner ≠ synthetic_food_nutitionist

variable lunar_energy_engineer_not_synthetic_food_nutitionist:
    lunar_energy_engineer ≠ synthetic_food_nutitionist

variable only_knowheyans:
    ∀ (X: knowheyan) ,
      ( X = a
      ∨ X = b
      ∨ X = c
      ∨ X = d
      ∨ X = e )

variable only_jobs:
    ∀ (X: job) ,
      ( X = airfoil_technician
      ∨ X = communications_consultant
      ∨ X = space_planner
      ∨ X = lunar_energy_engineer
      ∨ X = synthetic_food_nutitionist )

variable unique_ages:
    ∀ (X: knowheyan) (Y: knowheyan) ,
      ( X ≠ Y
     → age_of(X) ≠ age_of(Y) )

variable unique_jobs:
    ∀ (X: knowheyan) (Y: knowheyan) ,
      ( X ≠ Y
     → job_of(X) ≠ job_of(Y) )

variable age_transitive:
    ∀ (X: age) (Y: age) (Z: age) ,
      ( ( greater(X,Y)
        ∧ greater(Y,Z) )
     →  greater(X,Z) )

variable age_irreflexive:
    ∀ (X: age)(Y: age) ,
      ¬ ( greater(X,Y)
        ∧ greater(Y,X) )

variable age_greater:
  ∀ (X: age)(Y: age) ,
      ( X ≠ Y
    ↔ ( greater(X,Y)
        ∨ greater(Y,X) ) )

variable communications_consultant_not_younger:
    ∀ (X: knowheyan) ,
      ( job_of(X) = communications_consultant
     → ¬ ∃ (Y: knowheyan) , greater(age_of(Y),age_of(X)) )

variable age_info1:
    greater(age_of(a),age_of(d))

variable age_info2:
    greater(age_of(d),age_of(b))

variable age_info3:
    ∀ (X: knowheyan) ,
      ( job_of(X) = lunar_energy_engineer
     → greater(age_of(X),age_of(b)) )

variable age_info4:
    greater(age_of(b),age_of(c))

variable age_job1:
    ∀ (X: knowheyan) (Y: knowheyan) ,
      ( ( job_of(X) = airfoil_technician
        ∧ job_of(Y) = space_planner )
     → greater(age_of(X),age_of(Y)) )

variable age_job2:
    ∀ (X: knowheyan) (Y: knowheyan) ,
      ( ( job_of(X) = space_planner
        ∧ job_of(Y) = synthetic_food_nutitionist )
     ∧ greater(age_of(X),age_of(Y)) )

variable c_not_youngest:
    ∃ (X: knowheyan) , greater(age_of(c),age_of(X))

-- conjecture : known_jobs
theorem known_jobs :
    ( job_of(a) = communications_consultant
    ∧ job_of(d) = lunar_energy_engineer
    ∧ job_of(b) = airfoil_technician
    ∧ job_of(c) = space_planner
    ∧ job_of(e) = synthetic_food_nutitionist) := sorry


/-
Copyright (c) 2020 Thomas Browning and Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning, Patrick Lutz
-/

import group_theory.solvable
import field_theory.polynomial_galois_group
import ring_theory.roots_of_unity

/-!
# The Abel-Ruffini Theorem

This file proves one direction of the Abel-Ruffini theorem, namely that if an element is solvable
by radicals, then its minimal polynomial has solvable Galois group.

## Main definitions

* `solvable_by_rad F E` : the intermediate field of solvable-by-radicals elements

## Main results

* the Abel-Ruffini Theorem `solvable_by_rad.is_solvable'` : An irreducible polynomial with a root
that is solvable by radicals has a solvable Galois group.
-/

noncomputable theory
open_locale classical polynomial

open polynomial intermediate_field

section abel_ruffini

variables {F : Type*} [field F] {E : Type*} [field E] [algebra F E]

lemma gal_zero_is_solvable : is_solvable (0 : F[X]).gal :=
by apply_instance

lemma gal_one_is_solvable : is_solvable (1 : F[X]).gal :=
by apply_instance

lemma gal_C_is_solvable (x : F) : is_solvable (C x).gal :=
by apply_instance

lemma gal_X_is_solvable : is_solvable (X : F[X]).gal :=
by apply_instance

lemma gal_X_sub_C_is_solvable (x : F) : is_solvable (X - C x).gal :=
by apply_instance

lemma gal_X_pow_is_solvable (n : ℕ) : is_solvable (X ^ n : F[X]).gal :=
by apply_instance

lemma gal_mul_is_solvable {p q : F[X]}
  (hp : is_solvable p.gal) (hq : is_solvable q.gal) : is_solvable (p * q).gal :=
solvable_of_solvable_injective (gal.restrict_prod_injective p q)

lemma gal_prod_is_solvable {s : multiset F[X]}
  (hs : ∀ p ∈ s, is_solvable (gal p)) : is_solvable s.prod.gal :=
begin
  apply multiset.induction_on' s,
  { exact gal_one_is_solvable },
  { intros p t hps hts ht,
    rw [multiset.insert_eq_cons, multiset.prod_cons],
    exact gal_mul_is_solvable (hs p hps) ht },
end

lemma gal_is_solvable_of_splits {p q : F[X]}
  (hpq : fact (p.splits (algebra_map F q.splitting_field))) (hq : is_solvable q.gal) :
  is_solvable p.gal :=
begin
  haveI : is_solvable (q.splitting_field ≃ₐ[F] q.splitting_field) := hq,
  exact solvable_of_surjective (alg_equiv.restrict_normal_hom_surjective q.splitting_field),
end

lemma gal_is_solvable_tower (p q : F[X])
  (hpq : p.splits (algebra_map F q.splitting_field))
  (hp : is_solvable p.gal)
  (hq : is_solvable (q.map (algebra_map F p.splitting_field)).gal) :
  is_solvable q.gal :=
begin
  let K := p.splitting_field,
  let L := q.splitting_field,
  haveI : fact (p.splits (algebra_map F L)) := ⟨hpq⟩,
  let ϕ : (L ≃ₐ[K] L) ≃* (q.map (algebra_map F K)).gal :=
    (is_splitting_field.alg_equiv L (q.map (algebra_map F K))).aut_congr,
  have ϕ_inj : function.injective ϕ.to_monoid_hom := ϕ.injective,
  haveI : is_solvable (K ≃ₐ[F] K) := hp,
  haveI : is_solvable (L ≃ₐ[K] L) := solvable_of_solvable_injective ϕ_inj,
  exact is_solvable_of_is_scalar_tower F p.splitting_field q.splitting_field,
end

section gal_X_pow_sub_C

lemma gal_X_pow_sub_one_is_solvable (n : ℕ) : is_solvable (X ^ n - 1 : F[X]).gal :=
begin
  by_cases hn : n = 0,
  { rw [hn, pow_zero, sub_self],
    exact gal_zero_is_solvable },
  have hn' : 0 < n := pos_iff_ne_zero.mpr hn,
  have hn'' : (X ^ n - 1 : F[X]) ≠ 0 := X_pow_sub_C_ne_zero hn' 1,
  apply is_solvable_of_comm,
  intros σ τ,
  ext a ha,
  simp only [mem_root_set_of_ne hn'', map_sub, aeval_X_pow, aeval_one, sub_eq_zero] at ha,
  have key : ∀ σ : (X ^ n - 1 : F[X]).gal, ∃ m : ℕ, σ a = a ^ m,
  { intro σ,
    lift n to ℕ+ using hn',
    exact map_root_of_unity_eq_pow_self σ.to_alg_hom (roots_of_unity.mk_of_pow_eq a ha) },
  obtain ⟨c, hc⟩ := key σ,
  obtain ⟨d, hd⟩ := key τ,
  rw [σ.mul_apply, τ.mul_apply, hc, τ.map_pow, hd, σ.map_pow, hc, ←pow_mul, pow_mul'],
end

lemma gal_X_pow_sub_C_is_solvable_aux (n : ℕ) (a : F)
  (h : (X ^ n - 1 : F[X]).splits (ring_hom.id F)) : is_solvable (X ^ n - C a).gal :=
begin
  by_cases ha : a = 0,
  { rw [ha, C_0, sub_zero],
    exact gal_X_pow_is_solvable n },
  have ha' : algebra_map F (X ^ n - C a).splitting_field a ≠ 0 :=
    mt ((injective_iff_map_eq_zero _).mp (ring_hom.injective _) a) ha,
  by_cases hn : n = 0,
  { rw [hn, pow_zero, ←C_1, ←C_sub],
    exact gal_C_is_solvable (1 - a) },
  have hn' : 0 < n := pos_iff_ne_zero.mpr hn,
  have hn'' : X ^ n - C a ≠ 0 := X_pow_sub_C_ne_zero hn' a,
  have hn''' : (X ^ n - 1 : F[X]) ≠ 0 := X_pow_sub_C_ne_zero hn' 1,
  have mem_range : ∀ {c}, c ^ n = 1 → ∃ d, algebra_map F (X ^ n - C a).splitting_field d = c :=
    λ c hc, ring_hom.mem_range.mp (minpoly.mem_range_of_degree_eq_one F c (h.def.resolve_left hn'''
      (minpoly.irreducible ((splitting_field.normal (X ^ n - C a)).is_integral c)) (minpoly.dvd F c
      (by rwa [map_id, alg_hom.map_sub, sub_eq_zero, aeval_X_pow, aeval_one])))),
  apply is_solvable_of_comm,
  intros σ τ,
  ext b hb,
  simp only [mem_root_set_of_ne hn'', map_sub, aeval_X_pow, aeval_C, sub_eq_zero] at hb,
  have hb' : b ≠ 0,
  { intro hb',
    rw [hb', zero_pow hn'] at hb,
    exact ha' hb.symm },
  have key : ∀ σ : (X ^ n - C a).gal, ∃ c, σ b = b * algebra_map F _ c,
  { intro σ,
    have key : (σ b / b) ^ n = 1 := by rw [div_pow, ←σ.map_pow, hb, σ.commutes, div_self ha'],
    obtain ⟨c, hc⟩ := mem_range key,
    use c,
    rw [hc, mul_div_cancel' (σ b) hb'] },
  obtain ⟨c, hc⟩ := key σ,
  obtain ⟨d, hd⟩ := key τ,
  rw [σ.mul_apply, τ.mul_apply, hc, τ.map_mul, τ.commutes, hd, σ.map_mul, σ.commutes, hc],
  rw [mul_assoc, mul_assoc, mul_right_inj' hb', mul_comm],
end

lemma splits_X_pow_sub_one_of_X_pow_sub_C {F : Type*} [field F] {E : Type*} [field E]
  (i : F →+* E) (n : ℕ) {a : F} (ha : a ≠ 0) (h : (X ^ n - C a).splits i) : (X ^ n - 1).splits i :=
begin
  have ha' : i a ≠ 0 := mt ((injective_iff_map_eq_zero i).mp (i.injective) a) ha,
  by_cases hn : n = 0,
  { rw [hn, pow_zero, sub_self],
    exact splits_zero i },
  have hn' : 0 < n := pos_iff_ne_zero.mpr hn,
  have hn'' : (X ^ n - C a).degree ≠ 0 :=
    ne_of_eq_of_ne (degree_X_pow_sub_C hn' a) (mt with_bot.coe_eq_coe.mp hn),
  obtain ⟨b, hb⟩ := exists_root_of_splits i h hn'',
  rw [eval₂_sub, eval₂_X_pow, eval₂_C, sub_eq_zero] at hb,
  have hb' : b ≠ 0,
  { intro hb',
    rw [hb', zero_pow hn'] at hb,
    exact ha' hb.symm },
  let s := ((X ^ n - C a).map i).roots,
  have hs : _ = _ * (s.map _).prod := eq_prod_roots_of_splits h,
  rw [leading_coeff_X_pow_sub_C hn', ring_hom.map_one, C_1, one_mul] at hs,
  have hs' : s.card = n := (nat_degree_eq_card_roots h).symm.trans nat_degree_X_pow_sub_C,
  apply @splits_of_exists_multiset F E _ _ i (X ^ n - 1) (s.map (λ c : E, c / b)),
  rw [leading_coeff_X_pow_sub_one hn', ring_hom.map_one, C_1, one_mul, multiset.map_map],
  have C_mul_C : (C (i a⁻¹)) * (C (i a)) = 1,
  { rw [←C_mul, ←i.map_mul, inv_mul_cancel ha, i.map_one, C_1] },
  have key1 : (X ^ n - 1).map i = C (i a⁻¹) * ((X ^ n - C a).map i).comp (C b * X),
  { rw [polynomial.map_sub, polynomial.map_sub, polynomial.map_pow, map_X, map_C,
        polynomial.map_one, sub_comp, pow_comp, X_comp, C_comp, mul_pow, ←C_pow, hb, mul_sub,
        ←mul_assoc, C_mul_C, one_mul] },
  have key2 : (λ q : E[X], q.comp (C b * X)) ∘ (λ c : E, X - C c) =
    (λ c : E, C b * (X - C (c / b))),
  { ext1 c,
    change (X - C c).comp (C b * X) = C b * (X - C (c / b)),
    rw [sub_comp, X_comp, C_comp, mul_sub, ←C_mul, mul_div_cancel' c hb'] },
  rw [key1, hs, multiset_prod_comp, multiset.map_map, key2, multiset.prod_map_mul,
    multiset.map_const, multiset.prod_replicate, hs', ←C_pow, hb, ←mul_assoc, C_mul_C, one_mul],
  all_goals { exact field.to_nontrivial F },
end

lemma gal_X_pow_sub_C_is_solvable (n : ℕ) (x : F) : is_solvable (X ^ n - C x).gal :=
begin
  by_cases hx : x = 0,
  { rw [hx, C_0, sub_zero],
    exact gal_X_pow_is_solvable n },
  apply gal_is_solvable_tower (X ^ n - 1) (X ^ n - C x),
  { exact splits_X_pow_sub_one_of_X_pow_sub_C _ n hx (splitting_field.splits _) },
  { exact gal_X_pow_sub_one_is_solvable n },
  { rw [polynomial.map_sub, polynomial.map_pow, map_X, map_C],
    apply gal_X_pow_sub_C_is_solvable_aux,
    have key := splitting_field.splits (X ^ n - 1 : F[X]),
    rwa [←splits_id_iff_splits, polynomial.map_sub, polynomial.map_pow, map_X, polynomial.map_one]
      at key }
end

end gal_X_pow_sub_C

variables (F)

/-- Inductive definition of solvable by radicals -/
inductive is_solvable_by_rad : E → Prop
| base (a : F) : is_solvable_by_rad (algebra_map F E a)
| add (a b : E) : is_solvable_by_rad a → is_solvable_by_rad b → is_solvable_by_rad (a + b)
| neg (α : E) : is_solvable_by_rad α → is_solvable_by_rad (-α)
| mul (α β : E) : is_solvable_by_rad α → is_solvable_by_rad β → is_solvable_by_rad (α * β)
| inv (α : E) : is_solvable_by_rad α → is_solvable_by_rad α⁻¹
| rad (α : E) (n : ℕ) (hn : n ≠ 0) : is_solvable_by_rad (α^n) → is_solvable_by_rad α

variables (E)

/-- The intermediate field of solvable-by-radicals elements -/
def solvable_by_rad : intermediate_field F E :=
{ carrier := is_solvable_by_rad F,
  zero_mem' := by { convert is_solvable_by_rad.base (0 : F), rw ring_hom.map_zero },
  add_mem' := is_solvable_by_rad.add,
  neg_mem' := is_solvable_by_rad.neg,
  one_mem' := by { convert is_solvable_by_rad.base (1 : F), rw ring_hom.map_one },
  mul_mem' := is_solvable_by_rad.mul,
  inv_mem' := is_solvable_by_rad.inv,
  algebra_map_mem' := is_solvable_by_rad.base }

namespace solvable_by_rad

variables {F} {E} {α : E}

lemma induction (P : solvable_by_rad F E → Prop)
(base : ∀ α : F, P (algebra_map F (solvable_by_rad F E) α))
(add : ∀ α β : solvable_by_rad F E, P α → P β → P (α + β))
(neg : ∀ α : solvable_by_rad F E, P α → P (-α))
(mul : ∀ α β : solvable_by_rad F E, P α → P β → P (α * β))
(inv : ∀ α : solvable_by_rad F E, P α → P α⁻¹)
(rad : ∀ α : solvable_by_rad F E, ∀ n : ℕ, n ≠ 0 → P (α^n) → P α)
(α : solvable_by_rad F E) : P α :=
begin
  revert α,
  suffices : ∀ (α : E), is_solvable_by_rad F α → (∃ β : solvable_by_rad F E, ↑β = α ∧ P β),
  { intro α,
    obtain ⟨α₀, hα₀, Pα⟩ := this α (subtype.mem α),
    convert Pα,
    exact subtype.ext hα₀.symm },
  apply is_solvable_by_rad.rec,
  { exact λ α, ⟨algebra_map F (solvable_by_rad F E) α, rfl, base α⟩ },
  { intros α β hα hβ Pα Pβ,
    obtain ⟨⟨α₀, hα₀, Pα⟩, β₀, hβ₀, Pβ⟩ := ⟨Pα, Pβ⟩,
    exact ⟨α₀ + β₀, by {rw [←hα₀, ←hβ₀], refl }, add α₀ β₀ Pα Pβ⟩ },
  { intros α hα Pα,
    obtain ⟨α₀, hα₀, Pα⟩ := Pα,
    exact ⟨-α₀, by {rw ←hα₀, refl }, neg α₀ Pα⟩ },
  { intros α β hα hβ Pα Pβ,
    obtain ⟨⟨α₀, hα₀, Pα⟩, β₀, hβ₀, Pβ⟩ := ⟨Pα, Pβ⟩,
    exact ⟨α₀ * β₀, by {rw [←hα₀, ←hβ₀], refl }, mul α₀ β₀ Pα Pβ⟩ },
  { intros α hα Pα,
    obtain ⟨α₀, hα₀, Pα⟩ := Pα,
    exact ⟨α₀⁻¹, by {rw ←hα₀, refl }, inv α₀ Pα⟩ },
  { intros α n hn hα Pα,
    obtain ⟨α₀, hα₀, Pα⟩ := Pα,
    refine ⟨⟨α, is_solvable_by_rad.rad α n hn hα⟩, rfl, rad _ n hn _⟩,
    convert Pα,
    exact subtype.ext (eq.trans ((solvable_by_rad F E).coe_pow _ n) hα₀.symm) }
end

theorem is_integral (α : solvable_by_rad F E) : is_integral F α :=
begin
  revert α,
  apply solvable_by_rad.induction,
  { exact λ _, is_integral_algebra_map },
  { exact λ _ _, is_integral_add },
  { exact λ _, is_integral_neg },
  { exact λ _ _, is_integral_mul },
  { exact λ α hα, subalgebra.inv_mem_of_algebraic (integral_closure F (solvable_by_rad F E))
      (show is_algebraic F ↑(⟨α, hα⟩ : integral_closure F (solvable_by_rad F E)),
        by exact is_algebraic_iff_is_integral.mpr hα) },
  { intros α n hn hα,
    obtain ⟨p, h1, h2⟩ := is_algebraic_iff_is_integral.mpr hα,
    refine is_algebraic_iff_is_integral.mp ⟨p.comp (X ^ n),
      ⟨λ h, h1 (leading_coeff_eq_zero.mp _), by rw [aeval_comp, aeval_X_pow, h2]⟩⟩,
    rwa [←leading_coeff_eq_zero, leading_coeff_comp, leading_coeff_X_pow, one_pow, mul_one] at h,
    rwa nat_degree_X_pow }
end

/-- The statement to be proved inductively -/
def P (α : solvable_by_rad F E) : Prop := is_solvable (minpoly F α).gal

/-- An auxiliary induction lemma, which is generalized by `solvable_by_rad.is_solvable`. -/
lemma induction3 {α : solvable_by_rad F E} {n : ℕ} (hn : n ≠ 0) (hα : P (α ^ n)) : P α :=
begin
  let p := minpoly F (α ^ n),
  have hp : p.comp (X ^ n) ≠ 0,
  { intro h,
    cases (comp_eq_zero_iff.mp h) with h' h',
    { exact minpoly.ne_zero (is_integral (α ^ n)) h' },
    { exact hn (by rw [←nat_degree_C _, ←h'.2, nat_degree_X_pow]) } },
  apply gal_is_solvable_of_splits,
  { exact ⟨splits_of_splits_of_dvd _ hp (splitting_field.splits (p.comp (X ^ n)))
      (minpoly.dvd F α (by rw [aeval_comp, aeval_X_pow, minpoly.aeval]))⟩ },
  { refine gal_is_solvable_tower p (p.comp (X ^ n)) _ hα _,
    { exact gal.splits_in_splitting_field_of_comp _ _ (by rwa [nat_degree_X_pow]) },
    { obtain ⟨s, hs⟩ := (splits_iff_exists_multiset _).1 (splitting_field.splits p),
      rw [map_comp, polynomial.map_pow, map_X, hs, mul_comp, C_comp],
      apply gal_mul_is_solvable (gal_C_is_solvable _),
      rw multiset_prod_comp,
      apply gal_prod_is_solvable,
      intros q hq,
      rw multiset.mem_map at hq,
      obtain ⟨q, hq, rfl⟩ := hq,
      rw multiset.mem_map at hq,
      obtain ⟨q, hq, rfl⟩ := hq,
      rw [sub_comp, X_comp, C_comp],
      exact gal_X_pow_sub_C_is_solvable n q } },
end

/-- An auxiliary induction lemma, which is generalized by `solvable_by_rad.is_solvable`. -/
lemma induction2 {α β γ : solvable_by_rad F E} (hγ : γ ∈ F⟮α, β⟯) (hα : P α) (hβ : P β) : P γ :=
begin
  let p := (minpoly F α),
  let q := (minpoly F β),
  have hpq := polynomial.splits_of_splits_mul _ (mul_ne_zero (minpoly.ne_zero (is_integral α))
    (minpoly.ne_zero (is_integral β))) (splitting_field.splits (p * q)),
  let f : F⟮α, β⟯ →ₐ[F] (p * q).splitting_field := classical.choice (alg_hom_mk_adjoin_splits
  begin
    intros x hx,
    cases hx,
    rw hx,
    exact ⟨is_integral α, hpq.1⟩,
    cases hx,
    exact ⟨is_integral β, hpq.2⟩,
  end),
  have key : minpoly F γ = minpoly F (f ⟨γ, hγ⟩) := minpoly.eq_of_irreducible_of_monic
    (minpoly.irreducible (is_integral γ)) begin
      suffices : aeval (⟨γ, hγ⟩ : F ⟮α, β⟯) (minpoly F γ) = 0,
      { rw [aeval_alg_hom_apply, this, alg_hom.map_zero] },
      apply (algebra_map F⟮α, β⟯ (solvable_by_rad F E)).injective,
      rw [ring_hom.map_zero, ← aeval_algebra_map_apply],
      exact minpoly.aeval F γ,
    end (minpoly.monic (is_integral γ)),
  rw [P, key],
  exact gal_is_solvable_of_splits ⟨normal.splits (splitting_field.normal _) _⟩
    (gal_mul_is_solvable hα hβ),
end

/-- An auxiliary induction lemma, which is generalized by `solvable_by_rad.is_solvable`. -/

theorem is_solvable (α : solvable_by_rad F E) :
  is_solvable (minpoly F α).gal :=
begin
  revert α,
  apply solvable_by_rad.induction,
  { exact λ α, by { rw minpoly.eq_X_sub_C, exact gal_X_sub_C_is_solvable α } },
  { exact λ α β, induction2 (add_mem (subset_adjoin F _ (set.mem_insert α _))
      (subset_adjoin F _ (set.mem_insert_of_mem α (set.mem_singleton β)))) },
  { exact λ α, induction1 (neg_mem (mem_adjoin_simple_self F α)) },
  { exact λ α β, induction2 (mul_mem (subset_adjoin F _ (set.mem_insert α _))
      (subset_adjoin F _ (set.mem_insert_of_mem α (set.mem_singleton β)))) },
  { exact λ α, induction1 (inv_mem (mem_adjoin_simple_self F α)) },
  { exact λ α n, induction3 },
end

/-- **Abel-Ruffini Theorem** (one direction): An irreducible polynomial with an
`is_solvable_by_rad` root has solvable Galois group -/
lemma is_solvable' {α : E} {q : F[X]} (q_irred : irreducible q)
  (q_aeval : aeval α q = 0) (hα : is_solvable_by_rad F α) :
  _root_.is_solvable q.gal :=
begin
  haveI : _root_.is_solvable (q * C q.leading_coeff⁻¹).gal,
  { rw [minpoly.eq_of_irreducible q_irred q_aeval,
        ←show minpoly F (⟨α, hα⟩ : solvable_by_rad F E) = minpoly F α,
        from minpoly.eq_of_algebra_map_eq (ring_hom.injective _) (is_integral ⟨α, hα⟩) rfl],
    exact is_solvable ⟨α, hα⟩ },
  refine solvable_of_surjective (gal.restrict_dvd_surjective ⟨C q.leading_coeff⁻¹, rfl⟩ _),
  rw [mul_ne_zero_iff, ne, ne, C_eq_zero, inv_eq_zero],
  exact ⟨q_irred.ne_zero, leading_coeff_ne_zero.mpr q_irred.ne_zero⟩,
end

end solvable_by_rad

end abel_ruffini


lemma zero_le (a : mynat) : 0 ≤ a :=
begin
rw le_iff_exists_add,
use a,
rwa zero_add,
end