/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis, Eric Wieser
-/

import group_theory.congruence
import linear_algebra.multilinear

/-!
# Tensor product of an indexed family of modules over commutative semirings

We define the tensor product of an indexed family `s : ι → Type*` of modules over commutative
semirings. We denote this space by `⨂[R] i, s i` and define it as `free_add_monoid (R × Π i, s i)`
quotiented by the appropriate equivalence relation. The treatment follows very closely that of the
binary tensor product in `linear_algebra/tensor_product.lean`.

## Main definitions

* `pi_tensor_product R s` with `R` a commutative semiring and `s : ι → Type*` is the tensor product
  of all the `s i`'s. This is denoted by `⨂[R] i, s i`.
* `tprod R f` with `f : Π i, s i` is the tensor product of the vectors `f i` over all `i : ι`.
  This is bundled as a multilinear map from `Π i, s i` to `⨂[R] i, s i`.
* `lift_add_hom` constructs an `add_monoid_hom` from `(⨂[R] i, s i)` to some space `F` from a
  function `φ : (R × Π i, s i) → F` with the appropriate properties.
* `lift φ` with `φ : multilinear_map R s E` is the corresponding linear map
  `(⨂[R] i, s i) →ₗ[R] E`. This is bundled as a linear equivalence.
* `pi_tensor_product.reindex e` re-indexes the components of `⨂[R] i : ι, M` along `e : ι ≃ ι₂`.
* `pi_tensor_product.tmul_equiv` equivalence between a `tensor_product` of `pi_tensor_product`s and
  a single `pi_tensor_product`.

## Notations

* `⨂[R] i, s i` is defined as localized notation in locale `tensor_product`
* `⨂ₜ[R] i, f i` with `f : Π i, f i` is defined globally as the tensor product of all the `f i`'s.

## Implementation notes

* We define it via `free_add_monoid (R × Π i, s i)` with the `R` representing a "hidden" tensor
  factor, rather than `free_add_monoid (Π i, s i)` to ensure that, if `ι` is an empty type,
  the space is isomorphic to the base ring `R`.
* We have not restricted the index type `ι` to be a `fintype`, as nothing we do here strictly
  requires it. However, problems may arise in the case where `ι` is infinite; use at your own
  caution.

## TODO

* Define tensor powers, symmetric subspace, etc.
* API for the various ways `ι` can be split into subsets; connect this with the binary
  tensor product.
* Include connection with holors.
* Port more of the API from the binary tensor product over to this case.

## Tags

multilinear, tensor, tensor product
-/

open function

section semiring

