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

import algebra.algebra.basic

/-!
# Trivial Square-Zero Extension

Given a module `M` over a ring `R`, the trivial square-zero extension of `M` over `R` is defined
to be the `R`-algebra `R ⊕ M` with multiplication given by
`(r₁ + m₁) * (r₂ + m₂) = r₁ r₂ + r₁ m₂ + r₂ m₁`.

It is a square-zero extension because `M^2 = 0`.
-/

universes u v w

/--
"Trivial Square-Zero Extension".

Given a module `M` over a ring `R`, the trivial square-zero extension of `M` over `R` is defined
to be the `R`-algebra `R × M` with multiplication given by
`(r₁ + m₁) * (r₂ + m₂) = r₁ r₂ + r₁ m₂ + r₂ m₁`.

It is a square-zero extension because `M^2 = 0`.
-/
@[nolint has_inhabited_instance] def triv_sq_zero_ext (R : Type u) (M : Type v) :=
R × M

local notation `tsze` := triv_sq_zero_ext

namespace triv_sq_zero_ext

section basic
variables {R : Type u} {M : Type v}

/-- The canonical inclusion `R → triv_sq_zero_ext R M`. -/
def inl [has_zero M] (r : R) : tsze R M :=
(r, 0)

/-- The canonical inclusion `M → triv_sq_zero_ext R M`. -/
def inr [has_zero R] (m : M) : tsze R M :=
(0, m)

/-- The canonical projection `triv_sq_zero_ext R M → R`. -/
def fst (x : tsze R M) : R :=
x.1

/-- The canonical projection `triv_sq_zero_ext R M → M`. -/
def snd (x : tsze R M) : M :=
x.2

@[ext] lemma ext {x y : tsze R M} (h1 : x.fst = y.fst) (h2 : x.snd = y.snd) : x = y :=
prod.ext h1 h2

@[simp] lemma fst_inl [has_zero M] (r : R) : (inl r : tsze R M).fst = r := rfl
@[simp] lemma snd_inl [has_zero M] (r : R) : (inl r : tsze R M).snd = 0 := rfl
@[simp] lemma fst_inr [has_zero R] (m : M) : (inr m : tsze R M).fst = 0 := rfl
@[simp]

lemma inl_injective [has_zero M] : function.injective (inl : R → tsze R M) :=
function.left_inverse.injective fst_inl

lemma inr_injective [has_zero R] : function.injective (inr : M → tsze R M) :=
function.left_inverse.injective snd_inr

end basic

section add
variables (R : Type u) (M : Type v)

instance [has_zero R] [has_zero M] : has_zero (tsze R M) :=
prod.has_zero

@[simp] lemma fst_zero [has_zero R] [has_zero M] : (0 : tsze R M).fst = 0 := rfl
@[simp] lemma snd_zero [has_zero R] [has_zero M] : (0 : tsze R M).snd = 0 := rfl
@[simp] lemma inl_zero [has_zero R] [has_zero M] : (inl 0 : tsze R M) = 0 := rfl
@[simp] lemma inr_zero [has_zero R] [has_zero M] : (inr 0 : tsze R M) = 0 := rfl

instance [has_add R] [has_add M] : has_add (tsze R M) :=
prod.has_add

@[simp] lemma fst_add [has_add R] [has_add M] (x₁ x₂ : tsze R M) :
  (x₁ + x₂).fst = x₁.fst + x₂.fst := rfl
@[simp] lemma snd_add [has_add R] [has_add M] (x₁ x₂ : tsze R M) :
  (x₁ + x₂).snd = x₁.snd + x₂.snd := rfl

instance [has_neg R] [has_neg M] : has_neg (tsze R M) :=
prod.has_neg

@[simp] lemma fst_neg [has_neg R] [has_neg M] (x : tsze R M) : (-x).fst = -x.fst := rfl
@[simp] lemma snd_neg [has_neg R] [has_neg M] (x : tsze R M) : (-x).snd = -x.snd := rfl

instance [add_semigroup R] [add_semigroup M] : add_semigroup (tsze R M) :=
prod.add_semigroup

instance [add_monoid R] [add_monoid M] : add_monoid (tsze R M) :=
prod.add_monoid

@[simp] lemma inl_add [has_add R] [add_monoid M] (r₁ r₂ : R) :
  (inl (r₁ + r₂) : tsze R M) = inl r₁ + inl r₂ :=
ext rfl (add_zero 0).symm

@[simp] lemma inr_add [add_monoid R] [has_add M] (m₁ m₂ : M) :
  (inr (m₁ + m₂) : tsze R M) = inr m₁ + inr m₂ :=
ext (add_zero 0).symm rfl

lemma inl_fst_add_inr_snd_eq [add_monoid R] [add_monoid M] (x : tsze R M) :
  inl x.fst + inr x.snd = x :=
ext (add_zero x.1) (zero_add x.2)

instance [add_group R] [add_group M] : add_group (tsze R M) :=
prod.add_group

@[simp] lemma inl_neg [has_neg R] [add_group M] (r : R) :
  (inl (-r) : tsze R M) = -inl r :=
ext rfl neg_zero.symm

@[simp] lemma inr_neg [add_group R] [has_neg M] (m : M) :
  (inr (-m) : tsze R M) = -inr m :=
ext neg_zero.symm rfl

instance [add_comm_semigroup R] [add_comm_semigroup M] : add_comm_semigroup (tsze R M) :=
prod.add_comm_semigroup

instance [add_comm_monoid R] [add_comm_monoid M] : add_comm_monoid (tsze R M) :=
prod.add_comm_monoid

instance [add_comm_group R] [add_comm_group M] : add_comm_group (tsze R M) :=
prod.add_comm_group

end add

section smul
variables (R : Type u) (M : Type v)

instance [has_mul R] [has_scalar R M] : has_scalar R (tsze R M) :=
⟨λ r x, (r * x.1, r • x.2)⟩

@[simp] lemma fst_smul [has_mul R] [has_scalar R M] (r : R) (x : tsze R M) :
  (r • x).fst = r * x.fst := rfl
@[simp] lemma snd_smul [has_mul R] [has_scalar R M] (r : R) (x : tsze R M) :
  (r • x).snd = r • x.snd := rfl

@[simp] lemma inr_smul [mul_zero_class R] [has_scalar R M] (r : R) (m : M) :
  (inr (r • m) : tsze R M) = r • inr m :=
ext (mul_zero _).symm rfl

instance [monoid R] [mul_action R M] : mul_action R (tsze R M) :=
{ one_smul := λ x, ext (one_mul x.1) (one_smul R x.2) ,
  mul_smul := λ r₁ r₂ x, ext (mul_assoc r₁ r₂ x.1) (mul_smul r₁ r₂ x.2) }

instance [semiring R] [add_monoid M] [distrib_mul_action R M] : distrib_mul_action R (tsze R M) :=
{ smul_add := λ r x₁ x₂, ext (mul_add r x₁.1 x₂.1) (smul_add r x₁.2 x₂.2),
  smul_zero := λ r, ext (mul_zero r) (smul_zero r) }

instance [semiring R] [add_comm_monoid M] [module R M] : module R (tsze R M) :=
{ add_smul := λ r₁ r₂ x, ext (add_mul r₁ r₂ x.1) (add_smul r₁ r₂ x.2),
  zero_smul := λ x, ext (zero_mul x.1) (zero_smul R x.2) }

