/-
Copyright (c) 2020 Gihan Marasingha. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gihan Marasingha
-/
import .decision_nec
import tactic.linarith

/-!
# Decision procedure - sufficient condition and decidability

We give a sufficient condition for a string to be derivable in the MIU language. Together with the
necessary condition, we use this to prove that `derivable` is an instance of `decicdable_pred`.

Let `count I st` and `count U st` denote the number of `I`s (respectively `U`s) in `st : miustr`.

We'll show that `st` is derivable if it has the form `M::x` where `x` is a string of `I`s and `U`s
for which `count I x` is congruent to 1 or 2 modulo 3.

To prove this, it suffices to show `derivable M::y` where `y` is any `miustr` consisting only of
`I`s such that the number of `I`s in `y` is `a+3b`, where `a = count I x` and `b = count U x`.
This suffices because Rule 3 permits us to change any string of three consecutive `I`s into a `U`.

As `count I y = (count I x) + 3*(count U x) ≡ (count I x) [MOD 3]`, it suffices to show
`derivable M::z` where `z` is an `miustr` of `I`s such that `count I z` is congruent to
1 or 2 modulo 3.

Let `z` be such an `miustr` and let `c` denote `count I z`, so `c ≡ 1 or 2 [MOD 3]`.
To derive such an `miustr`, it suffices to derive an `miustr` `M::w`, where again w is an
`miustr` of only `I`s with the additional conditions that `count I w` is a power of 2, that
`count I w ≥ c` and that `count I w ≡ c [MOD 3]`.

To see that this suffices, note that we can remove triples of `I`s from the end of `M::w`,
creating `U`s as we go along. Once the number of `I`s equals `m`, we remove `U`s two at a time
until we have no `U`s. The only issue is that we may begin the removal process with an odd number
of `U`s.

Writing `d = count I w`, we see that this happens if and only if `(d-c)/3` is odd.
In this case, we must apply Rule 1 to `z`, prior to removing triples of `I`s. We thereby
introduce an additional `U` and ensure that the final number of `U`s will be even.

## Tags

miu, decision procedure, decidability, decidable_pred, decidable
-/

namespace miu

open miu_atom list nat

/--
We start by showing that an `miustr` `M::w` can be derived, where `w` consists only of `I`s and
where `count I w` is a power of 2.
-/
private lemma der_cons_repeat (n : ℕ) : derivable (M::(repeat I (2^n))) :=
begin
  induction n with k hk,
  { constructor, }, -- base case
  { rw [succ_eq_add_one, nat.pow_add, nat.pow_one 2, mul_two,repeat_add], -- inductive step
    exact derivable.r2 hk, },
end

/-!
## Converting `I`s to `U`s

For any given natural number `c ≡ 1 or 2 [MOD 3]`, we need to show that can derive an `miustr`
`M::w` where `w` consists only of `I`s,  where `d = count I w` is a power of 2, where `d ≥ c` and
where `d ≡ c [MOD 3]`.

Given the above lemmas, the desired result reduces to an arithmetic result, given in the file
`arithmetic.lean`.

We'll use this result to show we can derive an `miustr` of the form `M::z` where `z` is an string
consisting only of `I`s such that `count I z ≡ 1 or 2 [MOD 3]`.

As an intermediate step, we show that derive `z` from `zt`, where `t` is aN `miustr` consisting of
an even number of `U`s and `z` is any `miustr`.
-/

/--
Any number of successive occurrences of `"UU"` can be removed from the end of a `derivable` `miustr`
to produce another `derivable` `miustr`.
-/
lemma der_of_der_append_repeat_U_even {z : miustr} {m : ℕ} (h : derivable (z ++ repeat U (m*2)))
  : derivable z :=
begin
  induction m with k hk,
  { revert h,
    simp only [list.repeat, zero_mul, append_nil, imp_self], },
  { apply hk,
    simp only [succ_mul, repeat_add] at h,
    change repeat U 2 with [U,U] at h,
    rw ←(append_nil (z ++ repeat U (k*2) )),
    apply derivable.r4,
    simp only [append_nil, append_assoc,h], },
end

/-!
In fine-tuning my application of `simp`, I issued the following commend to determine which lemmas
`simp` uses.

`set_option trace.simplify.rewrite true`
-/

/--
We may replace several consecutive occurrences of  `"III"` with the same number of `"U"`s.
In application of the following lemma, `xs` will either be `[]` or `[U]`.
-/
lemma der_cons_repeat_I_repeat_U_append_of_der_cons_repeat_I_append (c k : ℕ)
  (hc : c % 3 = 1 ∨ c % 3 = 2) (xs : miustr) (hder : derivable (M ::(repeat I (c+3*k)) ++ xs)) :
    derivable (M::(repeat I c ++ repeat U k) ++ xs) :=
begin
  revert xs,
  induction k with a ha,
  { simp only [list.repeat, mul_zero, add_zero, append_nil, forall_true_iff, imp_self],},
  { intro xs,
    specialize ha (U::xs),
    intro h₂,
    simp only [succ_eq_add_one, repeat_add], -- We massage the goal
    rw [←append_assoc, ←cons_append],        -- into a form amenable
    change repeat U 1 with [U],             -- to the application of
    rw [append_assoc, singleton_append],     -- ha.
    apply ha,
    apply derivable.r3,
    change [I,I,I] with repeat I 3,
    simp only [cons_append, ←repeat_add],
    convert h₂, },
end

/-!
### Arithmetic

We collect purely arithmetic lemmas: `add_mod2` is used to ensure we have an even number of `U`s
while `le_pow2_and_pow2_eq_mod3` treats the congruence condition modulo 3.
-/
section arithmetic

/--
For every `a`, the number `a + a % 2` is even.
-/
lemma add_mod2 (a : ℕ) : ∃ t, a + a % 2 = t*2 :=
begin
  simp only [mul_comm _ 2], -- write `t*2` as `2*t`
  apply dvd_of_mod_eq_zero, -- it suffices to prove `(a + a % 2) % 2 = 0`
  rw [add_mod, mod_mod, ←two_mul, mul_mod_right],
end

private lemma le_pow2_and_pow2_eq_mod3' (c : ℕ) (x : ℕ) (h : c = 1 ∨ c = 2) :
  ∃ m : ℕ, c + 3*x ≤ 2^m ∧ 2^m % 3 = c % 3 :=
begin
  induction x with k hk,
  { use (c+1),
    cases h with hc hc;
    { rw hc, norm_num }, },
  { rcases hk with ⟨g, hkg, hgmod⟩,
    by_cases hp : (c + 3*(k+1) ≤ 2 ^g),
    { use g, exact ⟨hp,hgmod⟩ },
    use (g+2),
    { split,
      { rw [mul_succ, ←add_assoc,nat.pow_add],
        change 2^2 with (1+3), rw [mul_add (2^g) 1 3, mul_one],
        linarith [hkg, one_le_two_pow g], },
      { rw [nat.pow_add,←mul_one c],
        exact modeq.modeq_mul hgmod rfl, }, }, },
end

/--
If `a` is 1 or 2 modulo 3, then exists `k` a power of 2 for which `a ≤ k` and `a ≡ k [MOD 3]`.
-/
lemma le_pow2_and_pow2_eq_mod3 (a : ℕ) (h : a % 3 = 1 ∨ a % 3 = 2) :
  ∃ m : ℕ, a ≤ 2^m ∧ 2^m % 3 = a % 3:=
begin
  cases le_pow2_and_pow2_eq_mod3' (a%3) (a/3) h with m hm,
  use m,
  split,
  { convert hm.1, exact (mod_add_div a 3).symm, },
  { rw [hm.2, mod_mod _ 3], },
end

end arithmetic