variables {ι ι₂ ι₃ : Type*} [decidable_eq ι] [decidable_eq ι₂] [decidable_eq ι₃]
variables {R : Type*} [comm_semiring R]
variables {R' : Type*} [comm_semiring R'] [algebra R' R]
variables {s : ι → Type*} [∀ i, add_comm_monoid (s i)] [∀ i, module R (s i)]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {E : Type*} [add_comm_monoid E] [module R E]
variables {F : Type*} [add_comm_monoid F]

namespace pi_tensor_product
include R
variables (R) (s)

/-- The relation on `free_add_monoid (R × Π i, s i)` that generates a congruence whose quotient is
the tensor product. -/
inductive eqv : free_add_monoid (R × Π i, s i) → free_add_monoid (R × Π i, s i) → Prop
| of_zero : ∀ (r : R) (f : Π i, s i) (i : ι) (hf : f i = 0), eqv (free_add_monoid.of (r, f)) 0
| of_zero_scalar : ∀ (f : Π i, s i), eqv (free_add_monoid.of (0, f)) 0
| of_add : ∀ (r : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i), eqv
    (free_add_monoid.of (r, update f i m₁) + free_add_monoid.of (r, update f i m₂))
    (free_add_monoid.of (r, update f i (m₁ + m₂)))
| of_add_scalar : ∀ (r r' : R) (f : Π i, s i), eqv
    (free_add_monoid.of (r, f) + free_add_monoid.of (r', f))
    (free_add_monoid.of (r + r', f))
| of_smul : ∀ (r : R) (f : Π i, s i) (i : ι) (r' : R), eqv
    (free_add_monoid.of (r, update f i (r' • (f i))))
    (free_add_monoid.of (r' * r, f))
| add_comm : ∀ x y, eqv (x + y) (y + x)

end pi_tensor_product

variables (R) (s)

/-- `pi_tensor_product R s` with `R` a commutative semiring and `s : ι → Type*` is the tensor
  product of all the `s i`'s. This is denoted by `⨂[R] i, s i`. -/
def pi_tensor_product : Type* :=
(add_con_gen (pi_tensor_product.eqv R s)).quotient

variables {R}

/- This enables the notation `⨂[R] i : ι, s i` for the pi tensor product, given `s : ι → Type*`. -/
localized "notation `⨂[`:100 R `] ` binders `, ` r:(scoped:67 f, pi_tensor_product R f) := r"
  in tensor_product

open_locale tensor_product

namespace pi_tensor_product

section module

instance : add_comm_monoid (⨂[R] i, s i) :=
{ add_comm := λ x y, add_con.induction_on₂ x y $ λ x y, quotient.sound' $
    add_con_gen.rel.of _ _ $ eqv.add_comm _ _,
  .. (add_con_gen (pi_tensor_product.eqv R s)).add_monoid }

instance : inhabited (⨂[R] i, s i) := ⟨0⟩

variables (R) {s}

/-- `tprod_coeff R r f` with `r : R` and `f : Π i, s i` is the tensor product of the vectors `f i`
over all `i : ι`, multiplied by the coefficient `r`. Note that this is meant as an auxiliary
definition for this file alone, and that one should use `tprod` defined below for most purposes. -/
def tprod_coeff (r : R) (f : Π i, s i) : ⨂[R] i, s i := add_con.mk' _ $ free_add_monoid.of (r, f)

variables {R}

lemma zero_tprod_coeff (f : Π i, s i) : tprod_coeff R 0 f = 0 :=
quotient.sound' $ add_con_gen.rel.of _ _ $ eqv.of_zero_scalar _

lemma zero_tprod_coeff' (z : R) (f : Π i, s i) (i : ι) (hf: f i = 0) : tprod_coeff R z f = 0 :=
quotient.sound' $ add_con_gen.rel.of _ _ $ eqv.of_zero _ _ i hf

lemma add_tprod_coeff (z : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i) :
  tprod_coeff R z (update f i m₁) + tprod_coeff R z (update f i m₂) =
    tprod_coeff R z (update f i (m₁ + m₂)) :=
quotient.sound' $ add_con_gen.rel.of _ _ (eqv.of_add z f i m₁ m₂)

lemma add_tprod_coeff' (z₁ z₂ : R) (f : Π i, s i) :
  tprod_coeff R z₁ f + tprod_coeff R z₂ f = tprod_coeff R (z₁ + z₂) f :=
quotient.sound' $ add_con_gen.rel.of _ _ (eqv.of_add_scalar z₁ z₂ f)

lemma smul_tprod_coeff_aux (z : R) (f : Π i, s i) (i : ι) (r : R) :
  tprod_coeff R z (update f i (r • f i)) = tprod_coeff R (r * z) f :=
 quotient.sound' $ add_con_gen.rel.of _ _ $ eqv.of_smul _ _ _ _

lemma smul_tprod_coeff (z : R) (f : Π i, s i) (i : ι) (r : R')
  [module R' (s i)] [is_scalar_tower R' R (s i)] :
  tprod_coeff R z (update f i (r • f i)) = tprod_coeff R (r • z) f :=
begin
  have h₁ : r • z = (r • (1 : R)) * z := by simp,
  have h₂ : r • (f i) = (r • (1 : R)) • f i := by simp,
  rw [h₁, h₂],
  exact smul_tprod_coeff_aux z f i _,
end

/-- Construct an `add_monoid_hom` from `(⨂[R] i, s i)` to some space `F` from a function
`φ : (R × Π i, s i) → F` with the appropriate properties. -/
def lift_add_hom (φ : (R × Π i, s i) → F)
  (C0 : ∀ (r : R) (f : Π i, s i) (i : ι) (hf : f i = 0), φ (r, f) = 0)
  (C0' : ∀ (f : Π i, s i), φ (0, f) = 0)
  (C_add : ∀ (r : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i),
    φ (r, update f i m₁) + φ (r, update f i m₂) = φ (r, update f i (m₁ + m₂)))
  (C_add_scalar : ∀ (r r' : R) (f : Π i, s i),
    φ (r , f) + φ (r', f) = φ (r + r', f))
  (C_smul : ∀ (r : R) (f : Π i, s i) (i : ι) (r' : R),
    φ (r, update f i (r' • (f i))) = φ (r' * r, f))
: (⨂[R] i, s i) →+ F :=
(add_con_gen (pi_tensor_product.eqv R s)).lift (free_add_monoid.lift φ) $ add_con.add_con_gen_le $
λ x y hxy, match x, y, hxy with
| _, _, (eqv.of_zero r' f i hf)        := (add_con.ker_rel _).2 $
    by simp [free_add_monoid.lift_eval_of, C0 r' f i hf]
| _, _, (eqv.of_zero_scalar f)        := (add_con.ker_rel _).2 $
    by simp [free_add_monoid.lift_eval_of, C0']
| _, _, (eqv.of_add z f i m₁ m₂)      := (add_con.ker_rel _).2 $
    by simp [free_add_monoid.lift_eval_of, C_add]
| _, _, (eqv.of_add_scalar z₁ z₂ f)      := (add_con.ker_rel _).2 $
    by simp [free_add_monoid.lift_eval_of, C_add_scalar]
| _, _, (eqv.of_smul z f i r')     := (add_con.ker_rel _).2 $
    by simp [free_add_monoid.lift_eval_of, C_smul]
| _, _, (eqv.add_comm x y)         := (add_con.ker_rel _).2 $
    by simp_rw [add_monoid_hom.map_add, add_comm]
end

-- Most of the time we want the instance below this one, which is easier for typeclass resolution
-- to find.
instance has_scalar' : has_scalar R' (⨂[R] i, s i) :=
⟨λ r, lift_add_hom (λ f : R × Π i, s i, tprod_coeff R (r • f.1) f.2)
  (λ r' f i hf, by simp_rw [zero_tprod_coeff' _ f i hf])
  (λ f, by simp [zero_tprod_coeff])
  (λ r' f i m₁ m₂, by simp [add_tprod_coeff])
  (λ r' r'' f, by simp [add_tprod_coeff', mul_add])
  (λ z f i r', by simp [smul_tprod_coeff])⟩

instance : has_scalar R (⨂[R] i, s i) := pi_tensor_product.has_scalar'

lemma smul_tprod_coeff' (r : R') (z : R) (f : Π i, s i) :
  r • (tprod_coeff R z f) = tprod_coeff R (r • z) f := rfl

protected theorem smul_add (r : R') (x y : ⨂[R] i, s i) :
  r • (x + y) = r • x + r • y :=
add_monoid_hom.map_add _ _ _

@[elab_as_eliminator]
protected theorem induction_on'
  {C : (⨂[R] i, s i) → Prop}
  (z : ⨂[R] i, s i)
  (C1 : ∀ {r : R} {f : Π i, s i}, C (tprod_coeff R r f))
  (Cp : ∀ {x y}, C x → C y → C (x + y)) : C z :=
begin
  have C0 : C 0,
  { have h₁ := @C1 0 0,
    rwa [zero_tprod_coeff] at h₁ },
  refine add_con.induction_on z (λ x, free_add_monoid.rec_on x C0 _),
  simp_rw add_con.coe_add,
  refine λ f y ih, Cp _ ih,
  convert @C1 f.1 f.2,
  simp only [prod.mk.eta],
end

-- Most of the time we want the instance below this one, which is easier for typeclass resolution
-- to find.
instance module' : module R' (⨂[R] i, s i) :=
{ smul := (•),
  smul_add := λ r x y, pi_tensor_product.smul_add r x y,
  mul_smul := λ r r' x,
    begin
      refine pi_tensor_product.induction_on' x _ _,
      { intros r'' f,
        simp [smul_tprod_coeff', smul_smul] },
      { intros x y ihx ihy,
        simp [pi_tensor_product.smul_add, ihx, ihy] }
    end,
  one_smul := λ x, pi_tensor_product.induction_on' x
    (λ f, by simp [smul_tprod_coeff' _ _])
    (λ z y ihz ihy, by simp_rw [pi_tensor_product.smul_add, ihz, ihy]),
  add_smul := λ r r' x,
    begin
      refine pi_tensor_product.induction_on' x _ _,
      { intros r f,
        simp [smul_tprod_coeff' _ _, add_smul, add_tprod_coeff'] },
      { intros x y ihx ihy,
        simp [pi_tensor_product.smul_add, ihx, ihy, add_add_add_comm] }
    end,
  smul_zero := λ r, add_monoid_hom.map_zero _,
  zero_smul := λ x,
    begin
      refine pi_tensor_product.induction_on' x _ _,
      { intros r f,
        simp_rw [smul_tprod_coeff' _ _, zero_smul],
        exact zero_tprod_coeff _ },
      { intros x y ihx ihy,
        rw [pi_tensor_product.smul_add, ihx, ihy, add_zero] },
    end }

instance : module R' (⨂[R] i, s i) := pi_tensor_product.module'

variables {R}

variables (R)
/-- The canonical `multilinear_map R s (⨂[R] i, s i)`. -/
def tprod : multilinear_map R s (⨂[R] i, s i) :=
{ to_fun := tprod_coeff R 1,
  map_add' := λ f i x y, (add_tprod_coeff (1 : R) f i x y).symm,
  map_smul' := λ f i r x,
    by simp_rw [smul_tprod_coeff', ←smul_tprod_coeff (1 : R) _ i, update_idem, update_same] }

variables {R}

notation `⨂ₜ[`:100 R`] ` binders `, ` r:(scoped:67 f, tprod R f) := r

@[simp]
lemma tprod_coeff_eq_smul_tprod (z : R) (f : Π i, s i) : tprod_coeff R z f = z • tprod R f :=
begin
  have : z = z • (1 : R) := by simp only [mul_one, algebra.id.smul_eq_mul],
  conv_lhs { rw this },
  rw ←smul_tprod_coeff',
  refl,
end

@[elab_as_eliminator]
protected theorem induction_on
  {C : (⨂[R] i, s i) → Prop}
  (z : ⨂[R] i, s i)
  (C1 : ∀ {r : R} {f : Π i, s i}, C (r • (tprod R f)))
  (Cp : ∀ {x y}, C x → C y → C (x + y)) : C z :=
begin
  simp_rw ←tprod_coeff_eq_smul_tprod at C1,
  exact pi_tensor_product.induction_on' z @C1 @Cp,
end

@[ext]
theorem ext {φ₁ φ₂ : (⨂[R] i, s i) →ₗ[R] E}
  (H : φ₁.comp_multilinear_map (tprod R) = φ₂.comp_multilinear_map (tprod R)) : φ₁ = φ₂ :=
begin
  refine linear_map.ext _,
  refine λ z,
    (pi_tensor_product.induction_on' z _ (λ x y hx hy, by rw [φ₁.map_add, φ₂.map_add, hx, hy])),
  { intros r f,
    rw [tprod_coeff_eq_smul_tprod, φ₁.map_smul, φ₂.map_smul],
    apply _root_.congr_arg,
    exact multilinear_map.congr_fun H f }
end

end module

section multilinear
open multilinear_map
variables {s}

/-- Auxiliary function to constructing a linear map `(⨂[R] i, s i) → E` given a
`multilinear map R s E` with the property that its composition with the canonical
`multilinear_map R s (⨂[R] i, s i)` is the given multilinear map. -/
def lift_aux (φ : multilinear_map R s E) : (⨂[R] i, s i) →+ E :=
  lift_add_hom (λ (p : R × Π i, s i), p.1 • (φ p.2))
    (λ z f i hf, by rw [map_coord_zero φ i hf, smul_zero])
    (λ f, by rw [zero_smul])
    (λ z f i m₁ m₂, by rw [←smul_add, φ.map_add])
    (λ z₁ z₂ f, by rw [←add_smul])
    (λ z f i r, by simp [φ.map_smul, smul_smul, mul_comm])

lemma lift_aux_tprod (φ : multilinear_map R s E) (f : Π i, s i) : lift_aux φ (tprod R f) = φ f :=
by simp only [lift_aux, lift_add_hom, tprod, multilinear_map.coe_mk, tprod_coeff,
              free_add_monoid.lift_eval_of, one_smul, add_con.lift_mk']

lemma lift_aux_tprod_coeff (φ : multilinear_map R s E) (z : R) (f : Π i, s i) :
  lift_aux φ (tprod_coeff R z f) = z • φ f :=
by simp [lift_aux, lift_add_hom, tprod_coeff, free_add_monoid.lift_eval_of]

lemma lift_aux.smul {φ : multilinear_map R s E} (r : R) (x : ⨂[R] i, s i) :
  lift_aux φ (r • x) = r • lift_aux φ x :=
begin
  refine pi_tensor_product.induction_on' x _ _,
  { intros z f,
    rw [smul_tprod_coeff' r z f, lift_aux_tprod_coeff, lift_aux_tprod_coeff, smul_assoc] },
  { intros z y ihz ihy,
    rw [smul_add, (lift_aux φ).map_add, ihz, ihy, (lift_aux φ).map_add, smul_add] }
end

/-- Constructing a linear map `(⨂[R] i, s i) → E` given a `multilinear_map R s E` with the
property that its composition with the canonical `multilinear_map R s E` is
the given multilinear map `φ`. -/
def lift : (multilinear_map R s E) ≃ₗ[R] ((⨂[R] i, s i) →ₗ[R] E) :=
{ to_fun := λ φ, { map_smul' := lift_aux.smul, .. lift_aux φ },
  inv_fun := λ φ', φ'.comp_multilinear_map (tprod R),
  left_inv := λ φ, by { ext, simp [lift_aux_tprod, linear_map.comp_multilinear_map] },
  right_inv := λ φ, by { ext, simp [lift_aux_tprod] },
  map_add' := λ φ₁ φ₂, by { ext, simp [lift_aux_tprod] },
  map_smul' := λ r φ₂, by { ext, simp [lift_aux_tprod] } }

variables {φ : multilinear_map R s E}

@[simp] lemma lift.tprod (f : Π i, s i) : lift φ (tprod R f) = φ f := lift_aux_tprod φ f
theorem lift.unique' {φ' : (⨂[R] i, s i) →ₗ[R] E} (H : φ'.comp_multilinear_map (tprod R) = φ) :
  φ' = lift φ :=
ext $ H.symm ▸ (lift.symm_apply_apply φ).symm

@[simp]
theorem lift_symm (φ' : (⨂[R] i, s i) →ₗ[R] E) : lift.symm φ' = φ'.comp_multilinear_map (tprod R) :=
rfl

@[simp]
theorem lift_tprod : lift (tprod R : multilinear_map R s _) = linear_map.id :=
eq.symm $ lift.unique' rfl

section

variables (R M)
/-- Re-index the components of the tensor power by `e`.

For simplicity, this is defined only for homogeneously- (rather than dependently-) typed components.
-/
def reindex (e : ι ≃ ι₂) : ⨂[R] i : ι, M ≃ₗ[R] ⨂[R] i : ι₂, M :=
linear_equiv.of_linear
  ((lift.symm.trans $
    multilinear_map.dom_dom_congr_linear_equiv M (⨂[R] i : ι₂, M) R R e.symm).trans
      lift (linear_map.id))
  ((lift.symm.trans $
    multilinear_map.dom_dom_congr_linear_equiv M (⨂[R] i : ι, M) R R e).trans
      lift (linear_map.id))
  (by { ext, simp })
  (by { ext, simp })

end

@[simp] lemma reindex_tprod (e : ι ≃ ι₂) (f : Π i, M) :
  reindex R M e (tprod R f) = tprod R (λ i, f (e.symm i)) :=
lift.tprod f

@[simp] lemma reindex_comp_tprod (e : ι ≃ ι₂) :
  (reindex R M e : ⨂[R] i : ι, M →ₗ[R] ⨂[R] i : ι₂, M).comp_multilinear_map (tprod R) =
    (tprod R : multilinear_map R (λ i, M) _).dom_dom_congr e.symm :=
multilinear_map.ext $ reindex_tprod e

@[simp] lemma lift_comp_reindex (e : ι ≃ ι₂) (φ : multilinear_map R (λ _ : ι₂, M) E) :
  (lift φ).comp ↑(reindex R M e) = lift (φ.dom_dom_congr e.symm) :=
by { ext, simp, }

@[simp]
lemma lift_reindex (e : ι ≃ ι₂) (φ : multilinear_map R (λ _, M) E) (x : ⨂[R] i, M) :
  lift φ (reindex R M e x) = lift (φ.dom_dom_congr e.symm) x :=
linear_map.congr_fun (lift_comp_reindex e φ) x

@[simp] lemma reindex_trans (e : ι ≃ ι₂) (e' : ι₂ ≃ ι₃) :
  (reindex R M e).trans (reindex R M e') = reindex R M (e.trans e') :=
begin
  apply linear_equiv.to_linear_map_injective,
  ext f,
  simp only [linear_equiv.trans_apply, linear_equiv.coe_coe, reindex_tprod,
    linear_map.coe_comp_multilinear_map, function.comp_app, multilinear_map.dom_dom_congr_apply,
    reindex_comp_tprod],
  congr,
end

@[simp] lemma reindex_symm (e : ι ≃ ι₂) :
  (reindex R M e).symm = reindex R M e.symm := rfl

@[simp] lemma reindex_refl : reindex R M (equiv.refl ι) = linear_equiv.refl R _ :=
begin
  apply linear_equiv.to_linear_map_injective,
  ext1,
  rw [reindex_comp_tprod, linear_equiv.refl_to_linear_map, equiv.refl_symm],
  refl,
end

/-- The tensor product over an empty set of indices is isomorphic to the base ring -/
def pempty_equiv : ⨂[R] i : pempty, M ≃ₗ[R] R :=
{ to_fun := lift ⟨λ (_ : pempty → M), (1 : R), λ v, pempty.elim, λ v, pempty.elim⟩,
  inv_fun := λ r, r • tprod R (λ v, pempty.elim v),
  left_inv := λ x, by {
    apply x.induction_on,
    { intros r f,
      have : f = (λ i, pempty.elim i) := funext (λ i, pempty.elim i),
      simp [this], },
    { simp only,
      intros x y hx hy,
      simp [add_smul, hx, hy] }},
  right_inv := λ t, by simp only [mul_one, algebra.id.smul_eq_mul, multilinear_map.coe_mk,
    linear_map.map_smul, pi_tensor_product.lift.tprod],
  map_add' := linear_map.map_add _,
  map_smul' := linear_map.map_smul _, }

section tmul

/-- Collapse a `tensor_product` of `pi_tensor_product`s. -/
private def tmul : (⨂[R] i : ι, M) ⊗[R] (⨂[R] i : ι₂, M) →ₗ[R] ⨂[R] i : ι ⊕ ι₂, M :=
tensor_product.lift
  { to_fun := λ a, pi_tensor_product.lift $ pi_tensor_product.lift
      (multilinear_map.curry_sum_equiv R _ _ M _ (tprod R)) a,
    map_add' := λ a b, by simp only [linear_equiv.map_add, linear_map.map_add],
    map_smul' := λ r a, by simp only [linear_equiv.map_smul, linear_map.map_smul], }

private lemma tmul_apply (a : ι → M) (b : ι₂ → M) :
  tmul ((⨂ₜ[R] i, a i) ⊗ₜ[R] (⨂ₜ[R] i, b i)) = ⨂ₜ[R] i, sum.elim a b i :=
begin
  erw [tensor_product.lift.tmul, pi_tensor_product.lift.tprod, pi_tensor_product.lift.tprod],
  refl
end

/-- Expand `pi_tensor_product` into a `tensor_product` of two factors. -/
private def tmul_symm : ⨂[R] i : ι ⊕ ι₂, M →ₗ[R] (⨂[R] i : ι, M) ⊗[R] (⨂[R] i : ι₂, M) :=
-- by using tactic mode, we avoid the need for a lot of `@`s and `_`s
pi_tensor_product.lift $ by apply multilinear_map.dom_coprod; [exact tprod R, exact tprod R]

private lemma tmul_symm_apply (a : ι ⊕ ι₂ → M) :
  tmul_symm (⨂ₜ[R] i, a i) = (⨂ₜ[R] i, a (sum.inl i)) ⊗ₜ[R] (⨂ₜ[R] i, a (sum.inr i)) :=
pi_tensor_product.lift.tprod _

variables (R M)

/-- Equivalence between a `tensor_product` of `pi_tensor_product`s and a single
`pi_tensor_product` indexed by a `sum` type.

For simplicity, this is defined only for homogeneously- (rather than dependently-) typed components.
-/
def tmul_equiv : (⨂[R] i : ι, M) ⊗[R] (⨂[R] i : ι₂, M) ≃ₗ[R] ⨂[R] i : ι ⊕ ι₂, M :=
linear_equiv.of_linear tmul tmul_symm
  (by { ext x,
        show tmul (tmul_symm (tprod R x)) = tprod R x, -- Speed up the call to `simp`.
        simp only [tmul_symm_apply, tmul_apply, sum.elim_comp_inl_inr], })
  (by { ext x y,
        show tmul_symm (tmul (tprod R x ⊗ₜ[R] tprod R y)) = tprod R x ⊗ₜ[R] tprod R y,
        simp only [tmul_apply, tmul_symm_apply, sum.elim_inl, sum.elim_inr], })

@[simp] lemma tmul_equiv_apply (a : ι → M) (b : ι₂ → M) :
  tmul_equiv R M ((⨂ₜ[R] i, a i) ⊗ₜ[R] (⨂ₜ[R] i, b i)) = ⨂ₜ[R] i, sum.elim a b i :=
tmul_apply a b

@[simp] lemma tmul_equiv_symm_apply (a : ι ⊕ ι₂ → M) :
  (tmul_equiv R M).symm (⨂ₜ[R] i, a i) = (⨂ₜ[R] i, a (sum.inl i)) ⊗ₜ[R] (⨂ₜ[R] i, a (sum.inr i)) :=
tmul_symm_apply a

end tmul

end multilinear

end pi_tensor_product

end semiring

section ring
namespace pi_tensor_product

open pi_tensor_product
open_locale tensor_product

variables {ι : Type*} [decidable_eq ι] {R : Type*} [comm_ring R]
variables {s : ι → Type*} [∀ i, add_comm_group (s i)] [∀ i, module R (s i)]

/- Unlike for the binary tensor product, we require `R` to be a `comm_ring` here, otherwise
this is false in the case where `ι` is empty. -/
instance : add_comm_group (⨂[R] i, s i) := module.add_comm_monoid_to_add_comm_group R

end pi_tensor_product
end ring


/-
Copyright (c) 2020 The Xena project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kevin Buzzard
Thanks: Imperial College London, leanprover-community
-/

import data.polynomial -- polynomials in one variable over rings
import complex.field -- solutions to levels 1 to 5
/-!

# Level 6: The complex numbers are algebraically closed

-/

namespace complex

open polynomial

lemma exists_root {f : polynomial ℂ} (hf : 0 < degree f) : ∃ z : ℂ, is_root f z :=
begin
  sorry
end

end complex

/-
Chris Hughes, an undergraduate mathematician at Imperial College London, proved
this result in Lean and PR'ed it to Lean's maths library.

Here is the link to the docs
https://leanprover-community.github.io/mathlib_docs/analysis/complex/polynomial.html

and here is the code
https://github.com/leanprover-community/mathlib/blob/3710744/src/analysis/complex/polynomial.lean#L34
-/


import algebra.euclidean_domain ring_theory.ideals
universes u v
variables {α : Type u} {β : Type v} [comm_ring α] {a b : α}

open set function
local attribute [instance] classical.prop_decidable

class is_principal_ideal (S : set α) : Prop :=
(principal : ∃ a : α, S = {x | a ∣ x})

class principal_ideal_domain (α : Type u) extends integral_domain α :=
(principal : ∀ (S : set α) [is_ideal S], is_principal_ideal S)

namespace is_principal_ideal

noncomputable def generator (S : set α) [is_principal_ideal S] : α :=
classical.some (principal S)

lemma generator_generates (S : set α) [is_principal_ideal S] : {x | generator S ∣ x} = S :=
eq.symm (classical.some_spec (principal S))

instance to_is_ideal (S : set α) [is_principal_ideal S] : is_ideal S :=
{ to_is_submodule :=
  { zero_ := by rw ← generator_generates S; simp,
    add_ := λ x y h, by rw ← generator_generates S at *; exact (dvd_add_iff_right h).1,
    smul := λ c x h, by rw ← generator_generates S at h ⊢; exact dvd_mul_of_dvd_right h _ } }

end is_principal_ideal

@[simp] lemma zero_dvd_iff {α : Type u} [comm_semiring α] {a : α} : 0 ∣ a ↔ a = 0 :=
⟨eq_zero_of_zero_dvd, λ h, by rw h⟩

open euclidean_domain is_principal_ideal

lemma mod_eq_sub_mul_div {α : Type*} [euclidean_domain α] (a b : α) :
  a % b = a - b * (a / b) :=
calc a % b = b * (a / b) + a % b - b * (a / b) : by simp
... = a - b * (a / b) : by rw div_add_mod

lemma mod_mem_iff {α : Type*} [euclidean_domain α] {S : set α} [is_ideal S] {x y : α}
  (hy : y ∈ S) : x % y ∈ S ↔ x ∈ S :=
⟨λ hxy, div_add_mod x y ▸ is_ideal.add (is_ideal.mul_right hy) hxy,
  λ hx, (mod_eq_sub_mul_div x y).symm ▸ is_ideal.sub hx (is_ideal.mul_right hy)⟩

instance euclidean_domain.to_principal_ideal_domain {α : Type*} [euclidean_domain α] :
  principal_ideal_domain α :=
{ principal := λ S h, by exactI
    ⟨if h : {x : α | x ∈ S ∧ x ≠ 0} = ∅
    then ⟨0, set.ext $ λ a, ⟨by finish [set.ext_iff],
            λ h₁, (show a = 0, by simpa using h₁).symm ▸ is_ideal.zero S⟩⟩
    else
    have wf : well_founded euclidean_domain.r := euclidean_domain.r_well_founded α,
    have hmin : well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h ∈ S ∧
        well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h ≠ 0,
      from well_founded.min_mem wf {x : α | x ∈ S ∧ x ≠ 0} h,
    ⟨well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h,
      set.ext $ λ x,
      ⟨λ hx, div_add_mod x (well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h) ▸
        dvd_add (dvd_mul_right _ _)
        (have (x % (well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h) ∉ {x : α | x ∈ S ∧ x ≠ 0}),
          from λ h₁, well_founded.not_lt_min wf _ h h₁ (mod_lt x hmin.2),
        have x % well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h = 0, by finish [(mod_mem_iff hmin.1).2 hx],
        by simp *),
      λ hx, let ⟨y, hy⟩ := hx in hy.symm ▸ is_ideal.mul_right hmin.1⟩⟩⟩ }
#print set.subset_a
def is_prime_ideal.to_maximal_ideal {α : Type*} [principal_ideal_domain α] (S : set α)
  [hpi : is_prime_ideal S] : is_maximal_ideal S :=
{ eq_or_univ_of_subset := λ T hT (hST : S ⊆ T), begin
    haveI := principal_ideal_domain.principal S,
    haveI := @principal_ideal_domain.principal _ _ T { ..hT },
    rw [← generator_generates S, ← generator_generates T] at *,
    cases hST (dvd_refl _) with x hx,
    cases is_prime_ideal.mem_or_mem_of_mul_mem
      (show generator T * x ∈ {x : α | generator S ∣ x}, by simp [hx.symm]),
    { exact or.inl (set.subset.antisymm (λ y, dvd.trans h) hST) },
    { right,
      cases h with y hy,
      dsimp at *, }
  end,
  ..hpi }


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem amc12b_2003_p6
  (a r : ℝ)
  (u : ℕ → ℝ)
  (h₀ : ∀ k, u k = a * r^k)
  (h₁ : u 1 = 2)
  (h₂ : u 3 = 6) :
  u 0 = 2 / real.sqrt 3 ∨ u 0 = - (2 / real.sqrt 3) :=
begin
  simp * at *,
  apply eq_or_eq_neg_of_sq_eq_sq,
  norm_num [pow_bit1, *],
  norm_num [pow_succ, mul_assoc, mul_comm a] at h₂,
  field_simp [pow_succ', mul_comm a, h₀, mul_left_comm, *] at *,
  rw [mul_assoc, mul_comm],
  nlinarith,
end


import .love08_operational_semantics_demo

/-! # LoVe Demo 10: Denotational Semantics

We review a third way to specify the semantics of a programming language:
denotational semantics. Denotational semantics attempt to directly specify the
meaning of programs.

If operational semantics is an idealized interpreter and Hoare logic is an
idealized verifier, then denotational semantics is an idealized compiler. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Compositionality

A __denotational semantics__ defines the meaning of each program as a
mathematical object:

    `⟦ ⟧ : syntax → semantics`

A key property of denotational semantics is __compositionality__: The meaning of
a compound statement should be defined in terms of the meaning of its
components. This disqualifies

    `⟦S⟧ = {st | (S, prod.fst st) ⟹ prod.snd st}`

i.e.

    `⟦S⟧ = {(s, t) | (S, s) ⟹ t}`

because operational semantics are not compositional.

In short, we want

    `⟦S ; T⟧              = … ⟦S⟧ … ⟦T⟧ …`
    `⟦if b then S else T⟧ = … ⟦S⟧ … ⟦T⟧ …`
    `⟦while b do S⟧       = … ⟦S⟧ …`

An evaluation function on arithmetic expressions

    `eval : aexp → ((string → ℤ) → ℤ)`

is a denotational semantics. We want the same for imperative programs.

## A Relational Denotational Semantics

We can represent the semantics of an imperative program as a function from
initial state to final state or more generally as a relation between initial
state and final state: `set (state × state)`.

A program's meaning is defined to be the set of possible input/output pairs.

For `skip`, `:=`, `;`, and `if then else`, the denotational semantics is
easy: -/

namespace sorry_defs

#print Id
#print comp
#print restrict

def denote : stmt → set (state × state)
| stmt.skip         := Id
| (stmt.assign n a) :=
  {st | prod.snd st = (prod.fst st){n ↦ a (prod.fst st)}}
| (stmt.seq S T)    := denote S ◯ denote T
| (stmt.ite b S T)  :=
  (denote S ⇃ b) ∪ (denote T ⇃ (λs, ¬ b s))
| (stmt.while b S)  := sorry

end sorry_defs

/-! We write `⟦S⟧` for `denote S`. For `while`, we would like to write

    `((denote S ◯ denote (stmt.while b S)) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s))`

but this is ill-founded due to the recursive call on `stmt.while b S`.

What we are looking for is an `X` such that

    `X = ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s))`

In other words, we are looking for a fixpoint.

Most of this lecture is concerned with building a least fixpoint operator
`lfp` that will allow us to define the `while` case as well:

    `lfp (λX, ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s)))`

## Fixpoints

A __fixpoint__ (or fixed point) of `f` is a solution for `X` in the equation

    `X = f X`

In general, fixpoints may not exist at all (e.g., `f := nat.succ`), or there may
be several fixpoints (e.g., `f := id`). But under some conditions on `f`, a
unique __least fixpoint__ and a unique __greatest fixpoint__ are guaranteed to
exist.

Consider this __fixpoint equation__:

    `X = (λ(p : ℕ → Prop) (n : ℕ), n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ p m) X`
      `= (λn : ℕ, n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ X m)`

where `X : ℕ → Prop` and
`f := (λ(p : ℕ → Prop) (n : ℕ), n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ p m)`.

The above example admits only one fixpoint. The fixpoint equation uniquely
specifies `X` as the set of even numbers.

In general, the least and greatest fixpoint may be different:

    `X = X`

Here, the least fixpoint is `(λ_, False)` and the greatest fixpoint is
`(λ_, True)`. Conventionally, `False < True`, and thus
`(λ_, False) < (λ_, True)`. Similarly, `∅ < @set.univ α` (assuming `α` is
inhabited).

For the semantics of programming languages:

* `X` will have type `set (state × state)` (which is isomorphic to
  `state → state → Prop`), representing relations between states;

* `f` will correspond to either taking one extra iteration of the loop (if the
  condition `b` is true) or the identity (if `b` is false).

**Key observation**:

    Inductive predicates correspond to least fixpoints, but they are built into
    Lean's logic (the calculus of inductive constructions).

## Monotone Functions

Let `α` and `β` be types with partial order `≤`. A function `f : α → β` is
__monotone__ if

    `a ≤ b → f a ≤ f b`   for all `a`, `b`

Many operations on sets (e.g., `∪`), relations (e.g., `◯`), and functions
(e.g., `λx, x`, `λ_, k`, `∘`) are monotone or preserve monotonicity.

All monotone functions `f : set α → set α` admit least and greatest fixpoints.

**Example of a nonmonotone function**:

    `f A = (if A = ∅ then set.univ else ∅)`

Assuming `α` is inhabited, we have `∅ ⊆ set.univ`, but
`f ∅ = set.univ ⊈ ∅ = f set.univ`. -/
#print partial_order

def monotone {α β : Type} [partial_order α] [partial_order β]
  (f : α → β) : Prop :=
∀a₁ a₂, a₁ ≤ a₂ → f a₁ ≤ f a₂

lemma monotone_id {α : Type} [partial_order α] :
  monotone (λa : α, a) :=
begin
  rw monotone,
  intros a₁ a₂ ha,
  exact ha
end

lemma monotone_const {α β : Type} [partial_order α]
    [partial_order β] (b : β) :
  monotone (λ_ : α, b) :=
begin
  intros a₁ a₂ ha,
  simp
end

lemma monotone_union {α β : Type} [partial_order α]
    (f g : α → set β) (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ∪ g a) :=
begin
  rw monotone,
  intros a₁ a₂ ha b hb,
  cases' hb,
  { exact set.mem_union_left (g a₂) (hf a₁ a₂ ha h) },
  { exact or.intro_right _ (hg a₁ a₂ ha h) }
end

/-! We will prove the following two lemmas in the exercise. -/

namespace sorry_lemmas

lemma monotone_comp {α β : Type} [partial_order α]
    (f g : α → set (β × β)) (hf : monotone f)
    (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
sorry

lemma monotone_restrict {α β : Type} [partial_order α]
    (f : α → set (β × β)) (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
sorry

end sorry_lemmas

/-! ## Complete Lattices

To define the least fixpoint on sets, we need `⊆` and `⋂`. Complete lattices
capture this concept abstractly. A __complete lattice__ is an ordered type `α`
for which each set of type `set α` has an infimum.

More precisely, A complete lattice consists of

* a partial order `≤ : α → α → Prop` (i.e., a reflexive, transitive, and
  antisymmetric binary predicate);

* an operator `Inf : set α → α`, called __infimum__.

Moreover, `Inf A` must satisfy these two properties:

* `Inf A` is a lower bound of `A`: `Inf A ≤ b` for all `b ∈ A`;

* `Inf A` is a greatest lower bound: `b ≤ Inf A` for all `b` such that
  `∀a, a ∈ A → b ≤ a`.

**Warning:** `Inf A` is not necessarily an element of `A`.

Examples:

* `set α` is an instance w.r.t. `⊆` and `⋂` for all `α`;
* `Prop` is an instance w.r.t. `→` and `∀` (`Inf A := ∀a ∈ A, a`);
* `enat := ℕ ∪ {∞}`;
* `ereal := ℝ ∪ {- ∞, ∞}`;
* `β → α` if `α` is a complete lattice;
* `α × β` if `α`, `β` are complete lattices.

Finite example (with apologies for the ASCII art):

                Z            Inf {}           = ?
              /   \          Inf {Z}          = ?
             A     B         Inf {A, B}       = ?
              \   /          Inf {Z, A}       = ?
                Y            Inf {Z, A, B, Y} = ?

Nonexamples:

* `ℕ`, `ℤ`, `ℚ`, `ℝ`: no infimum for `∅`, `Inf ℕ`, etc.
* `erat := ℚ ∪ {- ∞, ∞}`: `Inf {q | 2 < q * q} = sqrt 2` is not in `erat`. -/

@[class] structure complete_lattice (α : Type)
  extends partial_order α : Type :=
(Inf    : set α → α)
(Inf_le : ∀A b, b ∈ A → Inf A ≤ b)
(le_Inf : ∀A b, (∀a, a ∈ A → b ≤ a) → b ≤ Inf A)

/-! For sets: -/

@[instance] def set.complete_lattice {α : Type} :
  complete_lattice (set α) :=
{ le          := (⊆),
  le_refl     := by tautology,
  le_trans    := by tautology,
  le_antisymm :=
    begin
      intros A B hAB hBA,
      apply set.ext,
      tautology
    end,
  Inf         := λX, {a | ∀A, A ∈ X → a ∈ A},
  Inf_le      := by tautology,
  le_Inf      := by tautology }

/-! ## Least Fixpoint -/

def lfp {α : Type} [complete_lattice α] (f : α → α) : α :=
complete_lattice.Inf ({a | f a ≤ a})

lemma lfp_le {α : Type} [complete_lattice α] (f : α → α)
    (a : α) (h : f a ≤ a) :
  lfp f ≤ a :=
complete_lattice.Inf_le _ _ h

lemma le_lfp {α : Type} [complete_lattice α] (f : α → α)
    (a : α) (h : ∀a', f a' ≤ a' → a ≤ a') :
  a ≤ lfp f :=
complete_lattice.le_Inf _ _ h

/-! **Knaster-Tarski theorem:** For any monotone function `f`:

* `lfp f` is a fixpoint: `lfp f = f (lfp f)` (lemma `lfp_eq`);
* `lfp f` is smaller than any other fixpoint: `X = f X → lfp f ≤ X`. -/

lemma lfp_eq {α : Type} [complete_lattice α] (f : α → α)
    (hf : monotone f) :
  lfp f = f (lfp f) :=
begin
  have h : f (lfp f) ≤ lfp f :=
    begin
      apply le_lfp,
      intros a' ha',
      apply @le_trans _ _ _ (f a'),
      { apply hf,
        apply lfp_le,
        assumption },
      { assumption }
    end,
  apply le_antisymm,
  { apply lfp_le,
    apply hf,
    assumption },
  { assumption }
end

lemma lfp_least {α : Type} [complete_lattice α] (f : α → α) (X : α) (hX : X = f X) :
  lfp f ≤ X :=
begin
  apply lfp_le,
  rw ← hX,
  -- `rw ← hX` is syntax for "rewrite with hX, right to left."
  -- It will replace `f X` with `X`.
  -- At that point, the goal is `X ≤ X`, which is solved automatically.
end

/-! ## A Relational Denotational Semantics, Continued -/

def denote : stmt → set (state × state)
| stmt.skip         := Id
| (stmt.assign x a) :=
  {st | prod.snd st = (prod.fst st){x ↦ a (prod.fst st)}}
| (stmt.seq S T)    := denote S ◯ denote T
| (stmt.ite b S T)  :=
  (denote S ⇃ b) ∪ (denote T ⇃ (λs, ¬ b s))
| (stmt.while b S)  :=
  lfp (λX, ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s)))

notation `⟦` S `⟧`:= denote S

/-
This proof is entirely compositional:
we just need to combine the monotone rules we've proved in the right order.
You could imagine this being done automatically...

Exercise: write this as a term mode proof!
-/
lemma lfp_monotone (b : state → Prop) (S : stmt) :
  monotone ((λX, ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s)))) :=
begin
  apply monotone_union,
  { apply sorry_lemmas.monotone_restrict,
    apply sorry_lemmas.monotone_comp,
    { exact monotone_const _ },
    { exact monotone_id } },
  { apply sorry_lemmas.monotone_restrict,
    exact monotone_const _ }
end

/-! ## Application to Program Equivalence

Based on the denotational semantics, we introduce the notion of program
equivalence: `S₁ ~ S₂`. (Compare with exercise 8.) -/

def denote_equiv (S₁ S₂ : stmt) : Prop :=
⟦S₁⟧ = ⟦S₂⟧

infix ` ~ ` := denote_equiv

/-! It is obvious from the definition that `~` is an equivalence relation.

Program equivalence can be used to replace subprograms by other subprograms with
the same semantics. This is achieved by the following congruence rules: -/

lemma denote_equiv.seq_congr {S₁ S₂ T₁ T₂ : stmt}
    (hS : S₁ ~ S₂) (hT : T₁ ~ T₂) :
  S₁ ;; T₁ ~ S₂ ;; T₂ :=
by simp [denote_equiv, denote, *] at *

lemma denote_equiv.ite_congr {b} {S₁ S₂ T₁ T₂ : stmt}
    (hS : S₁ ~ S₂) (hT : T₁ ~ T₂) :
  stmt.ite b S₁ T₁ ~ stmt.ite b S₂ T₂ :=
by simp [denote_equiv, denote, *] at *

lemma denote_equiv.while_congr {b} {S₁ S₂ : stmt}
    (hS : S₁ ~ S₂) :
  stmt.while b S₁ ~ stmt.while b S₂ :=
by simp [denote_equiv, denote, *] at *

/-! Compare the simplicity of these proofs with the corresponding proofs for a
big-step semantics (exercise 8).

Let us prove some program equivalences. -/

lemma denote_equiv.skip_assign_id {x} :
  stmt.assign x (λs, s x) ~ stmt.skip :=
by simp [denote_equiv, denote, Id]

lemma denote_equiv.seq_skip_left {S : stmt} :
  stmt.skip ;; S ~ S :=
by simp [denote_equiv, denote, Id, comp]

lemma denote_equiv.seq_skip_right {S : stmt} :
  S ;; stmt.skip ~ S :=
by simp [denote_equiv, denote, Id, comp]

lemma denote_equiv.ite_seq_while {b} {S : stmt} :
  stmt.ite b (S ;; stmt.while b S) stmt.skip ~ stmt.while b S :=
begin
  simp [denote_equiv, denote],
  apply eq.symm,
  apply lfp_eq,
  apply monotone_union,
  { apply sorry_lemmas.monotone_restrict,
    apply sorry_lemmas.monotone_comp,
    { exact monotone_const _ },
    { exact monotone_id } },
  { apply sorry_lemmas.monotone_restrict,
    exact monotone_const _ }
end

/-! ## Equivalence of the Denotational and the Big-Step Semantics
## (**optional**) -/

lemma denote_of_big_step (S : stmt) (s t : state) (h : (S, s) ⟹ t) :
  (s, t) ∈ ⟦S⟧ :=
begin
  induction' h; try { solve1 { simp [denote, *] } },
  case seq {
    apply exists.intro t,
    exact and.intro ih_h ih_h_1 },
  case while_true {
    rw eq.symm denote_equiv.ite_seq_while,
    simp [denote, *],
    apply exists.intro t,
    apply and.intro; assumption },
  case while_false {
    rw eq.symm denote_equiv.ite_seq_while,
    simp [denote, *] }
end

lemma big_step_of_denote :
  ∀(S : stmt) (s t : state), (s, t) ∈ ⟦S⟧ → (S, s) ⟹ t
| stmt.skip         s t := by simp [denote]
| (stmt.assign n a) s t := by simp [denote]
| (stmt.seq S T)    s t :=
  begin
    intro h,
    cases' h with u hu,
    exact big_step.seq
      (big_step_of_denote S _ _ (and.elim_left hu))
      (big_step_of_denote T _ _ (and.elim_right hu))
  end
| (stmt.ite b S T)  s t :=
  begin
    intro h,
    cases' h,
    case inl {
      cases' h,
      apply big_step.ite_true right,
      exact big_step_of_denote _ _ _ left },
    case inr {
      cases' h,
      apply big_step.ite_false right,
      exact big_step_of_denote _ _ _ left }
  end
| (stmt.while b S)  s t :=
  begin
    have hw : ⟦stmt.while b S⟧
        ≤ {st | (stmt.while b S, prod.fst st) ⟹ prod.snd st} :=
      begin
        apply lfp_le _ _ _,
        intros x hx,
        cases' x with s' t',
        simp at hx,
        cases' hx,
        case inl {
          cases' h with hst hs,
          cases' hst with u hu,
          apply big_step.while_true hs,
          { exact big_step_of_denote S _ _ (and.elim_left hu) },
          { exact and.elim_right hu } },
        case inr {
          cases' h,
          cases' left,
          apply big_step.while_false right }
      end,
    apply hw
  end

lemma denote_iff_big_step (S : stmt) (s t : state) :
  (s, t) ∈ ⟦S⟧ ↔ (S, s) ⟹ t :=
iff.intro (big_step_of_denote S s t) (denote_of_big_step S s t)

/-! ## A Simpler Approach Based on an Inductive Predicate (**optional**) -/

inductive awhile (b : state → Prop)
    (r : set (state × state)) :
  state → state → Prop
| true {s t u} (hcond : b s) (hbody : (s, t) ∈ r)
    (hrest : awhile t u) :
  awhile s u
| false {s} (hcond : ¬ b s) :
  awhile s s

def denote_ind : stmt → set (state × state)
| stmt.skip         := Id
| (stmt.assign x a) :=
  {st | prod.snd st = (prod.fst st){x ↦ a (prod.fst st)}}
| (stmt.seq S T)    := denote_ind S ◯ denote_ind T
| (stmt.ite b S T)  :=
  (denote_ind S ⇃ b) ∪ (denote_ind T ⇃ (λs, ¬ b s))
| (stmt.while b S)  :=
  {st | awhile b (denote_ind S) (prod.fst st) (prod.snd st)}

end LoVe