/-- The canonical `R`-linear inclusion `M → triv_sq_zero_ext R M`. -/
@[simps apply]
def inr_hom [semiring R] [add_comm_monoid M] [module R M] : M →ₗ[R] tsze R M :=
{ to_fun := inr,
  map_add' := inr_add R M,
  map_smul' := inr_smul R M }

end smul

section mul
variables (R : Type u) (M : Type v)

instance [has_one R] [has_zero M] : has_one (tsze R M) :=
⟨(1, 0)⟩

@[simp] lemma fst_one [has_one R] [has_zero M] : (1 : tsze R M).fst = 1 := rfl
@[simp] lemma snd_one [has_one R] [has_zero M] : (1 : tsze R M).snd = 0 := rfl
@[simp] lemma inl_one [has_one R] [has_zero M] : (inl 1 : tsze R M) = 1 := rfl

instance [has_mul R] [has_add M] [has_scalar R M] : has_mul (tsze R M) :=
⟨λ x y, (x.1 * y.1, x.1 • y.2 + y.1 • x.2)⟩

@[simp] lemma fst_mul [has_mul R] [has_add M] [has_scalar R M] (x₁ x₂ : tsze R M) :
  (x₁ * x₂).fst = x₁.fst * x₂.fst := rfl
@[simp] lemma snd_mul [has_mul R] [has_add M] [has_scalar R M] (x₁ x₂ : tsze R M) :
  (x₁ * x₂).snd = x₁.fst • x₂.snd + x₂.fst • x₁.snd := rfl

@[simp] lemma inl_mul [monoid R] [add_monoid M] [distrib_mul_action R M] (r₁ r₂ : R) :
  (inl (r₁ * r₂) : tsze R M) = inl r₁ * inl r₂ :=
ext rfl $ show (0 : M) = r₁ • 0 + r₂ • 0, by rw [smul_zero, zero_add, smul_zero]

lemma inl_mul_inl [monoid R] [add_monoid M] [distrib_mul_action R M] (r₁ r₂ : R) :
  (inl r₁ * inl r₂ : tsze R M) = inl (r₁ * r₂) :=
(inl_mul R M r₁ r₂).symm

lemma inl_mul_inr [semiring R] [add_comm_monoid M] [module R M] (r : R) (m : M) :
  (inl r * inr m : tsze R M) = inr (r • m) :=
ext (mul_zero r) $ show r • m + (0 : R) • 0 = r • m, by rw [smul_zero, add_zero]

lemma inr_mul_inl [semiring R] [add_comm_monoid M] [module R M] (r : R) (m : M) :
  (inr m * inl r : tsze R M) = inr (r • m) :=
ext (zero_mul r) $ show (0 : R) • 0 + r • m = r • m, by rw [smul_zero, zero_add]

@[simp] lemma inr_mul_inr [semiring R] [add_comm_monoid M] [module R M] (m₁ m₂ : M) :
  (inr m₁ * inr m₂ : tsze R M) = 0 :=
ext (mul_zero _) $ show (0 : R) • m₂ + (0 : R) • m₁ = 0, by rw [zero_smul, zero_add, zero_smul]

instance [comm_monoid R] [add_monoid M] [distrib_mul_action R M] : monoid (tsze R M) :=
{ mul_assoc := λ x y z, ext (mul_assoc x.1 y.1 z.1) $
    show (x.1 * y.1) • z.2 + z.1 • (x.1 • y.2 + y.1 • x.2) =
      x.1 • (y.1 • z.2 + z.1 • y.2) + (y.1 * z.1) • x.2,
    by simp_rw [smul_add, ← mul_smul, add_assoc, mul_comm],
  one_mul := λ x, ext (one_mul x.1) $ show (1 : R) • x.2 + x.1 • 0 = x.2,
    by rw [one_smul, smul_zero, add_zero],
  mul_one := λ x, ext (mul_one x.1) $ show (x.1 • 0 : M) + (1 : R) • x.2 = x.2,
    by rw [smul_zero, zero_add, one_smul],
  .. triv_sq_zero_ext.has_one R M,
  .. triv_sq_zero_ext.has_mul R M }

instance [comm_semiring R] [add_comm_monoid M] [module R M] : comm_semiring (tsze R M) :=
{ mul_comm := λ x₁ x₂, ext (mul_comm x₁.1 x₂.1) $
    show x₁.1 • x₂.2 + x₂.1 • x₁.2 = x₂.1 • x₁.2 + x₁.1 • x₂.2, from add_comm _ _,
  zero_mul := λ x, ext (zero_mul x.1) $ show (0 : R) • x.2 + x.1 • 0 = 0,
    by rw [zero_smul, zero_add, smul_zero],
  mul_zero := λ x, ext (mul_zero x.1) $ show (x.1 • 0 : M) + (0 : R) • x.2 = 0,
    by rw [smul_zero, zero_add, zero_smul],
  left_distrib := λ x₁ x₂ x₃, ext (mul_add x₁.1 x₂.1 x₃.1) $
    show x₁.1 • (x₂.2 + x₃.2) + (x₂.1 + x₃.1) • x₁.2 =
      x₁.1 • x₂.2 + x₂.1 • x₁.2 + (x₁.1 • x₃.2 + x₃.1 • x₁.2),
    by simp_rw [smul_add, add_smul, add_add_add_comm],
  right_distrib := λ x₁ x₂ x₃, ext (add_mul x₁.1 x₂.1 x₃.1) $
    show (x₁.1 + x₂.1) • x₃.2 + x₃.1 • (x₁.2 + x₂.2) =
      x₁.1 • x₃.2 + x₃.1 • x₁.2 + (x₂.1 • x₃.2 + x₃.1 • x₂.2),
    by simp_rw [add_smul, smul_add, add_add_add_comm],
  .. triv_sq_zero_ext.monoid R M,
  .. triv_sq_zero_ext.add_comm_monoid R M }

/-- The canonical inclusion of rings `R → triv_sq_zero_ext R M`. -/
@[simps apply]
def inl_hom [comm_semiring R] [add_comm_monoid M] [module R M] : R →+* tsze R M :=
{ to_fun := inl,
  map_one' := inl_one R M,
  map_mul' := inl_mul R M,
  map_zero' := inl_zero R M,
  map_add' := inl_add R M }

end mul

section algebra
variables (R : Type u) (M : Type v)

instance [comm_semiring R] [add_comm_monoid M] [module R M] : algebra R (tsze R M) :=
{ commutes' := λ r x, mul_comm _ _,
  smul_def' := λ r x, ext rfl $ show r • x.2 = r • x.2 + x.1 • 0, by rw [smul_zero, add_zero],
  .. triv_sq_zero_ext.module R M,
  .. triv_sq_zero_ext.inl_hom R M }

/-- The canonical `R`-algebra projection `triv_sq_zero_ext R M → R`. -/
def fst_hom [comm_semiring R] [add_comm_monoid M] [module R M] : tsze R M →ₐ[R] R :=
{ to_fun := fst,
  map_one' := fst_one R M,
  map_mul' := fst_mul R M,
  map_zero' := fst_zero R M,
  map_add' := fst_add R M,
  commutes' := fst_inl }

/-- The canonical `R`-module projection `triv_sq_zero_ext R M → M`. -/
@[simps apply]
def snd_hom [semiring R] [add_comm_monoid M] [module R M] : tsze R M →ₗ[R] M :=
{ to_fun := snd,
  map_add' := snd_add R M,
  map_smul' := snd_smul R M}

end algebra

end triv_sq_zero_ext


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

import data.list.basic
import data.list.infix

/-!

# Dropping or taking from lists on the right

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

Taking or removing element from the tail end of a list

## Main defintions

- `rdrop n`: drop `n : ℕ` elements from the tail
- `rtake n`: take `n : ℕ` elements from the tail
- `drop_while p`: remove all the elements that satisfy a decidable `p : α → Prop` from the tail of
  a list until hitting the first non-satisfying element
- `take_while p`: take all the elements that satisfy a decidable `p : α → Prop` from the tail of
  a list until hitting the first non-satisfying element

## Implementation detail

The two predicate-based methods operate by performing the regular "from-left" operation on
`list.reverse`, followed by another `list.reverse`, so they are not the most performant.
The other two rely on `list.length l` so they still traverse the list twice. One could construct
another function that takes a `L : ℕ` and use `L - n`. Under a proof condition that
`L = l.length`, the function would do the right thing.

-/

variables {α : Type*} (p : α → Prop) [decidable_pred p] (l : list α) (n : ℕ)

namespace list

/-- Drop `n` elements from the tail end of a list. -/
def rdrop : list α := l.take (l.length - n)

@[simp] lemma rdrop_nil : rdrop ([] : list α) n = [] := by simp [rdrop]
@[simp] lemma rdrop_zero : rdrop l 0 = l := by simp [rdrop]

lemma rdrop_eq_reverse_drop_reverse : l.rdrop n = reverse (l.reverse.drop n) :=
begin
  rw rdrop,
  induction l using list.reverse_rec_on with xs x IH generalizing n,
  { simp },
  { cases n,
    { simp [take_append] },
    { simp [take_append_eq_append_take, IH] } }
end

@[simp] lemma rdrop_concat_succ (x : α) : rdrop (l ++ [x]) (n + 1) = rdrop l n :=
by simp [rdrop_eq_reverse_drop_reverse]

/-- Take `n` elements from the tail end of a list. -/
def rtake : list α := l.drop (l.length - n)

@[simp] lemma rtake_nil : rtake ([] : list α) n = [] := by simp [rtake]
@[simp] lemma rtake_zero : rtake l 0 = [] := by simp [rtake]

lemma rtake_eq_reverse_take_reverse : l.rtake n = reverse (l.reverse.take n) :=
begin
  rw rtake,
  induction l using list.reverse_rec_on with xs x IH generalizing n,
  { simp },
  { cases n,
    { simp },
    { simp [drop_append_eq_append_drop, IH] } }
end

@[simp] lemma rtake_concat_succ (x : α) : rtake (l ++ [x]) (n + 1) = rtake l n ++ [x] :=
by simp [rtake_eq_reverse_take_reverse]

/-- Drop elements from the tail end of a list that satisfy `p : α → Prop`.
Implemented naively via `list.reverse` -/
def rdrop_while : list α := reverse (l.reverse.drop_while p)

@[simp] lemma rdrop_while_nil : rdrop_while p ([] : list α) = [] :=
by simp [rdrop_while, drop_while]
lemma rdrop_while_concat (x : α) :
  rdrop_while p (l ++ [x]) = if p x then rdrop_while p l else l ++ [x] :=
begin
  simp only [rdrop_while, drop_while, reverse_append, reverse_singleton, singleton_append],
  split_ifs with h h;
  simp [h]
end
@[simp] lemma rdrop_while_concat_pos (x : α) (h : p x) :
  rdrop_while p (l ++ [x]) = rdrop_while p l :=
by rw [rdrop_while_concat, if_pos h]
@[simp] lemma rdrop_while_concat_neg (x : α) (h : ¬ p x) :
  rdrop_while p (l ++ [x]) = l ++ [x] :=
by rw [rdrop_while_concat, if_neg h]

lemma rdrop_while_singleton (x : α) :
  rdrop_while p [x] = if p x then [] else [x] :=
by rw [←nil_append [x], rdrop_while_concat, rdrop_while_nil]

lemma rdrop_while_last_not (hl : (l.rdrop_while p) ≠ []):
  ¬ p ((rdrop_while p l).last hl) :=
begin
  simp_rw rdrop_while,
  rw last_reverse,
  exact drop_while_nth_le_zero_not _ _ _
end

lemma rdrop_while_prefix : l.rdrop_while p <+: l :=
begin
  rw [←reverse_suffix, rdrop_while, reverse_reverse],
  exact drop_while_suffix _
end

variables {p} {l}

@[simp] lemma rdrop_while_eq_nil_iff : rdrop_while p l = [] ↔ ∀ x ∈ l, p x :=
by simp [rdrop_while]

-- it is in this file because it requires `list.infix`
@[simp] lemma drop_while_eq_self_iff :
  drop_while p l = l ↔ ∀ (hl : 0 < l.length), ¬ p (l.nth_le 0 hl) :=
begin
  induction l with hd tl IH,
  { simp },
  { rw drop_while,
    split_ifs,
    { simp only [h, length, nth_le, nat.succ_pos', not_true, forall_true_left, iff_false],
      intro H,
      refine (cons_ne_self hd tl) (sublist.antisymm _ (sublist_cons _ _)),
      rw ←H,
      exact (drop_while_suffix _).sublist },
    { simp [h] } }
end

@[simp] lemma rdrop_while_eq_self_iff : rdrop_while p l = l ↔ ∀ (hl : l ≠ []), ¬ p (l.last hl) :=
begin
  simp only [rdrop_while, reverse_eq_iff, length_reverse, ne.def, drop_while_eq_self_iff,
             last_eq_nth_le, ←length_eq_zero, pos_iff_ne_zero],
  refine forall_congr _,
  intro h,
  rw [nth_le_reverse'],
  { simp },
  { rw [←ne.def, ←pos_iff_ne_zero] at h,
    simp [tsub_lt_iff_right (nat.succ_le_of_lt h)] }
end

variables (p) (l)

lemma drop_while_idempotent : drop_while p (drop_while p l) = drop_while p l :=
drop_while_eq_self_iff.mpr (drop_while_nth_le_zero_not _ _)

lemma rdrop_while_idempotent : rdrop_while p (rdrop_while p l) = rdrop_while p l :=
rdrop_while_eq_self_iff.mpr (rdrop_while_last_not _ _)

/-- Take elements from the tail end of a list that satisfy `p : α → Prop`.
Implemented naively via `list.reverse` -/
def rtake_while : list α := reverse (l.reverse.take_while p)

@[simp] lemma rtake_while_nil : rtake_while p ([] : list α) = [] :=
by simp [rtake_while, take_while]
lemma rtake_while_concat (x : α) :
  rtake_while p (l ++ [x]) = if p x then rtake_while p l ++ [x] else [] :=
begin
  simp only [rtake_while, take_while, reverse_append, reverse_singleton, singleton_append],
  split_ifs with h h;
  simp [h]
end
@[simp]

lemma rtake_while_suffix : l.rtake_while p <:+ l :=
begin
  rw [←reverse_prefix, rtake_while, reverse_reverse],
  exact take_while_prefix _
end

variables {p} {l}

@[simp] lemma rtake_while_eq_self_iff : rtake_while p l = l ↔ ∀ x ∈ l, p x :=
by simp [rtake_while, reverse_eq_iff]

@[simp] lemma rtake_while_eq_nil_iff : rtake_while p l = [] ↔ ∀ (hl : l ≠ []), ¬ p (l.last hl) :=
begin
  induction l using list.reverse_rec_on;
  simp [rtake_while]
end

lemma mem_rtake_while_imp {x : α} (hx : x ∈ rtake_while p l) : p x :=
begin
  suffices : x ∈ take_while p l.reverse,
  { exact mem_take_while_imp this },
  rwa [←mem_reverse, ←rtake_while]
end

variables (p) (l)

lemma rtake_while_idempotent : rtake_while p (rtake_while p l) = rtake_while p l :=
rtake_while_eq_self_iff.mpr (λ _, mem_rtake_while_imp)

end list


import Mathlib
import Lean
import Mathlib.Data.Finset.Basic

universe u v w

def Finset.next_elem (s:Finset Nat) : Nat :=
  match Finset.max s with
  | some x => Nat.succ x
  | none => 0

theorem Finset.next_elem_not_in_self (s:Finset Nat) : next_elem s ∉ s :=
by
  intro h1
  simp only [next_elem] at h1
  generalize h2 : Finset.max s = x
  rw [h2] at h1
  cases x with
  | none =>
    have := Finset.max_eq_bot.1 h2
    simp only [this, not_mem_empty] at *
  | some x =>
    simp only at *
    have := Finset.le_max h1
    rw [h2] at this
    simp only [LE.le, Option.mem_def, Option.some.injEq, Nat.lt_eq, exists_eq_left'] at this
    have := this (.succ x) (by trivial)
    simp_arith at this

structure Heap.Cell where
  type: Type 0
  val: type

structure Heap where
  domain : Finset Nat
  val : {x // x ∈ domain} → Heap.Cell

instance : Inhabited Heap where
  default := ⟨∅, fun x => by
    apply False.elim
    cases x.property
  ⟩

instance : Singleton (Nat × Heap.Cell) Heap where
  singleton pair :=
    let (ref, cell) := pair
    ⟨{ref}, fun _ => cell⟩

instance : EmptyCollection Heap where
  emptyCollection := default

def Heap.eval (m:Heap) (x:Nat) : Option Cell :=
  dite (x ∈ m.domain) (fun h => some <| m.val ⟨x, h⟩) (fun _ => none)

theorem Heap.eval_eq_thm : ∀ m₁ m₂ : Heap,
  (∀ x, eval m₁ x = eval m₂ x) → m₁ = m₂ :=
by
  intro ⟨d1, v1⟩ ⟨d2, v2⟩ h1
  have : ∀ x, x ∈ d1 ↔ x ∈ d2 := by
    intro x
    constructor <;> intro h2
    <;> apply by_contradiction
    <;> intro h3
    <;> have := h1 x
    <;> simp only [eval, h2, h3, dite_true, dite_false] at this

  have : d1 = d2 := Finset.ext_iff.2 this
  induction this
  simp only [mk.injEq, heq_eq_eq, true_and]

  apply funext
  intro x
  have := h1 x
  simp only [eval, Finset.coe_mem, Subtype.coe_eta, dite_eq_ite, ite_true, Option.some.injEq] at this
  assumption

#check Disjoint
#check Finset.disjUnion
def Heap.disjoint (m₁ m₂: Heap) : Prop := Disjoint m₁.domain m₂.domain

theorem Heap.disjoint_thm (m₁ m₂: Heap) : disjoint m₁ m₂ = (m₁.domain ∩ m₂.domain = ∅) := by
  simp only [disjoint, Finset.disjoint_iff_ne, ne_eq, eq_iff_iff]
  constructor
  . intros h1
    rw [Finset.ext_iff]
    simp only [Finset.mem_inter, Finset.not_mem_empty, iff_false, not_and]
    intro a h2 h3
    apply h1 a h2 a h3 rfl
  . intros h1 a h2 b h3 h4
    simp only [Finset.ext_iff, Finset.mem_inter, Finset.not_mem_empty, iff_false, not_and] at h1
    induction h4
    apply h1 a
    <;> assumption

infixl:62 " /// " => Heap.disjoint

instance : Union Heap := ⟨fun m₁ m₂ => ⟨
  m₁.domain ∪ m₂.domain,
  fun x => dite (x.1 ∈ m₁.domain) (fun h => m₁.val ⟨x.val, h⟩)
  (fun h1 => dite (x.1 ∈ m₂.domain) (fun h => m₂.val ⟨x.val, h⟩) (by
    intro h2
    apply False.elim
    have := x.property
    simp only [Finset.mem_union] at this
    apply Or.elim this
    <;> intro h
    . exact h1 h
    . exact h2 h
  ))
⟩⟩

@[simp] instance : Membership Nat Heap := ⟨fun x m => x ∈ m.domain⟩

instance {x:Nat} {m:Heap} : Decidable (x ∈ m) := inferInstanceAs (Decidable (x ∈ m.domain))

@[simp] def Heap.join := @Union.union Heap _

@[simp] theorem Heap.eval_join_thm : ∀ m₁ m₂ x,
  eval (m₁ ∪ m₂) x = match eval m₁ x with
    | none => eval m₂ x
    | some x => some x
:= by
  intro m₁ m₂ x
  apply @Classical.byCases (x ∈ m₁.domain) <;>
  apply @Classical.byCases (x ∈ m₂.domain) <;>
  intro h1 h2 <;> simp only [
    eval, h1, h2, Union.union, Finset.mem_mk,
    Multiset.mem_ndunion, Finset.mem_val,
    or_self, or_true, or_false, dite_true, dite_false]

#print Associative

theorem Heap.join_is_Associative : ∀ m₁ m₂ m₃:Heap, m₁ ∪ (m₂ ∪ m₃) = (m₁ ∪ m₂) ∪ m₃ := by
  intro m1 m2 m3
  apply Heap.eval_eq_thm
  intro x
  simp only [eval_join_thm]
  cases eval m1 x <;>
  cases eval m2 x <;>
  simp only

instance : Associative Heap.join := by
  simp only [Associative]
  intros
  apply Eq.symm
  apply Heap.join_is_Associative

theorem Heap.disjoint_is_symmetric : ∀ m₁ m₂, m₁ /// m₂ → m₂ /// m₁ :=
by
  simp only [Symmetric, disjoint_thm]
  intro m₁ m₂ h
  have h := Finset.ext_iff.1 h
  apply Finset.ext_iff.2
  simp only [Finset.mem_inter, Finset.not_mem_empty, iff_false, not_and] at *
  intro x h1 h2
  apply h x h2 h1

theorem Heap.disjoint_symm : ∀ m₁ m₂, m₁ /// m₂ ↔ m₂ /// m₁ :=
by
  intros
  constructor
  <;> apply Heap.disjoint_is_symmetric

theorem Heap.join_symm : ∀ m₁ m₂, m₁ /// m₂ → m₁ ∪ m₂ = m₂ ∪ m₁ :=
by
  intro m₁ m₂ h1
  apply eval_eq_thm
  intro x
  simp only [eval_join_thm]
  apply @Classical.byCases (x ∈ m₁.domain) <;>
  apply @Classical.byCases (x ∈ m₂.domain) <;>
  intro h2 h3 <;> simp only [eval, h2, h3, dite_true, dite_false]
  apply False.elim
  simp only [disjoint_thm] at h1
  have := Finset.ext_iff.1 h1 x
  simp only [Finset.mem_inter, Finset.not_mem_empty, iff_false, not_and] at this
  apply this
  <;> assumption

@[simp] theorem Heap.eval_empty :
  ∀ x, eval ∅ x = none :=
by
  intro x
  simp only [eval, EmptyCollection.emptyCollection]
  simp only [default, dite_false, Finset.not_mem_empty]

@[simp] theorem Heap.disjoint_empty_left :
  ∀ m:Heap, disjoint m ∅ :=
by
  simp only [disjoint, EmptyCollection.emptyCollection]
  simp only [default, Finset.disjoint_empty_right, forall_const]

@[simp] theorem Heap.disjoint_empty_right :
  ∀ m:Heap, disjoint ∅ m :=
by
  simp only [disjoint, EmptyCollection.emptyCollection]
  simp only [default, Finset.disjoint_empty_left, forall_const]

@[simp] theorem Heap.join_empty_right :
  ∀ m:Heap, ∅ ∪ m = m :=
by
  intro m
  apply eval_eq_thm
  intro x
  simp only [eval_join_thm, eval_empty]

@[simp] theorem Heap.join_empty_left :
  ∀ m:Heap, m ∪ ∅ = m :=
by
  intro m
  apply eval_eq_thm
  intro x
  simp only [eval_empty, eval_join_thm]
  cases eval m x
  <;> simp only

@[simp] theorem Heap.join_domain :
  ∀ m₁ m₂ : Heap, (m₁ ∪ m₂).domain = m₁.domain ∪ m₂.domain :=
by
  intro m₁ m₂
  simp only [Union.union]

@[simp] theorem Heap.disjoint_join_comp1 :
  ∀ m₁ m₂ m₃, m₁ /// m₂ ∪ m₃ ↔ (m₁ /// m₂ ∧ m₁ /// m₃) :=
by
  intro m₁ m₂ m₃
  constructor
  <;> intro h
  <;> simp only [disjoint_thm, join_domain] at *
  . have h1 := Finset.ext_iff.1 h
    constructor <;> apply Finset.ext_iff.2
    <;> simp only [Finset.mem_union, Finset.mem_inter, Finset.not_mem_empty, iff_false, not_and] at *
    . intro x h2 h3
      apply h1 x
      assumption
      apply Or.inl
      assumption
    . intro x h2 h3
      apply h1 x
      assumption
      apply Or.inr
      assumption
  . apply Finset.ext_iff.2
    have h1 := Finset.ext_iff.1 h.1
    have h2 := Finset.ext_iff.1 h.2
    simp only [Finset.mem_inter, Finset.mem_union, Finset.not_mem_empty, iff_false, not_and] at *
    intro x h3 h4
    cases h4
    . apply h1 x <;> assumption
    . apply h2 x <;> assumption

@[simp] theorem Heap.disjoint_join_comp2 :
  ∀ m₁ m₂ m₃, m₁ ∪ m₂ /// m₃ ↔ (m₁ /// m₃ ∧ m₂ /// m₃) :=
by
  intro m₁ m₂ m₃
  simp only [disjoint_symm, disjoint_join_comp1]

instance : Symmetric Heap.disjoint := Heap.disjoint_is_symmetric

def Heap.context_stability (p:Heap → Prop) := ∀ m₁ m₂, m₁ /// m₂ → p m₁ → p (m₁ ∪ m₂)

def Heap.prop := { p:Heap → Prop // context_stability p }

@[simp] def Heap.pure_prop_definition (p:Prop) : Heap → Prop := fun _ => p

def Heap.pure_prop_stability (p:Prop) : context_stability (pure_prop_definition p) :=
  by simp [context_stability, pure_prop_definition]

@[simp] def Heap.pure_prop (p:Prop) : Heap.prop :=
  ⟨pure_prop_definition p, pure_prop_stability p⟩

@[simp] def Heap.star_prop_definition (P Q:Heap.prop) : Heap → Prop :=
  fun m => ∃ m₁ m₂,
    m = m₁ ∪ m₂ ∧ m₁ /// m₂ ∧ P.val m₁ ∧ Q.val m₂

def Heap.star_prop_stability (P Q:Heap.prop) : context_stability (star_prop_definition P Q) :=
by
  intro m m' h1 h2
  apply Exists.elim h2
  intro m₁ h2
  apply Exists.elim h2
  intro m₂ h2
  -- use m₁ and m₂ ∪ m'
  apply Exists.intro m₁
  apply Exists.intro (m₂ ∪ m')
  constructor
  . simp only [h2.1]
    have := Heap.join_is_Associative
    simp only [Associative] at this
    rw [this]
  . constructor
    . simp only [disjoint_join_comp1]
      simp only [h2.1, disjoint_join_comp2] at h1
      constructor
      . apply h2.2.1
      . exact h1.1
    . constructor
      . exact h2.2.2.1
      . apply Q.property
        . simp only [h2.1, disjoint_join_comp2] at h1
          exact h1.2
        . exact h2.2.2.2

@[simp] def Heap.star_prop (P Q:Heap.prop) : Heap.prop :=
  ⟨star_prop_definition P Q, star_prop_stability P Q⟩

@[simp] def Heap.magic_prop_definitoin (P Q:Heap.prop) : Heap → Prop :=
  fun m : Heap =>
    ∀ m':Heap, m /// m' → P.val m' → Q.val (m ∪ m')

def Heap.magic_prop_stability (P Q:Heap.prop) : context_stability (magic_prop_definitoin P Q) :=
by
  intro m₁ m₂ h1 h2 m' h3 h4
  have h2 := h2 (m₂ ∪ m')
  rw [join_is_Associative] at h2
  apply h2
  simp only [disjoint_join_comp1, disjoint_join_comp2] at *
  constructor
  . apply h1
  . apply h3.1
  . rw [join_symm] <;>
    simp only [disjoint_join_comp2] at h3
    apply P.property
    rw [disjoint_symm]
    exact h3.2
    assumption
    exact h3.2

@[simp] def Heap.magic_prop (P Q:Heap.prop) : Heap.prop :=
  ⟨Heap.magic_prop_definitoin P Q, Heap.magic_prop_stability P Q⟩

@[simp] def Heap.exists_prop_definition {α:Sort u} (prop:α → Heap.prop) : Heap → Prop :=
  λ m: Heap => ∃ x:α, (prop x).val m

def Heap.exists_prop_stability {α: Sort u} (prop: α → Heap.prop) :
  context_stability (@exists_prop_definition α prop) :=
by
  simp only [context_stability, exists_prop_definition, forall_exists_index]
  intro m₁ m₂ h1 x h2
  apply Exists.intro x
  apply (prop x).property
  <;> assumption

@[simp] def Heap.exists_prop {α:Sort u} (prop:α → Heap.prop) : Heap.prop :=
  ⟨exists_prop_definition prop, exists_prop_stability prop⟩

@[simp] def Heap.forall_prop_definition {α:Sort u} (prop:α → Heap.prop) : Heap → Prop :=
  λ m:Heap => ∀ x:α, (prop x).val m

theorem Heap.forall_prop_stability {α:Sort u} (prop:α → Heap.prop) : context_stability (forall_prop_definition prop) :=
by
  simp only [context_stability]
  intro m₁ m₂ h1 h2 x
  apply (prop x).property
  assumption
  apply h2

@[simp] def Heap.forall_prop {α:Sort u} (prop:α → Heap.prop) : Heap.prop :=
  ⟨forall_prop_definition prop, forall_prop_stability prop⟩

@[simp] def Heap.and_prop_definition (P Q:Heap.prop) : Heap → Prop :=
  λ m:Heap => P.val m ∧ Q.val m

theorem Heap.and_prop_stability (P Q:Heap.prop) : context_stability (and_prop_definition P Q) :=
by
  simp only [context_stability, and_prop_definition, and_imp]
  intro m₁ m₂ h1 h2 h3
  constructor
  . apply P.property
    <;> assumption
  . apply Q.property
    <;> assumption

@[simp] def Heap.and_prop (P Q:Heap.prop) : Heap.prop :=
  ⟨and_prop_definition P Q, and_prop_stability P Q⟩

@[simp] def Heap.or_prop_definition (P Q:Heap.prop) : Heap → Prop :=
  λ m:Heap => P.val m ∨ Q.val m

def Heap.or_prop_stability (P Q:Heap.prop) : context_stability (or_prop_definition P Q) :=
by
  simp only [context_stability]
  intro m₁ m₂ h1 h2
  cases h2
  . apply Or.inl
    apply P.property
    <;> assumption
  . apply Or.inr
    apply Q.property
    <;> assumption

@[simp] def Heap.or_prop (P Q:Heap.prop) : Heap.prop :=
  ⟨or_prop_definition P Q, or_prop_stability P Q⟩

syntax " ⌜ " term " ⌝ " : term -- type as `ulcorner` and `urcorner`
syntax " ⌜ " " ⌝ " : term
macro_rules
| `(⌜ $p:term ⌝) => `( Heap.pure_prop $p )
| `( ⌜⌝ ) => `( Heap.pure_prop True )

infixr:67 " ⋆ " => Heap.star_prop -- type as `star`

infixr:65 " -⋆ " => Heap.magic_prop

infixr:35 " ∧ᴴ " => Heap.and_prop

infixr:30 " ∨ᴴ " => Heap.or_prop

#print Exists

@[simp] def Heap.as_prop_definition (p:Heap→Prop) : Heap → Prop := fun m => ∀ m', m /// m' → p (m ∪ m')

theorem Heap.as_prop_stability (p:Heap→Prop) : context_stability (as_prop_definition p) :=
by
  simp only [context_stability]
  intro m₁ m₂ h1 h2 m' h3
  simp only [disjoint_join_comp2] at h3
  rw [<-join_is_Associative]
  apply h2
  simp only [disjoint_join_comp1]
  constructor
  . apply h1
  . apply h3.1

@[simp] def Heap.as_prop (p:Heap→Prop) : Heap.prop :=
  ⟨as_prop_definition p, as_prop_stability p⟩

open Lean in
open TSyntax.Compat in
macro "∃ᴴ " xs:explicitBinders ", " b:term : term => expandExplicitBinders ``Heap.exists_prop xs b

open Lean in
open TSyntax.Compat in
macro "∀ᴴ " xs:explicitBinders ", " b:term : term => expandExplicitBinders ``Heap.forall_prop xs b

#check (∃ᴴ x, ⌜ x ⌝) ⋆ ∀ᴴ y, ⌜ y ⌝

abbrev Heap.Pointer := Nat

@[simp] def Heap.assign_prop_definition (ref:Nat) (cell:Cell) : Heap → Prop :=
  fun m => eval m ref = some cell

def Heap.assign_prop_stability (ref:Nat) (cell:Cell) : context_stability (assign_prop_definition ref cell) :=
by
  simp only [context_stability, assign_prop_definition, eval_join_thm]
  intro m₁ m₂ _ h2
  generalize h3 : eval m₁ ref = x₁
  generalize h4 : eval m₂ ref = x₂
  cases x₁ <;> cases x₂ <;> simp only [Option.some.injEq]
  case none.none =>
    rw [h3] at h2
    cases h2
  case none.some x =>
    rw [h3] at h2
    cases h2
  case some.none x =>
    rw [h3] at h2
    cases h2
    rfl
  case some.some x y =>
    rw [h3] at h2
    cases h2
    rfl

@[simp] def Heap.assign_prop (ref:Nat) (cell:Cell) : Heap.prop :=
  ⟨
    assign_prop_definition ref cell,
    assign_prop_stability ref cell
  ⟩

infixl:70 " ↦ " => Heap.assign_prop -- type as `mapsto`

@[simp] theorem Heap.star_magic_reduction (P Q:Heap.prop) : ∀ m, (P ⋆ (P -⋆ Q)).val m → Q.val m :=
by
  intro m1
  simp only [star_prop, star_prop_definition, magic_prop, magic_prop_definitoin, forall_exists_index, and_imp]
  intro m2 m3 h1 h2 h3 h4
  have := h4 m2
  simp only at *
  rw [join_symm, disjoint_symm, <-h1] at this
  apply this
  <;> assumption
  rw [disjoint_symm]
  assumption

def Heap.models (P Q:Heap.prop) : Prop :=
  ∀ m, P.1 m → Q.1 m

infix:25  " ⊧ " => Heap.models -- type as vdash

theorem Heap.star_is_symmetric (P Q:Heap.prop) : P ⋆ Q ⊧ Q ⋆ P :=
by
  intro m
  simp only [star_prop, star_prop_definition]
  intro h1
  apply Exists.elim h1
  intro m1 h1
  apply Exists.elim h1
  intro m2 h1
  rw [join_symm, disjoint_symm] at h1
  apply Exists.intro m2
  apply Exists.intro m1
  constructor
  . apply h1.1
  . constructor
    . apply h1.2.1
    . constructor
      . apply h1.2.2.2
      . apply h1.2.2.1
  apply h1.2.1


import data.real.basic
import data.int.order
import order.well_founded_set
import data.int.parity
import tactic
import init.data.int.order
import combinatorics.simple_graph.basic
import data.fintype.card
import data.nat.basic

--Types and helper functions for points in d dimensional space
def point (d : ℕ) : Type := vector ℝ d
def int_point (d : ℕ) : Type := vector ℤ d
def int_point_to_point {d : ℕ} (p : int_point d) : point d :=
  let fn : fin d → ℝ := λ x : fin d, ↑(vector.nth p x) in
  vector.of_fn fn

--Misc helper functions
lemma lt_of_le_add_neg {a : ℝ} {b : ℝ} {c : ℝ} (h : c < 0) : a ≤ b + c → a < b :=
  by {intro h', linarith}

lemma floor_mono_eq {a : ℝ} {b : ℝ} (h : a = b) : int.floor(a) = int.floor(b) :=
begin
  have a_le_b : a ≤ b := le_of_eq h,
  symmetry' at h,
  have b_le_a : b ≤ a := le_of_eq h,
  have floor_a_le_floor_b : int.floor(a) ≤ int.floor(b) := int.floor_mono a_le_b,
  have floor_b_le_floor_a : int.floor(b) ≤ int.floor(a) := int.floor_mono b_le_a,
  linarith,
end

lemma ceil_mono_eq {a : ℝ} {b : ℝ} (h : a = b) : int.ceil(a) = int.ceil(b) :=
begin
  have a_le_b : a ≤ b := le_of_eq h,
  symmetry' at h,
  have b_le_a : b ≤ a := le_of_eq h,
  have ceil_a_le_ceil_b := int.ceil_mono a_le_b,
  have ceil_b_le_ceil_a := int.ceil_mono b_le_a,
  linarith,
end

lemma coe_nat_abs_ge_zero (z : ℤ) : (z.nat_abs : ℤ) ≥ 0 :=
begin
  have h : z.nat_abs ≥ 0,
  by_cases z = 0,
  rw h,
  rw int.nat_abs_zero,
  linarith,
  have h' := int.nat_abs_pos_of_ne_zero h,
  linarith,
  assumption_mod_cast,
end

lemma eq_of_le_and_ge {a : ℤ} {b : ℤ} (a_le_b : a ≤ b) (b_le_a : b ≤ a) : a = b :=
begin
  replace a_le_b := eq_or_lt_of_le a_le_b,
  replace b_le_a := eq_or_lt_of_le b_le_a,
  cases a_le_b,
  assumption,
  cases b_le_a,
  symmetry,
  assumption,
  linarith,
end

lemma eq_or_lt_or_gt (a : ℤ) (b : ℤ) : a = b ∨ a < b ∨ a > b :=
begin
  by_cases a_le_b : a ≤ b,
  by_cases a_eq_b : a = b, left, exact a_eq_b,
  right, left, exact lt_of_le_of_ne a_le_b a_eq_b,
  right, right, linarith,
end

lemma real_eq_or_lt_or_gt (a : ℝ) (b : ℝ) : a = b ∨ a < b ∨ a > b :=
begin
  by_cases a_le_b : a ≤ b,
  by_cases a_eq_b : a = b, left, exact a_eq_b,
  right, left, exact lt_of_le_of_ne a_le_b a_eq_b,
  right, right, linarith,
end

lemma nat_eq_or_lt_or_gt (a : ℕ) (b : ℕ) : a = b ∨ a < b ∨ a > b :=
begin
  by_cases a_le_b : a ≤ b,
by_cases a_eq_b : a = b, left, exact a_eq_b,
right, left, exact lt_of_le_of_ne a_le_b a_eq_b,
right, right, linarith,
end

lemma floor_val {x : ℝ} {a : ℤ} (h : ↑a ≤ x) (h2 : x < ↑a + 1) : int.floor(x) = a :=
begin
  have floor_mono_h := int.floor_mono h,
  have floor_a_eq_a : int.floor(a : ℝ) = a := int.floor_coe a,
  rw floor_a_eq_a at floor_mono_h,
  have floor_x_le_x := int.floor_le x,
  have floor_x_lt_a_add_one : ((int.floor(x)) : ℝ) < ↑a + 1 := by linarith,
  replace floor_x_lt_a_add_one : ⌊x⌋ < a + 1 := by assumption_mod_cast,
  linarith,
end

lemma ceil_val {x : ℝ} {a : ℤ} (h : ↑a - 1 < x) (h2 : x ≤ ↑a) : int.ceil(x) = a :=
begin
  have ceil_mono_h2 := int.ceil_mono h2,
  have ceil_a_eq_a : int.ceil(a : ℝ) = a := int.ceil_coe a,
  rw ceil_a_eq_a at ceil_mono_h2,
  have x_le_ceil_x := int.le_ceil x,
  have coe_a_lt_ceil_x_add_one : ↑a < ↑(int.ceil x) + (1 : ℝ) := by linarith,
  have a_lt_ceil_x_add_one : a < (int.ceil x) + 1 := by assumption_mod_cast,
  have a_le_ceil_x := int.le_of_lt_add_one a_lt_ceil_x_add_one,
  linarith,
end

lemma ceil_one : int.ceil((1 : ℝ)) = 1 :=
begin
  have one_sub_one_lt_one : 1 - 1 < 1 := by linarith,
  have coe_one_sub_one_lt_one : ↑(1 : ℤ) - 1 < (1 : ℝ) := by assumption_mod_cast,
  have one_le_one : 1 ≤ 1 := by refl,
  have coe_one_le_one : (1 : ℝ) ≤ ↑(1 : ℤ) := by assumption_mod_cast,
  exact ceil_val coe_one_sub_one_lt_one coe_one_le_one,
end

lemma mul_div_two_of_even {a : ℤ} (a_is_even : even a) : 2 * (a / 2) = a :=
begin
  rw even_iff_two_dvd at a_is_even,
  have two_ne_zero : (2 : ℤ) ≠ 0 := by linarith,
  have two_times_a_eq_a_times_two : 2 * a = a * 2 := by rw mul_comm,
  symmetry,
  have almost_goal := int.eq_mul_div_of_mul_eq_mul_of_dvd_left two_ne_zero a_is_even two_times_a_eq_a_times_two,
  linarith,
end

lemma mul_div_of_ne_zero {b : ℝ} (a : ℝ) (b_ne_zero : b ≠ 0) : b * (a / b) = a :=
begin
  have h : b = 0 → a = 0 := by {intro b_eq_zero, exfalso, exact b_ne_zero b_eq_zero},
  exact mul_div_cancel_of_imp' h,
end

lemma lt_le_trans {a : ℝ} {b : ℝ} {c : ℝ} (h : a < b) (h' : b ≤ c) : a < c := by linarith
lemma le_lt_trans {a : ℝ} {b : ℝ} {c : ℝ} (h : a ≤ b) (h' : b < c) : a < c := by linarith

lemma nat_le_of_lt_add_one {a : ℕ} {b : ℕ} (h : a < b + 1) : a ≤ b := by linarith

--Vector helper functions
def zero_vector {d : ℕ} : point d := vector.of_fn (λ j, 0)
def int_zero_vector {d : ℕ} : int_point d := vector.of_fn (λ j, 0)
def unit_basis_vector {d : ℕ} (i : fin d) : point d := vector.of_fn (λ j, if(i = j) then 1 else 0)
def neg_unit_basis_vector {d : ℕ} (i : fin d) : point d := vector.of_fn (λ j, if(i=j) then -1 else 0)
def int_unit_basis_vector {d : ℕ} (i : fin d) : int_point d := vector.of_fn (λ j, if(i = j) then 1 else 0)
def int_neg_unit_basis_vector {d : ℕ} (i : fin d) : int_point d := vector.of_fn (λ j, if(i=j) then -1 else 0)

def add_vectors {d : ℕ} (v1 : point d) (v2 : point d) := vector.of_fn(λ j, v1.nth j + v2.nth j)
def add_int_vectors {d : ℕ} (v1 : int_point d) (v2 : int_point d) := vector.of_fn(λ j, v1.nth j + v2.nth j)

lemma add_same_vector {d : ℕ} {v1 : point d} {v2 : point d} (v3 : point d) (h : v1 = v2) : add_vectors v1 v3 = add_vectors v2 v3 :=
begin
  rw [add_vectors, add_vectors],
  apply vector.ext,
  intro i,
  simp,
  rw h,
end

lemma add_vectors_comm {d : ℕ} (v1 : point d) (v2 : point d) : add_vectors v1 v2 = add_vectors v2 v1 :=
begin
  rw [add_vectors, add_vectors],
  apply vector.ext,
  intro i,
  simp only [vector.nth_of_fn],
  rw add_comm,
end

lemma add_int_vectors_comm {d : ℕ} (v1 : int_point d) (v2 : int_point d) : add_int_vectors v1 v2 = add_int_vectors v2 v1 :=
begin
  rw [add_int_vectors, add_int_vectors],
  apply vector.ext,
  intro i,
  simp only [vector.nth_of_fn],
  rw add_comm,
end

lemma add_vectors_assoc {d : ℕ} (v1 : point d) (v2 : point d) (v3 : point d) :
  add_vectors (add_vectors v1 v2) v3 = add_vectors v1 (add_vectors v2 v3) :=
begin
  rw [add_vectors, add_vectors, add_vectors, add_vectors],
  apply vector.ext,
  intro i,
  simp only [vector.nth_of_fn],
  rw add_assoc,
end

lemma add_int_vectors_assoc {d : ℕ} (v1 : int_point d) (v2 : int_point d) (v3 : int_point d) :
  add_int_vectors (add_int_vectors v1 v2) v3 = add_int_vectors v1 (add_int_vectors v2 v3) :=
begin
  rw [add_int_vectors, add_int_vectors, add_int_vectors, add_int_vectors],
  apply vector.ext,
  intro i,
  simp only [vector.nth_of_fn],
  rw add_assoc,
end

lemma remove_same_vector {d : ℕ} {v1 : point d} {v2 : point d} {v3 : point d} (h : add_vectors v1 v3 = add_vectors v2 v3) : v1 = v2 :=
begin
  apply vector.ext,
  intro i,
  have h' : (add_vectors v1 v3).nth i = (add_vectors v2 v3).nth i := by rw h,
  rw [add_vectors, add_vectors] at h',
  simp only [vector.nth_of_fn] at h',
  linarith,
end

lemma unit_basis_vector_add_neg_unit_basis_vector_eq_zero {d : ℕ} (i : fin d) :
  add_vectors (unit_basis_vector i) (neg_unit_basis_vector i) = zero_vector :=
begin
  apply vector.ext,
  intro j,
  rw [neg_unit_basis_vector, unit_basis_vector, add_vectors, zero_vector],
  simp only [vector.nth_of_fn],
  by_cases i_eq_j : i = j, {rw i_eq_j, simp only [if_true, eq_self_iff_true, add_right_neg],},
  rw if_neg i_eq_j,
  simp only [ite_eq_right_iff, zero_add, neg_eq_zero, one_ne_zero],
  exact i_eq_j,
end

lemma add_zero_vector {d : ℕ} (v : point d) : add_vectors v zero_vector = v :=
begin
  rw [zero_vector, add_vectors],
  simp only [add_zero, vector.of_fn_nth, vector.nth_of_fn],
end

lemma zero_vector_add {d : ℕ} (v : point d) : add_vectors zero_vector v = v :=
begin
  rw [zero_vector, add_vectors],
  simp only [zero_add, vector.of_fn_nth, vector.nth_of_fn],
end

def scaled_basis_vector {d : ℕ} (scalar : ℝ) (i : fin d) : point d := vector.of_fn (λ j, if(i = j) then scalar else 0)
def int_scaled_basis_vector {d : ℕ} (scalar : ℤ) (i : fin d) : int_point d := vector.of_fn (λ j, if(i = j) then scalar else 0)
def double_int_vector {d : ℕ} (x : int_point d) : int_point d := vector.of_fn (λ j : fin d, 2 * (x.nth j))

--Mod one helper functions

/-
Note: There's no point in trying to build a computational version of eq_mod_one because it would require real equality which
isn't computable
-/
def eq_mod_one (a : ℝ) (b : ℝ) : Prop := ∃ a_floor : ℤ, ∃ b_floor : ℤ, ∃ y : ℝ, 0 ≤ y ∧ y < 1 ∧ a = a_floor + y ∧ b = b_floor + y
def ne_mod_one (a : ℝ) (b : ℝ) : Prop := ¬(eq_mod_one a b)

lemma eq_mod_one_reflexive (a : ℝ) : eq_mod_one a a :=
begin
  rw eq_mod_one,
  have floor_le_fact := int.floor_le a,
  have lt_floor_add_one_fact := int.lt_floor_add_one a,
  use [int.floor(a), int.floor(a), a - ↑(int.floor(a))],
  exact ⟨by linarith, by linarith, by linarith, by linarith⟩,
end

lemma eq_mod_one_symmetric {a : ℝ} {b : ℝ} (h : eq_mod_one a b) : eq_mod_one b a :=
begin
  rw eq_mod_one,
  rw eq_mod_one at h,
  rcases h with ⟨a_floor, b_floor, y, zero_le_y, y_lt_one, a_eq_y_mod_one, b_eq_y_mod_one⟩,
  use [b_floor, a_floor, y],
  exact ⟨zero_le_y, y_lt_one, b_eq_y_mod_one, a_eq_y_mod_one⟩,
end

lemma eq_mod_one_transitive {a : ℝ} {b : ℝ} {c : ℝ} (h1 : eq_mod_one a b) (h2 : eq_mod_one b c) : eq_mod_one a c :=
begin
  rw eq_mod_one at h1,
  rcases h1 with ⟨a_floor, b_floor, y, zero_le_y, y_lt_one, a_eq_y_mod_one, b_eq_y_mod_one⟩,
  rcases h2 with ⟨b_floor', c_floor, y', zero_le_y', y'_lt_one, b_eq_y', c_eq_y_mod_one⟩,
  have b_floor_eq_b_floor' : b_floor = b_floor' :=
    begin
      have b_floor_add_y_eq_b_floor'_add_y' : y + ↑b_floor = y' + ↑b_floor' := by linarith,
      have floor_mono_fact := floor_mono_eq b_floor_add_y_eq_b_floor'_add_y',
      have floor_add_int_fact1 := int.floor_add_int y b_floor,
      have floor_add_int_fact2 := int.floor_add_int y' b_floor',
      rw [floor_add_int_fact1, floor_add_int_fact2] at floor_mono_fact,

      replace zero_le_y : ↑(0 : ℤ) ≤ y := by assumption_mod_cast,
      replace y_lt_one : y < ↑(0 : ℤ) + 1 :=
        begin
          have coe_goal : y < 0 + 1 := by linarith,
          assumption_mod_cast,
        end,
      have floor_y_eq_zero := floor_val zero_le_y y_lt_one,

      replace zero_le_y' : ↑(0 : ℤ) ≤ y' := by assumption_mod_cast,
      replace y'_lt_one : y' < ↑(0 : ℤ) + 1 :=
        begin
          have coe_goal : y' < 0 + 1 := by linarith,
          assumption_mod_cast,
        end,
      have floor_y'_eq_zero := floor_val zero_le_y' y'_lt_one,

      rw [floor_y_eq_zero, floor_y'_eq_zero] at floor_mono_fact,
      simp at floor_mono_fact,
      exact floor_mono_fact,
    end,
  have y_eq_y' : y = y' :=
    begin
      have b_defs : ↑b_floor + y = ↑b_floor' + y' := by linarith,
      rw b_floor_eq_b_floor' at b_defs,
      linarith,
    end,
  rw ← y_eq_y' at c_eq_y_mod_one,
  rw eq_mod_one,
  use [a_floor, c_floor, y],
  exact ⟨zero_le_y, y_lt_one, a_eq_y_mod_one, c_eq_y_mod_one⟩,
end

lemma add_mod_eq_add_mod_right {a : ℝ} {b : ℝ} {c : ℝ} (h1 : eq_mod_one a b) : eq_mod_one (a + c) (b + c) :=
begin
  rw eq_mod_one at h1,
  rcases h1 with ⟨a_floor, b_floor, y, zero_le_y, y_lt_one, a_val, b_val⟩,
  rw eq_mod_one,
  have floor_le_fact := int.floor_le (y + c),
  have lt_floor_add_one_fact := int.lt_floor_add_one (y + c),
  have floor_c_le_c := int.floor_le c,
  have c_lt_floor_c_add_one := int.lt_floor_add_one c,
  by_cases y_add_c_remainder_lt_one : y + c - ↑(int.floor c) < 1,
  { use [a_floor + int.floor(c), b_floor + int.floor(c), y + c - ↑(int.floor c)],
    exact ⟨by linarith, by linarith, by {simp, linarith,}, by {simp, linarith,}⟩,
  },
  use [a_floor + int.floor(c) + 1, b_floor + int.floor(c) + 1, y + c - ↑(int.floor c) - 1],
  exact ⟨by linarith, by linarith, by {simp, linarith}, by {simp, linarith,}⟩,
end

lemma subst_summand_eq_mod_one {a : ℝ} {b : ℝ} {c : ℝ} {d : ℝ} : eq_mod_one a d → eq_mod_one (a + b) c → eq_mod_one (d + b) c :=
begin
  intros a_eq_d_mod_one,
  rcases a_eq_d_mod_one with ⟨a_floor, d_floor, y, zero_le_y, y_lt_one, a_def, d_def⟩,
  rintro ⟨a_add_b_floor, c_floor, y', zero_le_y', y'_lt_one, a_add_b_def, c_def⟩,
  rw eq_mod_one,
  use [a_add_b_floor - a_floor + d_floor, c_floor, y', zero_le_y', y'_lt_one, by {simp only [int.cast_add, int.cast_sub], linarith}, c_def],
end

lemma eq_mod_one_int_add {a : ℝ} {b : ℤ} {c : ℝ} : eq_mod_one a c → eq_mod_one (a + ↑b) c :=
begin
  rw [eq_mod_one, eq_mod_one],
  rintro ⟨a_floor, c_floor, y, zero_le_y, y_lt_one, a_eq_a_floor_add_y, c_eq_c_floor_add_y⟩,
  use [a_floor + b, c_floor, y, zero_le_y, y_lt_one],
  split,
  { rw a_eq_a_floor_add_y,
    finish,
  },
  exact c_eq_c_floor_add_y,
end

lemma eq_mod_one_int_sub {a : ℝ} {b : ℤ} {c : ℝ} : eq_mod_one a c → eq_mod_one (a - ↑b) c :=
begin
  have b_id : -↑b = (↑(-b) : ℝ) := by finish,
  rw [sub_eq_add_neg a ↑b, b_id],
  exact eq_mod_one_int_add,
end

--Helpers for finsets
lemma sorted_list_to_finset_lemma :
  ∀ l : list ℝ, list.sorted (≤) l → l.nodup → finset.sort (≤) l.to_finset = l :=
begin
  intros l l_sorted l_nodup,
  cases l with l_hd l_tl,
  { simp only [list.to_finset_nil],
    have emptyset_to_list_eq_nil : finset.to_list ∅ = (list.nil : list ℝ) := finset.to_list_empty,
    have emptyset_sort_perm_emptyset_to_list := finset.sort_perm_to_list has_le.le (∅ : finset ℝ),
    rw finset.to_list_empty at emptyset_sort_perm_emptyset_to_list,
    exact list.perm.eq_nil emptyset_sort_perm_emptyset_to_list,
  },
  have finset_sort_output_nodup : (finset.sort (≤) (l_hd :: l_tl).to_finset).nodup :=
    finset.sort_nodup (≤) (l_hd :: l_tl).to_finset,
  have perm_goal : finset.sort (≤) (l_hd :: l_tl).to_finset ~ l_hd :: l_tl :=
    begin
      rw list.perm_ext finset_sort_output_nodup l_nodup,
      intro a,
      rw [← list.to_finset_eq l_nodup],
      simp only [finset.mem_sort, multiset.mem_coe, finset.mem_mk],
    end,
  have finset_to_list_ordered_output_sorted := finset.sort_sorted has_le.le ((l_hd :: l_tl).to_finset),
  exact list.eq_of_perm_of_sorted perm_goal finset_to_list_ordered_output_sorted l_sorted,
end


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

notation, basic datatypes and type classes
-/
prelude
import Init.Core
set_option linter.missingDocs true -- keep it documented

theorem of_eq_true (h : p = True) : p := h ▸ trivial

theorem eq_true (h : p) : p = True :=
  propext ⟨fun _ => trivial, fun _ => h⟩

theorem eq_false (h : ¬ p) : p = False :=
  propext ⟨fun h' => absurd h' h, fun h' => False.elim h'⟩

theorem eq_false' (h : p → False) : p = False := eq_false h

theorem eq_true_of_decide {p : Prop} {_ : Decidable p} (h : decide p = true) : p = True :=
  eq_true (of_decide_eq_true h)

theorem eq_false_of_decide {p : Prop} {_ : Decidable p} (h : decide p = false) : p = False :=
  eq_false (of_decide_eq_false h)

@[simp] theorem eq_self (a : α) : (a = a) = True := eq_true rfl

theorem implies_congr {p₁ p₂ : Sort u} {q₁ q₂ : Sort v} (h₁ : p₁ = p₂) (h₂ : q₁ = q₂) : (p₁ → q₁) = (p₂ → q₂) :=
  h₁ ▸ h₂ ▸ rfl

theorem implies_dep_congr_ctx {p₁ p₂ q₁ : Prop} (h₁ : p₁ = p₂) {q₂ : p₂ → Prop} (h₂ : (h : p₂) → q₁ = q₂ h) : (p₁ → q₁) = ((h : p₂) → q₂ h) :=
  propext ⟨
    fun hl hp₂ => (h₂ hp₂).mp (hl (h₁.mpr hp₂)),
    fun hr hp₁ => (h₂ (h₁.mp hp₁)).mpr (hr (h₁.mp hp₁))⟩

theorem implies_congr_ctx {p₁ p₂ q₁ q₂ : Prop} (h₁ : p₁ = p₂) (h₂ : p₂ → q₁ = q₂) : (p₁ → q₁) = (p₂ → q₂) :=
  implies_dep_congr_ctx h₁ h₂

theorem forall_congr {α : Sort u} {p q : α → Prop} (h : ∀ a, p a = q a) : (∀ a, p a) = (∀ a, q a) :=
  (funext h : p = q) ▸ rfl

theorem let_congr {α : Sort u} {β : Sort v} {a a' : α} {b b' : α → β}
    (h₁ : a = a') (h₂ : ∀ x, b x = b' x) : (let x := a; b x) = (let x := a'; b' x) :=
  h₁ ▸ (funext h₂ : b = b') ▸ rfl

theorem let_val_congr {α : Sort u} {β : Sort v} {a a' : α}
    (b : α → β) (h : a = a') : (let x := a; b x) = (let x := a'; b x) := h ▸ rfl

theorem let_body_congr {α : Sort u} {β : α → Sort v} {b b' : (a : α) → β a}
    (a : α) (h : ∀ x, b x = b' x) : (let x := a; b x) = (let x := a; b' x) :=
  (funext h : b = b') ▸ rfl

@[congr]
theorem ite_congr {x y u v : α} {s : Decidable b} [Decidable c]
    (h₁ : b = c) (h₂ : c → x = u) (h₃ : ¬ c → y = v) : ite b x y = ite c u v := by
  cases Decidable.em c with
  | inl h => rw [if_pos h]; subst b; rw [if_pos h]; exact h₂ h
  | inr h => rw [if_neg h]; subst b; rw [if_neg h]; exact h₃ h

theorem Eq.mpr_prop {p q : Prop} (h₁ : p = q) (h₂ : q)  : p  := h₁ ▸ h₂
theorem Eq.mpr_not  {p q : Prop} (h₁ : p = q) (h₂ : ¬q) : ¬p := h₁ ▸ h₂

@[congr]
theorem dite_congr {_ : Decidable b} [Decidable c]
    {x : b → α} {u : c → α} {y : ¬b → α} {v : ¬c → α}
    (h₁ : b = c)
    (h₂ : (h : c)  → x (h₁.mpr_prop h) = u h)
    (h₃ : (h : ¬c) → y (h₁.mpr_not h)  = v h) :
    dite b x y = dite c u v := by
  cases Decidable.em c with
  | inl h => rw [dif_pos h]; subst b; rw [dif_pos h]; exact h₂ h
  | inr h => rw [dif_neg h]; subst b; rw [dif_neg h]; exact h₃ h

@[simp] theorem ne_eq (a b : α) : (a ≠ b) = ¬(a = b) := rfl
@[simp] theorem ite_true (a b : α) : (if True then a else b) = a := rfl
@[simp] theorem ite_false (a b : α) : (if False then a else b) = b := rfl
@[simp] theorem dite_true {α : Sort u} {t : True → α} {e : ¬ True → α} : (dite True t e) = t True.intro := rfl
@[simp] theorem dite_false {α : Sort u} {t : False → α} {e : ¬ False → α} : (dite False t e) = e not_false := rfl
@[simp] theorem ite_self {α : Sort u} {c : Prop} {d : Decidable c} (a : α) : ite c a a = a := by cases d <;> rfl
@[simp] theorem and_self (p : Prop) : (p ∧ p) = p := propext ⟨(·.1), fun h => ⟨h, h⟩⟩
@[simp] theorem and_true (p : Prop) : (p ∧ True) = p := propext ⟨(·.1), (⟨·, trivial⟩)⟩
@[simp] theorem true_and (p : Prop) : (True ∧ p) = p := propext ⟨(·.2), (⟨trivial, ·⟩)⟩
@[simp] theorem and_false (p : Prop) : (p ∧ False) = False := eq_false (·.2)
@[simp] theorem false_and (p : Prop) : (False ∧ p) = False := eq_false (·.1)
@[simp] theorem or_self (p : Prop) : (p ∨ p) = p := propext ⟨fun | .inl h | .inr h => h, .inl⟩
@[simp] theorem or_true (p : Prop) : (p ∨ True) = True := eq_true (.inr trivial)
@[simp] theorem true_or (p : Prop) : (True ∨ p) = True := eq_true (.inl trivial)
@[simp] theorem or_false (p : Prop) : (p ∨ False) = p := propext ⟨fun (.inl h) => h, .inl⟩
@[simp] theorem false_or (p : Prop) : (False ∨ p) = p := propext ⟨fun (.inr h) => h, .inr⟩
@[simp] theorem iff_self (p : Prop) : (p ↔ p) = True := eq_true .rfl
@[simp] theorem iff_true (p : Prop) : (p ↔ True) = p := propext ⟨(·.2 trivial), fun h => ⟨fun _ => trivial, fun _ => h⟩⟩
@[simp] theorem true_iff (p : Prop) : (True ↔ p) = p := propext ⟨(·.1 trivial), fun h => ⟨fun _ => h, fun _ => trivial⟩⟩
@[simp] theorem iff_false (p : Prop) : (p ↔ False) = ¬p := propext ⟨(·.1), (⟨·, False.elim⟩)⟩
@[simp] theorem false_iff (p : Prop) : (False ↔ p) = ¬p := propext ⟨(·.2), (⟨False.elim, ·⟩)⟩
@[simp] theorem false_implies (p : Prop) : (False → p) = True := eq_true False.elim
@[simp] theorem implies_true (α : Sort u) : (α → True) = True := eq_true fun _ => trivial
@[simp] theorem true_implies (p : Prop) : (True → p) = p := propext ⟨(· trivial), (fun _ => ·)⟩

@[simp] theorem Bool.or_false (b : Bool) : (b || false) = b  := by cases b <;> rfl
@[simp] theorem Bool.or_true (b : Bool) : (b || true) = true := by cases b <;> rfl
@[simp] theorem Bool.false_or (b : Bool) : (false || b) = b  := by cases b <;> rfl
@[simp] theorem Bool.true_or (b : Bool) : (true || b) = true := by cases b <;> rfl
@[simp] theorem Bool.or_self (b : Bool) : (b || b) = b       := by cases b <;> rfl
@[simp] theorem Bool.or_eq_true (a b : Bool) : ((a || b) = true) = (a = true ∨ b = true) := by
  cases a <;> cases b <;> decide

@[simp] theorem Bool.and_false (b : Bool) : (b && false) = false := by cases b <;> rfl
@[simp] theorem Bool.and_true (b : Bool) : (b && true) = b       := by cases b <;> rfl
@[simp] theorem Bool.false_and (b : Bool) : (false && b) = false := by cases b <;> rfl
@[simp] theorem Bool.true_and (b : Bool) : (true && b) = b       := by cases b <;> rfl
@[simp] theorem Bool.and_self (b : Bool) : (b && b) = b          := by cases b <;> rfl
@[simp] theorem Bool.and_eq_true (a b : Bool) : ((a && b) = true) = (a = true ∧ b = true) := by
  cases a <;> cases b <;> decide

theorem Bool.and_assoc (a b c : Bool) : (a && b && c) = (a && (b && c)) := by
  cases a <;> cases b <;> cases c <;> decide
theorem Bool.or_assoc (a b c : Bool) : (a || b || c) = (a || (b || c)) := by
  cases a <;> cases b <;> cases c <;> decide

@[simp] theorem Bool.not_not (b : Bool) : (!!b) = b := by cases b <;> rfl
@[simp] theorem Bool.not_true  : (!true) = false := by decide
@[simp] theorem Bool.not_false : (!false) = true := by decide
@[simp] theorem Bool.not_beq_true (b : Bool) : (!(b == true)) = (b == false) := by cases b <;> rfl
@[simp] theorem Bool.not_beq_false (b : Bool) : (!(b == false)) = (b == true) := by cases b <;> rfl
@[simp] theorem Bool.not_eq_true' (b : Bool) : ((!b) = true) = (b = false) := by cases b <;> simp
@[simp] theorem Bool.not_eq_false' (b : Bool) : ((!b) = false) = (b = true) := by cases b <;> simp

@[simp] theorem Bool.beq_to_eq (a b : Bool) :
  (a == b) = (a = b) := by cases a <;> cases b <;> decide
@[simp] theorem Bool.not_beq_to_not_eq (a b : Bool) :
  (!(a == b)) = ¬(a = b) := by cases a <;> cases b <;> decide

@[simp] theorem Bool.not_eq_true (b : Bool) : (¬(b = true)) = (b = false) := by cases b <;> decide
@[simp] theorem Bool.not_eq_false (b : Bool) : (¬(b = false)) = (b = true) := by cases b <;> decide

@[simp] theorem decide_eq_true_eq [Decidable p] : (decide p = true) = p := propext <| Iff.intro of_decide_eq_true decide_eq_true
@[simp] theorem decide_not [h : Decidable p] : decide (¬ p) = !decide p := by cases h <;> rfl
@[simp] theorem not_decide_eq_true [h : Decidable p] : ((!decide p) = true) = ¬ p := by cases h <;> simp [decide, *]

@[simp] theorem heq_eq_eq {α : Sort u} (a b : α) : HEq a b = (a = b) := propext <| Iff.intro eq_of_heq heq_of_eq

@[simp] theorem cond_true (a b : α) : cond true a b = a := rfl
@[simp] theorem cond_false (a b : α) : cond false a b = b := rfl

@[simp] theorem beq_self_eq_true [BEq α] [LawfulBEq α] (a : α) : (a == a) = true := LawfulBEq.rfl
@[simp] theorem beq_self_eq_true' [DecidableEq α] (a : α) : (a == a) = true := by simp [BEq.beq]

@[simp] theorem bne_self_eq_false [BEq α] [LawfulBEq α] (a : α) : (a != a) = false := by simp [bne]
@[simp] theorem bne_self_eq_false' [DecidableEq α] (a : α) : (a != a) = false := by simp [bne]

@[simp] theorem Nat.le_zero_eq (a : Nat) : (a ≤ 0) = (a = 0) :=
  propext ⟨fun h => Nat.le_antisymm h (Nat.zero_le ..), fun h => by simp [h]⟩

@[simp] theorem decide_False : decide False = false := rfl
@[simp] theorem decide_True : decide True = true := rfl


import data.set
import .basis
import .basic

/-!
# What is going on here?

Here we define the notion of spanning, independence, and basis for a family of terms in a pregeometry.
By a family, we just mean a function `ι : S → T` from some other type `S`.

The following lemmas help in going back and forth between the definitions here and those in `src/pregeom/basis.lean`:
1. `spanning_iff_range_spanning` says that `ι` spans if and only if its image does.
2. `indep_iff_injective_range_indep` says that `ι` is independent if and only if `ι` is injective and its image is independent.
3. `basis_iff_injective_range_basis` says that `ι` is a basis if and only if `ι` is injective and its image is a basis.

-/

open_locale classical

variables {T : Type*}
variables {S : Type*} (ι : S → T)

namespace pregeom
namespace basis_family

open set
open function

/-- The restriction of ι to the complemenet of {x}. -/
def res (x : S) : {y : S // y ≠ x} → T := λ ⟨y,_⟩, ι y

/-- Independence for a family. -/
def is_indep [has_cl T] : Prop := ∀ x : S, ι x ∉ cl (range $ res ι x)

/-- Spanning condition for a family. -/
def is_spanning [has_cl T] : Prop := ∀ t : T, t ∈ cl (range ι)

/-- Definition of a basis for a family. -/
def is_basis [has_cl T] : Prop := is_indep ι ∧ is_spanning ι

variable {ι}

/-- If ι is injective, then the image of the restriction of ι to the complement of s is
the complement of ι s in the image of ι. -/
lemma range_res_eq_sub_range_of_injective {s : S} : injective ι → range (res ι s) = range ι \ {ι s} :=
begin
  intro h,
  ext, refine ⟨by tidy, _⟩,
  rintro ⟨⟨y,rfl⟩,h2⟩,
  use y,
  repeat {finish},
end

variable [pregeom T]

/-- If ι is independence, then ι is injective. -/
theorem injective_of_indep : is_indep ι → injective ι :=
begin
  intro indep,
  intros y x h,
  by_contradiction contra,
  replace indep := indep x,
  have : ι y ∈ range (res ι x), by exact ⟨⟨y,contra⟩, by finish⟩,
  rw h at this,
  replace this := inclusive this,
  contradiction,
end

/-- ι spans if and only if its image spans. -/
theorem spanning_iff_range_spanning : is_spanning ι ↔ basis.is_spanning (range ι) := by tauto

/-- ι is independent if and only if ι is injective and its image is independent. -/
theorem indep_iff_injective_range_indep : is_indep ι ↔ injective ι ∧ basis.is_indep (range ι) :=
begin
  split,
  { intro h,
    have c1 := injective_of_indep h,
    refine ⟨c1,_⟩,
    rintros _ ⟨y,rfl⟩,
    replace h := h y,
    change _ ∉ cl (range ι \ _),
    rwa ←range_res_eq_sub_range_of_injective c1, },
  { rintros ⟨h1,h2⟩,
    intro s,
    rw range_res_eq_sub_range_of_injective h1,
    apply h2,
    use s, }
end

/-- ι is a basis if and only if ι is injective and its image is a basis.
This can be used to go back and forth between the definition of bases for sets and for families.
 -/
theorem basis_iff_injective_range_basis : is_basis ι ↔ injective ι ∧ basis.is_basis (range ι) :=
begin
  split,
  { rintro ⟨h1,h2⟩,
    rw indep_iff_injective_range_indep at h1,
    exact ⟨h1.1,⟨h1.2,h2⟩⟩, },
  { rintro ⟨h1,h2,h3⟩,
    refine ⟨_,h3⟩,
    rw indep_iff_injective_range_indep,
    finish, }
end

end basis_family
end pregeom