lemma repeat_pow_minus_append  {m : ℕ} : M :: repeat I (2^m - 1) ++ [I] = M::(repeat I (2^m)) :=
begin
  change [I] with repeat I 1,
  rw [cons_append, ←repeat_add, nat.sub_add_cancel (one_le_pow' m 1)],
end

/--
`der_repeat_I_of_mod3` states that `M::y` is `derivable` if `y` is any `miustr` consisiting just of
`I`s, where `count I y` is 1 or 2 modulo 3.
-/
lemma der_repeat_I_of_mod3 (c : ℕ) (h : c % 3 = 1 ∨ c % 3 = 2):
  derivable (M::(repeat I c)) :=
begin
  -- From `der_cons_repeat`, we can derive the `miustr` `M::w` described in the introduction.
  cases (le_pow2_and_pow2_eq_mod3 c h) with m hm, -- `2^m` will be  the number of `I`s in `M::w`
  have hw₂ : derivable (M::(repeat I (2^m)) ++ repeat U ((2^m -c)/3 % 2)),
  { cases mod_two_eq_zero_or_one ((2^m -c)/3) with h_zero h_one,
    { simp only [der_cons_repeat m, append_nil,list.repeat, h_zero], }, -- `(2^m - c)/3 ≡ 0 [MOD 2]`
    { rw [h_one, ←repeat_pow_minus_append, append_assoc], -- case `(2^m - c)/3 ≡ 1 [MOD 2]`
      apply derivable.r1,
      rw repeat_pow_minus_append,
      exact (der_cons_repeat m), }, },
  have hw₃ : derivable (M::(repeat I c) ++ repeat U ((2^m-c)/3) ++ repeat U ((2^m-c)/3 % 2)),
  { apply der_cons_repeat_I_repeat_U_append_of_der_cons_repeat_I_append c ((2^m-c)/3) h,
    convert hw₂, -- now we must show `c + 3 * ((2 ^ m - c) / 3) = 2 ^ m`
    rw nat.mul_div_cancel',
    { exact add_sub_of_le hm.1, },
    { exact (modeq.modeq_iff_dvd' hm.1).mp hm.2.symm, }, },
  rw [append_assoc, ←repeat_add _ _] at hw₃,
  cases add_mod2 ((2^m-c)/3) with t ht,
  rw ht at hw₃,
  exact der_of_der_append_repeat_U_even hw₃,
end

example (c : ℕ) (h : c % 3 = 1 ∨ c % 3 = 2):
  derivable (M::(repeat I c)) :=
begin
  -- From `der_cons_repeat`, we can derive the `miustr` `M::w` described in the introduction.
  cases (le_pow2_and_pow2_eq_mod3 c h) with m hm, -- `2^m` will be  the number of `I`s in `M::w`
  have hw₂ : derivable (M::(repeat I (2^m)) ++ repeat U ((2^m -c)/3 % 2)),
  { cases mod_two_eq_zero_or_one ((2^m -c)/3) with h_zero h_one,
    { simp only [der_cons_repeat m, append_nil, list.repeat,h_zero], }, -- `(2^m - c)/3 ≡ 0 [MOD 2]`
    { rw [h_one, ←repeat_pow_minus_append, append_assoc], -- case `(2^m - c)/3 ≡ 1 [MOD 2]`
      apply derivable.r1,
      rw repeat_pow_minus_append,
      exact (der_cons_repeat m), }, },
  have hw₃ : derivable (M::(repeat I c) ++ repeat U ((2^m-c)/3) ++ repeat U ((2^m-c)/3 % 2)),
  { apply der_cons_repeat_I_repeat_U_append_of_der_cons_repeat_I_append c ((2^m-c)/3) h,
    convert hw₂, -- now we must show `c + 3 * ((2 ^ m - c) / 3) = 2 ^ m`
    rw nat.mul_div_cancel',
    { exact add_sub_of_le hm.1, },
    { exact (modeq.modeq_iff_dvd' hm.1).mp hm.2.symm, }, },
  rw [append_assoc, ←repeat_add _ _] at hw₃,
  cases add_mod2 ((2^m-c)/3) with t ht,
  rw ht at hw₃,
  exact der_of_der_append_repeat_U_even hw₃,
end

/-!
### `decstr` is a sufficient condition

The remainder of this file sets up the proof that `dectstr en` is sufficent to ensure
`derivable en`. Decidability of `derivable en` is an easy consequence.

The proof proceeds by induction on the `count U` of `en`.

We tackle first the base case of the induction. This requires auxiliary results giving
conditions under which  `count I ys = length ys`.
-/

/--
If an `miustr` has a zero `count U` and contains no `M`, then its `count I` is its length.
-/
lemma count_I_eq_length_of_count_U_zero_and_neg_mem {ys : miustr} (hu : count U ys = 0)
  (hm : M ∉ ys) : count I ys = length ys :=
begin
  induction ys with x xs hxs,
  { refl, },
  { cases x,
    { exfalso, exact hm (mem_cons_self M xs), }, -- case `x = M` gives a contradiction.
    { rw [count_cons, if_pos (rfl), length, succ_eq_add_one, succ_inj'], -- case `x = I`
      apply hxs,
      { simpa only [count], },
      { simp only [mem_cons_iff,false_or] at hm, exact hm, }, },
    { exfalso, simp only [count, countp_cons_of_pos] at hu,  -- case `x = U` gives a contradiction.
      exact succ_ne_zero _ hu, }, },
end

/--
`base_case_suf` is the base case of the sufficiency result.
-/
lemma base_case_suf (en : miustr) (h : decstr en) (hu : count U en = 0) : derivable en :=
begin
  rcases h with ⟨⟨mhead, nmtail⟩, hi ⟩,
  have : en ≠ nil,
  { intro k, simp only [k, count, countp, if_false, zero_mod, zero_ne_one, false_or] at hi,
    contradiction, },
  rcases (exists_cons_of_ne_nil this) with ⟨y,ys,rfl⟩,
  rw head at mhead,
  rw mhead at *,
  suffices  : ∃ c, repeat I c = ys ∧ (c % 3 = 1 ∨ c % 3 = 2),
  { rcases this with ⟨c, hysr, hc⟩,
    rw ←hysr,
    exact der_repeat_I_of_mod3 c hc, },
  { simp only [count] at *,
    use (count I ys),
    refine and.intro _ hi,
    apply repeat_count_eq_of_count_eq_length,
    exact count_I_eq_length_of_count_U_zero_and_neg_mem hu nmtail, },
end

/-!
Before continuing to the proof of the induction step, we need other auxiliary results that
relate to `count U`.
-/
lemma mem_of_count_U_eq_succ {xs : miustr} {k : ℕ} (h : count U xs = succ k) : U ∈ xs :=
begin
  induction xs with z zs hzs,
  { exfalso, rw count at h, contradiction, },
  { simp only [mem_cons_iff],
    cases z,
    repeat -- cases `z = M` and `z=I`
    { right, apply hzs, simp only [count, countp, if_false] at h, rw ←h, refl, },
    { left, refl, }, }, -- case `z = U`
end

lemma eq_append_cons_U_of_count_U_pos {k : ℕ} {zs : miustr} (h : count U zs = succ k) :
∃ (as bs : miustr), (zs = as ++ U :: bs) :=
mem_split (mem_of_count_U_eq_succ h)

/--
`ind_hyp_suf` is the inductive step of the sufficiency result.
 -/
lemma ind_hyp_suf (k : ℕ) (ys : miustr) (hu : count U ys = succ k) (hdec : decstr ys) :
∃ (as bs : miustr), (ys = M::as ++ U:: bs) ∧ (count U (M::as ++ [I,I,I] ++ bs) = k) ∧
  decstr (M::as ++ [I,I,I] ++ bs) :=
begin
  rcases hdec with ⟨⟨mhead,nmtail⟩, hic⟩,
  have : ys ≠ nil,
  { intro k, simp only [k ,count, countp, zero_mod, false_or, zero_ne_one] at hic, contradiction, },
  rcases (exists_cons_of_ne_nil this) with ⟨z,zs,rfl⟩,
  rw head at mhead,
  rw mhead at *,
  simp only [count, countp, cons_append, if_false, countp_append] at *,
  rcases (eq_append_cons_U_of_count_U_pos hu) with ⟨as,bs,hab⟩,
  rw hab at *,
  simp only [countp, cons_append, if_pos, if_false, countp_append] at *,
  use [as,bs],
  apply and.intro rfl (and.intro (succ.inj hu) _),
  split,
  { apply and.intro rfl,
    simp only [tail, mem_append, mem_cons_iff, false_or, not_mem_nil, or_false] at *,
    exact nmtail, },
  { simp only [count, countp, cons_append, if_false, countp_append, if_pos],
    rw [add_right_comm, add_mod_right], exact hic, },
end

/--
`der_of_decstr` states that `derivable en` follows from `decstr en`.
-/
theorem der_of_decstr {en : miustr} (h : decstr en) : derivable en :=
begin
/- The next three lines have the effect of introducing `count U en` as a variable that can be used
 for induction -/
  have hu : ∃ n, count U en = n := exists_eq',
  cases hu with n hu,
  revert en, /- Crucially, we need the induction hypothesis to quantify over `en` -/
  induction n with k hk,
  { exact base_case_suf, },
  { intros ys hdec hus,
    rcases ind_hyp_suf k ys hus hdec with ⟨as, bs, hyab, habuc, hdecab⟩,
    have h₂ : derivable (M::as ++ [I,I,I] ++ bs) := hk hdecab habuc,
    rw hyab,
    exact derivable.r3 h₂, },
end

/-!
### Decidability of `derivable`
-/

/--
Finally, we have the main result, namely that `derivable` is a decidable predicate.
-/
instance : decidable_pred derivable :=
λ en, decidable_of_iff _ ⟨der_of_decstr, decstr_of_der⟩

/-!
By decidability, we can automatically determine whether any given `miustr` is `derivable`.
-/

example : ¬(derivable "MU") :=
dec_trivial

example : derivable "MUIUIUIIIIIUUUIUII" :=
dec_trivial

end miu


import data.real.basic

open_locale classical

/-
Theoretical negations.

This file is for people interested in logic who want to fully understand
negations.

Here we don't use `contrapose` or `push_neg`. The goal is to prove lemmas
that are used by those tactics. Of course we can use
`exfalso`, `by_contradiction` and `by_cases`.

If this doesn't sound like fun then skip ahead to the next file.
-/

section negation_prop

variables P Q : Prop

-- 0055
example : (P → Q) ↔ (¬ Q → ¬ P) :=
begin
  -- sorry
  split,
  { intros h hnQ hP,
    exact hnQ (h hP) },
  { intros h hP,
    by_contradiction hnQ,
    exact h hnQ hP },
  -- sorry
end

-- 0056
lemma non_imp (P Q : Prop) : ¬ (P → Q) ↔ P ∧ ¬ Q :=
begin
  -- sorry
  split,
  { intro h,
    by_contradiction H,
    apply h,
    intro hP,
    by_contradiction H',
    apply H,
    exact ⟨hP, H'⟩ },
  { intros h h',
    cases h with hP hnQ,
    exact hnQ (h' hP) },
  -- sorry
end

-- In the next one, let's use the axiom
-- propext {P Q : Prop} : (P ↔ Q) → P = Q

-- 0057
example (P : Prop) : ¬ P ↔ P = false :=
begin
  -- sorry
  split,
  { intro h,
    apply propext,
    split,
    { intro h',
      exact h h' },
    { intro h,
      exfalso,
      exact h } },
  { intro h,
    rw h,
    exact id },
  -- sorry
end

end negation_prop

section negation_quantifiers
variables (X : Type) (P : X → Prop)

-- 0058
example : ¬ (∀ x, P x) ↔ ∃ x, ¬ P x :=
begin
  -- sorry
  split,
  { intro h,
    by_contradiction H,
    apply h,
    intros x,
    by_contradiction H',
    apply H,
    use [x, H'] },
  { rintros ⟨x, hx⟩ h',
    exact hx (h' x) },
  -- sorry
end

-- 0059
example : ¬ (∃ x, P x) ↔ ∀ x, ¬ P x :=
begin
  -- sorry
  split,
  { intros h x h',
    apply h,
    use [x, h'] },
  { rintros h ⟨x, hx⟩,
    exact h x hx },
  -- sorry
end

-- 0060
example (P : ℝ → Prop) : ¬ (∃ ε > 0, P ε) ↔ ∀ ε > 0, ¬ P ε :=
begin
  -- sorry
  split,
  { intros h ε ε_pos hP,
    apply h,
    use [ε, ε_pos, hP] },
  { rintros h ⟨ε, ε_pos, hP⟩,
    exact h ε ε_pos hP },
  -- sorry
end

-- 0061
example (P : ℝ → Prop) : ¬ (∀ x > 0, P x) ↔ ∃ x > 0, ¬ P x :=
begin
  -- sorry
  split,
  { intros h,
    by_contradiction H,
    apply h,
    intros x x_pos,
    by_contradiction HP,
    apply H,
    use [x, x_pos, HP] },
  { rintros ⟨x, xpos, hx⟩ h',
    exact hx (h' x xpos) },
  -- sorry
end

end negation_quantifiers


namespace hidden

set_option trace.simplify true

@[class] structure group (α : Type) : Type :=
(mul : α → α → α)
(one : α)
(inv : α → α)
(mul_assoc : ∀ a b c, mul (mul a b) c = mul a (mul b c))
(one_mul : ∀ a, mul one a = a)
(mul_left_inv : ∀ a, mul (inv a) a = one)

-- potential instance of group class
inductive ℤ₂ : Type
| zero
| one

def ℤ₂.add : ℤ₂ → ℤ₂ → ℤ₂
| ℤ₂.zero a       := a
| a       ℤ₂.zero := a
| ℤ₂.one  ℤ₂.one  := ℤ₂.zero

-- def ℤ₂.neg (a : ℤ₂) := a

notation `z0` := ℤ₂.zero
notation `z1` := ℤ₂.one

-- #reduce ℤ₂.neg z0 -- z0
-- #reduce ℤ₂.neg z1 -- z1

#print add_group

-- proof of fact that ℤ₂ structure is group
@[instance] def ℤ₂.add_group : add_group ℤ₂ :=
{
  add := ℤ₂.add,
  add_assoc := by intros a b c; cases a; cases b; cases c; simp only [(+), ℤ₂.add],
  zero := ℤ₂.zero,
  zero_add := by intro a; cases a; simp only [(+), ℤ₂.add],
  add_zero := by intro a; cases a; simp only [(+), ℤ₂.add],
  neg      := (λ x, x),
  add_left_neg := begin
    intro a,
    -- have h : Z₂.add_group.neg a = a,
    simp only [],
    cases a,
    trivial, -- or refl
    refl,
  end,
}

-- With this instance declaration,
-- we can now use the notations 0, +, and -:
#reduce ℤ₂.one + 0 - 0 - ℤ₂.one -- ℤ₂.zero
#reduce ℤ₂.one + 0 + ℤ₂.one -- ℤ₂.zero

#reduce z0 + z0 -- z0
#reduce z0 + z1 -- z1
#reduce z1 + z0 -- z1
#reduce z1 + z1 -- z0
-- #reduce (3 : ℤ₂)

example (a : ℤ₂) :
  a + a = z0 :=
begin
-- simp [ℤ₂.add], -- fails
  cases a; refl,
end

lemma ex1 (a : ℤ₂) (b : ℤ₂) :
  a ≠ b → a + b = z1 :=
begin
  intro h,
  cases a; cases b,
    exfalso, simp at h, exact h,
    refl,
    refl,
    exfalso, simp at h, exact h,
end

lemma ex2 (a : ℤ₂) (b : ℤ₂) :
  a ≠ b → a + b = z1 :=
begin
  intro h,
  cases a; cases b,
  repeat {
    refl <|> { exfalso, simp at h, exact h },
  },
end
#print ex1
#print ex2

end hidden


import tactic
import algebra.field
import analysis.complex.polynomial
import data.multiset.basic
import field_theory.splitting_field

noncomputable theory
open_locale classical

open complex polynomial

universes u
variables {k : Type u}  [field k]

class algebraically_closed (k : Type u) extends field k :=
(exists_root (f : polynomial k) (hf : 0 < degree f) : ∃ z : k, is_root f z)

-- need a better name
lemma linear_factor_poly [algebraically_closed k] {f : polynomial ℂ} (hge0 : 0 < f.degree) :
  splits (ring_hom.id ℂ) f :=
begin
sorry,
end

instance : algebraically_closed ℂ :=
sorry

#check splits
#check ring_hom.id ℂ


import game.world10.level16 -- hide
namespace mynat -- hide
/-

# Inequality world.

## Level 17: definition of `<`

OK so we are going to *define* `a < b` by `a ≤ b ∧ ¬ (b ≤ a)`,
and given `lt_aux_one a b` and `lt_aux_two a b` it should now just
be a few lines to prove `a < b ↔ succ(a) ≤ b`.

-/

definition lt (a b : mynat) := a ≤ b ∧ ¬ (b ≤ a)

-- incantation so that we can use `<` notation:
instance : has_lt mynat := ⟨lt⟩

/- Lemma :
For all naturals $a$ and $b$,
$$a<b\iff\operatorname{succ}(a)\le b.$$
-/
lemma lt_iff_succ_le (a b : mynat) : a < b ↔ succ a ≤ b :=
begin [nat_num_game]
  split,
    exact lt_aux_one a b,
  exact lt_aux_two a b,

end
/-
For now -- that's it. In the next version of the natural number game we will go on and make
the natural numbers into an `ordered_cancel_comm_monoid`, which is the most
exotic of all the structures defined on the natural numbers in Lean 3.4.2.

Interested in playing levels involving other kinds of mathematics?
Look here for more ideas about what to do next.

Interested in learning more? Join us on the
Zulip Lean chat
and ask questions in the `#new members` stream. Real names preferred. Be nice.
-/

end mynat -- hide


import number_theory.basic
import data.nat.totient
import data.nat.pow
import field_theory.finite.basic

open nat

def encrypt (e n m : ℕ) := m ^ e % n
def decrypt (d n m : ℕ) := m ^ d % n

theorem RSA_correct (n d e m : ℕ) (h₁ : ∃ k : ℕ, e * d = n.totient * k + 1)
        (h₂ : m.coprime n) :
        decrypt d n (encrypt e n m) ≡ m [MOD n] :=
begin
  rw [encrypt, decrypt],
  rw ← pow_mod,
  rw ← pow_mul,
  apply modeq.trans (mod_modeq _ _),
  cases h₁ with k h,
  rw h,
  rw [pow_add, pow_mul, pow_one],
  suffices h' : (m ^ n.totient) ^ k ≡ 1 [MOD n],
  { nth_rewrite_rhs 0 ← one_mul m,
    exact modeq.mul_right m h', },
  { rw ← one_pow k,
    apply modeq.pow,
    exact modeq.pow_totient h₂, }
end


import data.int.basic

section
  variable A : Type
  variable f : A → A
  variable P : A → Prop
  variable h : ∀ x, P x → P (f x)

  -- Show the following:
  example : ∀ y, P y → P (f (f y)) :=
    assume y,
    assume Py: P y,
    have Py_imp_Pfy: P y → P (f y), from h y,
    have Pfy: P (f y), from Py_imp_Pfy Py,
    have Pfy_imp_Pffy: P (f y) → P (f(f y)), from h (f y),
    show P (f (f y)), from Pfy_imp_Pffy Pfy
end

section
  variable U : Type
  variables A B : U → Prop

  example : (∀ x, A x ∧ B x) → ∀ x, A x :=
    assume h,
    assume x,
    have Ax_and_Bx: A x ∧ B x, from h x,
    show A x, from and.left Ax_and_Bx
end

section
  variable U : Type
  variables A B C : U → Prop

  variable h1 : ∀ x, A x ∨ B x
  variable h2 : ∀ x, A x → C x
  variable h3 : ∀ x, B x → C x

  example : ∀ x, C x :=
    assume x,
    have Ax_or_Bx: A x ∨ B x, from h1 x,
    have Ax_imp_Cx: A x → C x, from h2 x,
    have Bx_imp_Cx: B x → C x, from h3 x,
    show C x, from or.elim Ax_or_Bx Ax_imp_Cx Bx_imp_Cx
end

section
  variable Person : Type
  variable shaves : Person → Person → Prop
  variable barber : Person
  variable h : ∀ x, shaves barber x ↔ ¬ shaves x x

  example : false :=
    have h_barber: shaves barber barber ↔ ¬ shaves barber barber, from h barber,
    have h1: ¬shaves barber barber,
      from assume h_shaves,
      show false, from (h_barber.elim_left h_shaves) h_shaves,
    show false, from h1 (h_barber.elim_right h1)
end

section
  variable U : Type
  variables A B : U → Prop

  example : (∃ x, A x) → ∃ x, A x ∨ B x :=
    assume h,
    exists.elim h $
      assume x (h1: A x),
      have A x ∨ B x, from or.inl h1,
      exists.intro x this
end

section
  variable U : Type
  variables A B : U → Prop

  variable h1 : ∀ x, A x → B x
  variable h2 : ∃ x, A x

  example : ∃ x, B x :=
   exists.elim h2 $
    assume x (Ax : A x),
    have Ax_imp_Bx: A x → B x, from h1 x,
    have B x, from Ax_imp_Bx Ax,
    exists.intro x this
end

section
  variable  U : Type
  variables A B C : U → Prop

  example (h1 : ∃ x, A x ∧ B x) (h2 : ∀ x, B x → C x) :
  ∃ x, A x ∧ C x :=
    exists.elim h1 $
      assume x (Ax_and_Bx: A x ∧ B x),
      have Bx_imp_Cx: B x → C x, from h2 x,
      have Ax: A x, from and.left Ax_and_Bx,
      have Bx: B x, from and.right Ax_and_Bx,
      have Cx: C x, from Bx_imp_Cx Bx,
      have Ax_and_Cx: A x ∧ C x, from and.intro Ax Cx,
      exists.intro x Ax_and_Cx
end

section
  variable  U : Type
  variables A B C : U → Prop

  example : (¬ ∃ x, A x) → ∀ x, ¬ A x :=
    assume h,
    assume x,
    assume Ax,
    have exists_Ax: ∃x, A x, from exists.intro x Ax,
    show false, from h exists_Ax

  example : (∀ x, ¬ A x) → ¬ ∃ x, A x :=
    assume h,
    assume exists_Ax,
    exists.elim exists_Ax $
      assume x (Ax: A x),
      have ¬A x, from h x,
      show false, from this Ax
end

section
  variable  U : Type
  variables R : U → U → Prop

  example : (∃ x, ∀ y, R x y) → ∀ y, ∃ x, R x y :=
    assume h,
    exists.elim h $
      assume x (h₁: ∀ y, R x y),
      assume y,
      have Rxy: R x y, from h₁ y,
      exists.intro x Rxy
end

section
  variable {A : Type}
  variables {a b c : A}

  theorem foo {A : Type} {a b c : A} : a = b → c = b → a = c :=
  sorry

  theorem my_symm (h : b = a) : a = b :=
    have a = a, from rfl,
    show a = b, from foo ‹a = a› h

  theorem my_trans (h1 : a = b) (h2 : b = c) : a = c :=
    have c = b, from my_symm h2,
    show a = c, from foo h1 ‹c = b›
end

section
  variables x y z : ℤ

  theorem t1 : x - x = 0 :=
  calc
  x - x = x + -x : by rw sub_eq_add_neg
      ... = 0      : by rw add_right_neg

  theorem t2 (h : x + y = x + z) : y = z :=
  calc
  y     = 0 + y        : by rw zero_add
      ... = (-x + x) + y : by rw add_left_neg
      ... = -x + (x + y) : by rw add_assoc
      ... = -x + (x + z) : by rw h
      ... = (-x + x) + z : by rw add_assoc
      ... = 0 + z        : by rw add_left_neg
      ... = z            : by rw zero_add

  theorem t3 (h : x + y = z + y) : x = z :=
  calc
  x     = x + 0        : by rw add_zero
      ... = x + (y + -y) : by rw add_right_neg
      ... = (x + y) + -y : by rw add_assoc
      ... = (z + y) + -y : by rw h
      ... = z + (y + -y) : by rw add_assoc
      ... = z + 0        : by rw add_right_neg
      ... = z            : by rw add_zero

  theorem t4 (h : x + y = 0) : x = -y :=
  calc
  x     = x + 0        : by rw add_zero
      ... = x + (y + -y) : by rw add_right_neg
      ... = (x + y) + -y : by rw add_assoc
      ... = 0 + -y       : by rw h
      ... = -y           : by rw zero_add

  theorem t5 : x * 0 = 0 :=
  have h1 : x * 0 + x * 0 = x * 0 + 0, from
  calc
      x * 0 + x * 0 = x * (0 + 0) : by rw left_distrib
              ... = x * 0       : by rw add_zero
              ... = x * 0 + 0   : by rw add_zero,
  show x * 0 = 0, from t2 _ _ _ h1

  theorem t6 : x * (-y) = -(x * y) :=
  have h1 : x * (-y) + x * y = 0, from
  calc
      x * (-y) + x * y = x * (-y + y) : by rw left_distrib
                  ... = x * 0        : by rw add_left_neg
                  ... = 0            : by rw t5 x,
  show x * (-y) = -(x * y), from t4 _ _ h1

  theorem t7 : x + x = 2 * x :=
  calc
  x + x = 1 * x + 1 * x : by rw one_mul
      ... = (1 + 1) * x   : by rw right_distrib
      ... = 2 * x         : rfl
end


import data.real.basic
import data.nat.gcd

open nat

#check add_lt_add_of_lt_of_le
#check add_lt_add_of_le_of_lt
#check int.sub_lt_sub_of_lt_of_le

-- BEGIN

/- In the follwoing example,we use dvd_gcd_iff to replace an expression of
the form m ∣ gcd n k by the equivalent expression m ∣ n ∧ m ∣ k -/
example : 3 ∣ gcd 6 15 :=
begin
  rw dvd_gcd_iff,
  split,
  { use 2, norm_num,},
  { use 5, norm_num,}
end

example (x y z : ℝ) (h : x + y > z) : x > z - y :=
sub_lt_iff_lt_add.mpr h

example (x y z : ℝ) (h : x + y < z) : x < z - y :=
lt_sub_iff_add_lt.mpr h

/- It is often convenient to rewrite a statement to an equivalent one
 In the following example, we use abs_lt to replace an expression of
 the form abs x < y by the equivalent expression - y < x ∧ x < y -/
example (x y : ℝ) : abs (x + 3) < 5 → -8 < x ∧ x < 2 :=
begin
  rw abs_lt,
  intro h,
  cases h with h1 h2,
  split,
  rw ← sub_lt_iff_lt_add at h1,
  norm_num at h1,
  exact h1,
  rw ← lt_sub_iff_add_lt at h2,
  norm_num at h2,
  exact h2,
end

example (x y : ℝ) : abs (x + 3) < 5 → -8 < x ∧ x < 2 :=
begin
  rw abs_lt,
  intro h,
  cases h with h1 h2,
  split;
  linarith,
end

-- END


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.polynomial.degree
import data.polynomial.degree.trailing_degree

/-!
# Erase the leading term of a univariate polynomial

## Definition

* `erase_lead f`: the polynomial `f - leading term of f`

`erase_lead` serves as reduction step in an induction, shaving off one monomial from a polynomial.
The definition is set up so that it does not mention subtraction in the definition,
and thus works for polynomials over semirings as well as rings.
-/

noncomputable theory
open_locale classical

open polynomial finsupp finset

namespace polynomial

variables {R : Type*} [semiring R] {f : polynomial R}

/-- `erase_lead f` for a polynomial `f` is the polynomial obtained by
subtracting from `f` the leading term of `f`. -/
def erase_lead (f : polynomial R) : polynomial R :=
finsupp.erase f.nat_degree f

section erase_lead

lemma erase_lead_support (f : polynomial R) :
  f.erase_lead.support = f.support.erase f.nat_degree :=
-- `rfl` fails because LHS uses `nat.decidable_eq` but RHS is classical.
by convert rfl

lemma erase_lead_coeff (i : ℕ) :
  f.erase_lead.coeff i = if i = f.nat_degree then 0 else f.coeff i :=
-- `rfl` fails because LHS uses `nat.decidable_eq` but RHS is classical.
by convert rfl

@[simp] lemma erase_lead_coeff_nat_degree : f.erase_lead.coeff f.nat_degree = 0 :=
finsupp.erase_same

lemma erase_lead_coeff_of_ne (i : ℕ) (hi : i ≠ f.nat_degree) :
  f.erase_lead.coeff i = f.coeff i :=
finsupp.erase_ne hi

@[simp] lemma erase_lead_zero : erase_lead (0 : polynomial R) = 0 :=
finsupp.erase_zero _

@[simp] lemma erase_lead_add_monomial_nat_degree_leading_coeff (f : polynomial R) :
  f.erase_lead + monomial f.nat_degree f.leading_coeff = f :=
begin
  ext i,
  simp only [erase_lead_coeff, coeff_monomial, coeff_add, @eq_comm _ _ i],
  split_ifs with h,
  { subst i, simp only [leading_coeff, zero_add] },
  { exact add_zero _ }
end

@[simp] lemma erase_lead_add_C_mul_X_pow (f : polynomial R) :
  f.erase_lead + (C f.leading_coeff) * X ^ f.nat_degree = f :=
by rw [C_mul_X_pow_eq_monomial, erase_lead_add_monomial_nat_degree_leading_coeff]

@[simp] lemma self_sub_monomial_nat_degree_leading_coeff {R : Type*} [ring R] (f : polynomial R) :
  f - monomial f.nat_degree f.leading_coeff = f.erase_lead :=
(eq_sub_iff_add_eq.mpr (erase_lead_add_monomial_nat_degree_leading_coeff f)).symm

@[simp] lemma self_sub_C_mul_X_pow {R : Type*} [ring R] (f : polynomial R) :
  f - (C f.leading_coeff) * X ^ f.nat_degree = f.erase_lead :=
by rw [C_mul_X_pow_eq_monomial, self_sub_monomial_nat_degree_leading_coeff]

lemma erase_lead_ne_zero (f0 : 2 ≤ f.support.card) : erase_lead f ≠ 0 :=
begin
  rw [ne.def, ← card_support_eq_zero, erase_lead_support],
  exact (zero_lt_one.trans_le $ (nat.sub_le_sub_right f0 1).trans
    finset.pred_card_le_card_erase).ne.symm
end

@[simp] lemma nat_degree_not_mem_erase_lead_support : f.nat_degree ∉ (erase_lead f).support :=
by convert not_mem_erase _ _

lemma ne_nat_degree_of_mem_erase_lead_support {a : ℕ} (h : a ∈ (erase_lead f).support) :
  a ≠ f.nat_degree :=
by { rintro rfl, exact nat_degree_not_mem_erase_lead_support h }

lemma erase_lead_support_card_lt (h : f ≠ 0) : (erase_lead f).support.card < f.support.card :=
begin
  rw erase_lead_support,
  exact card_lt_card (erase_ssubset $ nat_degree_mem_support_of_nonzero h)
end

lemma erase_lead_card_support' {c : ℕ} (fc : f.support.card = c + 1) :
  f.erase_lead.support.card = c :=
erase_lead_card_support fc

@[simp] lemma erase_lead_monomial (i : ℕ) (r : R) :
  erase_lead (monomial i r) = 0 :=
begin
  by_cases hr : r = 0,
  { subst r, simp only [monomial_zero_right, erase_lead_zero] },
  { rw [erase_lead, nat_degree_monomial _ _ hr], exact erase_single }
end

@[simp] lemma erase_lead_C (r : R) : erase_lead (C r) = 0 :=
erase_lead_monomial _ _

@[simp] lemma erase_lead_X : erase_lead (X : polynomial R) = 0 :=
erase_lead_monomial _ _

@[simp] lemma erase_lead_X_pow (n : ℕ) : erase_lead (X ^ n : polynomial R) = 0 :=
by rw [X_pow_eq_monomial, erase_lead_monomial]

@[simp] lemma erase_lead_C_mul_X_pow (r : R) (n : ℕ) : erase_lead (C r * X ^ n) = 0 :=
by rw [C_mul_X_pow_eq_monomial, erase_lead_monomial]

lemma erase_lead_degree_le : (erase_lead f).degree ≤ f.degree :=
begin
  rw degree_le_iff_coeff_zero,
  intros i hi,
  rw erase_lead_coeff,
  split_ifs with h, { refl },
  apply coeff_eq_zero_of_degree_lt hi
end

lemma erase_lead_nat_degree_le : (erase_lead f).nat_degree ≤ f.nat_degree :=
nat_degree_le_nat_degree erase_lead_degree_le

lemma erase_lead_nat_degree_lt (f0 : 2 ≤ f.support.card) :
  (erase_lead f).nat_degree < f.nat_degree :=
lt_of_le_of_ne erase_lead_nat_degree_le $ ne_nat_degree_of_mem_erase_lead_support $
  nat_degree_mem_support_of_nonzero $ erase_lead_ne_zero f0

lemma erase_lead_nat_degree_lt_or_erase_lead_eq_zero (f : polynomial R) :
  (erase_lead f).nat_degree < f.nat_degree ∨ f.erase_lead = 0 :=
begin
  by_cases h : f.support.card ≤ 1,
  { right,
    rw ← C_mul_X_pow_eq_self h,
    simp },
  { left,
    apply erase_lead_nat_degree_lt (lt_of_not_ge h) }
end

end erase_lead

/-- An induction lemma for polynomials. It takes a natural number `N` as a parameter, that is
required to be at least as big as the `nat_degree` of the polynomial.  This is useful to prove
results where you want to change each term in a polynomial to something else depending on the
`nat_degree` of the polynomial itself and not on the specific `nat_degree` of each term. -/
lemma induction_with_nat_degree_le {R : Type*} [semiring R] {P : polynomial R → Prop} (N : ℕ)
  (P_0 : P 0)
  (P_C_mul_pow : ∀ n : ℕ, ∀ r : R, r ≠ 0 → n ≤ N → P (C r * X ^ n))
  (P_C_add : ∀ f g : polynomial R, f.nat_degree ≤ N → g.nat_degree ≤ N → P f → P g → P (f + g)) :
  ∀ f : polynomial R, f.nat_degree ≤ N → P f :=
begin
  intros f df,
  generalize' hd : card f.support = c,
  revert f,
  induction c with c hc,
  { exact λ f df f0, by rwa (finsupp.support_eq_empty.mp (card_eq_zero.mp f0)) },
  { intros f df f0,
    rw ← erase_lead_add_C_mul_X_pow f,
    refine P_C_add f.erase_lead _ (erase_lead_nat_degree_le.trans df) _ _ _,
    { exact (nat_degree_C_mul_X_pow_le f.leading_coeff f.nat_degree).trans df },
    { exact hc _ (erase_lead_nat_degree_le.trans df) (erase_lead_card_support f0) },
    { refine P_C_mul_pow _ _ _ df,
      rw [ne.def, leading_coeff_eq_zero],
      rintro rfl,
      exact not_le.mpr c.succ_pos f0.ge } }
end

end polynomial


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

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, example sheet 1 : "forall" (`∀`)

A lot of questions about sets can be reduced to questions about logic.
We explain how to do this in Lean.

All the sets we consider on this and the next few sheets will all be
subsets of an underlying set `X`, which is our "universe" where all
the maths we do will take place. This underlying set `X` is called a "type" in
Lean. It plays the role of a "universe" -- every element we consider will
always be an element of `X`, and every subset we consider will
be a subset of `X`.

Notation: elements of `X` are called *terms* of the type `X` and the
notation is `x : X`. All the variables `x`, `y` and `z` which appear in this
sheet will always be terms of type `X`, i.e. elements of the set `X`
if you want to think set-theoretically.

All the sets `A`, `B`, `C` etc we consider will be subsets of `X`.
If `x : X` then `x` may or may not be an element of `A`, `B`, `C`,
but it will always be an element of `X`.

## Tactics

Tactics you will need to know for this sheet:

* `intro` (it works for `∀` goals as well as for `P → Q`)
* `specialize`

### The `intro` tactic

If the goal is `∀ x, P(x)` then `intro a,` lets `a` be an arbitrary
element of `X` (or, more precisely, an arbitrary term of type `X`)
and changes the goal to `P(a)`.

### The `specialize` tactic

If we have a hypothesis `h : ∀ x, P(x)` and we have a term `a : X`
then `specialize h a,` changes `h` to `h : P(a)`.

-/

-- set up variables
variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

-- You can start this one with `intro x`
example : ∀ x : X, x ∈ A → x ∈ A :=
begin
  sorry,
end

example : ∀ x : X, (x ∈ A ∧ x ∈ B) → x ∈ A :=
begin
  sorry
end

-- for this one if you start with `intros h x` then you might well
-- need `specialize h x` later on. This is how to use hypotheses with `∀` in.
example : (∀ x, x ∈ A ∧ x ∈ B) → (∀ x, x ∈ A) :=
begin
  sorry
end

example : (∀ x, x ∈ A ∧ x ∈ B) → (∀ y, y ∈ B ∧ y ∈ A) :=
begin
  sorry
end

example : (∀ x, x ∈ A → x ∈ B) → (∀ y, y ∈ B → y ∈ C) →
  (∀ z, z ∈ A → z ∈ C) :=
begin
  sorry
end


/-
Copyright (c) 2023 Maxwell Thum. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE. **TODO**: get this license
Author: Maxwell Thum.
-/
--import data.finset.powerset
import data.set.finite
--import data.set.default

/-!
# IMPORTANT
I am getting hung up on little details here and there and I don't think I can make some of these decisions
until I have a bigger picture of what all these definitions are supposed to serve. For now I will just try
to build the blueprint and move on with lots of `sorry`s.

# Abstract simplicial complexes (should this file be renamed? split up?)
A *(finite) abstract simplicial complex* `K` is a pair `(V, S)`, where
`V` is a finite set,
`S ⊆ 𝒫(V)` is a set of subsets of `V`,
every `σ ∈ S` is finite,
and for all `σ ∈ S`,
`σ' ⊆ σ` implies `σ' ∈ S`.
`V` is called the set of *vertices* and elements of `S` are called *simplices*.

## Notation

`σ ∈ K` means that `σ` is a simplex of `K`.

`K' ⊆ K` means that the simplices of `K'` are simplices of `K`.

-/

universes u v

namespace hidden -- temporary because of the new file

/-- Based off of `analysis.convex.simplicial_complex.basic`,
`https://ncatlab.org/nlab/show/simplicial+complex`, and Keenan Crane's DDG textbook.
I am (currently?) allowing the empty set to be a simplex. -/
--@[ext]
class abstract_simplicial_complex (A : Type*) := -- making this a class again?
(simplices : set (finset A))
(down_closed : ∀ σ ∈ simplices, ∀ τ ⊆ σ, τ ∈ simplices)

namespace abstract_simplicial_complex
variables {A : Type*} [K : abstract_simplicial_complex A]

/-- A `finset` belongs to an `abstract_simplicial_complex` if it's a simplex of it. -/
instance : has_mem (finset A) (abstract_simplicial_complex A) := ⟨λ σ K, σ ∈ K.simplices⟩

/-- The degree (or dimension) of a simplex is its cardinality minus one. -/ --
def degree (σ : finset A) : ℤ := σ.card - 1

/-- The set of `k`-simplices in `K`, the simplices in `K` with degree `k`. -/
def k_simplices (K : abstract_simplicial_complex A) (k : ℤ) : set (finset A) :=
  { σ ∈ K.simplices | degree σ = k }

-- **TODO**: make this more in line with `analysis.convex.simplicial_complex.basic`
/-- The set of vertices of an ASC, corresponding to its 0-simplices. -/
def vertices (K : abstract_simplicial_complex A) : set A := ⋃ σ ∈ K.simplices, (σ : set A)

/-- A pure (abstract) `k`-simplicial complex is such that every simplex is contained in
some `k`-simplex. -/
def is_pure_k_asc (K : abstract_simplicial_complex A) (k : ℕ) : Prop :=
  ∀ σ ∈ K.simplices, ∃ σ' ∈ K.k_simplices k, σ ⊆ σ'

/-- An ASC `K'` is a subcomplex of the ASC `K` if all of `K'`'s simplices belong to `K`. -/
--instance subcomplex : has_subset (abstract_simplicial_complex A) := ⟨λ K' K, K'.simplices ⊆ K.simplices⟩
def subcomplex (K' K : abstract_simplicial_complex A) : Prop := K'.simplices ⊆ K.simplices

-- -- ~~Is this unnecessary now that we have an instance of `has_subset`?~~
/-- Every ASC is a subcomplex of itself. -/
@[simp]
lemma asc_subcomplex_self (K : abstract_simplicial_complex A) : K.subcomplex K := rfl.subset

/-
/- I think I might prefer to just use `S ⊆ K.simplices`. Being able to just write `S ⊆ K` might be nice,
but `⊆` seems to be reserved for terms of the same type. -/
/-- Proposition that a set (not necessarily itself an ASC) is a subset of an ASC. -/
def subset_asc (S : set (finset A)) (K : abstract_simplicial_complex A) := S ⊆ K.simplices

/-- The set of simplices of a subcomplex of an ASC `K` form a subset of `K`. -/
@[simp]
lemma subcomplex_simplices_is_subset_asc (K' K : abstract_simplicial_complex A)
    (K'_subc_K : K'.subcomplex K) : subset_asc K'.simplices K := K'_subc_K

-- (is this lemma unnecessary?)
/-- In particular, the simplices of an ASC are a subset of themselves. -/
@[simp]
lemma asc_simplices_is_subset_asc (K : abstract_simplicial_complex A) :
    subset_asc K.simplices K := rfl.subset
-/

/-- The proposition that a subset of an ASC is closed downward
--, which is equivalent to it forming an ASC /
--subset by the previous lemma `of_subcomplex_is_subcomplex`.
--Note: I understand that logically this feels a bit... circular. I don't have a good way ...
Note 2: Both here and in `degree`, it seems weird that the definition doesn't (explicitly)
depend on the ASC stuff, but it's still important that we only want to talk about degree or
down-closedness in the context of an ASC. Right? -/
def is_down_closed (S : set (finset A)) (hS : S ⊆ K.simplices) : Prop :=
  ∀ σ ∈ S, ∀ τ ⊆ σ, τ ∈ S

/-
/-- Construct an ASC from a downward-closed subset of a given ASC. -/
--@[simps]
instance to_asc (K : abstract_simplicial_complex A)
  (S : set (finset A))
  (hS : S ⊆ K.simplices)
  (down_closed : is_down_closed S hS) :
  abstract_simplicial_complex A :=
{ simplices := S,
  down_closed := down_closed, }

/- The ASC constructed from a downward-closed subset of an ASC `K` is a subcomplex of `K`. -/
@[simp]
lemma to_asc_is_subcomplex (K : abstract_simplicial_complex A) (S : set (finset A))
    (hS : S ⊆ K.simplices) (down_closed : is_down_closed S hS) :
    (abstract_simplicial_complex.to_asc K S hS down_closed).subcomplex K :=
  hS
-/

/-- The star of a subset `S` of an ASC `K` is the set of simplices in `K` which contain a
simplex in `S`. -/
def star (S : set (finset A)) {hS : S ⊆ K.simplices} : set (finset A) :=
  { σ ∈ K.simplices | ∃ σ' ∈ S, σ' ⊆ σ }

/- trying to get blueprint working
/-- The star of a subset `S` of an ASC `K` indeed forms a subset of `K`. -/
@[simp]
lemma star_is_subset_asc (S : set (finset A))
    {hS : S ⊆ K.simplices} : (@star A K S hS) ⊆ K.simplices :=
  by sorry --simp only [subset_asc, star, set.sep_subset]
-/

/-- (Downward?) closure of a single simplex. -/
def simplex_closure (σ : finset A)
    (hσ : σ ∈ K.simplices) : set (finset A) :=
  { σ' ∈ K.simplices | σ' ⊆ σ }

/- **TODO**: Define union and intersection of complexes. Make these instances of `has_union`
and `has_int` or whatever they're called. This may be a good reason to let ∅ be a simplex.
On a related note, do we want `subcomplex` to be an instance of `has_sub`? -/
/-- The closure of a subset `S` of an ASC `K` is the union of the closures of its simplices.
--Book definition: "The closure Cl(S) is the smallest (i.e., fewest elements) subcomplex of
--K  that contains S." This is a rough definition in an arbitrary type `A` / possibly infinite
--set `K.simplices` as it is not necessarily clear that there even *exists* such a minimal set.
--Perhaps we need a nicer definition.  -/
def closure (S : set (finset A)) [hS : S ⊆ K.simplices] :
    set (finset A) :=
  ⋃ (σ ∈ S), simplex_closure σ (hS H)

/- for now
/-- The closure of a subset `S` of an ASC `K` indeed forms a subset of `K`. -/
@[simp]
lemma closure_is_subset_asc (S : set (finset A))
    (hS : S ⊆ K.simplices) : (closure S hS) ⊆ K.simplices := by
{ unfold subset_asc closure,
  simp at *,
  sorry
  }

@[simp]
lemma closure_is_down_closed (S : set (finset A))
    (hS : subset_asc S K) : is_down_closed (closure S hS) (closure_is_subset_asc S hS) :=
  sorry

/- The link of a subset of an ASC is -/
def link (S : set (finset A)) (hS : subset_asc S K) : set (finset A) :=
  S.star.closure.simplices \ S.closure.star.simplices

/--  -/
def boundary (K' : abstract_simplicial_complex A) [K'.subcomplex K]
    {k : ℕ} [is_pure_k_asc K' k] :
    abstract_simplicial_complex A := by sorry
--{ refine (closure _)}

-/
end abstract_simplicial_complex

end hidden


-- single line comment
universe u

def m: Nat := 1

#check m
#check m

#check (m + m)
#eval (m + m)

#check Nat × Nat

def Γ := 2 + m

def double (a: Nat) := a + a

#eval double (double 3)

section composition
  variable (α β γ: Type)

  def compose (f: α → β) (g: β → γ): (α -> γ) := fun x: α => g (f x)
end composition

def quadruble := compose _ _ _ double double

#print compose

section composition'
  variable (α β γ : Type)
  variable (g : β → γ) (f : α → β) (h : α → α)
  variable (x : α)

  def compose' := g (f x)
  def doTwice := h (h x)
  def doThrice := h (h (h x))
end composition'

def a: Nat := 3

#eval double a
#print compose'
#check (Nat : Sort 1)
#check (Prop : Sort 1)
#check (Prop : Type)

section proofs
  theorem hmm (α: Prop) (β: Prop): Prop := α
  theorem hmm2 : Prop -> Prop -> Prop :=
    fun α β => show Prop from α

  theorem hmm3 (hm: α): α := hm

  axiom myProof: Prop

  #check hmm
  #check hmm2
  #check hmm3 myProof
  #check @hmm3
  #check @hmm3 myProof
end proofs

section logic
  variable {α β π: Prop}
  variable (ha: α) (hb: β)

  theorem pair: α -> β -> α ∧ β := fun a b => And.intro a b
  theorem unpair: (α → β → π) → α ∧ β → π := fun f a =>
    show π from f (And.left a) (And.right a)

  theorem pairsCommute: (α ∧ β) → (β ∧ α) := fun p =>
    show (β ∧ α) from And.intro (And.right p) (And.left p)

  example (h: α ∧ β): β ∧ α := ⟨h.right, h.left⟩

  theorem thrice: (f: α) -> α ∧ α ∧ α := fun f => ⟨ f, f, f ⟩

  theorem negateFunc: (β → α) → ¬α → ¬β :=
    fun f notₐ b =>
      show False from notₐ (f b)

  #print pairsCommute
  #check (⟨ha, hb⟩: α ∧ β)

  theorem exFalso: (α ∧ ¬ α) → β :=
    fun contradiction =>
      show β from (contradiction.right contradiction.left).elim

  theorem pairIso: α ∧ β ↔ β ∧ α := ⟨ pairsCommute, pairsCommute ⟩
end logic

section classical
  open Classical

  variable (α : Prop)

  def dneT: Prop := ¬¬α → α

  theorem doubleNegation: α ↔ ¬¬α :=
    suffices l: α → ¬¬α from
    suffices r: ¬¬α → α from ⟨ l, r ⟩
    show dneT α from fun doubleNegA => (em α).elim
      (fun p: α => p)
      (fun p: ¬α => absurd p doubleNegA)
    show α → ¬¬α from (fun a f => f a)

  #print byCases

  theorem dne: dneT α := fun nnₚ =>
    byCases id
      (fun nₚ => (nnₚ nₚ).elim)

  #print byContradiction

  theorem dne': dneT α := fun nnₚ =>
    byContradiction fun nₚ => nnₚ nₚ
end classical

section exercises
  variable (p q r : Prop)

  theorem noContradictions : ¬(p ↔ ¬p) :=
    fun contradiction =>
      suffices someP: p from contradiction.mp someP someP
      suffices someNotP: ¬p from show p from contradiction.mpr someNotP
      show ¬p from fun p => contradiction.mp p p
end exercises

section quantifiers
  variable (α: Type) (r: α → α → Prop)
  variable (transitivity: ∀x y z, r x y → r y z → r x z)
  variable (n: Nat)

  variable (trans2: ∀x y z, r x y → r y z → r x z)
  variable (trans3: ∀τ β ω, r τ β → r β ω → r τ ω)

  axiom someA: α

  #print someA
  #check transitivity

  #print Eq.subst

  theorem substTest: (a b c: Nat) → (myProp: Nat -> Prop) →
    (a + b = c) → myProp c → myProp (a + b) :=
    fun a b c myProp p₁ l  => @Eq.subst Nat (fun a => myProp a) c (a + b) p₁.symm l
  theorem substTest': {a b c: Nat} → {myProp: Nat -> Prop} →
    (a + b = c) → myProp c → myProp (a + b) :=
    fun p₁ l  => p₁ ▸ l

  #check @congr
  #print congrArg
  #print congrFun

  theorem congrArgTest: {a b: Nat} → (c: Nat) → (a = b) → (a + c = b + c) :=
    fun c p₁ => congrArg (fun a => a + c) p₁

end quantifiers

section calc_
  variable (a b c d e : Nat)
  variable (h1 : a = b)
  variable (h2 : b = c + 1)
  variable (h3 : c = d)
  variable (h4 : e = 1 + d)

  theorem T : a = e :=
    calc
      a = b      := h1
      _ = c + 1  := h2
      _ = d + 1  := congrArg Nat.succ h3
      _ = 1 + d  := Nat.add_comm d 1
      _ = e      := h4.symm

  theorem T₂ : a = e :=
    calc
      a = b := h1
      _ = c + 1 := h2
      _ = d + 1 := by rw [h3]
      _ = 1 + d := by rw [Nat.add_comm]
      _ = e     := by rw [h4]

  theorem T₃ : a = e :=
    by rw [h1, h2, h3, Nat.add_comm, h4]

  theorem T₄ : a = e :=
    by simp [h1, h2, h3, Nat.add_comm, h4]

  example (a b c d : Nat) (h1 : a = b) (h2 : b ≤ c) (h3 : c + 1 < d) : a < d :=
    calc
      a = b     := h1
      _ < b + 1 := Nat.lt_succ_self b
      _ ≤ c + 1 := Nat.succ_le_succ h2
      _ < d     := h3

  variable (x y: Nat)

  theorem A₁: (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
    calc
      (x + y) * (x + y) = (x + y) * x + (x + y) * y  := by rw [Nat.mul_add]
          _ = x * x + y * x + (x * y + y * y)        := by simp [Nat.add_mul]
          _ = x * x + y * x + x * y + y * y          := by rw [←Nat.add_assoc]

  theorem A₂: (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
    by simp [Nat.add_mul, Nat.mul_add, Nat.add_assoc]

  axiom forallTest: ¬(∀a: Nat, a + a = a + 1)

  theorem existsOne: ∃a: Nat, a + a = a + 1 := ⟨ 1, rfl ⟩
  theorem existsBiggerThanOne: ∃a: Nat, a > 1 :=
    have r: 1 < 2 := Nat.succ_lt_succ (Nat.zero_lt_succ 0)
    ⟨ 2, r ⟩

  example (x : Nat) (h : x > 0) : ∃ y, y < x :=
    ⟨ 0, h ⟩
end calc_

section exists_print
  variable (g : Nat → Nat → Nat)
  variable (hg : g 0 0 = 0)

  theorem gex1 : ∃ x, g x x = x := ⟨0, hg⟩
  theorem gex2 : ∃ x, g x 0 = x := ⟨0, hg⟩
  theorem gex3 : ∃ x, g 0 0 = x := ⟨0, hg⟩
  theorem gex4 : ∃ x, g x x = 0 := ⟨0, hg⟩

  theorem gex5 : ∃ x, g x x = 0 := ⟨0, hg⟩
  theorem gex6 : ∃ x, g x x = 0 := ⟨0, hg⟩
  theorem gex7 : ∃ x, g x x = 0 := ⟨0, hg⟩

  set_option pp.explicit true  -- display implicit arguments
  #print gex1
  #print gex2
  #print gex3
  #print gex4
end exists_print

section existentials
  variable (α : Type) (p q : α → Prop)

  example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
    match h with
    | ⟨w, hw⟩ => ⟨w, hw.right, hw.left⟩

  theorem _matches : (n: Nat) → n + 1 = 1 + n := fun n =>
    match n with
    | Nat.succ w => calc
        Nat.succ w + 1 = Nat.succ (w + 1) := rfl
        _              = Nat.succ (1 + w) := by rw [_matches w]
        _              = 1 + Nat.succ w := rfl
    | Nat.zero => rfl
end existentials

section tactics
  theorem test (p q : Prop) (hp: p) (hq: q): p ∧ q ∧ p := by
    apply And.intro
    case left =>
      exact hp
    case right =>
      apply And.intro hq hp

  #print test

  theorem test₂ (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
    apply Iff.intro
    . intro h
      apply Or.elim h.right
      . intro hq
        apply Or.inl
        exact ⟨h.left, hq⟩
      . intro hr
        apply Or.inr
        exact ⟨h.left, hr⟩
    . intro h
      apply Or.elim h
      . intro pq
        apply And.intro
        . exact pq.left
        . exact Or.inl pq.right
      . intro pr
        apply And.intro
        . exact pr.left
        . exact Or.inr pr.right

  #print test₂
end tactics


/-
   lemma o theorem si se quiere dar un nombre al resultado, sino example
   Tipeo de → ∧ ∨ ¬ ↔
   Múltiples premisas
   Introducción del implica [intro(s)] y de la conjunción [apply and.intro]
-/
lemma Ejemplo1 (a b : Prop) : a → b → a ∧ b :=
begin
    intro ha,
    intro hb,         -- can be replaced by [intros ha hb],
    apply and.intro,  -- can be replaced by [apply (and.intro ha hb)]
        apply ha,
        apply hb
end

-- Eliminación de la conjunción [apply and.left, apply and.right]
lemma Ejemplo2 (a b : Prop) : a ∧ ¬b → ¬b ∧ a :=
begin
    intro h,
    apply and.intro,           -- can be replaced by [apply (and.intro (and.right h) (and.left h))]
        apply (and.right h),
        apply (and.left h)
end

-- Eliminación de la disyunción [apply or.elim]
lemma Ejemplo3 (a b c : Prop) : a ∨ b -> (a → c) -> (b → c) → c :=
begin
    intros hab hac hbc,
    apply (or.elim hab),   -- can be replaced by [apply (or.elim hab hac hbc)]
        apply hac,
        apply hbc
end

-- Eliminación del implica [apply premisa] e introducción de la disyunción [apply or.inl/inr]
lemma Ejemplo4 (a b c : Prop) : a -> (a ∨ b → c) → c :=
begin
    intros ha habc,
    apply habc,          -- can be replaced with [apply (habc (or.inl ha))]
        apply or.inl,
            apply ha
end

-- Introducción del iff [apply iff.intro]
lemma Ejemplo5 (a b : Prop) : a ∧ b ↔ b ∧ a :=
begin
    apply iff.intro,
        intro hab; apply (and.intro (and.right hab) (and.left hab)),
        intro hba; apply (and.intro (and.right hba) (and.left hba))
end

-- Eliminación de la negación: ¬a se define como  a → false,
-- por lo que para eliminar ¬a debo eliminar el implica [aplicación]
-- Eliminación de false [false.elim]
lemma Ejemplo6 (a b : Prop) : a -> ¬a -> b :=
begin
    intros ha hna,
    apply false.elim,   -- can be replaced with [apply (false.elim (hna ha))]
    apply (hna ha)
end

open classical
local attribute [instance] classical.prop_decidable

-- Logica clásica: prueba por reducción al absurdo.
-- Hay que agregar los dos comandos de arriba
-- Para probar una proposición, [by_contradiction] pide que
-- derivemos false a partir de la negación de la proposición.
lemma Ejemplo7 (a : Prop) : ¬¬a → a :=
begin
    intro hnna,
    by_contradiction,
    apply (hnna a_1)
end


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import algebra.order.ring.defs
import algebra.invertible

/-!
# Lemmas about `inv_of` in ordered (semi)rings.

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

variables {α : Type*} [linear_ordered_semiring α] {a : α}

@[simp] lemma inv_of_pos [invertible a] : 0 < ⅟a ↔ 0 < a :=
begin
  have : 0 < a * ⅟a, by simp only [mul_inv_of_self, zero_lt_one],
  exact ⟨λ h, pos_of_mul_pos_left this h.le, λ h, pos_of_mul_pos_right this h.le⟩
end

@[simp] lemma inv_of_nonpos [invertible a] : ⅟a ≤ 0 ↔ a ≤ 0 :=
by simp only [← not_lt, inv_of_pos]

@[simp] lemma inv_of_nonneg [invertible a] : 0 ≤ ⅟a ↔ 0 ≤ a :=
begin
  have : 0 < a * ⅟a, by simp only [mul_inv_of_self, zero_lt_one],
  exact ⟨λ h, (pos_of_mul_pos_left this h).le, λ h, (pos_of_mul_pos_right this h).le⟩
end

@[simp] lemma inv_of_lt_zero [invertible a] : ⅟a < 0 ↔ a < 0 :=
by simp only [← not_le, inv_of_nonneg]

@[simp] lemma inv_of_le_one [invertible a] (h : 1 ≤ a) : ⅟a ≤ 1 :=
by haveI := @linear_order.decidable_le α _; exact
mul_inv_of_self a ▸ le_mul_of_one_le_left (inv_of_nonneg.2 $ zero_le_one.trans h) h


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad

Universal and existential quantifiers. See also init.logic.
-/
import .connectives
open inhabited nonempty

theorem exists_imp_distrib {A : Type} {B : Prop} {P : A → Prop} : ((∃ a : A, P a) → B) ↔ (∀ a : A, P a → B) :=
iff.intro (λ e x H, e (exists.intro x H)) Exists.rec

theorem forall_iff_not_exists {A : Type} {P : A → Prop} : (¬ ∃ a : A, P a) ↔ ∀ a : A, ¬ P a :=
exists_imp_distrib

theorem not_forall_not_of_exists {A : Type} {p : A → Prop} (H : ∃ x, p x) : ¬ ∀ x, ¬ p x :=
assume H1 : ∀ x, ¬ p x,
  obtain (w : A) (Hw : p w), from H,
  absurd Hw (H1 w)

theorem not_exists_not_of_forall {A : Type} {p : A → Prop} (H2 : ∀ x, p x) : ¬ ∃ x, ¬p x :=
assume H1 : ∃ x, ¬ p x,
  obtain (w : A) (Hw : ¬ p w), from H1,
  absurd (H2 w) Hw

theorem not_forall_of_exists_not {A : Type} {P : A → Prop} (H : ∃ a : A, ¬ P a) : ¬ ∀ a : A, P a :=
assume H', not_exists_not_of_forall H' H

theorem forall_true_iff_true (A : Type) : (∀ x : A, true) ↔ true :=
iff_true_intro (λH, trivial)

theorem forall_p_iff_p (A : Type) [H : inhabited A] (p : Prop) : (∀ x : A, p) ↔ p :=
iff.intro (inhabited.destruct H) (λ Hr x, Hr)

theorem exists_p_iff_p (A : Type) [H : inhabited A] (p : Prop) : (∃ x : A, p) ↔ p :=
iff.intro (Exists.rec (λ x Hp, Hp)) (inhabited.destruct H exists.intro)

theorem forall_and_distribute {A : Type} (φ ψ : A → Prop) :
  (∀ x, φ x ∧ ψ x) ↔ (∀ x, φ x) ∧ (∀ x, ψ x) :=
iff.intro
  (assume H, and.intro (take x, and.left (H x)) (take x, and.right (H x)))
  (assume H x, and.intro (and.left H x) (and.right H x))

theorem exists_or_distribute {A : Type} (φ ψ : A → Prop) :
  (∃ x, φ x ∨ ψ x) ↔ (∃ x, φ x) ∨ (∃ x, ψ x) :=
iff.intro
  (Exists.rec (λ x, or.imp !exists.intro !exists.intro))
  (or.rec (exists_imp_exists (λ x, or.inl))
          (exists_imp_exists (λ x, or.inr)))

section
  open decidable eq.ops

  variables {A : Type} (P : A → Prop) (a : A) [H : decidable (P a)]
  include H

  definition decidable_forall_eq [instance] : decidable (∀ x, x = a → P x) :=
  if pa : P a then inl (λ x heq, eq.substr heq pa)
  else inr (not.mto (λH, H a rfl) pa)

  definition decidable_exists_eq [instance] : decidable (∃ x, x = a ∧ P x) :=
  if pa : P a then inl (exists.intro a (and.intro rfl pa))
  else inr (Exists.rec (λh, and.rec (λheq, eq.substr heq pa)))
end

/- definite description -/

section
  open classical

  noncomputable definition the {A : Type} {p : A → Prop} (H : ∃! x, p x) : A :=
  some (exists_of_exists_unique H)

  theorem the_spec {A : Type} {p : A → Prop} (H : ∃! x, p x) : p (the H) :=
  some_spec (exists_of_exists_unique H)

  theorem eq_the {A : Type} {p : A → Prop} (H : ∃! x, p x) {y : A} (Hy : p y) :
    y = the H :=
  unique_of_exists_unique H Hy (the_spec H)
end


/-
Copyright (c) 2022 Jiale Miao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jiale Miao, Kevin Buzzard, Alexander Bentkamp
-/

import analysis.inner_product_space.pi_L2
import linear_algebra.matrix.block

/-!
# Gram-Schmidt Orthogonalization and Orthonormalization

In this file we introduce Gram-Schmidt Orthogonalization and Orthonormalization.

The Gram-Schmidt process takes a set of vectors as input
and outputs a set of orthogonal vectors which have the same span.

## Main results

- `gram_schmidt` : the Gram-Schmidt process
- `gram_schmidt_orthogonal` :
  `gram_schmidt` produces an orthogonal system of vectors.
- `span_gram_schmidt` :
  `gram_schmidt` preserves span of vectors.
- `gram_schmidt_ne_zero` :
  If the input vectors of `gram_schmidt` are linearly independent,
  then the output vectors are non-zero.
- `gram_schmidt_basis` :
  The basis produced by the Gram-Schmidt process when given a basis as input.
- `gram_schmidt_normed` :
  the normalized `gram_schmidt` (i.e each vector in `gram_schmidt_normed` has unit length.)
- `gram_schmidt_orthornormal` :
  `gram_schmidt_normed` produces an orthornormal system of vectors.
- `gram_schmidt_orthonormal_basis`: orthonormal basis constructed by the Gram-Schmidt process from
  an indexed set of vectors of the right size
-/

open_locale big_operators
open finset submodule finite_dimensional

variables (𝕜 : Type*) {E : Type*} [is_R_or_C 𝕜] [normed_add_comm_group E] [inner_product_space 𝕜 E]
variables {ι : Type*} [linear_order ι] [locally_finite_order_bot ι] [is_well_order ι (<)]

local attribute [instance] is_well_order.to_has_well_founded

local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

/-- The Gram-Schmidt process takes a set of vectors as input
and outputs a set of orthogonal vectors which have the same span. -/
noncomputable def gram_schmidt (f : ι → E) : ι → E
| n := f n - ∑ i : Iio n, orthogonal_projection (𝕜 ∙ gram_schmidt i) (f n)
using_well_founded { dec_tac := `[exact mem_Iio.1 i.2] }

/-- This lemma uses `∑ i in` instead of `∑ i :`.-/
lemma gram_schmidt_def (f : ι → E) (n : ι):
  gram_schmidt 𝕜 f n = f n - ∑ i in Iio n,
    orthogonal_projection (𝕜 ∙ gram_schmidt 𝕜 f i) (f n) :=
by { rw [←sum_attach, attach_eq_univ, gram_schmidt], refl }

lemma gram_schmidt_def' (f : ι → E) (n : ι):
  f n = gram_schmidt 𝕜 f n + ∑ i in Iio n,
    orthogonal_projection (𝕜 ∙ gram_schmidt 𝕜 f i) (f n) :=
by rw [gram_schmidt_def, sub_add_cancel]

lemma gram_schmidt_def'' (f : ι → E) (n : ι):
  f n = gram_schmidt 𝕜 f n
  + ∑ i in Iio n, (⟪gram_schmidt 𝕜 f i, f n⟫ / ‖gram_schmidt 𝕜 f i‖ ^ 2) • gram_schmidt 𝕜 f i :=
begin
  convert gram_schmidt_def' 𝕜 f n,
  ext i,
  rw orthogonal_projection_singleton,
end

@[simp] lemma gram_schmidt_zero {ι : Type*} [linear_order ι] [locally_finite_order ι]
  [order_bot ι] [is_well_order ι (<)] (f : ι → E) : gram_schmidt 𝕜 f ⊥ = f ⊥ :=
by rw [gram_schmidt_def, Iio_eq_Ico, finset.Ico_self, finset.sum_empty, sub_zero]

/-- **Gram-Schmidt Orthogonalisation**:
`gram_schmidt` produces an orthogonal system of vectors. -/
theorem gram_schmidt_orthogonal (f : ι → E) {a b : ι} (h₀ : a ≠ b) :
  ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0 :=
begin
  suffices : ∀ a b : ι, a < b → ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0,
  { cases h₀.lt_or_lt with ha hb,
    { exact this _ _ ha, },
    { rw inner_eq_zero_symm,
      exact this _ _ hb, }, },
  clear h₀ a b,
  intros a b h₀,
  revert a,
  apply well_founded.induction (@is_well_founded.wf ι (<) _) b,
  intros b ih a h₀,
  simp only [gram_schmidt_def 𝕜 f b, inner_sub_right, inner_sum,
    orthogonal_projection_singleton, inner_smul_right],
  rw finset.sum_eq_single_of_mem a (finset.mem_Iio.mpr h₀),
  { by_cases h : gram_schmidt 𝕜 f a = 0,
    { simp only [h, inner_zero_left, zero_div, zero_mul, sub_zero], },
    { rw [← inner_self_eq_norm_sq_to_K, div_mul_cancel, sub_self],
      rwa [inner_self_ne_zero], }, },
  simp_intros i hi hia only [finset.mem_range],
  simp only [mul_eq_zero, div_eq_zero_iff, inner_self_eq_zero],
  right,
  cases hia.lt_or_lt with hia₁ hia₂,
  { rw inner_eq_zero_symm,
    exact ih a h₀ i hia₁ },
  { exact ih i (mem_Iio.1 hi) a hia₂ }
end

/-- This is another version of `gram_schmidt_orthogonal` using `pairwise` instead. -/
theorem gram_schmidt_pairwise_orthogonal (f : ι → E) :
  pairwise (λ a b, ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0) :=
λ a b, gram_schmidt_orthogonal 𝕜 f

lemma gram_schmidt_inv_triangular (v : ι → E) {i j : ι} (hij : i < j) :
  ⟪gram_schmidt 𝕜 v j, v i⟫ = 0 :=
begin
  rw gram_schmidt_def'' 𝕜 v,
  simp only [inner_add_right, inner_sum, inner_smul_right],
  set b : ι → E := gram_schmidt 𝕜 v,
  convert zero_add (0:𝕜),
  { exact gram_schmidt_orthogonal 𝕜 v hij.ne' },
  apply finset.sum_eq_zero,
  rintros k hki',
  have hki : k < i := by simpa using hki',
  have : ⟪b j, b k⟫ = 0 := gram_schmidt_orthogonal 𝕜 v (hki.trans hij).ne',
  simp [this],
end

open submodule set order

lemma mem_span_gram_schmidt (f : ι → E) {i j : ι} (hij : i ≤ j) :
  f i ∈ span 𝕜 (gram_schmidt 𝕜 f '' Iic j) :=
begin
  rw [gram_schmidt_def' 𝕜 f i],
  simp_rw orthogonal_projection_singleton,
  exact submodule.add_mem _ (subset_span $ mem_image_of_mem _ hij)
    (submodule.sum_mem _ $ λ k hk, smul_mem (span 𝕜 (gram_schmidt 𝕜 f '' Iic j)) _ $
    subset_span $ mem_image_of_mem (gram_schmidt 𝕜 f) $ (finset.mem_Iio.1 hk).le.trans hij),
end

lemma gram_schmidt_mem_span (f : ι → E) :
  ∀ {j i}, i ≤ j → gram_schmidt 𝕜 f i ∈ span 𝕜 (f '' Iic j)
| j := λ i hij,
begin
  rw [gram_schmidt_def 𝕜 f i],
  simp_rw orthogonal_projection_singleton,
  refine submodule.sub_mem _ (subset_span (mem_image_of_mem _ hij))
    (submodule.sum_mem _ $ λ k hk, _),
  let hkj : k < j := (finset.mem_Iio.1 hk).trans_le hij,
  exact smul_mem _ _ (span_mono (image_subset f $ Iic_subset_Iic.2 hkj.le) $
    gram_schmidt_mem_span le_rfl),
end
using_well_founded { dec_tac := `[assumption] }

lemma span_gram_schmidt_Iic (f : ι → E) (c : ι) :
  span 𝕜 (gram_schmidt 𝕜 f '' Iic c) = span 𝕜 (f '' Iic c) :=
span_eq_span (set.image_subset_iff.2 $ λ i, gram_schmidt_mem_span _ _) $
  set.image_subset_iff.2 $ λ i, mem_span_gram_schmidt _ _

lemma span_gram_schmidt_Iio (f : ι → E) (c : ι) :
  span 𝕜 (gram_schmidt 𝕜 f '' Iio c) = span 𝕜 (f '' Iio c) :=
span_eq_span
  (set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ Iic_subset_Iio.2 hi) $
    gram_schmidt_mem_span _ _ le_rfl) $
  set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ Iic_subset_Iio.2 hi) $
    mem_span_gram_schmidt _ _ le_rfl

/-- `gram_schmidt` preserves span of vectors. -/
lemma span_gram_schmidt (f : ι → E) : span 𝕜 (range (gram_schmidt 𝕜 f)) = span 𝕜 (range f) :=
span_eq_span (range_subset_iff.2 $ λ i, span_mono (image_subset_range _ _) $
  gram_schmidt_mem_span _ _ le_rfl) $
  range_subset_iff.2 $ λ i, span_mono (image_subset_range _ _) $ mem_span_gram_schmidt _ _ le_rfl

lemma gram_schmidt_of_orthogonal {f : ι → E} (hf : pairwise (λ i j, ⟪f i, f j⟫ = 0)) :
  gram_schmidt 𝕜 f = f :=
begin
  ext i,
  rw gram_schmidt_def,
  transitivity f i - 0,
  { congr,
    apply finset.sum_eq_zero,
    intros j hj,
    rw coe_eq_zero,
    suffices : span 𝕜 (f '' set.Iic j) ≤ (𝕜 ∙ f i)ᗮ,
    { apply orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero,
      rw mem_orthogonal_singleton_iff_inner_left,
      rw ←mem_orthogonal_singleton_iff_inner_right,
      exact this (gram_schmidt_mem_span 𝕜 f (le_refl j)) },
    rw span_le,
    rintros - ⟨k, hk, rfl⟩,
    rw [set_like.mem_coe, mem_orthogonal_singleton_iff_inner_left],
    apply hf,
    refine (lt_of_le_of_lt hk _).ne,
    simpa using hj },
  { simp },
end

variables {𝕜}

lemma gram_schmidt_ne_zero_coe
    {f : ι → E} (n : ι) (h₀ : linear_independent 𝕜 (f ∘ (coe : set.Iic n → ι))) :
  gram_schmidt 𝕜 f n ≠ 0 :=
begin
  by_contra h,
  have h₁ : f n ∈ span 𝕜 (f '' Iio n),
  { rw [← span_gram_schmidt_Iio 𝕜 f n, gram_schmidt_def' _ f, h, zero_add],
    apply submodule.sum_mem _ _,
    simp_intros a ha only [finset.mem_Ico],
    simp only [set.mem_image, set.mem_Iio, orthogonal_projection_singleton],
    apply submodule.smul_mem _ _ _,
    rw finset.mem_Iio at ha,
    refine subset_span ⟨a, ha, by refl⟩ },
  have h₂ : (f ∘ (coe : set.Iic n → ι)) ⟨n, le_refl n⟩
    ∈ span 𝕜 (f ∘ (coe : set.Iic n → ι) '' Iio ⟨n, le_refl n⟩),
  { rw [image_comp],
    convert h₁ using 3,
    ext i,
    simpa using @le_of_lt _ _ i n },
  apply linear_independent.not_mem_span_image h₀ _ h₂,
  simp only [set.mem_Iio, lt_self_iff_false, not_false_iff]
end

/-- If the input vectors of `gram_schmidt` are linearly independent,
then the output vectors are non-zero. -/
lemma gram_schmidt_ne_zero {f : ι → E} (n : ι) (h₀ : linear_independent 𝕜 f) :
  gram_schmidt 𝕜 f n ≠ 0 :=
gram_schmidt_ne_zero_coe _ (linear_independent.comp h₀ _ subtype.coe_injective)

/-- `gram_schmidt` produces a triangular matrix of vectors when given a basis. -/
lemma gram_schmidt_triangular {i j : ι} (hij : i < j) (b : basis ι 𝕜 E) :
  b.repr (gram_schmidt 𝕜 b i) j = 0 :=
begin
  have : gram_schmidt 𝕜 b i ∈ span 𝕜 (gram_schmidt 𝕜 b '' set.Iio j),
    from subset_span ((set.mem_image _ _ _).2 ⟨i, hij, rfl⟩),
  have : gram_schmidt 𝕜 b i ∈ span 𝕜 (b '' set.Iio j),
    by rwa [← span_gram_schmidt_Iio 𝕜 b j],
  have : ↑(((b.repr) (gram_schmidt 𝕜 b i)).support) ⊆ set.Iio j,
    from basis.repr_support_subset_of_mem_span b (set.Iio j) this,
  exact (finsupp.mem_supported' _ _).1
    ((finsupp.mem_supported 𝕜 _).2 this) j set.not_mem_Iio_self,
end

/-- `gram_schmidt` produces linearly independent vectors when given linearly independent vectors. -/
lemma gram_schmidt_linear_independent {f : ι → E} (h₀ : linear_independent 𝕜 f) :
  linear_independent 𝕜 (gram_schmidt 𝕜 f) :=
linear_independent_of_ne_zero_of_inner_eq_zero
    (λ i, gram_schmidt_ne_zero _ h₀) (λ i j, gram_schmidt_orthogonal 𝕜 f)

/-- When given a basis, `gram_schmidt` produces a basis. -/
noncomputable def gram_schmidt_basis (b : basis ι 𝕜 E) : basis ι 𝕜 E :=
basis.mk
  (gram_schmidt_linear_independent b.linear_independent)
  ((span_gram_schmidt 𝕜 b).trans b.span_eq).ge

lemma coe_gram_schmidt_basis (b : basis ι 𝕜 E) :
  (gram_schmidt_basis b : ι → E) = gram_schmidt 𝕜 b := basis.coe_mk _ _

variables (𝕜)

/-- the normalized `gram_schmidt`
(i.e each vector in `gram_schmidt_normed` has unit length.) -/
noncomputable def gram_schmidt_normed (f : ι → E) (n : ι) : E :=
(‖gram_schmidt 𝕜 f n‖ : 𝕜)⁻¹ • (gram_schmidt 𝕜 f n)

variables {𝕜}

lemma gram_schmidt_normed_unit_length_coe
    {f : ι → E} (n : ι) (h₀ : linear_independent 𝕜 (f ∘ (coe : set.Iic n → ι))) :
  ‖gram_schmidt_normed 𝕜 f n‖ = 1 :=
by simp only [gram_schmidt_ne_zero_coe n h₀,
  gram_schmidt_normed, norm_smul_inv_norm, ne.def, not_false_iff]

lemma gram_schmidt_normed_unit_length {f : ι → E} (n : ι) (h₀ : linear_independent 𝕜 f) :
  ‖gram_schmidt_normed 𝕜 f n‖ = 1 :=
gram_schmidt_normed_unit_length_coe _ (linear_independent.comp h₀ _ subtype.coe_injective)

lemma gram_schmidt_normed_unit_length' {f : ι → E} {n : ι} (hn : gram_schmidt_normed 𝕜 f n ≠ 0) :
  ‖gram_schmidt_normed 𝕜 f n‖ = 1 :=
begin
  rw gram_schmidt_normed at *,
  rw [norm_smul_inv_norm],
  simpa using hn,
end

/-- **Gram-Schmidt Orthonormalization**:
`gram_schmidt_normed` applied to a linearly independent set of vectors produces an orthornormal
system of vectors. -/
theorem gram_schmidt_orthonormal {f : ι → E} (h₀ : linear_independent 𝕜 f) :
  orthonormal 𝕜 (gram_schmidt_normed 𝕜 f) :=
begin
  unfold orthonormal,
  split,
  { simp only [gram_schmidt_normed_unit_length, h₀, eq_self_iff_true, implies_true_iff], },
  { intros i j hij,
    simp only [gram_schmidt_normed, inner_smul_left, inner_smul_right, is_R_or_C.conj_inv,
      is_R_or_C.conj_of_real, mul_eq_zero, inv_eq_zero, is_R_or_C.of_real_eq_zero, norm_eq_zero],
    repeat { right },
    exact gram_schmidt_orthogonal 𝕜 f hij }
end

/-- **Gram-Schmidt Orthonormalization**:
`gram_schmidt_normed` produces an orthornormal system of vectors after removing the vectors which
become zero in the process. -/
lemma gram_schmidt_orthonormal' (f : ι → E) :
  orthonormal 𝕜 (λ i : {i | gram_schmidt_normed 𝕜 f i ≠ 0}, gram_schmidt_normed 𝕜 f i) :=
begin
  refine ⟨λ i, gram_schmidt_normed_unit_length' i.prop, _⟩,
  rintros i j (hij : ¬ _),
  rw subtype.ext_iff at hij,
  simp [gram_schmidt_normed, inner_smul_left, inner_smul_right, gram_schmidt_orthogonal 𝕜 f hij],
end

lemma span_gram_schmidt_normed (f : ι → E) (s : set ι) :
  span 𝕜 (gram_schmidt_normed 𝕜 f '' s) = span 𝕜 (gram_schmidt 𝕜 f '' s) :=
begin
  refine span_eq_span (set.image_subset_iff.2 $ λ i hi, smul_mem _ _ $ subset_span $
    mem_image_of_mem _ hi)
    (set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ singleton_subset_set_iff.2 hi) _),
  simp only [coe_singleton, set.image_singleton],
  by_cases h : gram_schmidt 𝕜 f i = 0,
  { simp [h] },
  { refine mem_span_singleton.2 ⟨‖gram_schmidt 𝕜 f i‖, smul_inv_smul₀ _ _⟩,
    exact_mod_cast (norm_ne_zero_iff.2 h) }
end

lemma span_gram_schmidt_normed_range (f : ι → E) :
  span 𝕜 (range (gram_schmidt_normed 𝕜 f)) = span 𝕜 (range (gram_schmidt 𝕜 f)) :=
by simpa only [image_univ.symm] using span_gram_schmidt_normed f univ

section orthonormal_basis
variables [fintype ι] [finite_dimensional 𝕜 E] (h : finrank 𝕜 E = fintype.card ι) (f : ι → E)
include h

/-- Given an indexed family `f : ι → E` of vectors in an inner product space `E`, for which the
size of the index set is the dimension of `E`, produce an orthonormal basis for `E` which agrees
with the orthonormal set produced by the Gram-Schmidt orthonormalization process on the elements of
`ι` for which this process gives a nonzero number. -/
noncomputable def gram_schmidt_orthonormal_basis : orthonormal_basis ι 𝕜 E :=
((gram_schmidt_orthonormal' f).exists_orthonormal_basis_extension_of_card_eq h).some

lemma gram_schmidt_orthonormal_basis_apply {f : ι → E} {i : ι}
  (hi : gram_schmidt_normed 𝕜 f i ≠ 0) :
  gram_schmidt_orthonormal_basis h f i = gram_schmidt_normed 𝕜 f i :=
((gram_schmidt_orthonormal' f).exists_orthonormal_basis_extension_of_card_eq h).some_spec i hi

lemma gram_schmidt_orthonormal_basis_apply_of_orthogonal {f : ι → E}
  (hf : pairwise (λ i j, ⟪f i, f j⟫ = 0)) {i : ι} (hi : f i ≠ 0) :
  gram_schmidt_orthonormal_basis h f i = (‖f i‖⁻¹ : 𝕜) • f i :=
begin
  have H : gram_schmidt_normed 𝕜 f i = (‖f i‖⁻¹ : 𝕜) • f i,
  { rw [gram_schmidt_normed, gram_schmidt_of_orthogonal 𝕜 hf] },
  rw [gram_schmidt_orthonormal_basis_apply h, H],
  simpa [H] using hi,
end

lemma inner_gram_schmidt_orthonormal_basis_eq_zero {f : ι → E} {i : ι}
  (hi : gram_schmidt_normed 𝕜 f i = 0) (j : ι) :
  ⟪gram_schmidt_orthonormal_basis h f i, f j⟫ = 0 :=
begin
  rw ←mem_orthogonal_singleton_iff_inner_right,
  suffices : span 𝕜 (gram_schmidt_normed 𝕜 f '' Iic j)
    ≤ (𝕜 ∙ gram_schmidt_orthonormal_basis h f i)ᗮ,
  { apply this,
    rw span_gram_schmidt_normed,
    simpa using mem_span_gram_schmidt 𝕜 f (le_refl j) },
  rw span_le,
  rintros - ⟨k, -, rfl⟩,
  rw [set_like.mem_coe, mem_orthogonal_singleton_iff_inner_left],
  by_cases hk : gram_schmidt_normed 𝕜 f k = 0,
  { simp [hk] },
  rw ← gram_schmidt_orthonormal_basis_apply h hk,
  have : k ≠ i,
  { rintros rfl,
    exact hk hi },
  exact (gram_schmidt_orthonormal_basis h f).orthonormal.2 this,
end

lemma gram_schmidt_orthonormal_basis_inv_triangular {i j : ι} (hij : i < j) :
  ⟪gram_schmidt_orthonormal_basis h f j, f i⟫ = 0 :=
begin
  by_cases hi : gram_schmidt_normed 𝕜 f j = 0,
  { rw inner_gram_schmidt_orthonormal_basis_eq_zero h hi },
  { simp [gram_schmidt_orthonormal_basis_apply h hi, gram_schmidt_normed, inner_smul_left,
      gram_schmidt_inv_triangular 𝕜 f hij] }
end

lemma gram_schmidt_orthonormal_basis_inv_triangular' {i j : ι} (hij : i < j) :
  (gram_schmidt_orthonormal_basis h f).repr (f i) j = 0 :=
by simpa [orthonormal_basis.repr_apply_apply]
  using gram_schmidt_orthonormal_basis_inv_triangular h f hij

/-- Given an indexed family `f : ι → E` of vectors in an inner product space `E`, for which the
size of the index set is the dimension of `E`, the matrix of coefficients of `f` with respect to the
orthonormal basis `gram_schmidt_orthonormal_basis` constructed from `f` is upper-triangular. -/
lemma gram_schmidt_orthonormal_basis_inv_block_triangular :
  ((gram_schmidt_orthonormal_basis h f).to_basis.to_matrix f).block_triangular id :=
λ i j, gram_schmidt_orthonormal_basis_inv_triangular' h f

lemma gram_schmidt_orthonormal_basis_det :
  (gram_schmidt_orthonormal_basis h f).to_basis.det f =
    ∏ i, ⟪gram_schmidt_orthonormal_basis h f i, f i⟫ :=
begin
  convert matrix.det_of_upper_triangular (gram_schmidt_orthonormal_basis_inv_block_triangular h f),
  ext i,
  exact ((gram_schmidt_orthonormal_basis h f).repr_apply_apply (f i) i).symm,
end

end orthonormal_basis


/-
Copyright (c) 2022 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.inner_product_space.projection
import analysis.normed_space.lp_space

/-!
# Hilbert sum of a family of inner product spaces

Given a family `(G : ι → Type*) [Π i, inner_product_space 𝕜 (G i)]` of inner product spaces, this
file equips `lp G 2` with an inner product space structure, where `lp G 2` consists of those
dependent functions `f : Π i, G i` for which `∑' i, ∥f i∥ ^ 2`, the sum of the norms-squared, is
summable.  This construction is sometimes called the *Hilbert sum* of the family `G`.  By choosing
`G` to be `ι → 𝕜`, the Hilbert space `ℓ²(ι, 𝕜)` may be seen as a special case of this construction.

## Main definitions

* `orthogonal_family.linear_isometry`: Given a Hilbert space `E`, a family `G` of inner product
  spaces and a family `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E` with
  mutually-orthogonal images, there is an induced isometric embedding of the Hilbert sum of `G`
  into `E`.

* `orthogonal_family.linear_isometry_equiv`: Given a Hilbert space `E`, a family `G` of inner
  product spaces and a family `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E`
  with mutually-orthogonal images whose span is dense in `E`, there is an induced isometric
  isomorphism of the Hilbert sum of `G` with `E`.

* `hilbert_basis`: We define a *Hilbert basis* of a Hilbert space `E` to be a structure whose single
  field `hilbert_basis.repr` is an isometric isomorphism of `E` with `ℓ²(ι, 𝕜)` (i.e., the Hilbert
  sum of `ι` copies of `𝕜`).  This parallels the definition of `basis`, in `linear_algebra.basis`,
  as an isomorphism of an `R`-module with `ι →₀ R`.

* `hilbert_basis.has_coe_to_fun`: More conventionally a Hilbert basis is thought of as a family
  `ι → E` of vectors in `E` satisfying certain properties (orthonormality, completeness).  We obtain
  this interpretation of a Hilbert basis `b` by defining `⇑b`, of type `ι → E`, to be the image
  under `b.repr` of `lp.single 2 i (1:𝕜)`.  This parallels the definition `basis.has_coe_to_fun` in
  `linear_algebra.basis`.

* `hilbert_basis.mk`: Make a Hilbert basis of `E` from an orthonormal family `v : ι → E` of vectors
  in `E` whose span is dense.  This parallels the definition `basis.mk` in `linear_algebra.basis`.

* `hilbert_basis.mk_of_orthogonal_eq_bot`: Make a Hilbert basis of `E` from an orthonormal family
  `v : ι → E` of vectors in `E` whose span has trivial orthogonal complement.

## Main results

* `lp.inner_product_space`: Construction of the inner product space instance on the Hilbert sum
  `lp G 2`.  Note that from the file `analysis.normed_space.lp_space`, the space `lp G 2` already
  held a normed space instance (`lp.normed_space`), and if each `G i` is a Hilbert space (i.e.,
  complete), then `lp G 2` was already known to be complete (`lp.complete_space`).  So the work
  here is to define the inner product and show it is compatible.

* `orthogonal_family.range_linear_isometry`: Given a family `G` of inner product spaces and a family
  `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E` with mutually-orthogonal
  images, the image of the embedding `orthogonal_family.linear_isometry` of the Hilbert sum of `G`
  into `E` is the closure of the span of the images of the `G i`.

* `hilbert_basis.repr_apply_apply`: Given a Hilbert basis `b` of `E`, the entry `b.repr x i` of
  `x`'s representation in `ℓ²(ι, 𝕜)` is the inner product `⟪b i, x⟫`.

* `hilbert_basis.has_sum_repr`: Given a Hilbert basis `b` of `E`, a vector `x` in `E` can be
  expressed as the "infinite linear combination" `∑' i, b.repr x i • b i` of the basis vectors
  `b i`, with coefficients given by the entries `b.repr x i` of `x`'s representation in `ℓ²(ι, 𝕜)`.

* `exists_hilbert_basis`: A Hilbert space admits a Hilbert basis.

## Keywords

Hilbert space, Hilbert sum, l2, Hilbert basis, unitary equivalence, isometric isomorphism
-/

open is_R_or_C submodule filter
open_locale big_operators nnreal ennreal classical complex_conjugate

noncomputable theory

variables {ι : Type*}
variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [inner_product_space 𝕜 E] [cplt : complete_space E]
variables {G : ι → Type*} [Π i, inner_product_space 𝕜 (G i)]
local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

notation `ℓ²(` ι `,` 𝕜 `)` := lp (λ i : ι, 𝕜) 2

/-! ### Inner product space structure on `lp G 2` -/

namespace lp

lemma summable_inner (f g : lp G 2) : summable (λ i, ⟪f i, g i⟫) :=
begin
  -- Apply the Direct Comparison Test, comparing with ∑' i, ∥f i∥ * ∥g i∥ (summable by Hölder)
  refine summable_of_norm_bounded (λ i, ∥f i∥ * ∥g i∥) (lp.summable_mul _ f g) _,
  { rw real.is_conjugate_exponent_iff; norm_num },
  intros i,
  -- Then apply Cauchy-Schwarz pointwise
  exact norm_inner_le_norm _ _,
end

instance : inner_product_space 𝕜 (lp G 2) :=
{ inner := λ f g, ∑' i, ⟪f i, g i⟫,
  norm_sq_eq_inner := λ f, begin
    calc ∥f∥ ^ 2 = ∥f∥ ^ (2:ℝ≥0∞).to_real : by norm_cast
    ... = ∑' i, ∥f i∥ ^ (2:ℝ≥0∞).to_real : lp.norm_rpow_eq_tsum _ f
    ... = ∑' i, ∥f i∥ ^ 2 : by norm_cast
    ... = ∑' i, re ⟪f i, f i⟫ : by simp only [norm_sq_eq_inner]
    ... = re (∑' i, ⟪f i, f i⟫) : (is_R_or_C.re_clm.map_tsum _).symm
    ... = _ : by congr,
    { norm_num },
    { exact summable_inner f f },
  end,
  conj_sym := λ f g, begin
    calc conj _ = conj ∑' i, ⟪g i, f i⟫ : by congr
    ... = ∑' i, conj ⟪g i, f i⟫ : is_R_or_C.conj_cle.map_tsum
    ... = ∑' i, ⟪f i, g i⟫ : by simp only [inner_conj_sym]
    ... = _ : by congr,
  end,
  add_left := λ f₁ f₂ g, begin
    calc _ = ∑' i, ⟪(f₁ + f₂) i, g i⟫ : _
    ... = ∑' i, (⟪f₁ i, g i⟫ + ⟪f₂ i, g i⟫) :
          by simp only [inner_add_left, pi.add_apply, coe_fn_add]
    ... = (∑' i, ⟪f₁ i, g i⟫) + ∑' i, ⟪f₂ i, g i⟫ : tsum_add _ _
    ... = _ : by congr,
    { congr, },
    { exact summable_inner f₁ g },
    { exact summable_inner f₂ g }
  end,
  smul_left := λ f g c, begin
    calc _ = ∑' i, ⟪c • f i, g i⟫ : _
    ... = ∑' i, conj c * ⟪f i, g i⟫ : by simp only [inner_smul_left]
    ... = conj c * ∑' i, ⟪f i, g i⟫ : tsum_mul_left
    ... = _ : _,
    { simp only [coe_fn_smul, pi.smul_apply] },
    { congr },
  end,
  .. lp.normed_space }

lemma inner_eq_tsum (f g : lp G 2) : ⟪f, g⟫ = ∑' i, ⟪f i, g i⟫ := rfl

lemma has_sum_inner (f g : lp G 2) : has_sum (λ i, ⟪f i, g i⟫) ⟪f, g⟫ :=
(summable_inner f g).has_sum

lemma inner_single_left (i : ι) (a : G i) (f : lp G 2) : ⟪lp.single 2 i a, f⟫ = ⟪a, f i⟫ :=
begin
  refine (has_sum_inner (lp.single 2 i a) f).unique _,
  convert has_sum_ite_eq i ⟪a, f i⟫,
  ext j,
  rw lp.single_apply,
  split_ifs,
  { subst h },
  { simp }
end

lemma inner_single_right (i : ι) (a : G i) (f : lp G 2) : ⟪f, lp.single 2 i a⟫ = ⟪f i, a⟫ :=
by simpa [inner_conj_sym] using congr_arg conj (inner_single_left i a f)

end lp

/-! ### Identification of a general Hilbert space `E` with a Hilbert sum -/

namespace orthogonal_family
variables {V : Π i, G i →ₗᵢ[𝕜] E} (hV : orthogonal_family 𝕜 V)

include cplt hV

protected lemma summable_of_lp (f : lp G 2) : summable (λ i, V i (f i)) :=
begin
  rw hV.summable_iff_norm_sq_summable,
  convert (lp.mem_ℓp f).summable _,
  { norm_cast },
  { norm_num }
end

/-- A mutually orthogonal family of subspaces of `E` induce a linear isometry from `lp 2` of the
subspaces into `E`. -/
protected def linear_isometry : lp G 2 →ₗᵢ[𝕜] E :=
{ to_fun := λ f, ∑' i, V i (f i),
  map_add' := λ f g, by simp only [tsum_add (hV.summable_of_lp f) (hV.summable_of_lp g),
    lp.coe_fn_add, pi.add_apply, linear_isometry.map_add],
  map_smul' := λ c f, by simpa only [linear_isometry.map_smul, pi.smul_apply, lp.coe_fn_smul]
    using tsum_const_smul (hV.summable_of_lp f),
  norm_map' := λ f, begin
    classical, -- needed for lattice instance on `finset ι`, for `filter.at_top_ne_bot`
    have H : 0 < (2:ℝ≥0∞).to_real := by norm_num,
    suffices : ∥∑' (i : ι), V i (f i)∥ ^ ((2:ℝ≥0∞).to_real) = ∥f∥ ^ ((2:ℝ≥0∞).to_real),
    { exact real.rpow_left_inj_on H.ne' (norm_nonneg _) (norm_nonneg _) this },
    refine tendsto_nhds_unique  _ (lp.has_sum_norm H f),
    convert (hV.summable_of_lp f).has_sum.norm.rpow_const (or.inr H.le),
    ext s,
    exact_mod_cast (hV.norm_sum f s).symm,
  end }

protected lemma linear_isometry_apply (f : lp G 2) :
  hV.linear_isometry f = ∑' i, V i (f i) :=
rfl

protected lemma has_sum_linear_isometry (f : lp G 2) :
  has_sum (λ i, V i (f i)) (hV.linear_isometry f) :=
(hV.summable_of_lp f).has_sum

@[simp] protected lemma linear_isometry_apply_single {i : ι} (x : G i) :
  hV.linear_isometry (lp.single 2 i x) = V i x :=
begin
  rw [hV.linear_isometry_apply, ← tsum_ite_eq i (V i x)],
  congr,
  ext j,
  rw [lp.single_apply],
  split_ifs,
  { subst h },
  { simp }
end

@[simp] protected

/-- The canonical linear isometry from the `lp 2` of a mutually orthogonal family of subspaces of
`E` into E, has range the closure of the span of the subspaces. -/
protected lemma range_linear_isometry [Π i, complete_space (G i)] :
  hV.linear_isometry.to_linear_map.range = (⨆ i, (V i).to_linear_map.range).topological_closure :=
begin
  classical,
  refine le_antisymm _ _,
  { rintros x ⟨f, rfl⟩,
    refine mem_closure_of_tendsto (hV.has_sum_linear_isometry f) (eventually_of_forall _),
    intros s,
    refine sum_mem (supr (λ i, (V i).to_linear_map.range)) _,
    intros i hi,
    refine mem_supr_of_mem i _,
    exact linear_map.mem_range_self _ (f i) },
  { apply topological_closure_minimal,
    { refine supr_le _,
      rintros i x ⟨x, rfl⟩,
      use lp.single 2 i x,
      convert hV.linear_isometry_apply_single _ },
    exact hV.linear_isometry.isometry.uniform_inducing.is_complete_range.is_closed }
end

/-- A mutually orthogonal family of complete subspaces of `E`, whose range is dense in `E`, induces
a isometric isomorphism from E to `lp 2` of the subspaces.

Note that this goes in the opposite direction from `orthogonal_family.linear_isometry`. -/
noncomputable def linear_isometry_equiv [Π i, complete_space (G i)]
  (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) :
  E ≃ₗᵢ[𝕜] lp G 2 :=
linear_isometry_equiv.symm $
linear_isometry_equiv.of_surjective
hV.linear_isometry
begin
  refine linear_map.range_eq_top.mp _,
  rw ← hV',
  rw hV.range_linear_isometry,
end

/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an orthogonal family `G`,
a vector `w : lp G 2` is the image of the infinite sum of the associated elements in `E`. -/
protected lemma linear_isometry_equiv_symm_apply [Π i, complete_space (G i)]
  (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) (w : lp G 2) :
  (hV.linear_isometry_equiv hV').symm w = ∑' i, V i (w i) :=
by simp [orthogonal_family.linear_isometry_equiv, orthogonal_family.linear_isometry_apply]

/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an orthogonal family `G`,
a vector `w : lp G 2` is the image of the infinite sum of the associated elements in `E`, and this
sum indeed converges. -/
protected lemma has_sum_linear_isometry_equiv_symm [Π i, complete_space (G i)]
  (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) (w : lp G 2) :
  has_sum (λ i, V i (w i)) ((hV.linear_isometry_equiv hV').symm w) :=
by simp [orthogonal_family.linear_isometry_equiv, orthogonal_family.has_sum_linear_isometry]

/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an `ι`-indexed orthogonal
family `G`, an "elementary basis vector" in `lp G 2` supported at `i : ι` is the image of the
associated element in `E`. -/
@[simp] protected lemma linear_isometry_equiv_symm_apply_single [Π i, complete_space (G i)]
  (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) {i : ι} (x : G i) :
  (hV.linear_isometry_equiv hV').symm (lp.single 2 i x) = V i x :=
by simp [orthogonal_family.linear_isometry_equiv, orthogonal_family.linear_isometry_apply_single]

/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an `ι`-indexed orthogonal
family `G`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of
elements of `E`. -/
@[simp] protected lemma linear_isometry_equiv_symm_apply_dfinsupp_sum_single
  [Π i, complete_space (G i)]
  (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) (W₀ : Π₀ (i : ι), G i) :
  (hV.linear_isometry_equiv hV').symm (W₀.sum (lp.single 2)) = (W₀.sum (λ i, V i)) :=
by simp [orthogonal_family.linear_isometry_equiv,
  orthogonal_family.linear_isometry_apply_dfinsupp_sum_single]

/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an `ι`-indexed orthogonal
family `G`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of
elements of `E`. -/
@[simp] protected lemma linear_isometry_equiv_apply_dfinsupp_sum_single
  [Π i, complete_space (G i)]
  (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) (W₀ : Π₀ (i : ι), G i) :
  (hV.linear_isometry_equiv hV' (W₀.sum (λ i, V i)) : Π i, G i) = W₀ :=
begin
  rw ← hV.linear_isometry_equiv_symm_apply_dfinsupp_sum_single hV',
  rw linear_isometry_equiv.apply_symm_apply,
  ext i,
  simp [dfinsupp.sum, lp.single_apply] {contextual := tt},
end

end orthogonal_family

/-! ### Hilbert bases -/

section
variables (ι) (𝕜) (E)

/-- A Hilbert basis on `ι` for an inner product space `E` is an identification of `E` with the `lp`
space `ℓ²(ι, 𝕜)`. -/
structure hilbert_basis := of_repr :: (repr : E ≃ₗᵢ[𝕜] ℓ²(ι, 𝕜))

end

namespace hilbert_basis

instance {ι : Type*} : inhabited (hilbert_basis ι 𝕜 ℓ²(ι, 𝕜)) :=
⟨of_repr (linear_isometry_equiv.refl 𝕜 _)⟩

/-- `b i` is the `i`th basis vector. -/
instance : has_coe_to_fun (hilbert_basis ι 𝕜 E) (λ _, ι → E) :=
{ coe := λ b i, b.repr.symm (lp.single 2 i (1:𝕜)) }

@[simp] protected lemma repr_symm_single (b : hilbert_basis ι 𝕜 E) (i : ι) :
  b.repr.symm (lp.single 2 i (1:𝕜)) = b i :=
rfl

@[simp] protected lemma repr_self (b : hilbert_basis ι 𝕜 E) (i : ι) :
  b.repr (b i) = lp.single 2 i (1:𝕜) :=
by rw [← b.repr_symm_single, linear_isometry_equiv.apply_symm_apply]

protected lemma repr_apply_apply (b : hilbert_basis ι 𝕜 E) (v : E) (i : ι) :
  b.repr v i = ⟪b i, v⟫ :=
begin
  rw [← b.repr.inner_map_map (b i) v, b.repr_self, lp.inner_single_left],
  simp,
end

@[simp] protected lemma orthonormal (b : hilbert_basis ι 𝕜 E) : orthonormal 𝕜 b :=
begin
  rw orthonormal_iff_ite,
  intros i j,
  rw [← b.repr.inner_map_map (b i) (b j), b.repr_self, b.repr_self, lp.inner_single_left,
    lp.single_apply],
  simp,
end

protected lemma has_sum_repr_symm (b : hilbert_basis ι 𝕜 E) (f : ℓ²(ι, 𝕜)) :
  has_sum (λ i, f i • b i) (b.repr.symm f) :=
begin
  suffices H : (λ (i : ι), f i • b i) =
    (λ (b_1 : ι), (b.repr.symm.to_continuous_linear_equiv) ((λ (i : ι), lp.single 2 i (f i)) b_1)),
  { rw H,
    have : has_sum (λ (i : ι), lp.single 2 i (f i)) f := lp.has_sum_single ennreal.two_ne_top f,
    exact (↑(b.repr.symm.to_continuous_linear_equiv) : ℓ²(ι, 𝕜) →L[𝕜] E).has_sum this },
  ext i,
  apply b.repr.injective,
  have : lp.single 2 i (f i * 1) = f i • lp.single 2 i 1 := lp.single_smul 2 i (1:𝕜) (f i),
  rw mul_one at this,
  rw [linear_isometry_equiv.map_smul, b.repr_self, ← this,
    linear_isometry_equiv.coe_to_continuous_linear_equiv],
  exact (b.repr.apply_symm_apply (lp.single 2 i (f i))).symm,
end

protected lemma has_sum_repr (b : hilbert_basis ι 𝕜 E) (x : E) :
  has_sum (λ i, b.repr x i • b i) x :=
by simpa using b.has_sum_repr_symm (b.repr x)

@[simp] protected lemma dense_span (b : hilbert_basis ι 𝕜 E) :
  (span 𝕜 (set.range b)).topological_closure = ⊤ :=
begin
  classical,
  rw eq_top_iff,
  rintros x -,
  refine mem_closure_of_tendsto (b.has_sum_repr x) (eventually_of_forall _),
  intros s,
  simp only [set_like.mem_coe],
  refine sum_mem _ _,
  rintros i -,
  refine smul_mem _ _ _,
  exact subset_span ⟨i, rfl⟩
end

variables {v : ι → E} (hv : orthonormal 𝕜 v)
include hv cplt

/-- An orthonormal family of vectors whose span is dense in the whole module is a Hilbert basis. -/
protected def mk (hsp : (span 𝕜 (set.range v)).topological_closure = ⊤) :
  hilbert_basis ι 𝕜 E :=
hilbert_basis.of_repr $
hv.orthogonal_family.linear_isometry_equiv
begin
  convert hsp,
  simp [← linear_map.span_singleton_eq_range, ← submodule.span_Union],
end

@[simp] protected lemma coe_mk (hsp : (span 𝕜 (set.range v)).topological_closure = ⊤) :
  ⇑(hilbert_basis.mk hv hsp) = v :=
begin
  ext i,
  show (hilbert_basis.mk hv hsp).repr.symm _ = v i,
  simp [hilbert_basis.mk]
end

/-- An orthonormal family of vectors whose span has trivial orthogonal complement is a Hilbert
basis. -/
protected def mk_of_orthogonal_eq_bot (hsp : (span 𝕜 (set.range v))ᗮ = ⊥) : hilbert_basis ι 𝕜 E :=
hilbert_basis.mk hv
(by rw [← orthogonal_orthogonal_eq_closure, orthogonal_eq_top_iff, hsp])

@[simp] protected lemma coe_of_orthogonal_eq_bot_mk (hsp : (span 𝕜 (set.range v))ᗮ = ⊥) :
  ⇑(hilbert_basis.mk_of_orthogonal_eq_bot hv hsp) = v :=
hilbert_basis.coe_mk hv _

omit hv

/-- A Hilbert space admits a Hilbert basis extending a given orthonormal subset. -/
lemma _root_.orthonormal.exists_hilbert_basis_extension
  {s : set E} (hs : orthonormal 𝕜 (coe : s → E)) :
  ∃ (w : set E) (b : hilbert_basis w 𝕜 E), s ⊆ w ∧ ⇑b = (coe : w → E) :=
let ⟨w, hws, hw_ortho, hw_max⟩ := exists_maximal_orthonormal hs in
⟨ w,
  hilbert_basis.mk_of_orthogonal_eq_bot hw_ortho
    (by simpa [maximal_orthonormal_iff_orthogonal_complement_eq_bot hw_ortho] using hw_max),
  hws,
  hilbert_basis.coe_of_orthogonal_eq_bot_mk _ _ ⟩

variables (𝕜 E)

/-- A Hilbert space admits a Hilbert basis. -/
lemma _root_.exists_hilbert_basis :
  ∃ (w : set E) (b : hilbert_basis w 𝕜 E), ⇑b = (coe : w → E) :=
let ⟨w, hw, hw', hw''⟩ := (orthonormal_empty 𝕜 E).exists_hilbert_basis_extension in ⟨w, hw, hw''⟩

end hilbert_basis