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

import group_theory.quotient_group
import ring_theory.dedekind_domain

/-!
# The ideal class group

This file defines the ideal class group `class_group f` of fractional ideals
with respect to the fraction map `f`.

## Main definitions
 - `to_principal_ideal` sends an invertible `x : f.codomain` to an invertible fractional ideal
 - `class_group` is the quotient of invertible fractional ideals modulo `to_principal_ideal.range`
 - `class_group.mk0` sends a nonzero integral ideal in a Dedekind domain to its class

## Main results
 - `class_group.mk0_eq_mk0_iff` shows the equivalence with the "classical" definition,
   where `I ~ J` iff `x I = y J` for `x y ≠ (0 : R)`
-/

open ring
open ring.fractional_ideal

section integral_domain

variables {R K L : Type*} [integral_domain R]
variables [field K] [field L] [decidable_eq L]
variables (f : fraction_map R K)
variables [algebra f.codomain L] [finite_dimensional f.codomain L]
variables [algebra R L] [is_scalar_tower R f.codomain L]

open ring.fractional_ideal units

section
/-- `to_principal_ideal x` sends `x ≠ 0 : K` to the fractional ideal generated by `x` -/
@[irreducible]
def to_principal_ideal : units f.codomain →* units (fractional_ideal f) :=
{ to_fun := λ x,
  ⟨ span_singleton x,
    span_singleton x⁻¹,
    by simp only [span_singleton_one, units.mul_inv', span_singleton_mul_span_singleton],
    by simp only [span_singleton_one, units.inv_mul', span_singleton_mul_span_singleton]⟩,
  map_mul' := λ x y, ext
    (by simp only [units.coe_mk, units.coe_mul, span_singleton_mul_span_singleton]),
  map_one' := ext (by simp only [span_singleton_one, units.coe_mk, units.coe_one]) }

local attribute [semireducible] to_principal_ideal

variables {f}

@[simp] lemma coe_to_principal_ideal (x : units f.codomain) :
  (to_principal_ideal f x : fractional_ideal f) = span_singleton x :=
rfl

@[simp] lemma to_principal_ideal_eq_iff {I : units (fractional_ideal f)} {x : units f.codomain} :
  to_principal_ideal f x = I ↔ span_singleton (x : f.codomain) = I :=
units.ext_iff

end

instance principal_ideals.normal : (to_principal_ideal f).range.normal :=
subgroup.normal_of_comm _

section
/-- The class group with respect to `f : fraction_map R K`
is the group of invertible fractional ideals modulo the principal ideals. -/
@[derive(comm_group)]
def class_group := quotient_group.quotient (to_principal_ideal f).range

instance : inhabited (class_group f) := ⟨1⟩

@[simp] lemma fractional_ideal.coe_to_fractional_ideal_top :
  ((⊤ : ideal R) : fractional_ideal f) = 1 :=
by { rw [← ideal.one_eq_top], refl }

@[simp] lemma units.mk0_one {M : Type*} [group_with_zero M] (h) :
  units.mk0 (1 : M) h = 1 :=
by { ext, refl }

@[simp] lemma units.mk0_map {M : Type*} [group_with_zero M] (x y : M) (hxy) :
  mk0 (x * y) hxy = mk0 x (mul_ne_zero_iff.mp hxy).1 * mk0 y (mul_ne_zero_iff.mp hxy).2 :=
by { ext, refl }

/-- The monoid of nonzero ideals. -/
def nonzero_ideal (R : Type*) [integral_domain R] : submonoid (ideal R) :=
{ carrier := {I | I ≠ ⊥},
  one_mem' := show (1 : ideal R) ≠ ⊥, by { rw ideal.one_eq_top, exact submodule.bot_ne_top.symm },
  mul_mem' := λ I J (hI : I ≠ ⊥) (hJ : J ≠ ⊥), show I * J ≠ ⊥,
    by { obtain ⟨x, x_mem, x_ne⟩ := I.ne_bot_iff.mp hI,
         obtain ⟨y, y_mem, y_ne⟩ := J.ne_bot_iff.mp hJ,
         exact (submodule.ne_bot_iff _).mpr
           ⟨x * y, ideal.mul_mem_mul x_mem y_mem, mul_ne_zero x_ne y_ne⟩ } }

/-- Send a nonzero ideal to the corresponding class in the class group. -/
noncomputable def class_group.mk0 [is_dedekind_domain R] :
  nonzero_ideal R →* class_group f :=
(quotient_group.mk' _).comp
  { to_fun := λ I, units.mk0 I
      ((fractional_ideal.coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors R))).mpr I.2),
    map_one' := by simp,
    map_mul' := λ x y, by simp }

lemma quotient_group.mk'_eq_mk' {G : Type*} [group G] {N : subgroup G} [hN : N.normal] {x y : G} :
  quotient_group.mk' N x = quotient_group.mk' N y ↔ ∃ z ∈ N, x * z = y :=
(@quotient.eq _ (quotient_group.left_rel _) _ _).trans
  ⟨λ (h : x⁻¹ * y ∈ N), ⟨_, h, by rw [← mul_assoc, mul_right_inv, one_mul]⟩,
   λ ⟨z, z_mem, eq_y⟩,
     by { rw ← eq_y, show x⁻¹ * (x * z) ∈ N, rwa [← mul_assoc, mul_left_inv, one_mul] }⟩

lemma ideal.mem_mul_span_singleton {x y : R} {I : ideal R} :
  x ∈ I * ideal.span {y} ↔ ∃ z ∈ I, z * y = x :=
submodule.mem_smul_span_singleton

lemma ideal.mem_span_singleton_mul {x y : R} {I : ideal R} :
  x ∈ ideal.span {y} * I ↔ ∃ z ∈ I, y * z = x :=
by simp only [mul_comm, ideal.mem_mul_span_singleton]

lemma ideal.le_span_singleton_mul_iff {x : R} {I J : ideal R} :
  I ≤ ideal.span {x} * J ↔ ∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI :=
show (∀ {zI} (hzI : zI ∈ I), zI ∈ ideal.span {x} * J) ↔ ∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI,
by simp only [ideal.mem_span_singleton_mul]

lemma ideal.span_singleton_mul_le_iff {x : R} {I J : ideal R} :
  ideal.span {x} * I ≤ J ↔ ∀ z ∈ I, x * z ∈ J :=
begin
  simp only [ideal.mul_le, ideal.mem_span_singleton_mul, ideal.mem_span_singleton],
  split,
  { intros h zI hzI,
    exact h x (dvd_refl x) zI hzI },
  { rintros h _ ⟨z, rfl⟩ zI hzI,
    rw [mul_comm x z, mul_assoc],
    exact J.mul_mem_left _ (h zI hzI) },
end

lemma ideal.span_singleton_mul_le_span_singleton_mul {x y : R} {I J : ideal R} :
  ideal.span {x} * I ≤ ideal.span {y} * J ↔ ∀ zI ∈ I, ∃ zJ ∈ J, x * zI = y * zJ :=
by simp only [ideal.span_singleton_mul_le_iff, ideal.mem_span_singleton_mul, eq_comm]

lemma ideal.eq_singleton_mul {x : R} (I J : ideal R) :
  I = ideal.span {x} * J ↔ ((∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI) ∧ (∀ z ∈ J, x * z ∈ I)) :=
by simp only [le_antisymm_iff, ideal.le_span_singleton_mul_iff, ideal.span_singleton_mul_le_iff]

lemma ideal.singleton_mul_eq_singleton_mul {x y : R} (I J : ideal R) :
  ideal.span {x} * I = ideal.span {y} * J ↔
    ((∀ zI ∈ I, ∃ zJ ∈ J, x * zI = y * zJ) ∧
     (∀ zJ ∈ J, ∃ zI ∈ I, x * zI = y * zJ)) :=
by simp only [le_antisymm_iff, ideal.span_singleton_mul_le_span_singleton_mul, eq_comm]

lemma fractional_ideal.le_span_singleton_mul_iff {x : f.codomain} {I J : fractional_ideal f} :
  I ≤ span_singleton x * J ↔ ∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI :=
show (∀ {zI} (hzI : zI ∈ I), zI ∈ span_singleton x * J) ↔ ∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI,
by { simp only [fractional_ideal.mem_singleton_mul, eq_comm], refl }

lemma fractional_ideal.span_singleton_mul_le_iff {x : f.codomain} {I J : fractional_ideal f} :
  span_singleton x * I ≤ J ↔ ∀ z ∈ I, x * z ∈ J :=
begin
  simp only [fractional_ideal.mul_le, fractional_ideal.mem_singleton_mul,
             fractional_ideal.mem_span_singleton],
  split,
  { intros h zI hzI,
    exact h x ⟨1, one_smul _ _⟩ zI hzI },
  { rintros h _ ⟨z, rfl⟩ zI hzI,
    rw [algebra.smul_mul_assoc],
    exact submodule.smul_mem J.1 _ (h zI hzI) },
end

lemma fractional_ideal.eq_span_singleton_mul {x : f.codomain} {I J : fractional_ideal f} :
  I = span_singleton x * J ↔ (∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI) ∧ ∀ z ∈ J, x * z ∈ I :=
by simp only [le_antisymm_iff, fractional_ideal.le_span_singleton_mul_iff,
              fractional_ideal.span_singleton_mul_le_iff]

lemma class_group.mk0_eq_mk0_iff [is_dedekind_domain R]
  (I J : nonzero_ideal R) :
  class_group.mk0 f I = class_group.mk0 f J ↔
    ∃ (x y : R) (hx : x ≠ 0) (hy : y ≠ 0), ideal.span {x} * (I : ideal R) = ideal.span {y} * J :=
begin
  simp only [class_group.mk0, monoid_hom.comp_apply, monoid_hom.coe_mk, quotient_group.mk'_eq_mk',
    exists_prop, monoid_hom.mem_range, ideal.singleton_mul_eq_singleton_mul],
  split,
  { rintros ⟨z, ⟨xy, hxy, rfl⟩, eq_J⟩,
    have : (J : fractional_ideal f) = (span_singleton xy * I),
    { simpa only [mul_comm, eq_comm, coe_mk0, monoid_hom.to_fun_eq_coe, coe_to_principal_ideal,
                  units.coe_mul]
        using congr_arg (coe : _ → fractional_ideal f) eq_J },
    obtain ⟨hJI, hIJ⟩ := (fractional_ideal.eq_span_singleton_mul _).mp this,
    have hx : (f.to_localization_map.sec (xy : f.codomain)).1 ≠ 0,
    { suffices : f.to_map (f.to_localization_map.sec (xy : f.codomain)).1 ≠ 0,
      { refine mt (λ h, _) this,
        rw [h, ring_hom.map_zero] },
      rw [ne.def, ← localization_map.sec_spec (xy : f.codomain), mul_eq_zero],
      push_neg,
      use xy.ne_zero,
      exact f.to_map_ne_zero_of_mem_non_zero_divisors _ },
    use [(f.to_localization_map.sec (xy : f.codomain)).1,
         (f.to_localization_map.sec (xy : f.codomain)).2,
         hx,
         non_zero_divisors.ne_zero_of_mem (f.to_localization_map.sec (xy : f.codomain)).2.2],
    have x_eq : (xy * f.to_map (f.to_localization_map.sec (xy : f.codomain)).2 : f.codomain) =
        f.to_map (f.to_localization_map.sec (xy : f.codomain)).1 :=
      localization_map.sec_spec (xy : f.codomain),
    split,
    { intros zI hzI,
      obtain ⟨zJ, hzJ, (zJ_eq : f.to_map zJ = _ * f.to_map _)⟩ := hIJ (f.to_map zI) _,
      { use [zJ, hzJ],
        apply f.injective,
        rw [f.to_map.map_mul, f.to_map.map_mul, zJ_eq, ← x_eq],
        ac_refl },
      { simpa only [exists_prop, mem_coe_ideal, exists_mem_to_map_eq, coe_coe] using hzI } },
    { intros zJ hzJ,
      obtain ⟨zI', hzI', eq_zJ⟩ := hJI (f.to_map zJ) _,
      obtain ⟨zI, hzI, rfl⟩ := fractional_ideal.mem_coe_ideal.mp hzI',
      { use [zI, hzI],
        apply f.injective,
        rw [f.to_map.map_mul, f.to_map.map_mul, ← eq_zJ, ← x_eq],
        ac_refl },
      { simpa only [exists_prop, mem_coe_ideal, exists_mem_to_map_eq, coe_coe] using hzJ } } },
  { rintros ⟨x, y, hx, hy, hIJ, hJI⟩,
    have hy' := mem_non_zero_divisors_iff_ne_zero.mpr hy,
    refine ⟨_, ⟨units.mk0 (f.mk' x ⟨y, hy'⟩) _, rfl⟩, _⟩,
    { rw [ne.def, f.mk'_eq_iff_eq_mul, zero_mul],
      exact mt (f.to_map.injective_iff.mp f.injective _) hx },
    suffices : (J : fractional_ideal f) = span_singleton (f.mk' x ⟨y, _⟩) * I,
    { apply units.ext,
      simpa only [mul_comm, eq_comm, coe_mk0, coe_to_principal_ideal, units.coe_mul] using this },
    refine (fractional_ideal.eq_span_singleton_mul _).mpr ⟨_, _⟩,
    { intros zJ' hzJ',
      obtain ⟨zJ, hzJ, rfl⟩ := mem_coe_ideal.mp hzJ',
      obtain ⟨zI, hzI, x_mul_eq_y_mul⟩ := hJI zJ hzJ,
      refine ⟨f.to_map zI, mem_coe_ideal.mpr ⟨zI, hzI, rfl⟩, _⟩,
      apply mul_left_cancel' (f.to_map_ne_zero_of_mem_non_zero_divisors ⟨y, hy'⟩),
      rw [← mul_assoc, localization_map.mk'_spec', ← ring_hom.map_mul, ← ring_hom.map_mul,
          x_mul_eq_y_mul, subtype.coe_mk] },
    { intros zI' hzI',
      obtain ⟨zI, hzI, rfl⟩ := mem_coe_ideal.mp hzI',
      obtain ⟨zJ, hzJ, x_mul_eq_y_mul⟩ := hIJ zI hzI,
      refine mem_coe_ideal.mpr ⟨zJ, hzJ, _⟩,
      apply mul_left_cancel' (f.to_map_ne_zero_of_mem_non_zero_divisors ⟨y, hy'⟩),
      rw [← mul_assoc, localization_map.mk'_spec', ← ring_hom.map_mul, ← ring_hom.map_mul,
          x_mul_eq_y_mul, subtype.coe_mk] } },
end

lemma class_group.mk0_surjective [is_dedekind_domain R] : function.surjective (class_group.mk0 f) :=
begin
  rintros ⟨I⟩,
  obtain ⟨a, a_ne_zero', ha⟩ := I.1.2,
  have a_ne_zero := non_zero_divisors.ne_zero_of_mem a_ne_zero',
  have fa_ne_zero : f.to_map a ≠ 0 := f.to_map_ne_zero_of_mem_non_zero_divisors ⟨a, a_ne_zero'⟩,
  refine ⟨⟨{ carrier := { x | (f.to_map a)⁻¹ * f.to_map x ∈ I.1 }, .. }, _⟩, _⟩,
  { simp only [ring_hom.map_zero, set.mem_set_of_eq, mul_zero, ring_hom.map_mul],
    exact submodule.zero_mem I },
  { simp only [ring_hom.map_add, set.mem_set_of_eq, mul_zero, ring_hom.map_mul, mul_add],
    exact λ _ _ ha hb, submodule.add_mem I ha hb },
  { simp only [smul_eq_mul, set.mem_set_of_eq, mul_zero, ring_hom.map_mul, mul_add,
               mul_left_comm (f.to_map a)⁻¹],
    exact λ c _ hb, submodule.smul_mem I c hb },
  { apply (submodule.ne_bot_iff _).mpr,
    obtain ⟨x, x_ne, x_mem⟩ := exists_ne_zero_mem_is_integer I.ne_zero,
    refine ⟨a * x, _, mul_ne_zero a_ne_zero x_ne⟩,
    change (f.to_map a)⁻¹ * f.to_map (a * x) ∈ I.1,
    rwa [ring_hom.map_mul, ← mul_assoc, inv_mul_cancel fa_ne_zero, one_mul] },
  { symmetry,
    apply quotient.sound,
    refine ⟨units.mk0 (f.to_map a) fa_ne_zero, _⟩,
    apply @mul_left_cancel _ _ I,
    rw [← mul_assoc, mul_right_inv, one_mul, eq_comm, mul_comm I],
    simp only [monoid_hom.coe_mk, subtype.coe_mk, ring_hom.map_mul, coe_coe],
    apply units.ext,
    simp only [units.coe_mul, coe_to_principal_ideal, coe_mk0,
               fractional_ideal.eq_span_singleton_mul],
    split,
    { intros zJ' hzJ',
      obtain ⟨zJ, hzJ : (f.to_map a)⁻¹ * f.to_map zJ ∈ (I : fractional_ideal f), rfl⟩ :=
        mem_coe_ideal.mp hzJ',
      refine ⟨_, hzJ, _⟩,
      rw [← mul_assoc, mul_inv_cancel fa_ne_zero, one_mul] },
    { intros zI' hzI',
      rw mem_coe_ideal,
      obtain ⟨y, hy⟩ := ha zI' hzI',
      refine ⟨y, _, hy⟩,
      show (f.to_map a)⁻¹ * f.to_map y ∈ (I : fractional_ideal f),
      rwa [hy, ← mul_assoc, inv_mul_cancel fa_ne_zero, one_mul] } }
end

end

instance submodule.is_principal_bot {R M : Type*} [ring R] [add_comm_group M] [module R M] :
  (⊥ : submodule R M).is_principal :=
⟨⟨0, submodule.span_zero_singleton.symm⟩⟩

lemma class_group.mk_eq_one_iff [is_dedekind_domain R]
  {I : units (fractional_ideal f)} :
  quotient_group.mk' (to_principal_ideal f).range I = 1 ↔
    (I : submodule R f.codomain).is_principal :=
begin
  rw [← (quotient_group.mk' _).map_one, eq_comm, quotient_group.mk'_eq_mk'],
  simp only [exists_prop, one_mul, exists_eq_right, to_principal_ideal_eq_iff,
             monoid_hom.mem_range, coe_coe],
  refine ⟨λ ⟨x, hx⟩, ⟨⟨x, by rw [← hx, coe_span_singleton]⟩⟩, _⟩,
  unfreezingI { intros hI },
  obtain ⟨x, hx⟩ := @submodule.is_principal.principal _ _ _ _ _ _ hI,
  have hx' : (I : fractional_ideal f) = span_singleton x,
  { apply subtype.coe_injective, rw [hx, coe_span_singleton] },
  refine ⟨units.mk0 x _, _⟩,
  { intro x_eq, apply units.ne_zero I, simp [hx', x_eq] },
  simp [hx']
end

@[simp] lemma localization_map.to_map_mem_coe_submodule {I : ideal R} {x : R} :
  f.to_map x ∈ f.coe_submodule I ↔ x ∈ I :=
(localization_map.mem_coe_submodule _).trans
  ⟨λ ⟨y, hy, y_eq⟩, by rwa ← f.injective y_eq,
   λ hx, ⟨x, hx, rfl⟩⟩

@[simp]
lemma localization_map.coe_submodule_injective : function.injective f.coe_submodule :=
λ I J h, submodule.ext (λ x, by simp only [← f.to_map_mem_coe_submodule, h])

@[simp]
lemma localization_map.coe_submodule_le {I : ideal R} {J : submodule R f.codomain} :
  f.coe_submodule I ≤ J ↔ submodule.map f.lin_coe I ≤ J :=
iff.rfl

@[simp]
lemma localization_map.coe_submodule_span_singleton (x : R) :
  f.coe_submodule (submodule.span R {x}) = submodule.span R {f.to_map x} :=
by rw [localization_map.coe_submodule, submodule.map_span, set.image_singleton,
       localization_map.lin_coe_apply]

@[simp]
lemma localization_map.coe_submodule_is_principal {I : ideal R} :
  (f.coe_submodule I).is_principal ↔ I.is_principal :=
begin
  split;
    unfreezingI { intros hI };
    obtain ⟨x, hx⟩ := @submodule.is_principal.principal _ _ _ _ _ _ hI,
  { have x_mem : x ∈ f.coe_submodule I := hx.symm ▸ submodule.mem_span_singleton_self x,
    obtain ⟨x, x_mem, rfl⟩ := (localization_map.mem_coe_submodule _).mp x_mem,
    refine ⟨⟨x, localization_map.coe_submodule_injective f _⟩⟩,
    rw [hx, localization_map.coe_submodule_span_singleton] },
  { refine ⟨⟨f.to_map x, _⟩⟩,
    rw [hx, f.coe_submodule_span_singleton] }
end

lemma class_group.mk0_eq_one_iff [is_dedekind_domain R]
  {I : ideal R} (hI : I ≠ 0) :
  class_group.mk0 f ⟨I, hI⟩ = 1 ↔ I.is_principal :=
(class_group.mk_eq_one_iff _).trans f.coe_submodule_is_principal

/-- The class number is `1` iff the ring of integers is a principal ideal domain. -/
lemma card_class_group_eq_one_iff [is_dedekind_domain R] [fintype (class_group f)] :
  fintype.card (class_group f) = 1 ↔ is_principal_ideal_ring R :=
begin
  rw fintype.card_eq_one_iff,
  split,
  { rintros ⟨I, hI⟩,
    have eq_one : ∀ J : class_group f, J = 1 := λ J, trans (hI J) (hI 1).symm,
    refine ⟨λ I, _⟩,
    by_cases hI : I = ⊥,
    { rw hI, exact submodule.is_principal_bot },
    exact (class_group.mk0_eq_one_iff f hI).mp (eq_one _) },
  { unfreezingI { intros hpid },
    use 1,
    rintros ⟨I⟩,
    exact (class_group.mk_eq_one_iff f).mpr (I : fractional_ideal f).is_principal }
end

end integral_domain


namespace z

inductive nt: Type
| zero : nt
| succ : nt → nt

definition add_n : nt → nt → nt
| nt.zero x := x
| (nt.succ x) y := nt.succ (add_n x y)

definition product_n : nt → nt → nt
| x (nt.succ nt.zero) := x
| _ nt.zero := nt.zero
| x (nt.succ y) := add_n x (product_n x y)

definition eq_n : nt → nt → bool
| nt.zero nt.zero := tt
| (nt.succ a) (nt.succ b) := eq_n a b
| _ _ := ff

end z

inductive bina:Type
| O : bina
| pls : bina → bina
| dob : bina → bina

def inc_b : bina → bina
| bina.O := bina.pls bina.O
| (bina.dob x) := bina.pls (bina.dob x)
| (bina.pls (bina.dob x)) := bina.dob (inc_b x)
--else pls , O = 1
| _ := bina.dob (bina.pls bina.O)

def bin_to_un : bina → ℕ
| bina.O := 0
| (bina.pls x) := 1 + bin_to_un x
| (bina.dob x) := 2 * bin_to_un x

#eval bin_to_un (bina.dob (bina.pls (bina.dob (bina.dob (bina.dob (bina.pls bina.O))))))
#eval bina.pls(bina.dob (bina.pls (bina.O)))

def check1 : bina → bool
| x := bin_to_un (inc_b x) = (bin_to_un x) + 1

--   1 + pls dob n = 1 + 1 + 2 * n
-- = 1 + 1 + 2 * n
-- = 2 + 2 * n
-- = 2 * (1 + n)
--- = dob pls n

theorem mult_0_r : ∀ n:nat,
  n * 0 = 0 := begin
  simp
  end

open nat
theorem ac (m n : ℕ) : m^(succ n) = m * m^n :=
begin

induction n,
{
    simp
},
{
    unfold nat.pow,
    rewrite mul_comm
}

end

theorem plus_n_Sm : ∀ n m : nat,
  nat.succ (n + m) = n + (nat.succ m) := sorry

theorem plus_comm : ∀ n m : nat,
  n + m = m + n := sorry

theorem plus_assoc : ∀ n m p : nat,
  n + (m + p) = (n + m) + p := sorry

--open nat

theorem minus_diag : ∀ (n : nat), n - n = 0 :=
begin
intro n,
induction n,

{
    refl
},
{
    simp,
    rewrite ih_1
}

end

def is_even : ℕ → bool
| 0 := tt
| 1 := ff
| (nat.succ (nat.succ x)) := is_even x

definition b_not : bool → bool
| ff := tt
| tt := ff

theorem x_plus_two_also_even : ∀ n : nat, is_even n = is_even (n + 2) := begin
intro n,
induction n,
{
    refl
},
{
    cases (is_even a);cases is_even (nat.succ a);refl
}
end

theorem evenb_S : ∀ n : nat, is_even (nat.succ n) = b_not (is_even n) := begin

intro n,
induction n with d Hd,

{
    refl
},

{
    cases is_even (nat.succ d),
    {
        cases is_even (nat.succ (nat.succ d)),
        {
            --change ff=tt at ih_1,
            revert Hd,
            exact dec_trivial
        },
        {
            refl
        }
    },
    {
        cases is_even (nat.succ (nat.succ d)),
        {
            refl
        },
        {
            --change tt=ff at ih_1,
            revert Hd,
            exact dec_trivial
        }
    }
}

end

theorem A : ∀ n : z.nt, z.eq_n n n = tt := begin

intro n,

end

----------------------------------------
--trashier
----------------------------------------

namespace Z

inductive nt: Type
| zero : nt
| succ : nt → nt

definition add_n : nt → nt → nt
| nt.zero x := x
| (nt.succ x) y := nt.succ (add_n x y)

definition product_n : nt → nt → nt
| x (nt.succ nt.zero) := x
| _ nt.zero := nt.zero
| x (nt.succ y) := add_n x (product_n x y)

definition eq_n : nt → nt → bool
| nt.zero nt.zero := tt
| (nt.succ a) (nt.succ b) := eq_n a b
| _ _ := ff

-- x * (y+1) = xy + x
theorem nec : ∀x y: ℕ, x*(y+1)=x*y+x :=
begin
intros x y,
refl,
end

end Z

theorem test2 : ∀ n m : ℕ, n = m → n+n = m+m :=
begin
intros n m,
intro hyp,
subst hyp,
end

theorem plus_id_exercise : ∀ n m o : ℕ , n = m → m = o → n + m = m + o :=
begin
intros n m o,
intro H,
subst H,
intro H2,
subst H2
end

theorem mult_S_1 : ∀ n m : ℕ, m = nat.succ n → m * (1 + n) = m * m :=
begin
intros n m,
intro H,
subst H,
simp,
end

definition b_and : bool → bool → bool
| tt tt := tt
| _ _ := ff

definition b_or : bool → bool → bool
| ff ff := ff
| _ _ := tt

definition b_not : bool → bool
| ff := tt
| tt := ff

-- AND (a b) = NOT OR (NOT A NOT B)

theorem t : ∀ a b : bool, b_and a b = b_not ( b_or (b_not a ) (b_not b) ):=
begin
intros a b,
cases a,
{
    cases b,
    {
        exact dec_trivial
    },
    {
        exact dec_trivial
    }
},
{
    cases b,
    {
        exact dec_trivial
    },
    {
        exact dec_trivial
    }
}
end

theorem yy: ∀ x : bool, ¬ x = ff → x = tt:=
begin
intro x,
intro H,
admit
end

theorem a_b_c (c : bool) : ¬ (c = tt) → c = ff :=
begin
  intro H,
  cases c,
  { -- goal is ff = ff
    refl
  },
  { -- goal is tt = ff
    -- but we have hypothesis H : ¬tt = tt
    -- and that hypothesis is false
    --cases (H rfl)
    have H₂ : tt = tt,
      refl, -- now we have P in our context
    have Q := H H₂,
    -- check out the type of Q!
  }
end

--set_option pp.notation false
theorem andb_true_elim2_2 : ∀ b c : bool, b_and b c = true → c = true :=
begin

intros b c,
intro H₁,
by_cases b=tt,
{
    rename h H₂,
    by_cases c=tt,
    {
        subst h,
        refl
    },
    {
        subst H₂,

    }
},
{
admit
}

end

theorem identity_fn_applied_twice :
  ∀ (f : bool → bool),
  (∀ (x : bool), f x = x) →
  ∀ (b : bool), f (f b) = b := begin

  intro f,
  intro h,
  intro b,

  rewrite h,
  rewrite h,

end

theorem andb_eq_orb : ∀ (b c : bool), (b_and b c = b_or b c) → b = c:=
begin

intros b c,
--intro H,

cases b,
{
    cases c,
    {
        intro H,
        refl
    },
    {
        --change ff = b_or ff tt at H,
        --revert H,
        exact dec_trivial
    }
},
{
    cases c,
    {
        --change ff = tt at H,
        --revert H,
        exact dec_trivial
    },
    {
        intro H,
        refl
    }
}

end

example : b_and ff tt = b_or ff tt -> false :=
begin
  intro H,
  -- H : b_and ff tt = b_or ff tt
  change ff = tt at H,
  revert H,
  exact dec_trivial,
end


/-
Copyright (c) 2022 Matthias Uschold. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Matthias Uschold.
-/

import tactic
import algebra.group.basic
import data.real.basic
import topology.continuous_function.bounded
import topology.category.Top
import algebra.group.defs

/-!
# Means on Groups

In this file, we introduce means on groups,
i.e. `averaging' maps that turn bounded (continuous) functions G → ℝ into a real number.

## Main Definitions

- `mean`              : Structure for means
- `mean_pushforward`  : Pushing forward a mean on $G$ via a map $G → H$ yields a mean on $H$.

## Implementation Notes

We will ultimately need this notion to define amenability of groups via
invariant means (in the file def_amenable).

This file defines means by regarding all groups with their discrete topology,
thus enabling us to use `bounded_continuous_function`.
If you want to consider means on (non-discrete)
topological groups, one needs to change some definitions.

## References
* <https://en.wikipedia.org/wiki/Amenable_group>
* [C. Löh, *Geometric Group Theory*, Proposition 9.1.1][loeh17]

## Tags
mean
-/

open classical
open bounded_continuous_function

variables (G:Type*) [group G]

instance topspaceG : topological_space G := ⊥
instance discrtopG : discrete_topology G := ⟨rfl⟩

/-- A mean on a group-/
structure mean
:= mk ::
  (lin_map : (bounded_continuous_function G ℝ) →ₗ[ℝ] ℝ)
  (normality : lin_map (bounded_continuous_function.const G (1:ℝ)) = 1)
  (positivity: ∀ {f : bounded_continuous_function G ℝ},
                          (∀ (x:G), f x ≥ 0) → lin_map f ≥ 0)

instance : has_coe (mean G) ((bounded_continuous_function G ℝ) →ₗ[ℝ] ℝ)
      := {coe := mean.lin_map}

/--Equality of means can be checked by evaluation -/
@[ext]
theorem ext {m n : mean G}
  (h: ∀ f, m f = n f)
  : m = n
:= begin
  cases m,
  cases n,
  simp,
  ext,
  exact h x,
end

namespace mean

section el_facts

/-!
### Elementary facts

We collect some elementary facts about means
-/

@[simp]
lemma mean_of_neg
  (m : mean G)
  {f: bounded_continuous_function G ℝ}
  : m (-f) = - m f
:= begin
  have : m (-f) + m f = 0,
  {
    calc   m (-f) + m f
        = m ((-f) +f )
         : by exact (m.lin_map.map_add' (-f) f).symm
    ... = m 0
          : by ring_nf
    ... = m ((0:ℝ) • 0)
          : by simp
    ... = (ring_hom.id ℝ) 0 • m 0
          : by exact m.lin_map.map_smul' 0 0
    ... = 0
          : by simp,
  },
  linarith,
end

lemma mean_bounded
  (m : mean G)
  {f: bounded_continuous_function G ℝ}
  {M : ℝ}
  (fbound : ∀ (x:G), f x ≤ M)
  : m f ≤ M
:= begin
  -- strategy of proof : (M-f) is a positive function
  let diff : bounded_continuous_function G ℝ
      := bounded_continuous_function.const G M  - f,

  have diffpos : ∀ (x:G), diff x ≥ 0,
  {
    assume (x:G),
    dsimp[diff],
    by linarith only [fbound x],
  },

  have mdiffpos : m diff ≥ 0
      := m.positivity diffpos,

  have mean_const : m (bounded_continuous_function.const G M) = M,
  {
    calc   m (bounded_continuous_function.const G M)
        = m (M • bounded_continuous_function.const G 1)
          : by congr'; begin
            ext (x:G),
            simp,
          end
    ... = M • m (bounded_continuous_function.const G 1)
          : by exact m.lin_map.map_smul' M _
    ... = M • 1
          : by congr'; exact m.normality
    ... = M
          : by simp,
  },

  have : m f + m diff = M
  := by
  calc  m f + m diff
      = m (f + diff)
        : by exact (m.lin_map.map_add' f diff).symm
  ... = m (f + bounded_continuous_function.const G M - f)
        : by simp[diff]
  ... = m (bounded_continuous_function.const G M )
        : by simp
  ... = M
        : by simp [mean_const],

  by linarith only [this, mdiffpos],
end

/--Essentially: W.r.t. the sup-norm, m has norm ≤ 1-/
lemma mean_bounded_abs
  (m : mean G)
  {f: bounded_continuous_function G ℝ}
  {M : ℝ}
  (fbound : ∀ (x:G), |f x| ≤ M)
  : |m f| ≤ M
:= begin
  have bound_le : m f ≤ M,
  {
    have fbound' :  ∀ (x:G), f x ≤ M
      := (λ x, (abs_le.mp (fbound x)).2),
    exact mean_bounded G m fbound',
  },

  have bound_ge : m f ≥ -M,
  {
    have negfbound' :  ∀ (x:G), (-f) x ≤ M,
    {
      assume x:G,
      simp,
      by linarith[(abs_le.mp (fbound x)).1],
    },
    have : m (-f) ≤ M
            := mean_bounded G m negfbound',
    have : m (-f) = - m f
            := mean_of_neg G m,
    by linarith,
  },

  exact abs_le.mpr (and.intro bound_ge bound_le),
end

@[simp]
lemma mean_add
  {m : mean G}
  {f g: bounded_continuous_function G ℝ}
  : m (f+g) = m f + m g
:= m.lin_map.map_add' f g

@[simp]
lemma mean_smul
  {m : mean G}
  {f: bounded_continuous_function G ℝ}
  {r :ℝ}
  : m (r•f) =r •  (m f)
:= m.lin_map.map_smul' r f

/--Means are monotone functions-/
lemma mean_monotone
  {m : mean G}
  {f g: bounded_continuous_function G ℝ}
  (f_le_g : f ≤ g)
  : m f ≤ m g
:= begin
  have diff_pos: ∀ (x:G), (g-f) x ≥ 0,
  {
    assume x:G,
    have : (g-f) x = g x - f x
      := by refl,
    rw this,
    simp,
    exact f_le_g x,
  },
  calc  m f
      = m f + 0
        : by ring
  ... ≤  m f + m (g-f)
        : by {simp, exact m.positivity diff_pos,}
  ... = m (f+(g-f))
        : by rw mean_add
  ... = m g
        : by congr';ring,
end

end el_facts

section pushforward_mean

/-!
### Pushforwards of Means

We will often use the following construction: If `m` is a mean on `H`
and `π : G → H` is any map, we can obtain a mean on `G`
by composing with `π`.

-/

variables {H : Type* } [group H]
(π: G → H)

variable {G}

/-- Precomposition of a bounded_continuous_map with a continuous map-/
noncomputable def bcont_precomp
  {X Y: Type*}
  [topological_space X]
  [topological_space Y]
  (h : C(X,Y))
  (f : bounded_continuous_function Y ℝ)
  : bounded_continuous_function X ℝ
:= bounded_continuous_function.mk
      (continuous_map.comp f.to_continuous_map h)
      (by {
        rcases f.map_bounded' with ⟨C, hf⟩,
        use C,
        assume x y : X,
        specialize hf (h x) (h y),
        exact hf,
      })

/-- even easier: with discrete topology-/
noncomputable def bcont_precomp_discrete
  {X Y: Type*}
  [topological_space X] [discrete_topology X]
  [topological_space Y]
  (h : X → Y)
  (f : bounded_continuous_function Y ℝ)
  : bounded_continuous_function X ℝ
:= bcont_precomp (continuous_map.mk h continuous_of_discrete_topology) f

noncomputable def comp_bcont
  (f: bounded_continuous_function H ℝ)
  : bounded_continuous_function G ℝ
:= bcont_precomp_discrete π f

@[simp]
lemma comp_bcont_eval
  (π : G → H)
  (f: bounded_continuous_function H ℝ)
  (g :G)
  : comp_bcont π f g = f (π g)
:= by refl

@[simp]
noncomputable def pull_bcont
  (π : G → H)
  : (bounded_continuous_function H ℝ) →ₗ[ℝ] (bounded_continuous_function G ℝ)
:= linear_map.mk (λ f, comp_bcont π f)
              (by tauto) (by tauto)

include π

@[simp]
noncomputable def mean_pushforward_linmap
  (π : G → H)
  (m : mean G)
  : (bounded_continuous_function H ℝ) →ₗ[ℝ] ℝ
:= linear_map.comp m.lin_map (pull_bcont π)

lemma mean_pushforward_norm
  (π : G → H)
  (m : mean G)
  : (mean_pushforward_linmap π m) (bounded_continuous_function.const H (1:ℝ)) = 1
:= begin
  -- the pushforward of the 1-function is the 1-function
  have  pull_of_one
        : (pull_bcont π) (bounded_continuous_function.const H (1:ℝ))
        = bounded_continuous_function.const G (1:ℝ),
  {
    ext (x:G),
    simp,
  },
  calc  (mean_pushforward_linmap π m) (bounded_continuous_function.const H (1:ℝ))
      = m.lin_map (pull_bcont π (bounded_continuous_function.const H (1:ℝ)))
        : by tauto
  ... = m.lin_map (bounded_continuous_function.const G (1:ℝ))
        : by rw pull_of_one
  ... = 1
        : m.normality,
end

lemma mean_pushforward_pos
  (π : G → H)
  (m : mean G)
  : ∀ (f : bounded_continuous_function H ℝ),
                    (∀ (x:H), f(x) ≥ 0) → (mean_pushforward_linmap π m) f ≥ 0
:= begin
  assume f fnonneg,

  apply m.positivity,
  -- key step: pull_bcont π f is also nonneg
  change ∀(x:G), (pull_bcont π f) x ≥ 0,

  assume (x:G),
  specialize fnonneg (π x),
  by tauto,
end

/-- The mean on H, induced by the mean on G-/
@[simp]
noncomputable def mean_pushforward
  (π : G → H)
  (m : mean G)
  : mean H
:= mean.mk (mean_pushforward_linmap π m)
           (mean_pushforward_norm π m)
           (mean_pushforward_pos π m)

end pushforward_mean

end mean


import Lean

universe u

structure Magma where
  α   : Type u
  mul : α → α → α

instance : CoeSort Magma (Type u) where
  coe s := s.α

abbrev mul {M : Magma} (a b : M) : M :=
  M.mul a b

set_option pp.all true

infixl:70 (priority := high) "*" => mul

structure Semigroup extends Magma where
  mul_assoc (a b c : α) : a * b * c = a * (b * c)

instance : CoeSort Semigroup (Type u) where
  coe s := s.α

structure CommSemigroup extends Semigroup where
  mul_comm (a b : α) : a * b = b * a

structure Monoid extends Semigroup where
  one : α
  one_mul (a : α) : one * a = a
  mul_one (a : α) : a * one = a

instance : CoeSort Monoid (Type u) where
  coe s := s.α

structure CommMonoid extends Monoid where
  mul_comm (a b : α) : a * b = b * a

instance : Coe CommMonoid CommSemigroup where
  coe s := {
      α   := s.α
      mul := s.mul
      mul_assoc := s.mul_assoc
      mul_comm  := s.mul_comm
    }

structure Group extends Monoid where
  inv : α → α
  mul_left_inv (a : α) : (inv a) * a = one

instance : CoeSort Group (Type u) where
  coe s := s.α

abbrev inv {G : Group} (a : G) : G :=
  G.inv a

postfix:max "⁻¹" => inv

instance (G : Group) : OfNat (CoeSort.coe G.toMagma) (nat_lit 1) where
  ofNat := G.one

instance (G : Group) : OfNat (G.toMagma.α) (nat_lit 1) where
  ofNat := G.one

structure CommGroup extends Group where
  mul_comm (a b : α) : a * b = b * a

instance : CoeSort CommGroup (Type u) where
  coe s := s.α

theorem inv_mul_cancel_left {G : Group} (a b : G) : a⁻¹ * (a * b) = b := by
  rw [← G.mul_assoc, G.mul_left_inv, G.one_mul]

theorem toMonoidOneEq {G : Group} : G.toMonoid.one = 1 :=
  rfl

theorem inv_eq_of_mul_eq_one {G : Group} {a b : G} (h : a * b = 1) : a⁻¹ = b := by
  rw [← G.mul_one a⁻¹, toMonoidOneEq, ←h, ← G.mul_assoc, G.mul_left_inv, G.one_mul]

theorem inv_inv {G : Group} (a : G) : (a⁻¹)⁻¹ = a :=
  inv_eq_of_mul_eq_one (G.mul_left_inv a)

theorem mul_right_inv {G : Group} (a : G) : a * a⁻¹ = 1 := by
  have : a⁻¹⁻¹ * a⁻¹ = 1 := by rw [G.mul_left_inv]; rfl
  rw [inv_inv] at this
  assumption

unif_hint (G : Group) where
  |- G.toMonoid.one =?= 1

theorem mul_inv_rev {G : Group} (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ := by
  apply inv_eq_of_mul_eq_one
  rw [G.mul_assoc, ← G.mul_assoc b, mul_right_inv, G.one_mul, mul_right_inv]

theorem mul_inv {G : CommGroup} (a b : G) : (a * b)⁻¹ = a⁻¹ * b⁻¹ := by
  rw [mul_inv_rev, G.mul_comm]


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

import algebra.algebra.subalgebra.basic
import algebra.algebra.bilinear

/-!
# Towers of algebras

In this file we prove basic facts about towers of algebra.

An algebra tower A/S/R is expressed by having instances of `algebra A S`,
`algebra R S`, `algebra R A` and `is_scalar_tower R S A`, the later asserting the
compatibility condition `(r • s) • a = r • (s • a)`.

An important definition is `to_alg_hom R S A`, the canonical `R`-algebra homomorphism `S →ₐ[R] A`.

-/

open_locale pointwise
universes u v w u₁ v₁

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁) (M : Type v₁)

namespace algebra

variables [comm_semiring R] [semiring A] [algebra R A]
variables [add_comm_monoid M] [module R M] [module A M] [is_scalar_tower R A M]

variables {A}

/-- The `R`-algebra morphism `A → End (M)` corresponding to the representation of the algebra `A`
on the `R`-module `M`.

This is a stronger version of `distrib_mul_action.to_linear_map`, and could also have been
called `algebra.to_module_End`. -/
def lsmul : A →ₐ[R] module.End R M :=
{ to_fun := distrib_mul_action.to_linear_map R M,
  map_one' := linear_map.ext $ λ _, one_smul A _,
  map_mul' := λ a b, linear_map.ext $ smul_assoc a b,
  map_zero' := linear_map.ext $ λ _, zero_smul A _,
  map_add' := λ a b, linear_map.ext $ λ _, add_smul _ _ _,
  commutes' := λ r, linear_map.ext $ algebra_map_smul A r, }

@[simp] lemma lsmul_coe (a : A) : (lsmul R M a : M → M) = (•) a := rfl

lemma lmul_algebra_map (x : R) :
  lmul R A (algebra_map R A x) = algebra.lsmul R A x :=
eq.symm $ linear_map.ext $ smul_def x

end algebra

namespace is_scalar_tower

section module

variables [comm_semiring R] [semiring A] [algebra R A]
variables [add_comm_monoid M] [module R M] [module A M] [is_scalar_tower R A M]

variables {R} (A) {M}
theorem algebra_map_smul (r : R) (x : M) : algebra_map R A r • x = r • x :=
by rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul]

end module

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B]

variables {R S A}
theorem of_algebra_map_eq [algebra R A]
  (h : ∀ x, algebra_map R A x = algebra_map S A (algebra_map R S x)) :
  is_scalar_tower R S A :=
⟨λ x y z, by simp_rw [algebra.smul_def, ring_hom.map_mul, mul_assoc, h]⟩

/-- See note [partially-applied ext lemmas]. -/
theorem of_algebra_map_eq' [algebra R A]
  (h : algebra_map R A = (algebra_map S A).comp (algebra_map R S)) :
  is_scalar_tower R S A :=
of_algebra_map_eq $ ring_hom.ext_iff.1 h

variables (R S A)

instance subalgebra (S₀ : subalgebra R S) : is_scalar_tower S₀ S A :=
of_algebra_map_eq $ λ x, rfl

variables [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

theorem algebra_map_eq :
  algebra_map R A = (algebra_map S A).comp (algebra_map R S) :=
ring_hom.ext $ λ x, by simp_rw [ring_hom.comp_apply, algebra.algebra_map_eq_smul_one,
    smul_assoc, one_smul]

theorem algebra_map_apply (x : R) : algebra_map R A x = algebra_map S A (algebra_map R S x) :=
by rw [algebra_map_eq R S A, ring_hom.comp_apply]

instance subalgebra' (S₀ : subalgebra R S) : is_scalar_tower R S₀ A :=
@is_scalar_tower.of_algebra_map_eq R S₀ A _ _ _ _ _ _ $ λ _,
(is_scalar_tower.algebra_map_apply R S A _ : _)

@[ext] lemma algebra.ext {S : Type u} {A : Type v} [comm_semiring S] [semiring A]
  (h1 h2 : algebra S A) (h : ∀ (r : S) (x : A), (by haveI := h1; exact r • x) = r • x) : h1 = h2 :=
algebra.algebra_ext _ _ $ λ r, by
  simpa only [@algebra.smul_def _ _ _ _ h1, @algebra.smul_def _ _ _ _ h2, mul_one] using h r 1

/-- In a tower, the canonical map from the middle element to the top element is an
algebra homomorphism over the bottom element. -/
def to_alg_hom : S →ₐ[R] A :=
{ commutes' := λ _, (algebra_map_apply _ _ _ _).symm,
  .. algebra_map S A }

lemma to_alg_hom_apply (y : S) : to_alg_hom R S A y = algebra_map S A y := rfl

@[simp] lemma coe_to_alg_hom : ↑(to_alg_hom R S A) = algebra_map S A :=
ring_hom.ext $ λ _, rfl

@[simp] lemma coe_to_alg_hom' : (to_alg_hom R S A : S → A) = algebra_map S A :=
rfl

variables {R S A B}

@[simp, priority 900] lemma _root_.alg_hom.map_algebra_map (f : A →ₐ[S] B) (r : R) :
  f (algebra_map R A r) = algebra_map R B r :=
by rw [algebra_map_apply R S A r, f.commutes, ← algebra_map_apply R S B]

variables (R)

@[simp, priority 900] lemma _root_.alg_hom.comp_algebra_map_of_tower (f : A →ₐ[S] B) :
  (f : A →+* B).comp (algebra_map R A) = algebra_map R B :=
ring_hom.ext f.map_algebra_map

variables (R) {S A B}

-- conflicts with is_scalar_tower.subalgebra
@[priority 999] instance subsemiring (U : subsemiring S) : is_scalar_tower U S A :=
of_algebra_map_eq $ λ x, rfl

@[nolint instance_priority]
instance of_ring_hom {R A B : Type*} [comm_semiring R] [comm_semiring A] [comm_semiring B]
  [algebra R A] [algebra R B] (f : A →ₐ[R] B) :
  @is_scalar_tower R A B _ (f.to_ring_hom.to_algebra.to_has_scalar) _ :=
by { letI := (f : A →+* B).to_algebra, exact of_algebra_map_eq (λ x, (f.commutes x).symm) }

end semiring

end is_scalar_tower

section homs

variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B]
variables [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R) {A S B}

open is_scalar_tower

namespace alg_hom

/-- R ⟶ S induces S-Alg ⥤ R-Alg -/
def restrict_scalars (f : A →ₐ[S] B) : A →ₐ[R] B :=
{ commutes' := λ r, by { rw [algebra_map_apply R S A, algebra_map_apply R S B],
    exact f.commutes (algebra_map R S r) },
  .. (f : A →+* B) }

lemma restrict_scalars_apply (f : A →ₐ[S] B) (x : A) : f.restrict_scalars R x = f x := rfl

@[simp] lemma coe_restrict_scalars (f : A →ₐ[S] B) : (f.restrict_scalars R : A →+* B) = f := rfl

@[simp] lemma coe_restrict_scalars' (f : A →ₐ[S] B) : (restrict_scalars R f : A → B) = f := rfl

lemma restrict_scalars_injective :
  function.injective (restrict_scalars R : (A →ₐ[S] B) → (A →ₐ[R] B)) :=
λ f g h, alg_hom.ext (alg_hom.congr_fun h : _)

end alg_hom

namespace alg_equiv

/-- R ⟶ S induces S-Alg ⥤ R-Alg -/
def restrict_scalars (f : A ≃ₐ[S] B) : A ≃ₐ[R] B :=
{ commutes' := λ r, by { rw [algebra_map_apply R S A, algebra_map_apply R S B],
    exact f.commutes (algebra_map R S r) },
  .. (f : A ≃+* B) }

lemma restrict_scalars_apply (f : A ≃ₐ[S] B) (x : A) : f.restrict_scalars R x = f x := rfl

@[simp] lemma coe_restrict_scalars (f : A ≃ₐ[S] B) : (f.restrict_scalars R : A ≃+* B) = f := rfl

@[simp] lemma coe_restrict_scalars' (f : A ≃ₐ[S] B) : (restrict_scalars R f : A → B) = f := rfl

lemma restrict_scalars_injective :
  function.injective (restrict_scalars R : (A ≃ₐ[S] B) → (A ≃ₐ[R] B)) :=
λ f g h, alg_equiv.ext (alg_equiv.congr_fun h : _)

end alg_equiv

end homs

namespace subalgebra

open is_scalar_tower

section semiring

variables (R) {S A B} [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra R A] [algebra S B] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

/-- Given a scalar tower `R`, `S`, `A` of algebras, reinterpret an `S`-subalgebra of `A` an as an
`R`-subalgebra. -/
def restrict_scalars (U : subalgebra S A) : subalgebra R A :=
{ algebra_map_mem' := λ x, by { rw algebra_map_apply R S A, exact U.algebra_map_mem _ },
  .. U }

@[simp] lemma coe_restrict_scalars {U : subalgebra S A} :
  (restrict_scalars R U : set A) = (U : set A) := rfl

@[simp] lemma restrict_scalars_top : restrict_scalars R (⊤ : subalgebra S A) = ⊤ :=
set_like.coe_injective rfl

@[simp] lemma restrict_scalars_to_submodule {U : subalgebra S A} :
  (U.restrict_scalars R).to_submodule = U.to_submodule.restrict_scalars R :=
set_like.coe_injective rfl

@[simp] lemma mem_restrict_scalars {U : subalgebra S A} {x : A} :
  x ∈ restrict_scalars R U ↔ x ∈ U := iff.rfl

lemma restrict_scalars_injective :
  function.injective (restrict_scalars R : subalgebra S A → subalgebra R A) :=
λ U V H, ext $ λ x, by rw [← mem_restrict_scalars R, H, mem_restrict_scalars]

/-- Produces an `R`-algebra map from `U.restrict_scalars R` given an `S`-algebra map from `U`.

This is a special case of `alg_hom.restrict_scalars` that can be helpful in elaboration. -/
@[simp]
def of_restrict_scalars (U : subalgebra S A) (f : U →ₐ[S] B) : U.restrict_scalars R →ₐ[R] B :=
f.restrict_scalars R

end semiring

end subalgebra

namespace algebra

variables {R A} [comm_semiring R] [semiring A] [algebra R A]
variables {M} [add_comm_monoid M] [module A M] [module R M] [is_scalar_tower R A M]

lemma span_restrict_scalars_eq_span_of_surjective
  (h : function.surjective (algebra_map R A)) (s : set M) :
  (submodule.span A s).restrict_scalars R = submodule.span R s :=
begin
  refine le_antisymm (λ x hx, _) (submodule.span_subset_span _ _ _),
  refine submodule.span_induction hx _ _ _ _,
  { exact λ x hx, submodule.subset_span hx },
  { exact submodule.zero_mem _ },
  { exact λ x y, submodule.add_mem _ },
  { intros c x hx,
    obtain ⟨c', rfl⟩ := h c,
    rw is_scalar_tower.algebra_map_smul,
    exact submodule.smul_mem _ _ hx },
end

lemma coe_span_eq_span_of_surjective
  (h : function.surjective (algebra_map R A)) (s : set M) :
  (submodule.span A s : set M) = submodule.span R s :=
congr_arg coe (algebra.span_restrict_scalars_eq_span_of_surjective h s)

end algebra

namespace is_scalar_tower

open subalgebra

variables [comm_semiring R] [comm_semiring S] [comm_semiring A]
variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]

theorem adjoin_range_to_alg_hom (t : set A) :
  (algebra.adjoin (to_alg_hom R S A).range t).restrict_scalars R =
    (algebra.adjoin S t).restrict_scalars R :=
subalgebra.ext $ λ z,
show z ∈ subsemiring.closure (set.range (algebra_map (to_alg_hom R S A).range A) ∪ t : set A) ↔
  z ∈ subsemiring.closure (set.range (algebra_map S A) ∪ t : set A),
from suffices set.range (algebra_map (to_alg_hom R S A).range A) = set.range (algebra_map S A),
  by rw this,
by { ext z, exact ⟨λ ⟨⟨x, y, h1⟩, h2⟩, ⟨y, h2 ▸ h1⟩, λ ⟨y, hy⟩, ⟨⟨z, y, hy⟩, rfl⟩⟩ }

end is_scalar_tower

section semiring

variables {R S A}
variables [comm_semiring R] [semiring S] [add_comm_monoid A]
variables [algebra R S] [module S A] [module R A] [is_scalar_tower R S A]

namespace submodule

open is_scalar_tower

theorem smul_mem_span_smul_of_mem {s : set S} {t : set A} {k : S} (hks : k ∈ span R s)
  {x : A} (hx : x ∈ t) : k • x ∈ span R (s • t) :=
span_induction hks (λ c hc, subset_span $ set.mem_smul.2 ⟨c, x, hc, hx, rfl⟩)
  (by { rw zero_smul, exact zero_mem _ })
  (λ c₁ c₂ ih₁ ih₂, by { rw add_smul, exact add_mem _ ih₁ ih₂ })
  (λ b c hc, by { rw is_scalar_tower.smul_assoc, exact smul_mem _ _ hc })

theorem smul_mem_span_smul {s : set S} (hs : span R s = ⊤) {t : set A} {k : S}
  {x : A} (hx : x ∈ span R t) :
  k • x ∈ span R (s • t) :=
span_induction hx (λ x hx, smul_mem_span_smul_of_mem (hs.symm ▸ mem_top) hx)
  (by { rw smul_zero, exact zero_mem _ })
  (λ x y ihx ihy, by { rw smul_add, exact add_mem _ ihx ihy })
  (λ c x hx, smul_comm c k x ▸ smul_mem _ _ hx)

theorem span_smul {s : set S} (hs : span R s = ⊤) (t : set A) :
  span R (s • t) = (span S t).restrict_scalars R :=
le_antisymm (span_le.2 $ λ x hx, let ⟨p, q, hps, hqt, hpqx⟩ := set.mem_smul.1 hx in
  hpqx ▸ (span S t).smul_mem p (subset_span hqt)) $
λ p hp, span_induction hp (λ x hx, one_smul S x ▸ smul_mem_span_smul hs (subset_span hx))
  (zero_mem _)
  (λ _ _, add_mem _)
  (λ k x hx, smul_mem_span_smul' hs hx)

/-- A variant of `submodule.span_image` for `algebra_map`. -/
lemma span_algebra_map_image (a : set R) :
  submodule.span R (algebra_map R S '' a) =
    (submodule.span R a).map (algebra.linear_map R S) :=
(submodule.span_image $ algebra.linear_map R S).trans rfl

lemma span_algebra_map_image_of_tower {S T : Type*} [comm_semiring S] [semiring T]
  [module R S] [is_scalar_tower R S S] [algebra R T] [algebra S T] [is_scalar_tower R S T]
  (a : set S) :
  submodule.span R (algebra_map S T '' a) =
    (submodule.span R a).map ((algebra.linear_map S T).restrict_scalars R) :=
(submodule.span_image $ (algebra.linear_map S T).restrict_scalars R).trans rfl

lemma map_mem_span_algebra_map_image {S T : Type*} [comm_semiring S] [semiring T]
  [algebra R S] [algebra R T] [algebra S T] [is_scalar_tower R S T]
  (x : S) (a : set S) (hx : x ∈ submodule.span R a) :
  algebra_map S T x ∈ submodule.span R (algebra_map S T '' a) :=
by { rw [span_algebra_map_image_of_tower, mem_map], exact ⟨x, hx, rfl⟩ }

end submodule

end semiring

section ring

namespace algebra

variables [comm_semiring R] [ring A] [algebra R A]
variables [add_comm_group M] [module A M] [module R M] [is_scalar_tower R A M]

lemma lsmul_injective [no_zero_smul_divisors A M] {x : A} (hx : x ≠ 0) :
  function.injective (lsmul R M x) :=
smul_right_injective _ hx

end algebra

end ring


import category_theory.category.default

universes v u  -- The order in this declaration matters: v often needs to be explicitly specified while u often can be omitted

namespace category_theory

variables (C : Type u) [category.{v} C]

/-
# Category world

## Level 2: Definition of category

A category `C` consists of
  * a collection of objects `X, Y, Z, ...`
  * a collection of morphisms `f, g, h, ...`
so that:
  * each morphism has specified domain and codomain objects;
    `f : X ⟶ Y` signifies that `f` is a morphism with
    domain `X` and codomain `Y`
  * each object has a designated identity morphism `𝟙 X : X ⟶ X`
  * for any pair of morphisms `f, g` with the codomain of `f` equal
    to the domain of `g`,the exists a specified composite morphism
    `f ≫ g` whose domain is that of `f` and codomain that of `g`,
    i.e. `f : X ⟶ Y, g : Y ⟶ Z` then `f ≫ g : X ⟶ Z`
This data is subject to the following axioms:
  * For any `f : X ⟶ Y`,
  -/
  /- Axiom :
    f ≫ 𝟙 Y = f-/
  /- Axiom:
    𝟙 X ≫ f = f-/

  /-* For any composable triple of morphisms `f, g, h`, we have associativity
  `f ≫ (g ≫ h) = (f ≫ g) ≫ h`-/
  /- Axiom:
    f ≫ (g ≫ h) = (f ≫ g) ≫ h-/

/-First we start out with some easy lemmas to get us warmed up.-/

/- Lemma
If $$f : X ⟶ Y$$ and $$g : X ⟶ Y$$ are morphisms such that $$f = g$$, then $$f ≫ h = g ≫ h$$.
-/
lemma eq_postcomp_eq {X Y Z : C} {f g : Y ⟶ Z} (w : f = g) (h : X ⟶ Y) : h ≫ f = h ≫ g :=
begin
  rw w,
end

end category_theory


import data.finset
import .simple_graph.basic

universes u

open finset

variables {α : Type u} [decidable_eq α]

variables [fintype α]

/- A matroid M is an ordered pair `(E, ℐ)` consisting of a finite set `E` and
a collection `ℐ` of subsets of `E` having the following three properties:
  (I1) `∅ ∈ ℐ`.
  (I2) If `I ∈ ℐ` and `I' ⊆ I`, then `I' ∈ ℐ`.
  (I3) If `I₁` and `I₂` are in `I` and `|I₁| < |I₂|`, then there is an element `e` of `I₂ − I₁`
    such that `I₁ ∪ {e} ∈ I`.-/

def can_exchange (ℐ : finset α → Prop) : Prop :=
∀ I₁ I₂, ℐ I₁ ∧ ℐ I₂ → finset.card I₁ < finset.card I₂ → ∃ (e ∈ I₂ \ I₁), (ℐ (insert e I₁))

@[ext]
structure matroid (α : Type u) [fintype α] [decidable_eq α] :=
(ℐ : finset α → Prop)
(empty : ℐ ∅) -- (I1)
(hereditary : ∀ (I₁ : finset α), ℐ I₁ → ∀ (I₂ : finset α), I₂ ⊆ I₁ → ℐ I₂) -- (I2)
(ind : can_exchange ℐ) -- (I3)

namespace matroid

variables (M : matroid α) [decidable_pred M.ℐ]

/- A subset of `E` that is not in `ℐ` is called dependent. -/
def dependent_sets : finset (finset α) := filter (λ s, ¬ M.ℐ s) univ.powerset

-- (C1)
lemma empty_not_dependent : ∅ ∉ M.dependent_sets :=
begin
  sorry,
end

variables [decidable_pred (λ (D : finset α), can_exchange (λ (_x : finset α), _x ∈ D.powerset.erase D))]

def circuit : finset (finset α) :=
  finset.filter (λ (D : finset α), (∀ (S ∈ (erase D.powerset D)), M.ℐ S)) (M.dependent_sets)

@[simp]
lemma mem_circuit (C₁ : finset α) :
  C₁ ∈ M.circuit ↔ C₁ ∈ M.dependent_sets ∧ (∀ (C₂ ∈ (erase C₁.powerset C₁)), M.ℐ C₂) :=
begin
  sorry,
end

/- `(C2)` if C₁ and C₂ are members of C and C₁ ⊆ C₂, then C₂ = C₂.
In other words, C forms an antichain. -/
lemma circuit_antichain (C₁ C₂ : finset α) (h₁ : C₁ ∈ M.circuit) (h₂ : C₂ ∈ M.circuit) : C₁ ⊆ C₂ → C₁ = C₂ :=
begin
  sorry,
end

/- `(C3)` If C₁ and C₂ are distinct members of M.circuit and e ∈ C₁ ∩ C₂, then
there is a member C₃ of M.circuit such that C₃ ⊆ (C₁ ∪ C₂) - e.   -/
lemma circuit_dependence (C₁ C₂ : finset α) (h₁ : C₁ ∈ M.circuit) (h₂ : C₂ ∈ M.circuit) (h : C₁ ≠ C₂) (e : α) :
  e ∈ C₁ ∩ C₂ → ∃ C₃ ∈ M.circuit, C₃ ⊆ (C₁ ∪ C₂) \ {e} :=
begin
  sorry,
end

-- for this i think we need a lemma along the lines of, if α is fintype and p : finset α → Prop
-- is a function where ∀ y ⊆ x, p x → p y, then there are "maximal" x : finset α
-- or maybe we can define this w.r.t rank function?
/- A maximal member of `ℐ` is called a basis. -/
-- def bases : finset (finset α) := filter (λ s, M.ℐ s) univ.powerset

-- this is broken because of some missing instance somewhere, lean doesn't seem to
-- get that if V is finite then a simple graph on V will have finite edge set so
-- uncomment at your own peril (jk if you're feeling up for the challenge you can
-- probably figure out how to fix it)
/- variables (V : Type u) (G : simple_graph V) [fintype V] [decidable_eq V] [fintype G.edge_set]

namespace simple_graph

instance : fintype G.edge_set :=
{ elems := _,
  complete := _ }

end simple_graph

def graphic_matroid (G : simple_graph V) : matroid G.edge_set := _-/

-- coercing x from fintype ↑s to fintype α is proving very annoying
/- @[ext]
def restriction {V : Type u} (M : matroid α) (s : finset α) : matroid s :=
{ ℐ := λ x, M.ℐ _,
  empty := _,
  hereditary := _,
  ind := _ }-/

end matroid


-- Las_clases_de_equivalencia_de_elementos_relacionados_son_iguales.lean
-- Las clases de equivalencia de elementos relacionados son iguales
-- José A. Alonso Jiménez
-- Sevilla, 22 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que las clases de equivalencia de elementos relacionados
-- son iguales.
-- ---------------------------------------------------------------------

import tactic

variable  {X : Type}
variables {x y: X}
variable  {R : X → X → Prop}

def clase (R : X → X → Prop) (x : X) :=
  {y : X | R x y}

-- En la demostración se usará el siguiente lema del que se presentan
-- varias demostraciones.

-- 1ª demostración del lema auxiliar
example
  (h : equivalence R)
  (hxy : R x y)
  : clase R y ⊆ clase R x :=
begin
  intros z hz,
  have hyz : R y z := hz,
  have htrans : transitive R := h.2.2,
  have hxz : R x z := htrans hxy hyz,
  exact hxz,
end

-- 2ª demostración del lema auxiliar
example
  (h : equivalence R)
  (hxy : R x y)
  : clase R y ⊆ clase R x :=
begin
  intros z hz,
  exact h.2.2 hxy hz,
end

-- 3ª demostración del lema auxiliar
lemma aux
  (h : equivalence R)
  (hxy : R x y)
  : clase R y ⊆ clase R x :=
λ z hz, h.2.2 hxy hz

-- A continuación se presentan varias demostraciones del ejercicio
-- usando el lema auxiliar

-- 1ª demostración
example
  (h : equivalence R)
  (hxy : R x y)
  : clase R x = clase R y :=
begin
  apply le_antisymm,
  { have hs : symmetric R := h.2.1,
    have hyx : R y x := hs hxy,
    exact aux h hyx, },
  { exact aux h hxy, },
end

-- 2ª demostración
example
  (h : equivalence R)
  (hxy : R x y)
  : clase R x = clase R y :=
begin
  apply le_antisymm,
  { exact aux h (h.2.1 hxy), },
  { exact aux h hxy, },
end

-- 3ª demostración
example
  (h : equivalence R)
  (hxy : R x y)
  : clase R x = clase R y :=
le_antisymm (aux h (h.2.1 hxy)) (aux h hxy)


import data.list.basic

section tactics

theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro,
  exact hp,
  apply and.intro,
  exact hq,
  exact hp
end

#print test

theorem test' (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
  ⟨hp, hq, hp⟩

theorem test'' (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro hp; exact and.intro hq hp
end

theorem test''' (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
  by exact and.intro hp (and.intro hq hp)

variables {p q : Prop} (hp : p) (hq : q)

include hp hq

example : p ∧ q ∧ p :=
begin
  apply and.intro hp,
  exact and.intro hq hp
end

omit hp hq

example : p ∧ q ∧ p :=
let hp := hp, hq := hq in
begin
  apply and.intro hp,
  exact and.intro hq hp
end

theorem distr (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    apply or.elim (and.right h),
      intro hq,
      apply or.inl,
      apply and.intro,
        exact and.left h,
      exact hq,
    intro hr,
    apply or.inr,
    apply and.intro,
      apply and.left h,
    exact hr,
  intro h,
  apply or.elim h,
    intro hpq,
    apply and.intro,
      exact and.left hpq,
    apply or.inl,
    exact and.right hpq,
  intro hpr,
  apply and.intro,
    exact and.left hpr,
  apply or.inr,
  exact and.right hpr
end

#print distr

example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros a b c h₁ h₂,
  exact eq.trans (eq.symm h₂) h₁
end

variables x y z w : ℕ

example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
begin
  apply eq.trans h₁,
  apply eq.trans h₂,
  -- exact h₃
  assumption
end

example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
begin
  apply eq.trans,
  assumption,
  apply eq.trans,
  assumption,
  assumption
end

example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros,
  apply eq.trans,
  apply eq.symm,
  assumption,
  assumption
end

example (y : ℕ) : (λ x : ℕ, 0) y = 0 :=
begin
  refl
end

example (x : ℕ) : x ≤ x :=
begin
  refl
end

example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros,
  transitivity,
  symmetry,
  assumption,
  assumption
end

example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros,
  transitivity,
  symmetry,
  repeat { assumption }
end

example : ∃ a : ℕ, 5 = a :=
begin
  apply exists.intro,
  reflexivity
end

example : ∃ a : ℕ, a = a :=
begin
  fapply exists.intro,
  exact 0,
  reflexivity
end

example (x : ℕ) : x = x :=
begin
  revert x,
  -- goal is ⊢ ∀ (x : ℕ), x = x
  intro y,
  -- goal is y : ℕ ⊢ y = y
  reflexivity
end

example (x y : ℕ) (h : x = y) : y = x :=
begin
  revert h,
  -- goal is x y : ℕ ⊢ x = y → y = x
  intro h₁,
  -- goal is x y : ℕ, h₁ : x = y ⊢ y = x
  symmetry,
  assumption
end

example (x y : ℕ) (h : x = y) : y = x :=
begin
  revert x,
  -- goal is y : ℕ ⊢ ∀ (x : ℕ), x = y → y = x
  intros,
  symmetry,
  assumption
end

example : 3 = 3 :=
begin
  generalize : 3 = x,
  -- goal is x : ℕ ⊢ x = x,
  revert x,
  -- goal is ⊢ ∀ (x : ℕ), x = x
  intro y, reflexivity
end

example : 2 + 3 = 5 :=
begin
  generalize h : 3 = x,
  -- goal is x : ℕ, h : 3 = x ⊢ 2 + x = 5,
  rw ←h
end

example (p q : Prop) : p ∨ q → q ∨ p :=
begin
  intro h,
  cases h with hp hq,
  -- case hp : p
    right,
    exact hp,
  -- case hq : q
  left,
  exact hq
end

example (p q : Prop) : p ∧ q → q ∧ p :=
begin
  intro h,
  cases h with hp hq,
  constructor,
    exact hq,
  exact hp
end

theorem distr' (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  constructor,
    intro h,
    cases h with hp hqr,
    cases hqr with hq hr,
      left,
      constructor,
        assumption,
      assumption,
    right,
    constructor,
      assumption,
    assumption,
  intro h,
  cases h with hpq hpr,
    cases hpq with hp hq,
    constructor,
      assumption,
    left,
    assumption,
  cases hpr with hp hr,
  constructor,
    assumption,
  right,
  assumption
end

#print distr'

/- distr -/
theorem distr'' : ∀ (p q r : Prop), p ∧ (q ∨ r) ↔ p ∧ q ∨ p ∧ r :=
λ (p q r : Prop),
  {mp := λ (h : p ∧ (q ∨ r)),
           or.elim h.right (λ (hq : q), or.inl ⟨h.left, hq⟩) (λ (hr : r), or.inr ⟨h.left, hr⟩),
   mpr := λ (h : p ∧ q ∨ p ∧ r),
            or.elim h (λ (hpq : p ∧ q), ⟨hpq.left, or.inl hpq.right⟩)
              (λ (hpr : p ∧ r), ⟨hpr.left, or.inr hpr.right⟩)}

/- distr' -/
theorem distr''' : ∀ (p q r : Prop), p ∧ (q ∨ r) ↔ p ∧ q ∨ p ∧ r :=
λ (p q r : Prop),
  {mp := λ (h : p ∧ (q ∨ r)),
           and.dcases_on h
             (λ (hp : p) (hqr : q ∨ r),
                or.dcases_on hqr (λ (hq : q), or.inl ⟨hp, hq⟩) (λ (hr : r), or.inr ⟨hp, hr⟩)),
   mpr := λ (h : p ∧ q ∨ p ∧ r),
            or.dcases_on h (λ (hpq : p ∧ q), and.dcases_on hpq (λ (hp : p) (hq : q), ⟨hp, or.inl hq⟩))
              (λ (hpr : p ∧ r), and.dcases_on hpr (λ (hp : p) (hr : r), ⟨hp, or.inr hr⟩))}

example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
begin
  intro h,
  cases h with x px,
  constructor,
  left,
    assumption
end

example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
begin
  intro h,
  cases h with x px,
  existsi x,
  left,
  assumption
end

universes u v

def swap_pair {α : Type u} {β : Type v} : α × β → β × α :=
begin
  intro p,
  cases p with pa pb,
  constructor,
  repeat {assumption}
end

def swap_sum {α : Type u} {β : Type v} : α ⊕ β → β ⊕ α :=
begin
  intro p,
  cases p with pa pb,
    right,
    assumption,
  left,
  assumption
end

open nat

example (P : ℕ → Prop) (h₀ : P 0) (h₁ : ∀ n, P (succ n)) (m : ℕ) : P m :=
begin
  cases m with m',
    assumption,
  exact h₁ m'
end

example (p q : Prop) : p ∧ ¬p → q :=
begin
  intro h,
  cases h,
  contradiction
end

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
begin
  intro h,
  exact
    have hp : p, from h.left,
    have hqr : q ∨ r, from h.right,
    show (p ∧ q) ∨ (p ∧ r),
    begin
      cases hqr with hq hr,
        exact or.inl ⟨hp, hq⟩,
      exact or.inr ⟨hp, hr⟩
    end
end

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  constructor,
    intro h,
    cases h.right with hq hr,
      exact or.inl ⟨h.left, hq⟩,
    exact or.inr ⟨h.left, hr⟩,
  intro h,
  cases h with hpq hpr,
    exact ⟨hpq.left, or.inl hpq.right⟩,
  exact ⟨hpr.left, or.inr hpr.right⟩
end

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    show (p ∧ q) ∨ (p ∧ r),
    cases h.right with hq hr,
      from or.inl ⟨h.left, hq⟩,
      from or.inr ⟨h.left, hr⟩,
  intro h,
  show (p ∧ (q ∨ r)),
  { cases h with hpq hpr,
    from ⟨hpq.left, or.inl hpq.right⟩,
    from ⟨hpr.left, or.inr hpr.right⟩ }
end

example (n : ℕ) : n + 1 = nat.succ n :=
begin
  show nat.succ n = nat.succ n,
  reflexivity
end

example (n : ℕ) : n + 1 = nat.succ n :=
begin
  reflexivity
end

example (p q : Prop) : p ∧ q → q ∧ p :=
begin
  intro h,
  cases h with hp hq,
  split,
  show p, from hp,
  show q, from hq
end

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
begin
  intro h,
  cases h with hp hqr,
  show (p ∧ q) ∨ (p ∧ r),
  cases hqr with hq hr,
    have hpq : p ∧ q,
      from ⟨hp, hq⟩,
    left,
    assumption,
  have : p ∧ r,
    split; assumption,
  right, exact this
end

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
begin
  intro h,
  have hp := h.left,
  have hqr := h.right,
  show (p ∧ q) ∨ (p ∧ r),
  cases hqr with hq hr,
    exact or.inl ⟨hp, hq⟩,
  exact or.inr ⟨hp, hr⟩
end

example : ∃ x, x + 2 = 8 :=
begin
  let a : ℕ := 3 * 2,
  existsi a,
  reflexivity
end

example : ∃ x, x + 2 = 8 := by
{ let a : ℕ := 3 * 2,
  existsi a,
  reflexivity }

meta def my_tac : tactic unit :=
`[ repeat { {left, assumption} <|> right <|> assumption } ]

example (p q r : Prop) (hp : p) : p ∨ q ∨ r := by my_tac
example (p q r : Prop) (hq : q) : p ∨ q ∨ r := by my_tac
example (p q r : Prop) (hr : r) : p ∨ q ∨ r := by my_tac

example (p q r : Prop) (hp : p) (hq : q) (hr : r) :
  p ∧ q ∧ r :=
by split; try {split}; assumption

example (p q r : Prop) (hp : p) (hq : q) (hr : r) :
  p ∧ q ∧ r :=
begin
  split,
  all_goals { try {split} },
  all_goals { assumption }
end

example (p q r : Prop) (hp : p) (hq : q) (hr : r) :
  p ∧ ((p ∧ q) ∧ r) ∧ (q ∧ r ∧ p) :=
by repeat { any_goals { split <|> assumption} }

variables (f : ℕ → ℕ) (a k : ℕ)

example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
begin
  rw h₂, -- replace k with 0
  rw h₁  -- replace f 0 with 0
end

example (x y : ℕ) (p : ℕ → Prop) (q : Prop) (h : q → x = y)
  (h' : p y) (hq : q) : p x :=
by {
  rw h hq,
  assumption
}

example (a b c : ℕ) : a + b + c = a + c + b :=
begin
  rw [add_assoc, add_comm b, ←add_assoc]
end

example (a b c : ℕ) : a + b + c = a + c + b :=
begin
  rw [add_assoc, add_assoc, add_comm b]
end

example (a b c : ℕ) : a + b + c = a + c + b :=
begin
  rw [add_assoc, add_assoc, add_comm _ b]
end

example (h : a + 0 = 0) : f a = f 0 :=
by {
  rw add_zero at h,
  rw h
}

def tuple (α : Type u) (n : ℕ) :=
  { l : list α // list.length l = n }

variables {α : Type u} {n : ℕ}

example (h : n = 0) (t : tuple α n) : tuple α 0 :=
begin
  rw h at t,
  exact t
end

example {α : Type u} [ring α] (a b c : α) :
  a * 0 + 0 * b + c * 0 + 0 * a = 0 :=
begin
  rw [
    mul_zero,
    mul_zero,
    zero_mul,
    zero_mul
  ],
  repeat {
    rw add_zero
  }
end

example {α : Type u} [ring α] (a b c : α) :
  a * 0 + 0 * b + c * 0 + 0 * a = 0 :=
by { repeat { rw mul_zero <|> rw zero_mul <|> rw add_zero } }

example {α : Type u} [ring α] (a b c : α) :
  a * 0 + 0 * b + c * 0 + 0 * a = 0 :=
by { simp }

example {α : Type u} [group α] {a b : α} (h : a * b = 1) :
  a⁻¹ = b :=
by rw [
  ←(mul_one a⁻¹),
  ←h,
  inv_mul_cancel_left
]

open list

example (xs : list ℕ) :
  reverse (xs ++ [1, 2, 3]) = [3, 2, 1] ++ reverse xs :=
by simp

end tactics

section local_attr

open list

variables (α : Type) (p : ℕ → Prop) (w x y z : ℕ)

local attribute [simp] add_comm mul_assoc mul_comm mul_left_comm

example (xs ys : list α) :
  length (reverse (xs ++ ys)) = length xs + length ys :=
by simp

example (h : p ((x + 0) * (0 + y * 1 + z * 0))) :
  p (x * y) :=
by {
  simp at h,
  assumption
}

example (h : p (x * y + z * w * x)) : p (x * w * z + y * x) :=
by { simp at *, assumption }

def f (m n : ℕ) : ℕ := m + n + m

example {m n : ℕ} (h : n = 1) (h' : 0 = m) : (f m n) = n :=
by simp [h, h'.symm, f]

example (u w x y z : ℕ) (h₁ : x = y + z) (h₂ : w = u + x) :
  w = z + y + u :=
by simp *

end local_attr

section simp

open list
universe u
variables {α : Type} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by { unfold mk_symm, simp }

#print reverse_mk_symm

@[simp] theorem reverse_mk_symm' (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by simp [mk_symm]

#print reverse_mk_symm'

example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
by simp

example (xs ys : list ℕ) (p : list ℕ → Prop)
    (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by simp at h; assumption

end simp

example (p q r : Prop) (hp : p) :
(p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
by {
  split,
  left,
  assumption,

  split,
  right,
  left,
  assumption,

  right,
  right,
  assumption
}

theorem foo (p q r s : Prop) (hp : p) :
(p ∨ q ∨ r ∨ s) ∧ (q ∨ p ∨ r ∨ s) ∧ (q ∨ r ∨ p ∨ s) ∧ (q ∨ r ∨ s ∨ p) :=
by { repeat { split <|> { try { left }, from hp } <|> right } }

#print foo

/- shorter for three. gets smoked at four -/
example (p q r : Prop) (hp : p) :
(p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
⟨or.inl hp, or.inr (or.inl hp), or.inr (or.inr hp)⟩


import algebra.category.FinVect
import data.complex.basic
import data.matrix.basic
import ring_theory.matrix_algebra
open tensor_product
open_locale tensor_product

variables (K: Type) [field K]

structure rmatrix (C: Type) [category C] (x: C) := -- x 上の R 行列
  (hom: x ⊗ x → x ⊗ x)
  () -- ここに関係式

/- C -> FinVect, x -> (fin 2 -> K) -/

abbreviation mat (r c: nat) (K) := matrix (fin r) (fin c) K

def matrix_tensor {r₁ c₁ r₂ c₂} (M₁: mat r₁ c₁ K) (M₂: mat r₂ c₂ K)
  := tensor_product.map (matrix.to_lin' M₁) (matrix.to_lin' M₂)
#check matrix_tensor K

noncomputable def equiv_2_2_to_4 {m n}: ((fin m → K) ⊗[K] (fin n → K)) ≃ₗ[K] (fin (m * n) → K) := begin
  refine fin_dim_vectorspace_equiv _ _, tidy,
end

def mat1 := (1: matrix (fin 2) (fin 2) K)
def matrix_example := matrix_tensor K (mat1 K) (mat1 K)
#check (matrix_tensor ℚ (mat1 ℚ) (mat1 ℚ)) -- ((fin 2 → K) ⊗ (fin 2 → K))


-- Kyle Miller
import Init.Data.Nat.Basic
import Init.Core
import Tensor.Has

macro "exfalso" : tactic => `(apply False.elim)

def Function.leftInverse (g : β → α) (f : α → β) : Prop :=
    ∀ x, g (f x) = x
def Function.rightInverse (g : β → α) (f : α → β) : Prop :=
    Function.leftInverse f g

structure Equiv (α : Sort u) (β : Sort v) where
    toFun : α → β
    invFun : β → α
    leftInv : Function.leftInverse invFun toFun
    rightInv : Function.rightInverse invFun toFun

infix:25 " ≃ " => Equiv

def Equiv.symm (f : α ≃ β) : β ≃ α where
    toFun := f.invFun
    invFun := f.toFun
    leftInv := f.rightInv
    rightInv := f.leftInv

/-- An equivalence "is" a function. -/
instance (α : Type u) (β : Type v) : CoeFun (Equiv α β) (λ _ => α → β) where
    coe := Equiv.toFun

class Enumerable (α : Type u) where
    card : Nat
    enum : α ≃ Fin card

theorem cartEncodeProp {i j m n : Nat} (hi : i < m) (hj : j < n) : i * n + j < m * n := by
    cases m with
    | zero => exfalso; exact Nat.notLtZero _ hi
    | succ m => {
        rw [Nat.succ_mul];
        exact Nat.ltOfLeOfLt (Nat.addLeAddRight (Nat.mulLeMulRight _ (Nat.leOfLtSucc hi)) _) (Nat.addLtAddLeft hj _)
    }

def cartDecode {n m : Nat} (k : Fin (n * m)) : Fin n × Fin m :=
    let ⟨k, h⟩ := k
    (
        ⟨k / m, sorry⟩,
        ⟨k % m, Nat.modLt _ (by { cases m; exfalso; rw Nat.mul_zero at h; exact Nat.notLtZero _ h; apply Nat.succPos})⟩
    )

instance [Enumerable α] [Enumerable β] : Enumerable (α × β) where
    card := Enumerable.card α * Enumerable.card β
    enum := {
        toFun := λ (a, b) =>
            let ⟨i, hi⟩ := Enumerable.enum a
            let ⟨j, hj⟩ := Enumerable.enum b
            ⟨i * Enumerable.card β + j, cartEncodeProp hi hj⟩
        invFun := λ n =>
            let (i, j) := cartDecode n
            (Enumerable.enum.symm i, Enumerable.enum.symm j)
        leftInv := sorry
        rightInv := sorry
    }

instance : Enumerable (Fin n) where
    card := n
    enum := {
        toFun := id
        invFun := id
        leftInv := λ _ => rfl
        rightInv := λ _ => rfl
    }

instance : Enumerable Bool where
    card := 2
    enum := {
        toFun := fun
        | false => 0
        | true => 1
        invFun := fun
        | ⟨0, _⟩ => false
        | ⟨1, _⟩ => true
        | ⟨n+2, h⟩ => False.elim (Nat.notSuccLeZero _ (Nat.leOfSuccLeSucc (Nat.leOfSuccLeSucc h)))
        leftInv := fun
            | true => rfl
            | false => rfl
        rightInv := fun
            | ⟨0, _⟩ => rfl
            | ⟨1, _⟩ => rfl
            | ⟨n+2, h⟩ => False.elim (Nat.notSuccLeZero _ (Nat.leOfSuccLeSucc (Nat.leOfSuccLeSucc h)))
    }

instance : Enumerable Empty where
    card := 0
    enum := {
        toFun := fun t => nomatch t
        invFun := fun
        | ⟨n, h⟩ => False.elim (Nat.notSuccLeZero _ h)
        leftInv := fun t => nomatch t
        rightInv := fun t => nomatch t
    }

def Enumerable.listOf.aux (α : Type u) [Enumerable α] : Nat -> Nat -> List α
| lo, 0 => []
| lo, (left+1) =>
    if h : lo < Enumerable.card α then
        Enumerable.enum.symm ⟨lo, h⟩ :: aux α (lo + 1) left
    else [] -- Shouldn't happen, but makes the definition easy.

/-- Create a list of every term in the Enumerable type in order. -/
def Enumerable.listOf (α : Type u) [Enumerable α] : List α :=
    Enumerable.listOf.aux α 0 (Enumerable.card α)

/-- A function-backed vector -/
structure Vec (ι : Type u) (α : Type v) where
    toFun : ι → α

macro "vec" xs:Lean.explicitBinders " => " b:term : term => Lean.expandExplicitBinders `Vec.mk xs b

/-- support `v[i]` notation. -/
@[inline] def Vec.getOp (self : Vec ι α) (idx : ι) : α := self.toFun idx

/-- A vector as a function mapping indices to values. -/
class HasVec (β : Type u) (ι : outParam $ Type v) (α : outParam $ Type w) where
    toVec : β → Vec ι α
export HasVec (toVec)

instance : HasVec (Vec ι α) ι α := ⟨ id ⟩

instance [Add α] : Add (Vec ι α) where
    add v w := vec i => v[i] + w[i]
instance [Sub α] : Sub (Vec ι α) where
    sub v w := vec i => v[i] - w[i]
instance [Mul α] : Mul (Vec ι α) where
    mul v w := vec i => v[i] * w[i]
instance [Div α] : Div (Vec ι α) where
    div v w := vec i => v[i] / w[i]

namespace Vec

def push (v : Vec ι (Vec κ α)) : Vec (ι × κ) α := vec p => v[p.1][p.2]
def pop (v : Vec (ι × κ) α) : Vec ι (Vec κ α) := vec i j => v[(i, j)]
def reindex (v : Vec ι α) (f : κ → ι) : Vec κ α := vec i => v[f i]

instance [OfNat α n] : OfNat (Vec ι α) n where
    ofNat := vec i => OfNat.ofNat n

def transpose (v : Vec ι (Vec κ α)) : Vec κ (Vec ι α) := vec j i => v[i][j]

end Vec

def Vec.sum [Enumerable ι] [Add α] [OfNat α Nat.zero] (v : Vec ι α) : α := do
    let mut s : α := 0
    for i in Enumerable.listOf ι do
        s := s + v[i]
    return s

structure DenseVec (ι : Type u) [Enumerable ι] (α : Type v) where
    array : Array α
    hasSize : array.size = Enumerable.card ι

namespace DenseVec
variable {ι : Type u} [Enumerable ι] {α : Type v}

instance [Repr α] : Repr (DenseVec ι α) where
    reprPrec d _ := repr d.array

theorem sizeMapEq (a : Array α) (f : α → β) : (a.map f).size = a.size := sorry

instance [HMul α α₁ α₁] : HMul α (DenseVec ι α₁) (DenseVec ι α₁) where
    hMul r u := ⟨ u.array.map (λ x => r * x) , (sizeMapEq _ _).symm ▸ u.hasSize⟩

def fill (a : α) : DenseVec ι α where
    array := Array.mkArray (Enumerable.card ι) a
    hasSize := Array.size_mkArray ..

def empty [Inhabited α] : DenseVec ι α :=
    fill Inhabited.default

def translateIdx (v : DenseVec ι α) (i : ι) : Fin v.array.size :=
    let ⟨n, h⟩ := Enumerable.enum i
    ⟨n, by rw v.hasSize; exact h⟩

/-- Get the value associated to a particular index. -/
def get (v : DenseVec ι α) (i : ι) : α :=
    v.array.get (v.translateIdx i)

/-- support `v[i]` notation. -/
@[inline] def getOp (self : DenseVec ι α) (idx : ι) : α := self.get idx

instance : HasVec (DenseVec ι α) ι α where
    toVec v := vec i => v[i]

def of [HasVec β ι α] (v : β) : DenseVec ι α where
    array := do
        let v' := toVec v
        let mut a := Array.empty
        for i in Enumerable.listOf ι do
            a := a.push $ v'[i]
        return a
    hasSize := sorry -- need to define differently to be able to easily prove this

/-- Set the value associated to a particular index. -/
def set (v : DenseVec ι α) (i : ι) (a : α) : DenseVec ι α where
    array := v.array.set (v.translateIdx i) a
    hasSize := by rw [Array.size_set, v.hasSize]

def forIn {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (as : DenseVec ι α) (b : β) (f : α → β → m (ForInStep β)) : m β :=
    as.array.forIn b f

instance [HasZero α] [Enumerable ι] : HasZero (DenseVec ι α) where
    zero := ⟨ Array.mkArray (Enumerable.card ι) HasZero.zero, Array.size_mkArray .. ⟩
instance [HasZero α] [Enumerable ι] : OfNat (DenseVec ι α) 0 where
    ofNat := HasZero.zero

def pure (x : α) : DenseVec ι α := fill x

def dot_ (v w : DenseVec ι Float) : Float := do
    let mut s : Float := 0
    for i in Enumerable.listOf ι do
        s := s + v[i] * w[i]
    return s
def add_ [Add α] (v w : DenseVec ι α) : DenseVec ι α := do
    let mut v := v
    for i in Enumerable.listOf ι do
        v := v.set i (v.get i + w.get i)
    return v

-- dsk: alternate add
def add [Add α] [Inhabited α] ( u v : DenseVec ι α) : DenseVec ι α := do
    let mut values := u.array
    for i in [0:values.size] do
        values := values.set! i (values[i] + v.array[i])
    return ⟨ values , sorry ⟩

instance [Add α] [Inhabited α]: Add (DenseVec ι α) where
    add := add

end DenseVec

theorem List.toArraySizeEq (x : List α) : x.toArray.size = x.length := sorry

def List.toDenseVec (x : List α) : DenseVec (Fin x.length) α where
    array := x.toArray
    hasSize := List.toArraySizeEq ..

syntax "![" sepBy(term, ", ") "]" : term

macro_rules
  | `(![ $elems,* ]) => `(List.toDenseVec [ $elems,* ])

example : DenseVec (Fin 3) Nat := ![2,22,222]


import filter_world.level1 --hide

open set --hide
namespace filters --hide
localized "notation `P` := principal" in filters --hide

lemma mem_principal {X : Type} {s t : set X} : s ∈ P t ↔ t ⊆ s := iff.rfl -- hide

/- Axiom :
mem_principal : s ∈ P t ↔ t ⊆ s
-/

/-
# Level 2: Characterization of the princial filter of the total set
-/

/- Lemma
The only element of the principal filter of the universal set is the universal set.
-/
lemma univ_filter_univ {X : Type}: ∀ (A : set X), A ∈ P (univ : set X) ↔ A = univ :=
begin
  intros A,
  split; intro hA,
  {
    rw mem_principal at hA,
    ext,
    split,
    { intro hx,
      exact mem_univ x },
    { intro hx,
      exact hA hx }
  },
  {
    rw mem_principal,
    rw hA
  }

end

end filters --hide