/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/

import linear_algebra.matrix.determinant

/-!
# Changing the index type of a matrix

This file concerns the map `matrix.reindex`, mapping a `m` by `n` matrix
to an `m'` by `n'` matrix, as long as `m ≃ m'` and `n ≃ n'`.

## Main definitions

* `matrix.reindex_linear_equiv R A`: `matrix.reindex` is an `R`-linear equivalence between
  `A`-matrices.
* `matrix.reindex_alg_equiv R`: `matrix.reindex` is an `R`-algebra equivalence between `R`-matrices.

## Tags

matrix, reindex

-/

namespace matrix

open equiv

open_locale matrix

variables {l m n o : Type*} {l' m' n' o' : Type*} {m'' n'' : Type*}
variables (R A : Type*)

section add_comm_monoid
variables [semiring R] [add_comm_monoid A] [module R A]

/-- The natural map that reindexes a matrix's rows and columns with equivalent types,
`matrix.reindex`, is a linear equivalence. -/
def reindex_linear_equiv (eₘ : m ≃ m') (eₙ : n ≃ n') : matrix m n A ≃ₗ[R] matrix m' n' A :=
{ map_add'  := λ _ _, rfl,
  map_smul' := λ _ _, rfl,
  ..(reindex eₘ eₙ)}

@[simp] lemma reindex_linear_equiv_apply
  (eₘ : m ≃ m') (eₙ : n ≃ n') (M : matrix m n A) :
  reindex_linear_equiv R A eₘ eₙ M = reindex eₘ eₙ M :=
rfl

@[simp] lemma reindex_linear_equiv_symm (eₘ : m ≃ m') (eₙ : n ≃ n') :
  (reindex_linear_equiv R A eₘ eₙ).symm = reindex_linear_equiv R A eₘ.symm eₙ.symm :=
rfl

@[simp] lemma reindex_linear_equiv_refl_refl :
  reindex_linear_equiv R A (equiv.refl m) (equiv.refl n) = linear_equiv.refl R _ :=
linear_equiv.ext $ λ _, rfl

lemma reindex_linear_equiv_trans (e₁ : m ≃ m') (e₂ : n ≃ n') (e₁' : m' ≃ m'')
  (e₂' : n' ≃ n'') : (reindex_linear_equiv R A e₁ e₂).trans (reindex_linear_equiv R A e₁' e₂') =
   (reindex_linear_equiv R A (e₁.trans e₁') (e₂.trans e₂') : _ ≃ₗ[R] _) :=
by { ext, refl }

lemma reindex_linear_equiv_comp (e₁ : m ≃ m') (e₂ : n ≃ n') (e₁' : m' ≃ m'')
  (e₂' : n' ≃ n'') :
  (reindex_linear_equiv R A e₁' e₂') ∘ (reindex_linear_equiv R A e₁ e₂)
  = reindex_linear_equiv R A (e₁.trans e₁') (e₂.trans e₂') :=
by { rw [← reindex_linear_equiv_trans], refl }

lemma reindex_linear_equiv_comp_apply (e₁ : m ≃ m') (e₂ : n ≃ n') (e₁' : m' ≃ m'')
  (e₂' : n' ≃ n'') (M : matrix m n A) :
  (reindex_linear_equiv R A e₁' e₂') (reindex_linear_equiv R A e₁ e₂ M) =
    reindex_linear_equiv R A (e₁.trans e₁') (e₂.trans e₂') M :=
submatrix_submatrix _ _ _ _ _

lemma reindex_linear_equiv_one [decidable_eq m] [decidable_eq m'] [has_one A]
  (e : m ≃ m') : (reindex_linear_equiv R A e e (1 : matrix m m A)) = 1 :=
submatrix_one_equiv e.symm

end add_comm_monoid

section semiring
variables [semiring R] [semiring A] [module R A]

lemma reindex_linear_equiv_mul [fintype n] [fintype n']
  (eₘ : m ≃ m') (eₙ : n ≃ n') (eₒ : o ≃ o') (M : matrix m n A) (N : matrix n o A) :
  reindex_linear_equiv R A eₘ eₙ M ⬝ reindex_linear_equiv R A eₙ eₒ N =
    reindex_linear_equiv R A eₘ eₒ (M ⬝ N) :=
submatrix_mul_equiv M N _ _ _

lemma mul_reindex_linear_equiv_one [fintype n] [decidable_eq o] (e₁ : o ≃ n)
  (e₂ : o ≃ n') (M : matrix m n A) : M.mul (reindex_linear_equiv R A e₁ e₂ 1) =
    reindex_linear_equiv R A (equiv.refl m) (e₁.symm.trans e₂) M :=
by { haveI := fintype.of_equiv _ e₁.symm, exact mul_submatrix_one _ _ _ }

end semiring

section algebra

variables [comm_semiring R] [fintype n] [fintype m] [decidable_eq m] [decidable_eq n]

/--
For square matrices with coefficients in commutative semirings, the natural map that reindexes
a matrix's rows and columns with equivalent types, `matrix.reindex`, is an equivalence of algebras.
-/
def reindex_alg_equiv (e : m ≃ n) : matrix m m R ≃ₐ[R] matrix n n R :=
{ to_fun    := reindex e e,
  map_mul'  := λ a b, (reindex_linear_equiv_mul R R e e e a b).symm,
  commutes' := λ r, by simp [algebra_map, algebra.to_ring_hom, submatrix_smul],
  ..(reindex_linear_equiv R R e e) }

@[simp] lemma reindex_alg_equiv_apply (e : m ≃ n) (M : matrix m m R) :
  reindex_alg_equiv R e M = reindex e e M :=
rfl

@[simp] lemma reindex_alg_equiv_symm (e : m ≃ n) :
  (reindex_alg_equiv R e).symm = reindex_alg_equiv R e.symm :=
rfl

@[simp] lemma reindex_alg_equiv_refl : reindex_alg_equiv R (equiv.refl m) = alg_equiv.refl :=
alg_equiv.ext $ λ _, rfl

lemma reindex_alg_equiv_mul (e : m ≃ n) (M : matrix m m R) (N : matrix m m R) :
  reindex_alg_equiv R e (M ⬝ N) = reindex_alg_equiv R e M ⬝ reindex_alg_equiv R e N :=
(reindex_alg_equiv R e).map_mul M N

end algebra

/-- Reindexing both indices along the same equivalence preserves the determinant.

For the `simp` version of this lemma, see `det_submatrix_equiv_self`.
-/
lemma det_reindex_linear_equiv_self [comm_ring R] [fintype m] [decidable_eq m]
  [fintype n] [decidable_eq n] (e : m ≃ n) (M : matrix m m R) :
  det (reindex_linear_equiv R R e e M) = det M :=
det_reindex_self e M

/-- Reindexing both indices along the same equivalence preserves the determinant.

For the `simp` version of this lemma, see `det_submatrix_equiv_self`.
-/
lemma det_reindex_alg_equiv [comm_ring R] [fintype m] [decidable_eq m] [fintype n] [decidable_eq n]
  (e : m ≃ n) (A : matrix m m R) :
  det (reindex_alg_equiv R e A) = det A :=
det_reindex_self e A

end matrix


import data.real.basic

noncomputable theory -- hey, this isn't going to be actually numerically sound,
                     -- don't calculate anything

notation `|`x`|` := abs x

def is_limit (f : ℝ → ℝ) (c L : ℝ):= ∀ ε > 0, ∃ δ > (0 : ℝ), ∀ (x : ℝ), |x - c| < δ → |f x - L| < ε

/-
 `def` - defining mathematical things <- named
 `lemma` - stating less important statements (lemmas) <- named
 `theorem` - stating more important statements (theorems) <- named
 `example` - testing things and showing how things work
-/

-- (S : set ℝ).nonempty
variables (S : set ℝ)
#check S.nonempty

lemma test (S : set ℝ) (hS : S.nonempty) (a : ℝ) : a ∈ S := sorry

def id' (x : ℝ) := x

example : is_limit id' 0 0 :=
begin
  unfold is_limit id',
  intros ε ε_pos,
  use ε,
  split,
  { exact ε_pos},
  { intros x hx,
    exact hx}
end

def one_over (x : ℝ) := 1/x

-- false
example : is_limit one_over 0 0 :=
begin
  unfold is_limit one_over,
  intros ε ε_pos,
  use (1/ε),
  split,
  { simp only [one_div, gt_iff_lt, inv_pos], linarith,},
  { intros x hx, simp at hx,
    simp,
    sorry
  }
end


import data.real.basic

/-
# Chapter 1 : Sets

## Level 10

As a final test of your ability in working with sets, prove that the set of rational
numbers is dense in the reals.

This proof will, among other things, rely on several new axioms that appear
in the left side bar.
Note that you may need to change the type of some quantities from rationals to reals.
Lean doesn't necessarily consider the rational $2$ to be the same at the real number $2$.
Some of the axioms on the left make working with the casts from rationals to reals easier.
-/

/- Axiom : inv_prod_self :
∀ n : ℕ, 0 < n → (1/n : ℝ) * (n : ℝ ) = 1
-/

/- Axiom : inv_prod_other :
∀ (m : ℤ), ∀ (n : ℕ), 0 < n → (1/n : ℝ) * (m : ℝ) = (m/n : ℝ)
-/

/- Axiom : archimedean_R : ∀ x : ℝ, 0 < x → ∃ n : ℕ, 0 < n ∧ (1/n : ℝ) < x
-/

/- Axiom : has_ceiling : ∀ x : ℝ,  ∃ m : ℤ, ((m-1) : ℝ) ≤ x ∧ x < (m:ℝ)
-/

-- one way to prove ℚ dense in ℝ
def dense_in_R (A : set ℝ) := ∀ (x y : ℝ), x < y → ∃ a ∈ A, a ∈ set.Ioo x y
def embedded_rationals : set ℝ := { x | ∃ r : ℚ, x = ↑r }
-- begin hide
axiom archimedean_R : ∀ x : ℝ, 0 < x → ∃ n : ℕ, 0 < n ∧ (1/n : ℝ) < x
-- we might want to prove these below. Made into axioms just for ease.
-- the problem is that the proofs are too hard for this level, IMO (DS)
axiom has_ceiling : ∀ x : ℝ,  ∃ m : ℤ, ((m-1) : ℝ) ≤ x ∧ x < (m:ℝ)
axiom inv_prod_self : ∀ n : ℕ, 0 < n → (1/n : ℝ) * (n : ℝ ) = 1
axiom inv_prod_other : ∀ (m : ℤ), ∀ (n : ℕ), 0 < n → (1/n : ℝ) * (m : ℝ) = (m/n : ℝ)
-- end hide

/- Lemma
Rationals are dense in the reals.
-/
theorem rat_dense_in_R : dense_in_R embedded_rationals :=
begin
    intros x y hxy,
    have H := lt_trichotomy x 0,
    cases H with xL xr, swap, cases xr with x0 xR,
    -- case x = 0
    rw x0 at hxy,
    have G := archimedean_R y hxy,
    cases G with n hn, cases hn with hnL hnR,
    use (1/n), split, existsi (1/n : ℚ), norm_num,
    split, swap, exact hnR, rw x0, norm_num, exact hnL,
    -- case 0 < x
    have H : 0 < y - x, linarith,
    have G := archimedean_R (y-x) H,
    cases G with n hn, cases hn with hnL hnR,
    have F := has_ceiling (n*x),
    cases F with m hm, cases hm with hmL hmR,
    use (m/n), split, existsi (m/n : ℚ), norm_num,
    have hnL1 : 0 < (n : ℝ), norm_cast, exact hnL,
    have hnL2 : 0 < (1/n : ℝ), exact one_div_pos_of_pos hnL1,
    split, exact (lt_div_iff' hnL1).mpr hmR,
    have h1 : (m : ℝ) ≤ n*x + 1, linarith,
    have h2 : (m/n : ℝ) ≤ x + (1/n : ℝ),
        have h21 := (mul_le_mul_left hnL2).mpr h1,
        rw mul_add (1/n : ℝ) _ _ at h21, rw mul_one at h21,
        rw ← mul_assoc at h21,
        have h22 := inv_prod_self n hnL,    --cheating here
        rw h22 at h21, rw one_mul at h21,
        have h23 := inv_prod_other m n hnL, --and here
        rw h23 at h21, exact h21,
    have h3 : x + (1/n : ℝ) < x + (y-x), linarith,
    have h4 : x + (y-x) = y, norm_num, rw h4 at h3,
    linarith,
    -- case x < 0  -- reduces to the above
     have H : 0 < y - x, linarith,
    have G := archimedean_R (y-x) H,
    cases G with n hn, cases hn with hnL hnR,
    have F := has_ceiling (n*x),
    cases F with m hm, cases hm with hmL hmR,
    use (m/n), split, existsi (m/n : ℚ), norm_num,
    have hnL1 : 0 < (n : ℝ), norm_cast, exact hnL,
    have hnL2 : 0 < (1/n : ℝ), exact one_div_pos_of_pos hnL1,
    split, exact (lt_div_iff' hnL1).mpr hmR,
    have h1 : (m : ℝ) ≤ n*x + 1, linarith,
    have h1 : (m : ℝ) ≤ n*x + 1, linarith,
    have h2 : (m/n : ℝ) ≤ x + (1/n : ℝ),
        have h21 := (mul_le_mul_left hnL2).mpr h1,
        rw mul_add (1/n : ℝ) _ _ at h21, rw mul_one at h21,
        rw ← mul_assoc at h21,
        have h22 := inv_prod_self n hnL,    --cheating here
        rw h22 at h21, rw one_mul at h21,
        have h23 := inv_prod_other m n hnL, --and here
        rw h23 at h21, exact h21,
    have h3 : x + (1/n : ℝ) < x + (y-x), linarith,
    have h4 : x + (y-x) = y, norm_num, rw h4 at h3,
    linarith, done
end


/- Copyright (c) Alexander Kreuzer 2016, 2017

LEAN Proof of Feteke's lemma
-/

import theories.analysis.real_limit
import standard
import ak_utils
import ak_compat
open real nat set rat pnat num classical int analysis
open eq.ops

open ak

set_option pp.coercions true

definition subadditive (X : ℕ → ℝ) : Prop :=
   ∀ {n1: ℕ}, ∀ {n2: ℕ}, X (n1 + n2) ≤ X n1 + X n2

noncomputable definition seq_quot (X : ℕ → ℝ) : ℕ → ℝ
 | 0 := X 1
 | n := (X n) / real.of_nat n

lemma seq_quod_nn (X : ℕ→ℝ) (n : ℕ) (Hn : n > 0) :
  seq_quot X n = (X n) / real.of_nat n :=
begin
  cases n,
  have ¬ 0 > (0:ℕ), from not_lt_zero 0,
  apply absurd Hn this,
  unfold seq_quot
end

lemma seq_quod_eq_zero_one (X : ℕ → ℝ) :
  seq_quot X 0 = seq_quot X 1 :=
begin
  unfold seq_quot,
  have of_nat (succ zero) = (1:ℝ), from rfl,
  rewrite [this],
  xrewrite [div_one (X (succ zero))]
end

definition seq_mulindex (X : ℕ → ℝ) (c: ℕ) : ℕ → ℝ := λ n , X ( c * n)

proposition subadditive_seq_mulindex (X : ℕ → ℝ) (Hsa : subadditive X) (c : ℕ) : subadditive (seq_mulindex X c) :=
  take n1,
  take n2,
  have H1: X ( c * n1 +  c * n2) ≤ X ( c * n1) + X ( c * n2), from Hsa,
  show X ( c * (n1 + n2)) ≤ X ( c * n1) + X ( c * n2), from  (left_distrib c n1 n2)⁻¹ ▸ H1

proposition t1 (X : ℕ → ℝ) (Hsa : subadditive(X)) (n: ℕ):
  X (n + 1) ≤ of_nat (n+1) * X 1 :=
  nat.induction_on n
    (show X 1 ≤ 1 * X 1, from  (one_mul (X 1))⁻¹ ▸  (real.le_refl (X 1)) )
      (take n,
        assume IH : X (n+1) ≤ of_nat (n+1) * (X 1),
        have H1 : X (n+1+1) ≤ X (n+1) + (X 1) , from Hsa,
        have H2 : X (n+1) + X 1 ≤ of_nat (n+1) * X 1 + X 1, from add_le_add_right IH (X 1),
        have H2': 1 * X 1 = X 1, from one_mul (X 1),
        have H2'': of_nat 1 = (1:ℝ), from rfl,
        have H2''': of_nat (n+1+1)  = of_nat (n+1) + of_nat 1, from of_nat_add (n+1) 1,
        have H3 : of_nat (n+1) * X 1 + X 1 = of_nat (n+1+1) * X 1, from calc
          of_nat (n+1) * (X 1) + (X 1) = of_nat (n+1) * X 1 + 1  * X 1 : H2'
          ...    = (of_nat (n+1) + 1) * X 1 : right_distrib
          ...    = (of_nat (n+1) + of_nat 1) * X 1 : H2''
          ...    = (of_nat (n+1+1)) * X 1 : H2''',
        have H4 : X (n+1) + X 1 ≤ of_nat (n+1+1) * X 1, from H3 ▸ H2,
        show X (n+1+1) ≤ of_nat (n+1+1) * X 1, from real.le_trans Hsa H4)

attribute subadditive [irreducible]

corollary t1b (X : ℕ → ℝ) (Hsa : subadditive X) (c: ℕ) (n: ℕ):
  X (c * (n + 1)) ≤ of_nat (n+1) * X c:=
  let Y := seq_mulindex X c in
  let HY := subadditive_seq_mulindex X Hsa c in
    have H: Y (n+1) ≤ of_nat (n+1) * Y 1, from  t1 Y HY n,
    have H': Y (n+1) = X(c * (n +1)), from rfl,
    have H'': Y 1 = X(c), from eq.subst (mul_one c) rfl,
    show  X(c * (n + 1)) ≤ of_nat (n+1) * X c , from eq.subst H'' (eq.subst H'  H)

proposition t2 (X : ℕ → ℝ) (Hsa : subadditive X) (c : ℕ) (n : ℕ) :
  X n ≤ of_nat (div n c) * X c + X (n % c) :=
  assert H1: X n ≤ X (n / c * c) + X (n % c), from
  begin
    esimp [subadditive] at Hsa,
    have X n = X ((n / c * c) + n % c), from eq.subst (eq_div_mul_add_mod n c) rfl,
    rewrite [this],
    apply Hsa
  end,
  begin
    have div n c = 0 ∨ div n c ≠ 0, from !em,
    cases this,
    have n = n % c + (div n c) * c, from eq.subst !nat.add_comm  (eq_div_mul_add_mod n c),
    have n - (div n c) * c = n % c, from nat.sub_eq_of_eq_add this,
    rewrite [-this,a],
    have H: n - 0 = n, from rfl,
    have of_nat 0 * X c = 0, from zero_mul (X c),
    rewrite [zero_mul,H,this,zero_add],
    apply le_of_eq,
    apply rfl,

    have Ha: div n c = succ (pred (div n c)), from
      or.elim (eq_zero_or_eq_succ_pred (div n c)) (by contradiction) (assume Hp: _, Hp),
    rewrite [Ha],
    have X (c * succ (pred (div n c))) ≤ succ (pred (div n c)) * X c, from t1b X Hsa _ _,
    have H2: X (c * succ (pred (div n c))) + X (n % c) ≤ succ (pred (div n c)) * X c + X (n % c), from add_le_add_right this _,
    have H1': (div n c) * c = c * succ (pred (div n c)), from eq.subst Ha (nat.mul_comm (div n c) c),
    show _, from real.le_trans (eq.subst H1' H1) H2,
  end

corollary t2c (X : ℕ → ℝ) (Hsa : subadditive X) (c : ℕ) (n : ℕ) (Hc: c > (0 : ℕ)):
  X n ≤ of_nat (div n c) * X c + (ak.seq_max_to X c) :=
  have n % c ≤ c, from le_of_lt (mod_lt _ Hc),
  have X(n % c) ≤ seq_max_to X c, from seq_max_to_le X this,
  have of_nat (div n c) * X c + X (n % c) ≤ of_nat (div n c) * X c + seq_max_to X c, from add_le_add_left this _,
  show _, from le.trans (t2 X Hsa c n) this

lemma seq_quot_inf_conv ( X : ℕ → ℝ) (Hsa : subadditive X):
  ∀ (x : ℝ), is_inf ((seq_quot X) ' univ) x → ak_compat.converges_to_seq (seq_quot X) x :=
  let Xq := seq_quot X in
begin
  intros [x, Hinfx],
  have HinfxEx: ∀ (n : ℕ), Xq n ≥ x, from
  begin
    intro n,
    unfold is_inf at Hinfx,
    cases Hinfx with [Hinfx1,Hinfx2],
    unfold lb at Hinfx1,
    apply (Hinfx1 (Xq n)),
    esimp [image,mem,set_of,univ],
    existsi n,
    split,
    trivial,
    apply rfl
  end,
  unfold ak_compat.converges_to_seq,
  intro [ε, epspos],
  have ε * of_rat 0.3 > 0, from mul_pos epspos (of_rat_lt_of_rat_of_lt dec_trivial),
  have ∃ (y : ℝ), (y∈ Xq ' univ) ∧ (y - x < ε * of_rat 0.3), from inf_exists_point _ x Hinfx (ε * of_rat 0.3) this,
  have ∃ (n : ℕ), (Xq n - x < ε * of_rat 0.3) ∧ n > 0, from exists.elim this
  begin
    intros [a, Ha],
    cases Ha with [Ha1,Ha2],
    esimp [image,mem,set_of] at Ha1,
    show ∃ (n : ℕ), ((Xq n) - x < ε * of_rat 0.3) ∧ n > 0, from exists.elim Ha1
    begin
      intro [n, Hn],
      cases Hn with [Hn1, Hn2],
      cases n with [n0],
      -- case n = 0
      existsi 1,
      rewrite [-seq_quod_eq_zero_one,Hn2],
      split,
      assumption,
      exact zero_lt_one,
      -- case n =/= 0
      existsi (succ n0),
      rewrite [Hn2],
      split,
      assumption,
      exact !zero_lt_succ
    end
  end,
  show ∃ (N:ℕ), ∀ {n:ℕ},  n≥ N → abs(seq_quot X n - x) < ε, from exists.elim this
  begin
    intros [c,Hc],
    cases Hc with [Hc1, Hc2],
    let lb1 := inv (ε * of_rat 0.3) * seq_max_to X c,
    let lb2 := inv (ε * of_rat (-0.3)) * X c,
    existsi succ (max (int.nat_abs (ceil lb1)) (int.nat_abs (ceil lb2))),
    intros [n,Hn],
    have Xq n - x ≥ 0, from sub_nonneg_of_le (HinfxEx n),
    rewrite [abs_of_nonneg this],
    apply sub_lt_left_of_lt_add,
    have Hn': n > 0, from lt_of_lt_of_le (zero_lt_succ _) Hn,
    rewrite [seq_quod_nn X n Hn'],
    have X n ≤ of_nat (div n c) * X c + (seq_max_to X c), from t2c X Hsa c n Hc2,
    have Ht2c1: X n / of_nat n ≤  (of_nat (div n c) * X c + (seq_max_to X c)) / of_nat n, from div_le_div_of_le_of_pos this (of_nat_lt_of_nat_of_lt (eq.subst rfl  Hn')),
    have (of_nat (div n c) * X c + (seq_max_to X c)) / of_nat n = of_nat (div n c) * X c / of_nat n + (seq_max_to X c) / of_nat n,
      from eq.symm (div_add_div_same (of_nat (div n c) * X c) (seq_max_to X c) (of_nat n)),
    have Ht2c1': X n / of_nat n ≤ of_nat (div n c) * X c / of_nat n + (seq_max_to X c) / of_nat n, from this ▸ Ht2c1,

    have H1: (seq_max_to X c) / of_nat n < ε * of_rat 0.3, from
    begin
      apply div_lt_of_lt_mul_pos,
      apply of_nat_lt_of_nat_of_lt,
      apply Hn',

      apply inv_mul_lt_of_lt_pos_mul,
      assumption,

      have lb1 ≤ nat_abs (ceil lb1), from le.trans (le_ceil lb1) (of_int_le_of_int_of_le (le_nat_abs (ceil lb1))),
      apply (lt_of_le_of_lt this),
      apply of_nat_lt_of_nat_of_lt,
      apply lt_of_le_of_lt !le_max_left (lt_of_succ_le Hn),
    end,
    have H2: of_nat (div n c) * X c / of_nat n < x + ε * of_rat 0.6, from
    begin
      apply div_lt_of_lt_mul_pos,
      apply of_nat_lt_of_nat_of_lt,
      apply Hn',

      have c= succ (pred c), from or.elim (eq_zero_or_eq_succ_pred c) (assume H: _, absurd H (ne_of_gt Hc2))  (assume H: _, H),
      have Hseq_quot: X c / of_nat c = seq_quot X c, from calc
        X c / of_nat c = X (succ (pred c)) / of_nat (succ (pred c)) : this
        ... = seq_quot X (succ (pred c)) : rfl
        ... = seq_quot X c : this,

      have Hn'': 0< of_nat n, from
      begin
        cases n,
        have false, from (iff.mp (lt_self_iff_false 0) Hn'),
        exfalso,
        trivial,
        apply of_nat_lt_of_nat_of_lt,
        apply dec_trivial,
      end,

      cases em (X c ≥ 0) with [HXc,HXcn],
      have of_nat (n / c) ≤ of_nat n / of_nat c, from le_of_sub_nonneg (and.elim_right (nat_div_estimate n c Hc2)),
      have of_nat (n / c) * X c ≤ (of_nat n / of_nat c) * X c, from mul_le_mul_of_nonneg_right this HXc,
      apply lt_of_le_of_lt this,
      xrewrite (division.def (of_nat n) (of_nat c)),
      rewrite [mul.assoc,mul.comm],
      apply mul_lt_mul_of_pos_right,
      rewrite [mul.comm,-division.def],

      xrewrite Hseq_quot,
      apply lt_add_of_sub_lt_left,
      apply lt.trans Hc1,
      apply mul_lt_mul_of_pos_left,
      apply of_rat_lt_of_rat_of_lt,
      apply dec_trivial,
      assumption,
      assumption,

      have  of_nat n / of_nat c - 1 < of_nat (n / c), from sub_lt_right_of_lt_add (lt_add_of_sub_lt_left (and.elim_left (nat_div_estimate n c Hc2))),
      have of_nat (n / c) * X c < (of_nat n / of_nat c - 1) * X c, from mul_lt_mul_of_neg_right this (lt_of_not_ge HXcn),
      apply lt.trans this,
      rewrite [mul_sub_right_distrib,-mul_inv_cancel (ne_of_gt (of_nat_lt_of_nat_of_lt Hn')) ],
      xrewrite (division.def (of_nat n) (of_nat c)),
      rewrite [*mul.assoc,-mul_sub_left_distrib,mul.comm],
      apply mul_lt_mul_of_pos_right,
      apply sub_lt_left_of_lt_add,
      rewrite [mul.comm,-division.def],
      xrewrite Hseq_quot,
      rewrite [add.comm,add.assoc],
      apply lt_add_of_sub_lt_left,
      apply lt.trans Hc1,
      apply lt_add_of_sub_lt_left,
      rewrite [-mul_sub_left_distrib],
      xrewrite [-of_rat_sub],
      apply mul_lt_of_lt_pos_inv_mul,
      assumption,
      have (0.3:ℚ) - 0.6 = -0.3, from dec_trivial,
      rewrite this,
      apply mul_lt_of_gt_div_neg,
      apply mul_neg_of_pos_of_neg,
      assumption,
      apply of_rat_lt_of_rat_of_lt,
      apply dec_trivial,
      have lb2 ≤ nat_abs (ceil lb2), from le.trans (le_ceil lb2) (of_int_le_of_int_of_le (le_nat_abs (ceil lb2))),
      rewrite [division.def,mul.comm],
      apply (lt_of_le_of_lt this),
      apply of_nat_lt_of_nat_of_lt,
      apply lt_of_le_of_lt !le_max_right (lt_of_succ_le Hn),

      assumption
    end,
    apply lt_of_le_of_lt Ht2c1',
    apply lt_of_lt_of_le (add_lt_add H2 H1),
    rewrite add.assoc,
    apply add_le_add_left,
    rewrite [-left_distrib,-(mul_one ε),mul.assoc],
    apply mul_le_mul_of_nonneg_left,
    xrewrite one_mul,
    xrewrite [-of_rat_one,-of_rat_add],
    apply of_rat_le_of_rat_of_le,
    apply dec_trivial,

    apply real.le_of_lt,
    exact epspos
  end,
end

lemma seq_quot_conv_inf (X : ℕ → ℝ) (Hsa : subadditive X):
  ∀ (x : ℝ), ak_compat.converges_to_seq (seq_quot X) x → is_inf ((seq_quot X) ' univ) x :=
  begin
    intro,
    intro HX,
    let converges_seq_X := exists.intro x HX,
    exact exists.elim (@ex_inf_of_seq_from_limit (seq_quot X) converges_seq_X)
    begin
      intros [y,Hy],
      have ak_compat.converges_to_seq (seq_quot X) y, from seq_quot_inf_conv X Hsa y Hy,
      have x=y, from ak_compat.converges_to_seq_unique HX this,
      rewrite this,
      assumption
    end
  end

-- Feteke's Lemma
-- This will be just a combination of seq_quot_inf_conv and seq_quot_conv_inf
theorem feteke (X : ℕ → ℝ) (Hsa: subadditive X):
  ∀ (x: ℝ), ak_compat.converges_to_seq (seq_quot X) x ↔ is_inf ((seq_quot X) ' univ) x
  :=
  take x, iff.intro (seq_quot_conv_inf X Hsa x) (seq_quot_inf_conv X Hsa x)


import .logic_util .algebra_util .heq
import .finite .partial_order_induction
import .sum_over

@[reducible]
def is_boolean (R) [ring R] : Prop := ∀ a : R, a * a = a

section
parameters {R : Type _} [ring R]

lemma boolean_ring.has_char_2 (is_bool : is_boolean R) : ring.one R + ring.one R = 0 :=
begin
  suffices : (ring.one R + ring.one R) + (ring.one R + ring.one R)
            = (ring.one R + ring.one R) + ring.zero R,
  { apply add_left_cancel, assumption },
  rw (_ : ring.one R + ring.one R + ring.zero R = ring.one R + ring.one R),
  transitivity (ring.one R + ring.one R)*(ring.one R + ring.one R),
  { rw FOIL, rw ring.mul_one, ac_refl },
  { apply is_bool },
  { rw ring.add_zero }
end

lemma boolean_ring.add_self_zero (is_bool : is_boolean R) : ∀ a : R, a + a = 0 :=
λ a, calc a + a = a * 1 + a * 1                 : by { rw mul_one a }
          ...   = a * (1 + 1)                   : eq.symm $ left_distrib a 1 1
          ...   = a * (ring.one R + ring.one R) : rfl
          ...   = a * 0                         : by { rw boolean_ring.has_char_2 is_bool }
          ...   = 0                             : mul_zero a

lemma boolean_ring.neg_eq_self (is_bool : is_boolean R) : ∀ a : R, a = -a :=
λ a, eq_neg_of_add_eq_zero $ boolean_ring.add_self_zero is_bool a

lemma boolean_ring.eq_if_add_zero (is_bool : is_boolean R)
  : ∀ x y : R, x + y = 0 → x = y := by {
    intros,
    have : (x + y) + y = y, { rw a, apply zero_add },
    rw [add_assoc x y y,boolean_ring.add_self_zero is_bool, add_zero] at this,
    assumption
  }

theorem boolean_ring.comm (is_bool : is_boolean R) : ∀ (x y : R), x * y = y * x :=
begin
  intros x y,
  have h1 : x*y + y*x = x*y + x*y*x + y*x*y + y*x
       := calc x*y + y*x = (x*y + y*x)*(x*y + y*x) : eq.symm $ is_bool (x*y + y*x)
               ...       = (x*y)*(x*y) + (x*y)*(y*x) + (y*x)*(x*y) + (y*x)*(y*x) : by { apply FOIL }
               ...       = x * y + (x*y)*(y*x) + (y*x)*(x*y) + y*x : by { rw [is_bool (x*y), is_bool (y*x)] }
               ...       = x * y + x*y*x + (y*x)*(x*y) + y*x : by { rw (_ : (x*y)*(y*x) = x*(y*y)*x), rw is_bool y, repeat {rw mul_assoc}, }
               ...       = x * y + x*y*x + y*x*y + y*x : by { rw (_ : (y*x)*(x*y) = y*(x*x)*y), rw is_bool x, repeat {rw mul_assoc}, },
  have h2 : x*y*x = y*x*y,
  { apply boolean_ring.eq_if_add_zero is_bool,
    have h21 := add_right_cancel h1,
    rw add_assoc at h21,
    have h22 : x*y + 0 = x * y + (x * y * x + y * x * y),
    { refine eq.trans _ h21, apply add_zero },
    exact eq.symm (add_left_cancel h22) },
  have h3 : x*y = x*y*x :=
    calc x*y = (x*y)*(x*y) : eq.symm $ is_bool (x*y)
         ... = x*(y*x*y)   : by { repeat { rw mul_assoc } }
         ... = x*(x*y*x)   : congr_arg _ $ eq.symm h2
         ... = (x*x)*y*x   : by { repeat { rw mul_assoc } }
         ... = x*y*x       : by { rw is_bool x },
  have h4 : y*x = y*x*y :=
    calc y*x = (y*x)*(y*x) : eq.symm $ is_bool (y*x)
         ... = y*(x*y*x)   : by { repeat { rw mul_assoc } }
         ... = y*(x*y)     : by { rw ← h3 }
         ... = y*x*y       : by { rw mul_assoc },
  rw [h3, h4], assumption
end

class boolean_ring (R) extends comm_ring (R) :=
(is_bool : is_boolean R)

lemma is_bool {R'} [boolean_ring R'] : ∀ a : R', a*a = a := boolean_ring.is_bool R'

def boolean_ring.mk2 (h : is_boolean R) : boolean_ring R := {
  mul_comm := boolean_ring.comm h,
  is_bool := h,
  .._inst_1
}

open classical

instance pset.ring (T) : boolean_ring (set T) :=
{ boolean_ring .
  add := (Δ),
  mul := (∩),
  one := set.univ,
  zero := ∅,
  neg := id,
  add_assoc :=
    λ A B C, @symm_diff_assoc T A B C
                (λ x, prop_decidable (A x))
                (λ x, prop_decidable (B x))
                (λ x, prop_decidable (C x)),
  add_comm := symm_diff_comm,
  mul_assoc := inter_assoc,
  mul_comm := inter_comm,
  zero_add := empty_symm_diff,
  add_zero := by { intro, rw symm_diff_comm, apply empty_symm_diff },
  mul_one := inter_univ,
  one_mul := by { intro, rw (_ : set.inter set.univ a = a ∩ set.univ), apply inter_univ,
                  rw inter_comm, refl },
  add_left_neg := by { intro, simp, apply symm_diff_self },
  left_distrib := left_distrib_inter_symm_diff,
  right_distrib := by { intros, rw (_ : set.inter (a Δ b) c = c ∩ (a Δ b)),
                        rw (_ : set.inter a c = c ∩ a), rw (_ : set.inter b c = c ∩ b),
                        apply left_distrib_inter_symm_diff,
                        all_goals { rw inter_comm, refl } },
  is_bool := by intros; apply inter_self
}
end

@[reducible] noncomputable
def sum_of {R : Type _} [comm_ring R] (h : finite R) (S : set R) : R :=
  sum_over
  $ classical.some
  $ classical.some_spec
  $ classical.sets_of_finite_types_are_finite R h S

lemma sum_of_unique {R : Type _} [comm_ring R] (h : finite R) (S : set R)
  : ∀ n (f : fin n → R),
      function.injective f
      → S = fun.im f
      → sum_of h S = sum_over f :=
begin
  intros n f f_i f_s,
  let h1 := classical.sets_of_finite_types_are_finite R h S,
  let n1 := classical.some h1,
  let h2 := classical.some_spec h1,
  let f1 : fin n1 → R := classical.some h2,
  let h3 := classical.some_spec h2,
  transitivity sum_over f1, refl,
  have : n1 = n, symmetry,
  apply one_way_to_be_finite S _ f _ f1 f_i f_s h3.left h3.right,
  suffices : (λ (s : Σ' (n : ℕ), (fin n → R)), sum_over s.snd) ⟨n1, f1⟩
           = (λ (s : Σ' (n : ℕ), (fin n → R)), sum_over s.snd) ⟨n, f⟩,
  { exact this },
  let f1' := eq.transport (λ (k : ℕ), fin k → R) this f1,
  have fheq : f1 == f1' := heq_transport (λ k, fin k → R) this f1,
  have : @psigma.mk nat (λ n, fin n → R) n1 f1
        = @psigma.mk nat (λ n, fin n → R) n f1',
  { congr; assumption },
  rw this, simp, apply sum_over_unique,
  have := @same_embedding_from_ims_eq (fin n) R,
  apply same_embedding_from_ims_eq f1' f,
  { apply inj_implies_transport_inj fin (λ _, R), exact h3.left },
  { assumption },
  rw ← f_s, rw h3.right,
  symmetry, congr; assumption
end

section

local attribute [instance] classical.prop_decidable

parameters {R : Type _} [boolean_ring R] (is_finite : finite R)

instance pseudo_subset_order
  : partial_order R :=
{ partial_order .
  le := λ x y, x*y = x,
  le_refl := by { intro, simp [(≤)],
  rw is_bool a },
  le_trans := by { simp [(≤)], intros a b c hab hbc,
    exact calc a * c = (a * b) * c : by { rw hab }
               ...   = a * (b * c) : mul_assoc _ _ _
               ...   = a * b       : by { rw hbc }
               ...   = a           : hab },
  le_antisymm := λ a b h1 h2,
    calc a   = a * b : eq.symm h1
         ... = b * a : mul_comm _ _
         ... = b     : h2
}

def orthogonal (x y : R) := x * y = 0

def min_nonzero.set :=
  { x : R | x ≠ 0 ∧ (∀ y, x ≤ y ∨ orthogonal x y) }

lemma min_nonzero_def2
  : min_nonzero.set = { x : R | x ≠ 0 ∧ (∀ y, y < x → y = 0) } :=
begin
  funext, apply propext, constructor,
  { intro h, cases h with h_ne_zero h_le_or_orthogonal,
    constructor, assumption, intros y hy,
    cases h_le_or_orthogonal y,
    { exfalso, apply hy.right, assumption },
    { transitivity x * y, symmetry, cases hy,
      rw mul_comm,
      assumption' } },
  { intro h, cases h with h_ne_zero h_minimal,
    apply and.intro h_ne_zero,
    intro y,
    have h1 : (x * y) ≤ x,
    { refine (_ : (x * y)*x = x * y),
      rw mul_comm (x*y) x,
      rw ← mul_assoc, rw is_bool },
    by_cases (x ≤ (x * y)),
    { apply or.inl, apply le_antisymm; assumption },
    { apply or.inr, apply h_minimal,
      constructor; assumption }, }
end

lemma min_nonzero_def3 : min_nonzero.set = minimal (λ x, x ≠ 0) :=
by { rw min_nonzero_def2, dsimp [minimal], funext x,
     apply congr_arg (λ P, x ≠ 0 ∧ P),
     apply propext, constructor; intros h y; specialize h y;
     (`[rw ← classical.dne (y = 0)] <|> `[rw classical.dne (y = 0)]),
     assumption' }

def min_nonzero.type := subtype min_nonzero.set

lemma min_nonzero.orthogonal
  : ∀ (x y : min_nonzero.type), x ≠ y → x.val * y.val = 0 :=
begin
  dsimp [min_nonzero.type, min_nonzero.set], intros x y hxy,
  cases (x.property.right y.val); cases (y.property.right x.val),
  { exfalso, apply hxy, apply subtype.eq,
    transitivity x.val * y.val,
    symmetry, assumption,
    rw mul_comm, assumption },
  rw mul_comm, assumption'
end

lemma min_nonzero.orthogonal_contrapositive
  : ∀ {a b : min_nonzero.type}, ¬orthogonal a.val b.val → a = b :=
by { intros, apply classical.by_contradiction,
     intro, apply a_1, apply min_nonzero.orthogonal,
     assumption }

section pset_embed

noncomputable
def min_nonzero.pset_embed : set min_nonzero.type → R :=
 λ S, sum_of is_finite (subset_of_subtype_to_subset S)

lemma pset_embed_eq_sum_over :
  ∀ (S : set min_nonzero.type)
    {n} (f : fin n → min_nonzero.type),
  function.injective f
  → S = fun.im f
  → min_nonzero.pset_embed S
    = sum_over (λ n, subtype.val $ f n) :=
begin
  intros S n f f_i f_s,
  dsimp [min_nonzero.pset_embed],
  apply @sum_of_unique,
  { intros x y hxy, apply f_i,
    apply subtype.eq, assumption },
  { rw f_s, dsimp [subset_of_subtype_to_subset],
    funext x, apply propext,
    constructor; intro h; cases h,
    { cases h_h, existsi h_h_w,
      rw (_ : x = (subtype.mk x h_w).val),
      rw ← h_h_h, refl },
    { rw ← h_h, simp, existsi (f h_w).property,
      existsi h_w, apply subtype.eq, refl } }
end

lemma min_nonzero_orthogonal_set
  : ∀ (S : set min_nonzero.type) (x0 : min_nonzero.type),
    x0 ∉ S → x0.val * min_nonzero.pset_embed S = 0 :=
begin
  intros S x0,
  have : set.finite S,
  { apply classical.sets_of_finite_types_are_finite,
    apply classical.subtypes_of_finite_types_are_finite,
    assumption },
  cases this with size h, revert S,
  induction size; intros; cases h with f h; cases h with f_i f_s,
  all_goals { rw pset_embed_eq_sum_over S f f_i f_s, simp [sum_over] },
  { rename a h', rename size_ih ih, rename size_n size,
    let xn := f ⟨size, nat.lt_succ_self size⟩,
    let f' := fin.restrict f,
    have : {x ∈ S | x ≠ xn} = fun.im f',
    { rw im_restrict _ _ f_i,
      funext x, apply propext,
      rw (_ : ({x ∈ S | x ≠ xn} x ↔ (fun.im f∖{f ⟨size, _⟩}) x)
            ↔ ((x ∈ S ∧ x ≠ xn) ↔ (fun.im f x ∧ x ∉ {f ⟨size, _⟩}))),
      tactic.swap, refl,
      rw [elem_singleton, ( _ : x ∉ {y : min_nonzero.type | y = f ⟨size, _⟩}
                              ↔ x ≠ f ⟨size, _⟩)],
      tactic.swap, refl,
      rw ← f_s, constructor; intro h; cases h;
      constructor; assumption },
    rw left_distrib, rw min_nonzero.orthogonal,
    specialize ih { x ∈ S | x ≠ xn } _ _ ,
    rw (_ : fin.restrict (λ (n : fin (nat.succ size)), (f n).val)
          = (λ (n : fin size), (fin.restrict f n).val)),
    rw pset_embed_eq_sum_over { x ∈ S | x ≠ xn } f' at ih,
    rw [zero_add, ← ih],
    { apply restrict_inj_if_fun_inj f f_i },
    { exact this },
    refl, existsi f',
    { constructor,
      apply restrict_inj_if_fun_inj f f_i,
      exact this },
    { intro h, apply h', exact h.left },
    { intro h,
      have this' : f ⟨size, nat.lt_succ_self size⟩ ∈ fun.im f,
      existsi fin.mk size (nat.lt_succ_self size), refl,
      rw ← h at this', rw ← f_s at this',
      exact h' this' } }
end

lemma pset_embed_disj_union : ∀ A B, disjoint A B →
  min_nonzero.pset_embed (A ∪ B) = min_nonzero.pset_embed A + min_nonzero.pset_embed B :=
begin
  intros A B h,
  have : set.finite A,
  { apply classical.sets_of_finite_types_are_finite,
    apply classical.subtypes_of_finite_types_are_finite,
    assumption },
  cases this with A_size hA, cases hA with f hA, cases hA with f_i f_s,
  have : set.finite B,
  { apply classical.sets_of_finite_types_are_finite,
    apply classical.subtypes_of_finite_types_are_finite,
    assumption },
  cases this with B_size hB, cases hB with g hB, cases hB with g_i g_s,
  have := union_size' h f g f_i f_s g_i g_s,
  rw pset_embed_eq_sum_over (A ∪ B) (fin.glue f g) this.left this.right,
  rw (_ : (λ (n : fin (A_size + B_size)), (fin.glue f g n).val)
        = fin.glue (λ n : fin A_size, (f n).val)
                   (λ n : fin B_size, (g n).val)),
  { rw sum_over_glue, apply congr, apply congr_arg,
    rw pset_embed_eq_sum_over A f f_i f_s,
    rw pset_embed_eq_sum_over B g g_i g_s },
  { dunfold fin.glue, funext,
    by_cases h : n.val < A_size,
    rw [dif_pos _, dif_pos _]; assumption,
    rw [dif_neg _, dif_neg _]; assumption }
end

lemma pset_embed_minus_eq_minus : ∀ S S', S ⊆ S' →
  min_nonzero.pset_embed (S'∖S) = min_nonzero.pset_embed S' - min_nonzero.pset_embed S :=
begin
  intros S S' hsub,
  suffices : min_nonzero.pset_embed (S'∖S) + min_nonzero.pset_embed S = min_nonzero.pset_embed S',
  { exact calc min_nonzero.pset_embed (S'∖S)
                   = min_nonzero.pset_embed (S'∖S) + min_nonzero.pset_embed S - min_nonzero.pset_embed S
                   : eq.symm (add_sub_cancel _ _)
               ... = min_nonzero.pset_embed S' - min_nonzero.pset_embed S
                   : by { rw this } },
  have h1 : set.finite S',
  { apply classical.sets_of_finite_types_are_finite,
    apply classical.subtypes_of_finite_types_are_finite R is_finite },
  have h2 : set.finite (S' ∖ S),
  { apply classical.subsets_of_finite_sets_are_finite (minus_is_subset _ _) h1 },
  cases h2 with minus_size h2,
  cases h2 with f_minus h2,
  have h3 : set.finite S,
  { apply classical.subsets_of_finite_sets_are_finite hsub h1 },
  cases h3 with sub_size h3,
  cases h3 with f_sub h3,
  have := union_size' (minus_disj _ _) f_minus f_sub h2.left h2.right h3.left h3.right,
  rw @minus_subset_union_subset _ _ _ (λ _, classical.prop_decidable _) hsub at this,
  cases this with f_i f_s,
  rw ← pset_embed_disj_union,
  { congr, apply minus_subset_union_subset, assumption },
  apply minus_disj
end

lemma pset_embed_preserves_add : ∀ S S',
  min_nonzero.pset_embed (S + S')
  = min_nonzero.pset_embed S + min_nonzero.pset_embed S' :=
begin
  intros, rw (_ : S + S' = S Δ S'),
  { dsimp [(Δ)], rw pset_embed_minus_eq_minus,
    { rw (_ : min_nonzero.pset_embed S'
            = min_nonzero.pset_embed ((S'∖S) ∪ (S' ∩ S))),
      { rw pset_embed_disj_union (S'∖S),
        { rw ← add_assoc,
          rw ← pset_embed_disj_union,
          rw union_decomp_l,
          rw sub_eq_add_neg, congr,
          symmetry, rw inter_comm,
          apply boolean_ring.neg_eq_self is_bool,
          rw disjoint_symm, apply minus_disj },
        { rw disjoint_symm,
          apply disjoint_implies_disjoint_subset ,
          apply inter_subset_r,
          rw disjoint_symm,
          apply minus_disj } },
      congr, exact decomp S' S },
    exact (λ x hx, or.inl $ and.left hx) },
  refl
end

lemma pset_embed_preserves_zero : min_nonzero.pset_embed 0 = 0 :=
begin
  apply add_group.homomorphism_preserves_zero,
  exact pset_embed_preserves_add
end
set_option trace.check true

lemma pset_embed_preserves_mul
  : ∀ S S', min_nonzero.pset_embed (S * S')
          = min_nonzero.pset_embed S * min_nonzero.pset_embed S' :=
begin
  intros,
  cases (classical.sets_of_finite_types_are_finite _ (classical.subtypes_of_finite_types_are_finite _ is_finite _) S) with n hn,
  cases hn with f hn, cases hn with f_i f_s,
  cases (classical.sets_of_finite_types_are_finite _ (classical.subtypes_of_finite_types_are_finite _ is_finite _) S') with m hm,
  cases hm with g hm, cases hm with g_i g_s,
  rw pset_embed_eq_sum_over S f, any_goals { assumption },
  rw pset_embed_eq_sum_over S' g, any_goals { assumption },
  rw mul_sum_over_right,
  have h1 : ∀ i j, f i ∉ S' → (f i).val * (g j).val = 0,
  { intros, apply min_nonzero.orthogonal, intro h,
    apply a, rw [h, g_s], existsi j, refl },
  have h1 : ∀ i, f i ∉ S' → (f i).val * sum_over (λ j, (g j).val) = 0,
  { intros, rw mul_sum_over_left, rw ← sum_over_eq_zero ,
    congr, funext, apply h1, assumption },
  have h2 : ∀ i, f i ∈ S' →
               ∃ j, (f i).val = (g j).val
                  ∧ ∀ j' ≠ j, (f i).val ≠ (g j').val,
  { intros, rw g_s at a, cases a with j hj,
    existsi j, constructor, symmetry, congr, assumption,
    rw ← hj, intro j', apply mt, intro, apply g_i,
    symmetry, apply subtype.eq, assumption },
  have h2 : ∀ i, f i ∈ S' → (f i).val * sum_over (λ j, (g j).val) = (f i).val,
  { rw g_s, intros i h, specialize h2 i (eq.substr g_s h),
    cases h2 with j h2, cases h2 with hij hneq,
    rw mul_sum_over_left,
    rw sum_over_nonzero _ (λ _ : fin 1, (f i).val),
    { simp [sum_over] },
    { intros, apply g_i,
      transitivity (f i), rw mul_comm at a,
      apply min_nonzero.orthogonal_contrapositive a,
      have a' : (f i).val * (g y).val ≠ 0,
      rw ← a_1, assumption,
      apply min_nonzero.orthogonal_contrapositive a', },
    { intros x y _, apply fin1.singleton },
    { simp [fun.im],
      transitivity { y | (f i).val = y },
      { funext, apply propext, constructor,
        { intro e, cases e, assumption },
        { intro h, rw (_ : (f i).val = b),
          existsi fin.mk 0 nat.zero_lt_one, refl, assumption } },
      { rw hij, funext, apply propext, constructor,
        { intro h, rw (_ : y = (g j).val),
          constructor, existsi j, apply is_bool,
          exact (g j).property.left, symmetry, assumption },
        { intro h, cases h.left, rw ← h_1,
          have : (g j).val * (g w).val ≠ 0, rw ← h_1 at h, apply h.right,
          rw min_nonzero.orthogonal_contrapositive this,
          apply eq.symm, apply is_bool (g w).val } } } },
  have h2' : ∀ i, f i ∉ S' → (f i).val * sum_over (λ j, (g j).val) = 0,
  { intros, rw mul_sum_over_left, rw ← sum_over_eq_zero,
    congr, funext, apply min_nonzero.orthogonal, intro h,
    apply a, rw h, rw g_s, existsi k, refl },
  transitivity sum_over (λ (i : fin n),
                ite (f i ∈ (S * S'))
                    (sum_over (λ (j : fin m), (f i).val * (g j).val))
                    0),
  { cases (classical.sets_of_finite_types_are_finite _ (classical.subtypes_of_finite_types_are_finite _ is_finite _) (S*S')) with k hk,
    cases hk with in_p hk, cases hk with in_p_i in_p_s,
    rw pset_embed_eq_sum_over _ in_p in_p_i in_p_s,
    symmetry, apply sum_over_nonzero,
    { intros x y hnez_x hxy,
      apply f_i, apply subtype.eq,
      transitivity (ite (f x ∈ S * S') (sum_over (λ (j : fin m), (f x).val * (g j).val)) 0),
      { have mem1_x : f x ∈ S',
        { apply classical.by_contradiction, intro h,
          apply hnez_x, rw if_neg _, intro h', exact h h'.right, },
        have mem2_x : f x ∈ S,
        { rw f_s, existsi x, refl },
        have mem3_x : f x ∈ S * S' := ⟨mem2_x, mem1_x⟩,
        rw [if_pos _, ← mul_sum_over_left], symmetry, apply h2, exact mem1_x, exact mem3_x },
      transitivity (ite (f y ∈ S * S') (sum_over (λ (j : fin m), (f y).val * (g j).val)) 0),
      assumption,
      { have hnez_y : ite (f y ∈ S * S') (sum_over (λ (j : fin m), (f y).val * (g j).val)) 0 ≠ 0 := hxy ▸ hnez_x,
        have mem1_y : f y ∈ S',
        { apply classical.by_contradiction, intro h,
          apply hnez_y, rw if_neg _, intro h', exact h h'.right, },
        have mem2_y : f y ∈ S,
        { rw f_s, existsi y, refl },
        have mem3_y : f y ∈ S * S' := ⟨mem2_y, mem1_y⟩,
        rw [if_pos _, ← mul_sum_over_left], apply h2, exact mem1_y, exact mem3_y }},
    { intros x y hxy, apply in_p_i,
      apply subtype.eq, exact hxy },
    { transitivity { v | ∃ y : min_nonzero.type, y ∈ fun.im in_p ∧ v = y.val },
      { funext, apply propext, constructor; intro h; cases h,
        { existsi in_p h_w, constructor,
          existsi h_w, refl, symmetry, assumption },
        { cases h_h, cases h_h_left, existsi h_h_left_w,
          rw [h_h_right, ← h_h_left_h] } },
      transitivity { v | ∃ y : min_nonzero.type, y ∈ S * S' ∧ v = y.val },
      { funext, apply propext, constructor;
        intro h; cases h; existsi h_w; refine and.intro _ h_h.right,
        { rw in_p_s, exact h_h.left }, { rw ← in_p_s, exact h_h.left } },
      { funext, apply propext, constructor; intro h,
        { cases h, cases h_h, subst h_h_right, constructor,
          { have : h_w ∈ fun.im f := f_s ▸ h_h_left.left, cases this,
            existsi this_w, simp, subst this_h,
            rw if_pos h_h_left,
            rw ← mul_sum_over_left, apply h2, exact h_h_left.right },
          exact h_w.property.left },
        { cases h, cases h_left, subst h_left_h, simp at h_right,
          have : f h_left_w ∈ S * S',
          { apply classical.by_contradiction, intro h,
            rw if_neg _ at h_right, apply h_right rfl,
            assumption },
          existsi f h_left_w, apply and.intro this,
          simp, rw if_pos _, rw ← mul_sum_over_left,
          apply h2, exact this.right, exact this } } } },
  { congr, funext, by_cases (f i ∈ S * S'),
    { rw if_pos, rw mul_sum_over_left, exact h },
    { rw if_neg, rw h2',
      { intro h', apply h, refine and.intro  _ h',
        rw f_s, existsi i, refl },
      exact h } }
end

lemma pset_embed_inj : function.injective min_nonzero.pset_embed :=
  ker_trivial_imp_inj min_nonzero.pset_embed
                      pset_embed_preserves_add
  $ λ S h, by {
    cases (classical.sets_of_finite_types_are_finite _ _ S),
    { revert S, induction w; intros,
      { apply has_size_zero_iff_empty _ h_1 },
      { cases h_1 with f, cases h_1_h with f_i f_s,
        let x0 := f ⟨w_n, nat.lt_succ_self _⟩,
        rw pset_embed_eq_sum_over S f f_i f_s at h,
        rw (_ : sum_over (λ (n : fin (nat.succ w_n)), (f n).val)
              = sum_over (λ (n : fin w_n), (fin.restrict f n).val) + x0.val) at h,
        rw (_ : sum_over (λ (n : fin w_n), (fin.restrict f n).val)
              = min_nonzero.pset_embed (S ∖ { x0 })) at h,
        { have : x0.val * min_nonzero.pset_embed (S∖{x0}) + x0.val * x0.val = x0.val * 0,
          rw [← left_distrib, h],
          rw is_bool x0.val at this,
          rw mul_zero at this,
          rw min_nonzero_orthogonal_set (S∖{x0}) x0 at this,
          have h' := h,
          rw zero_add at this, rw this at h,
          rw add_zero at h, exfalso,
          apply x0.property.left, assumption,
          intro h, apply h.right,
          rw elem_singleton, exact rfl },
        { rw pset_embed_eq_sum_over,
          { apply restrict_inj_if_fun_inj _ f_i },
          { rw [f_s, im_restrict], assumption } },
        refl } },
    { apply classical.subtypes_of_finite_types_are_finite, assumption } }

noncomputable
def min_nonzero.proj : R → R :=
λ x, x * min_nonzero.pset_embed set.univ

lemma min_nonzero_proj_def2 {n} (f : fin n → R) (x : R)
  : function.injective f
  → min_nonzero.set = fun.im f
  → min_nonzero.proj x = sum_over (λ j, x * f j) :=
begin
  intros f_i f_s, dsimp [min_nonzero.proj],
  rw ← mul_sum_over_left, congr,
  have : ∀ j, min_nonzero.set (f j),
  { rw f_s, intro, existsi j, refl },
  rw pset_embed_eq_sum_over set.univ (λ j, ⟨f j, this j⟩),
  { intros i j h, apply f_i,
    rw ← subtype.mk.inj_eq, assumption },
  { funext, transitivity true, refl,
    apply propext, rw true_iff, cases a,
    rw f_s at a_property, cases a_property,
    existsi a_property_w, apply subtype.eq,
    assumption }
end

lemma min_nonzero_proj_def3
  : ∀ x, min_nonzero.proj x
       = min_nonzero.pset_embed {y : subtype min_nonzero.set | x * y.val ≠ 0} :=
begin
  intro x,
  have := classical.sets_of_finite_types_are_finite _  is_finite min_nonzero.set,
  destruct this, intros size h, cases h with f h, cases h with f_i f_s,
  rw min_nonzero_proj_def2 f x f_i f_s,
  { cases classical.subsets_of_finite_sets_are_finite (λ y (h : y ∈ min_nonzero.set ∧ x * y ≠ 0), h.left) this with size' h,
    cases h with g h, cases h with g_i g_s,
    rw sum_over_nonzero (λ j, x * f j) g,
    { have h1 : ∀ i, min_nonzero.set (g i),
      { have : ∀ i, fun.im g (g i) := λ i, ⟨i, rfl⟩,
        rw ← g_s at this, intro i, exact and.left (this i) },
      have h2 : ∀ i, x * (g i) ≠ 0,
      { have : ∀ i, fun.im g (g i) := λ i, ⟨i, rfl⟩,
        rw ← g_s at this, intro i, exact and.right (this i) },
      rw pset_embed_eq_sum_over _ (λ i, ⟨g i, h1 i⟩),
      { intros x y hxy, apply g_i,
        rw subtype.mk.inj_eq at hxy, assumption },
      { funext, apply propext, constructor; intro h,
        { have : fun.im g y.val,
          rw ← g_s, constructor, apply y.property,
          assumption, cases this with k hk,
          existsi k, apply subtype.eq, exact hk },
        { cases h, rw ← h_h, apply h2 } } },
    { intros a b hnez hab, simp at hab ⊢,
      apply f_i, transitivity x * f a,
      { rw mul_comm,
        have hnez_a : f a * x ≠ 0,
        { rw mul_comm, exact hnez },
        have : min_nonzero.set (f a),
        { rw f_s, existsi a, refl },
        symmetry, refine or.resolve_right (this.right x) hnez_a },
      transitivity x * f b, exact hab,
      { rw mul_comm,
        have hnez_b : f b * x ≠ 0,
        { rw mul_comm, rw ← hab, exact hnez },
        have : min_nonzero.set (f b),
        { rw f_s, existsi b, refl },
        refine or.resolve_right (this.right x) hnez_b } },
  assumption,
  { rw ← g_s, transitivity { t ∈ fun.im f | t * x = t },
    { funext, apply propext, constructor;
      rw ← f_s; intro h; apply and.intro h.left,
      { rw mul_comm at h,
        apply or.resolve_right (h.left.right x) h.right },
      { rw mul_comm,
        rw h.right, exact h.left.left } },
    { funext, apply propext, constructor; intro h,
      { cases h, destruct h_left, intros k hk,
        rw ← f_s at h_left, constructor,
        { existsi k, simp, rw hk,
          rw mul_comm, assumption },
        { exact h_left.left } },
      { cases h, cases h_left with k hk, simp at hk,
        have : f k = a,
        { rw ← hk, symmetry,
          rw mul_comm,
          have : min_nonzero.set (f k),
          { rw f_s, existsi k, refl },
          apply or.resolve_right (this.right x),
          rw ← hk at h_right,
          rw mul_comm at h_right,
          exact h_right },
        rw ← this at hk ⊢, constructor, { existsi k, refl },
        rw mul_comm at hk, exact hk } } } }
end

lemma min_nonzero_proj_linear : ∀ x y,
  min_nonzero.proj (x + y) = min_nonzero.proj x + min_nonzero.proj y :=
begin
  intros,
  cases classical.sets_of_finite_types_are_finite _  is_finite min_nonzero.set with size h,
  cases h with f h, cases h with f_i f_s,
  repeat { rw min_nonzero_proj_def2 f _ f_i f_s },
  rw ← sum_over_sum, congr, funext,
  apply right_distrib
end

lemma min_nonzero_proj_min_nonzero : ∀ x : min_nonzero.type,
  min_nonzero.proj x.val = x.val :=
begin
  intros,
  rw min_nonzero_proj_def3,
  rw (_ : {y : subtype min_nonzero.set | x.val * y.val ≠ 0} = { y | x = y }),
  rw pset_embed_eq_sum_over _ (λ j : fin 1, x),
  { simp [sum_over] },
  { intros x y _, apply fin1.singleton },
  { funext, apply propext, constructor; intro h,
    { existsi fin.mk 0 nat.zero_lt_one, assumption },
    { cases h, exact h_h } },
  { funext, apply propext, constructor; intro h,
    { apply min_nonzero.orthogonal_contrapositive, assumption },
    { rw (_ : x = y), suffices : y.val * y.val ≠ 0, exact this,
      rw is_bool y.val, exact y.property.left, assumption } }
end

lemma min_nonzero_proj_eq : ∀ x, min_nonzero.proj x = x :=
  have h1 : ∀ x y, orthogonal (x - x * y) y,
  from λ x y, calc (x - x * y) * y = x*y - (x*y)*y : mul_sub_right_distrib _ _ _
                   ...             = x*y - x*(y*y) : by rw mul_assoc
                   ...             = x*y - x*y     : by rw is_bool
                   ...             = 0             : sub_self _,
  have h2 : ∀ x y : R, x - x * y ≤ x,
  from λ x y, calc (x - x * y) * x = x*x - (x * y)*x   : mul_sub_right_distrib _ _ _
                   ...             = x*x - x * (x * y) : by rw mul_comm (x*y)
                   ...             = x*x - x*x*y       : by rw mul_assoc
                   ...             = x - x*y           : by rw is_bool,
  by {
    apply partial_order.induction, assumption',
    intros x ih,
    by_cases (x = 0),
    { rw h, rw min_nonzero_proj_def3,
      rw pset_embed_eq_sum_over _ fin.elim0,
      simp [sum_over], { intro a, exact a.elim0 },
      { funext, transitivity false; apply propext,
        { rw iff_false, simp, apply not_false },
        { rw false_iff, intro h, cases h, exact h_w.elim0 } } },
    cases partial_order.ex_min is_finite (λ r, r ≠ 0) x h with x' h',
    specialize h1 x x', specialize h2 x x',
    have h3 : min_nonzero.set x',
    { rw min_nonzero_def2,
      cases h'.left, constructor, assumption,
      intro y, rw classical.dne (y = 0), apply right },
    have h4 : x - x * x' < x,
    { apply lt_of_le_of_ne,
      assumption, intro h'', rw h'' at h1,
      apply h'.left.left,
      transitivity x' * x, symmetry, exact h'.right,
      rw mul_comm, exact h1 },
    transitivity min_nonzero.proj (x - x * x' + x * x'),
    rw sub_add_cancel, rw min_nonzero_proj_linear,
    rw ih (x - x * x') h4,
    rw (_ : x * x' = x'),
    rw (_ : x' = (subtype.mk x' h3).val),
    rw min_nonzero_proj_min_nonzero, simp,
    rw mul_comm, exact h'.right }

lemma pset_embed_surj : function.surjective min_nonzero.pset_embed :=
begin
  dsimp [function.surjective],
  apply partial_order.induction (λ r, ∃ S, min_nonzero.pset_embed S = r) is_finite,
  intros x ih, simp * at ih,
  existsi { y | x * subtype.val y ≠ 0 },
  transitivity min_nonzero.proj x,
  { symmetry, apply min_nonzero_proj_def3 },
  apply min_nonzero_proj_eq
end

lemma pset_embed_preserves_one : min_nonzero.pset_embed 1 = 1 :=
begin
  apply monoid.ident_unique, intro x,
  cases (pset_embed_surj 1),
  cases (pset_embed_surj x),
  rw [← h_1, ← pset_embed_preserves_mul, mul_one]
end

end pset_embed

end


example (x : α × β) : x = (x.1, x.2) :=
  rfl -- Should work with eta for structures

example (x : Unit) : x = ⟨⟩ :=
  rfl -- Should work with eta for structures

structure Equiv (α : Sort u) (β : Sort v) where
  toFun    : α → β
  invFun   : β → α
  left_inv  : ∀ x, invFun (toFun x) = x
  right_inv : ∀ x, toFun (invFun x) = x

infix:50 "≃" => Equiv

def Equiv.symm (e : α ≃ β) : β ≃ α :=
  { toFun     := e.invFun
    invFun    := e.toFun
    left_inv  := e.right_inv
    right_inv := e.left_inv }

theorem Equiv.symm.symm (e : α ≃ β) : e.symm.symm = e :=
  rfl -- Should work with eta for structures

structure Bla where
  x : Nat

def Bla.toNat (b : Bla) : Nat := b.x
def Nat.toBla (x : Nat) : Bla := { x }

example (b : Bla) : b.toNat.toBla = b :=
  rfl -- Should work with eta for structures

example (b : Bla) : b.toNat.toBla = b := by
  cases b
  rfl

example (x : Unit × α) : x = ((), x.2) := rfl

example (x : (_ : True ∨ False) ×' α) : x = ⟨Or.inl ⟨⟩, x.2⟩ := rfl

example (p : α × α → Prop) (h : ∀ x y, p (x, y)) : p z := h z.1 _

class TopologicalSpace (α : Type)

structure Homeomorph (α β : Type) [TopologicalSpace α] [TopologicalSpace β] extends Equiv α β where
  continuousToFun : True
  continuousInv : True

def Homeomorph.symm [TopologicalSpace α] [TopologicalSpace β] (f : Homeomorph α β) : Homeomorph β α where
  toFun           := f.invFun
  invFun          := f.toFun
  left_inv        := sorry
  right_inv       := sorry
  continuousToFun := f.continuousInv
  continuousInv   := sorry

example [TopologicalSpace α] [TopologicalSpace β] (f : Homeomorph α β) :
  f.symm.symm = f := rfl -- fails

def frob : Nat × Nat → Nat × Nat
  | (x, y) => (x + y, 42)

example (x : Nat × Nat) : (frob x).2 = 42 := rfl

example (x y : Unit) : x = y := rfl

constant f : Nat → Unit
constant g : Nat → Unit

example (x y : Nat) : f x = f y := rfl

example (x y : Nat) : f x = g y := rfl