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

! This file was ported from Lean 3 source module data.prod.tprod
! leanprover-community/mathlib commit c227d107bbada5d0d9d20287e3282c0a7f1651a0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Nodup

/-!
# Finite products of types

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

This file defines the product of types over a list. For `l : list ι` and `α : ι → Type*` we define
`list.tprod α l = l.foldr (λ i β, α i × β) punit`.
This type should not be used if `Π i, α i` or `Π i ∈ l, α i` can be used instead
(in the last expression, we could also replace the list `l` by a set or a finset).
This type is used as an intermediary between binary products and finitary products.
The application of this type is finitary product measures, but it could be used in any
construction/theorem that is easier to define/prove on binary products than on finitary products.

* Once we have the construction on binary products (like binary product measures in
  `measure_theory.prod`), we can easily define a finitary version on the type `tprod l α`
  by iterating. Properties can also be easily extended from the binary case to the finitary case
  by iterating.
* Then we can use the equivalence `list.tprod.pi_equiv_tprod` below (or enhanced versions of it,
  like a `measurable_equiv` for product measures) to get the construction on `Π i : ι, α i`, at
  least when assuming `[fintype ι] [encodable ι]` (using `encodable.sorted_univ`).
  Using `local attribute [instance] fintype.to_encodable` we can get rid of the argument
  `[encodable ι]`.

## Main definitions

* We have the equivalence `tprod.pi_equiv_tprod : (Π i, α i) ≃ tprod α l`
  if `l` contains every element of `ι` exactly once.
* The product of sets is `set.tprod : (Π i, set (α i)) → set (tprod α l)`.
-/

open List Function

variable {ι : Type _} {α : ι → Type _} {i j : ι} {l : List ι} {f : ∀ i, α i}

namespace List

variable (α)

/- warning: list.tprod -> List.TProd is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}}, (ι -> Type.{u_2}) -> (List.{u_1} ι) -> Type.{max u_2 u_3}
but is expected to have type
  forall {ι : Type.{u}}, (ι -> Type.{v}) -> (List.{u} ι) -> Type.{v}
Case conversion may be inaccurate. Consider using '#align list.tprod List.TProdₓ'. -/
/-- The product of a family of types over a list. -/
def TProd (l : List ι) : Type _ :=
  l.foldr (fun i β => α i × β) PUnit
#align list.tprod List.TProd

variable {α}

namespace Tprod

open List

/- warning: list.tprod.mk -> List.TProd.mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} (l : List.{u_1} ι), (forall (i : ι), α i) -> (List.TProd.{u_1, u_2, u_3} ι α l)
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} (l : List.{u} ι), (forall (i : ι), α i) -> (List.TProd.{u, v} ι α l)
Case conversion may be inaccurate. Consider using '#align list.tprod.mk List.TProd.mkₓ'. -/
/-- Turning a function `f : Π i, α i` into an element of the iterated product `tprod α l`. -/
protected def mk : ∀ (l : List ι) (f : ∀ i, α i), TProd α l
  | [] => fun f => PUnit.unit
  | i :: is => fun f => (f i, mk is f)
#align list.tprod.mk List.TProd.mk

instance [∀ i, Inhabited (α i)] : Inhabited (TProd α l) :=
  ⟨TProd.mk l default⟩

/- warning: list.tprod.fst_mk -> List.TProd.fst_mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} (i : ι) (l : List.{u_1} ι) (f : forall (i : ι), α i), Eq.{succ u_2} (α i) (Prod.fst.{u_2, max u_2 u_3} (α i) (List.foldr.{u_1, succ (max u_2 u_3)} ι Type.{max u_2 u_3} (fun (i : ι) (β : Type.{max u_2 u_3}) => Prod.{u_2, max u_2 u_3} (α i) β) PUnit.{succ (max u_2 u_3)} l) (List.TProd.mk.{u_1, u_2, u_3} ι (fun (i : ι) => α i) (List.cons.{u_1} ι i l) f)) (f i)
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} (i : ι) (l : List.{u} ι) (f : forall (i : ι), α i), Eq.{succ v} ((fun (i : ι) => α i) i) (Prod.fst.{v, v} ((fun (i : ι) => α i) i) (List.foldr.{u, succ v} ι Type.{v} (fun (i : ι) (β : Type.{v}) => Prod.{v, v} ((fun (i : ι) => α i) i) β) PUnit.{succ v} l) (List.TProd.mk.{u, v} ι (fun (i : ι) => α i) (List.cons.{u} ι i l) f)) (f i)
Case conversion may be inaccurate. Consider using '#align list.tprod.fst_mk List.TProd.fst_mkₓ'. -/
@[simp]
theorem fst_mk (i : ι) (l : List ι) (f : ∀ i, α i) : (TProd.mk (i :: l) f).1 = f i :=
  rfl
#align list.tprod.fst_mk List.TProd.fst_mk

/- warning: list.tprod.snd_mk -> List.TProd.snd_mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} (i : ι) (l : List.{u_1} ι) (f : forall (i : ι), α i), Eq.{succ (max u_2 u_3)} (List.foldr.{u_1, succ (max u_2 u_3)} ι Type.{max u_2 u_3} (fun (i : ι) (β : Type.{max u_2 u_3}) => Prod.{u_2, max u_2 u_3} (α i) β) PUnit.{succ (max u_2 u_3)} l) (Prod.snd.{u_2, max u_2 u_3} (α i) (List.foldr.{u_1, succ (max u_2 u_3)} ι Type.{max u_2 u_3} (fun (i : ι) (β : Type.{max u_2 u_3}) => Prod.{u_2, max u_2 u_3} (α i) β) PUnit.{succ (max u_2 u_3)} l) (List.TProd.mk.{u_1, u_2, u_3} ι (fun (i : ι) => α i) (List.cons.{u_1} ι i l) f)) (List.TProd.mk.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l f)
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} (i : ι) (l : List.{u} ι) (f : forall (i : ι), α i), Eq.{succ v} (List.foldr.{u, succ v} ι Type.{v} (fun (i : ι) (β : Type.{v}) => Prod.{v, v} ((fun (i : ι) => α i) i) β) PUnit.{succ v} l) (Prod.snd.{v, v} ((fun (i : ι) => α i) i) (List.foldr.{u, succ v} ι Type.{v} (fun (i : ι) (β : Type.{v}) => Prod.{v, v} ((fun (i : ι) => α i) i) β) PUnit.{succ v} l) (List.TProd.mk.{u, v} ι (fun (i : ι) => α i) (List.cons.{u} ι i l) f)) (List.TProd.mk.{u, v} ι (fun (i : ι) => α i) l f)
Case conversion may be inaccurate. Consider using '#align list.tprod.snd_mk List.TProd.snd_mkₓ'. -/
@[simp]
theorem snd_mk (i : ι) (l : List ι) (f : ∀ i, α i) : (TProd.mk (i :: l) f).2 = TProd.mk l f :=
  rfl
#align list.tprod.snd_mk List.TProd.snd_mk

variable [DecidableEq ι]

/- warning: list.tprod.elim -> List.TProd.elim is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} [_inst_1 : DecidableEq.{succ u_1} ι] {l : List.{u_1} ι}, (List.TProd.{u_1, u_2, u_3} ι α l) -> (forall {i : ι}, (Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) i l) -> (α i))
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} [_inst_1 : DecidableEq.{succ u} ι] {l : List.{u} ι}, (List.TProd.{u, v} ι α l) -> (forall {i : ι}, (Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) i l) -> (α i))
Case conversion may be inaccurate. Consider using '#align list.tprod.elim List.TProd.elimₓ'. -/
/-- Given an element of the iterated product `l.prod α`, take a projection into direction `i`.
  If `i` appears multiple times in `l`, this chooses the first component in direction `i`. -/
protected def elim : ∀ {l : List ι} (v : TProd α l) {i : ι} (hi : i ∈ l), α i
  | i :: is, v, j, hj =>
    if hji : j = i then by
      subst hji
      exact v.1
    else elim v.2 (hj.resolve_left hji)
#align list.tprod.elim List.TProd.elim

/- warning: list.tprod.elim_self -> List.TProd.elim_self is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} {i : ι} {l : List.{u_1} ι} [_inst_1 : DecidableEq.{succ u_1} ι] (v : List.TProd.{u_1, u_2, u_3} ι α (List.cons.{u_1} ι i l)), Eq.{succ u_2} (α i) (List.TProd.elim.{u_1, u_2, u_3} ι α (fun (a : ι) (b : ι) => _inst_1 a b) (List.cons.{u_1} ι i l) v i (List.mem_cons_self.{u_1} ι i l)) (Prod.fst.{u_2, max u_2 u_3} (α i) (List.foldr.{u_1, succ (max u_2 u_3)} ι Type.{max u_2 u_3} (fun (i : ι) (β : Type.{max u_2 u_3}) => Prod.{u_2, max u_2 u_3} (α i) β) PUnit.{succ (max u_2 u_3)} l) v)
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} {i : ι} {l : List.{u} ι} [_inst_1 : DecidableEq.{succ u} ι] (v : List.TProd.{u, v} ι α (List.cons.{u} ι i l)), Eq.{succ v} (α i) (List.TProd.elim.{u, v} ι α (fun (a : ι) (b : ι) => _inst_1 a b) (List.cons.{u} ι i l) v i (List.mem_cons_self.{u} ι i l)) (Prod.fst.{v, v} (α i) (List.foldr.{u, succ v} ι Type.{v} (fun (i : ι) (β : Type.{v}) => Prod.{v, v} (α i) β) PUnit.{succ v} l) v)
Case conversion may be inaccurate. Consider using '#align list.tprod.elim_self List.TProd.elim_selfₓ'. -/
@[simp]
theorem elim_self (v : TProd α (i :: l)) : v.elim (l.mem_cons_self i) = v.1 := by simp [tprod.elim]
#align list.tprod.elim_self List.TProd.elim_self

/- warning: list.tprod.elim_of_ne -> List.TProd.elim_of_ne is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} {i : ι} {j : ι} {l : List.{u_1} ι} [_inst_1 : DecidableEq.{succ u_1} ι] (hj : Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) j (List.cons.{u_1} ι i l)) (hji : Ne.{succ u_1} ι j i) (v : List.TProd.{u_1, u_2, u_3} ι α (List.cons.{u_1} ι i l)), Eq.{succ u_2} (α j) (List.TProd.elim.{u_1, u_2, u_3} ι α (fun (a : ι) (b : ι) => _inst_1 a b) (List.cons.{u_1} ι i l) v j hj) (List.TProd.elim.{u_1, u_2, u_3} ι α (fun (a : ι) (b : ι) => _inst_1 a b) l (Prod.snd.{u_2, max u_2 u_3} (α i) (List.foldr.{u_1, succ (max u_2 u_3)} ι Type.{max u_2 u_3} (fun (i : ι) (β : Type.{max u_2 u_3}) => Prod.{u_2, max u_2 u_3} (α i) β) PUnit.{succ (max u_2 u_3)} l) v) j (Or.resolve_left (Eq.{succ u_1} ι j i) (List.Mem.{u_1} ι j l) hj hji))
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} {i : ι} {j : ι} {l : List.{u} ι} [_inst_1 : DecidableEq.{succ u} ι] (hj : Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) j (List.cons.{u} ι i l)) (hji : Ne.{succ u} ι j i) (v : List.TProd.{u, v} ι α (List.cons.{u} ι i l)), Eq.{succ v} (α j) (List.TProd.elim.{u, v} ι α (fun (a : ι) (b : ι) => _inst_1 a b) (List.cons.{u} ι i l) v j hj) (List.TProd.elim.{u, v} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) l (Prod.snd.{v, v} (α i) (List.foldr.{u, succ v} ι Type.{v} (fun (i : ι) (β : Type.{v}) => Prod.{v, v} (α i) β) PUnit.{succ v} l) v) j (Or.resolve_left (Eq.{succ u} ι j i) (Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) j l) (Iff.mp (Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) j (List.cons.{u} ι i l)) (Or (Eq.{succ u} ι j i) (Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) j l)) (List.mem_cons.{u} ι j i l) hj) hji))
Case conversion may be inaccurate. Consider using '#align list.tprod.elim_of_ne List.TProd.elim_of_neₓ'. -/
@[simp]
theorem elim_of_ne (hj : j ∈ i :: l) (hji : j ≠ i) (v : TProd α (i :: l)) :
    v.elim hj = TProd.elim v.2 (hj.resolve_left hji) := by simp [tprod.elim, hji]
#align list.tprod.elim_of_ne List.TProd.elim_of_ne

/- warning: list.tprod.elim_of_mem -> List.TProd.elim_of_mem is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} {i : ι} {j : ι} {l : List.{u_1} ι} [_inst_1 : DecidableEq.{succ u_1} ι], (List.Nodup.{u_1} ι (List.cons.{u_1} ι i l)) -> (forall (hj : Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) j l) (v : List.TProd.{u_1, u_2, u_3} ι α (List.cons.{u_1} ι i l)), Eq.{succ u_2} (α j) (List.TProd.elim.{u_1, u_2, u_3} ι α (fun (a : ι) (b : ι) => _inst_1 a b) (List.cons.{u_1} ι i l) v j (List.mem_cons_of_mem.{u_1} ι i j l hj)) (List.TProd.elim.{u_1, u_2, u_3} ι α (fun (a : ι) (b : ι) => _inst_1 a b) l (Prod.snd.{u_2, max u_2 u_3} (α i) (List.foldr.{u_1, succ (max u_2 u_3)} ι Type.{max u_2 u_3} (fun (i : ι) (β : Type.{max u_2 u_3}) => Prod.{u_2, max u_2 u_3} (α i) β) PUnit.{succ (max u_2 u_3)} l) v) j hj))
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} {i : ι} {j : ι} {l : List.{u} ι} [_inst_1 : DecidableEq.{succ u} ι], (List.Nodup.{u} ι (List.cons.{u} ι i l)) -> (forall (hj : Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) j l) (v : List.TProd.{u, v} ι α (List.cons.{u} ι i l)), Eq.{succ v} (α j) (List.TProd.elim.{u, v} ι α (fun (a : ι) (b : ι) => _inst_1 a b) (List.cons.{u} ι i l) v j (List.mem_cons_of_mem.{u} ι i j l hj)) (List.TProd.elim.{u, v} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) l (Prod.snd.{v, v} (α i) (List.foldr.{u, succ v} ι Type.{v} (fun (i : ι) (β : Type.{v}) => Prod.{v, v} (α i) β) PUnit.{succ v} l) v) j hj))
Case conversion may be inaccurate. Consider using '#align list.tprod.elim_of_mem List.TProd.elim_of_memₓ'. -/
@[simp]
theorem elim_of_mem (hl : (i :: l).Nodup) (hj : j ∈ l) (v : TProd α (i :: l)) :
    v.elim (mem_cons_of_mem _ hj) = TProd.elim v.2 hj :=
  by
  apply elim_of_ne
  rintro rfl
  exact hl.not_mem hj
#align list.tprod.elim_of_mem List.TProd.elim_of_mem

/- warning: list.tprod.elim_mk -> List.TProd.elim_mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} [_inst_1 : DecidableEq.{succ u_1} ι] (l : List.{u_1} ι) (f : forall (i : ι), α i) {i : ι} (hi : Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) i l), Eq.{succ u_2} (α i) (List.TProd.elim.{u_1, u_2, u_3} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) l (List.TProd.mk.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l f) i hi) (f i)
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} [_inst_1 : DecidableEq.{succ u} ι] (l : List.{u} ι) (f : forall (i : ι), α i) {i : ι} (hi : Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) i l), Eq.{succ v} (α i) (List.TProd.elim.{u, v} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) l (List.TProd.mk.{u, v} ι (fun (i : ι) => α i) l f) i hi) (f i)
Case conversion may be inaccurate. Consider using '#align list.tprod.elim_mk List.TProd.elim_mkₓ'. -/
theorem elim_mk : ∀ (l : List ι) (f : ∀ i, α i) {i : ι} (hi : i ∈ l), (TProd.mk l f).elim hi = f i
  | i :: is, f, j, hj => by
    by_cases hji : j = i
    · subst hji
      simp
    · rw [elim_of_ne _ hji, snd_mk, elim_mk]
#align list.tprod.elim_mk List.TProd.elim_mk

/- warning: list.tprod.ext -> List.TProd.ext is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} [_inst_1 : DecidableEq.{succ u_1} ι] {l : List.{u_1} ι}, (List.Nodup.{u_1} ι l) -> (forall {v : List.TProd.{u_1, u_2, u_3} ι α l} {w : List.TProd.{u_1, u_2, u_3} ι α l}, (forall (i : ι) (hi : Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) i l), Eq.{succ u_2} (α i) (List.TProd.elim.{u_1, u_2, u_3} ι α (fun (a : ι) (b : ι) => _inst_1 a b) l v i hi) (List.TProd.elim.{u_1, u_2, u_3} ι α (fun (a : ι) (b : ι) => _inst_1 a b) l w i hi)) -> (Eq.{succ (max u_2 u_3)} (List.TProd.{u_1, u_2, u_3} ι α l) v w))
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} [_inst_1 : DecidableEq.{succ u} ι] {l : List.{u} ι}, (List.Nodup.{u} ι l) -> (forall {v : List.TProd.{u, v} ι α l} {w : List.TProd.{u, v} ι α l}, (forall (i : ι) (hi : Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) i l), Eq.{succ v} (α i) (List.TProd.elim.{u, v} ι α (fun (a : ι) (b : ι) => _inst_1 a b) l v i hi) (List.TProd.elim.{u, v} ι α (fun (a : ι) (b : ι) => _inst_1 a b) l w i hi)) -> (Eq.{succ v} (List.TProd.{u, v} ι α l) v w))
Case conversion may be inaccurate. Consider using '#align list.tprod.ext List.TProd.extₓ'. -/
@[ext]
theorem ext :
    ∀ {l : List ι} (hl : l.Nodup) {v w : TProd α l}
      (hvw : ∀ (i) (hi : i ∈ l), v.elim hi = w.elim hi), v = w
  | [], hl, v, w, hvw => PUnit.ext
  | i :: is, hl, v, w, hvw => by
    ext; rw [← elim_self v, hvw, elim_self]
    refine' ext (nodup_cons.mp hl).2 fun j hj => _
    rw [← elim_of_mem hl, hvw, elim_of_mem hl]
#align list.tprod.ext List.TProd.ext

/- warning: list.tprod.elim' -> List.TProd.elim' is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} {l : List.{u_1} ι} [_inst_1 : DecidableEq.{succ u_1} ι], (forall (i : ι), Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) i l) -> (List.TProd.{u_1, u_2, u_3} ι α l) -> (forall (i : ι), α i)
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} {l : List.{u} ι} [_inst_1 : DecidableEq.{succ u} ι], (forall (i : ι), Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) i l) -> (List.TProd.{u, v} ι α l) -> (forall (i : ι), α i)
Case conversion may be inaccurate. Consider using '#align list.tprod.elim' List.TProd.elim'ₓ'. -/
/-- A version of `tprod.elim` when `l` contains all elements. In this case we get a function into
  `Π i, α i`. -/
@[simp]
protected def elim' (h : ∀ i, i ∈ l) (v : TProd α l) (i : ι) : α i :=
  v.elim (h i)
#align list.tprod.elim' List.TProd.elim'

/- warning: list.tprod.mk_elim -> List.TProd.mk_elim is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} {l : List.{u_1} ι} [_inst_1 : DecidableEq.{succ u_1} ι], (List.Nodup.{u_1} ι l) -> (forall (h : forall (i : ι), Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) i l) (v : List.TProd.{u_1, u_2, u_3} ι α l), Eq.{succ (max u_2 u_3)} (List.TProd.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l) (List.TProd.mk.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l (List.TProd.elim'.{u_1, u_2, u_3} ι α l (fun (a : ι) (b : ι) => _inst_1 a b) h v)) v)
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} {l : List.{u} ι} [_inst_1 : DecidableEq.{succ u} ι], (List.Nodup.{u} ι l) -> (forall (h : forall (i : ι), Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) i l) (v : List.TProd.{u, v} ι α l), Eq.{succ v} (List.TProd.{u, v} ι (fun (i : ι) => α i) l) (List.TProd.mk.{u, v} ι (fun (i : ι) => α i) l (List.TProd.elim'.{u, v} ι α l (fun (a : ι) (b : ι) => _inst_1 a b) h v)) v)
Case conversion may be inaccurate. Consider using '#align list.tprod.mk_elim List.TProd.mk_elimₓ'. -/
theorem mk_elim (hnd : l.Nodup) (h : ∀ i, i ∈ l) (v : TProd α l) : TProd.mk l (v.elim' h) = v :=
  TProd.ext hnd fun i hi => by simp [elim_mk]
#align list.tprod.mk_elim List.TProd.mk_elim

/- warning: list.tprod.pi_equiv_tprod -> List.TProd.piEquivTProd is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} {l : List.{u_1} ι} [_inst_1 : DecidableEq.{succ u_1} ι], (List.Nodup.{u_1} ι l) -> (forall (i : ι), Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) i l) -> (Equiv.{max (succ u_1) (succ u_2), succ (max u_2 u_3)} (forall (i : ι), α i) (List.TProd.{u_1, u_2, u_3} ι α l))
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} {l : List.{u} ι} [_inst_1 : DecidableEq.{succ u} ι], (List.Nodup.{u} ι l) -> (forall (i : ι), Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) i l) -> (Equiv.{max (succ u) (succ v), succ v} (forall (i : ι), α i) (List.TProd.{u, v} ι α l))
Case conversion may be inaccurate. Consider using '#align list.tprod.pi_equiv_tprod List.TProd.piEquivTProdₓ'. -/
/-- Pi-types are equivalent to iterated products. -/
def piEquivTProd (hnd : l.Nodup) (h : ∀ i, i ∈ l) : (∀ i, α i) ≃ TProd α l :=
  ⟨TProd.mk l, TProd.elim' h, fun f => funext fun i => elim_mk l f (h i), mk_elim hnd h⟩
#align list.tprod.pi_equiv_tprod List.TProd.piEquivTProd

end Tprod

end List

namespace Set

open List

/- warning: set.tprod -> Set.tprod is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} (l : List.{u_1} ι), (forall (i : ι), Set.{u_2} (α i)) -> (Set.{max u_2 u_3} (List.TProd.{u_1, u_2, u_3} ι α l))
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} (l : List.{u} ι), (forall (i : ι), Set.{v} (α i)) -> (Set.{v} (List.TProd.{u, v} ι α l))
Case conversion may be inaccurate. Consider using '#align set.tprod Set.tprodₓ'. -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- A product of sets in `tprod α l`. -/
@[simp]
protected def tprod : ∀ (l : List ι) (t : ∀ i, Set (α i)), Set (TProd α l)
  | [], t => univ
  | i :: is, t => t i ×ˢ tprod is t
#align set.tprod Set.tprod

/- warning: set.mk_preimage_tprod -> Set.mk_preimage_tprod is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} (l : List.{u_1} ι) (t : forall (i : ι), Set.{u_2} (α i)), Eq.{max (succ (max u_1 u_2)) 1} (Set.{max u_1 u_2} (forall (i : ι), α i)) (Set.preimage.{max u_1 u_2, max u_2 u_3} (forall (i : ι), α i) (List.TProd.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l) (List.TProd.mk.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l) (Set.tprod.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l t)) (Set.pi.{u_1, u_2} ι (fun (i : ι) => α i) (setOf.{u_1} ι (fun (i : ι) => Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) i l)) t)
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} (l : List.{u} ι) (t : forall (i : ι), Set.{v} (α i)), Eq.{max (succ u) (succ v)} (Set.{max u v} (forall (i : ι), α i)) (Set.preimage.{max u v, v} (forall (i : ι), α i) (List.TProd.{u, v} ι (fun (i : ι) => α i) l) (List.TProd.mk.{u, v} ι (fun (i : ι) => α i) l) (Set.tprod.{u, v} ι (fun (i : ι) => α i) l t)) (Set.pi.{u, v} ι (fun (i : ι) => α i) (setOf.{u} ι (fun (i : ι) => Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) i l)) t)
Case conversion may be inaccurate. Consider using '#align set.mk_preimage_tprod Set.mk_preimage_tprodₓ'. -/
theorem mk_preimage_tprod :
    ∀ (l : List ι) (t : ∀ i, Set (α i)), TProd.mk l ⁻¹' Set.tprod l t = { i | i ∈ l }.pi t
  | [], t => by simp [Set.tprod]
  | i :: l, t => by
    ext f
    have : f ∈ tprod.mk l ⁻¹' Set.tprod l t ↔ f ∈ { x | x ∈ l }.pi t := by
      rw [mk_preimage_tprod l t]
    change tprod.mk l f ∈ Set.tprod l t ↔ ∀ i : ι, i ∈ l → f i ∈ t i at this
    -- `simp [set.tprod, tprod.mk, this]` can close this goal but is slow.
    rw [Set.tprod, tprod.mk, mem_preimage, mem_pi, prod_mk_mem_set_prod_eq]
    simp_rw [mem_set_of_eq, mem_cons_iff]
    rw [forall_eq_or_imp, and_congr_right_iff]
    exact fun _ => this
#align set.mk_preimage_tprod Set.mk_preimage_tprod

/- warning: set.elim_preimage_pi -> Set.elim_preimage_pi is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u_1}} {α : ι -> Type.{u_2}} [_inst_1 : DecidableEq.{succ u_1} ι] {l : List.{u_1} ι}, (List.Nodup.{u_1} ι l) -> (forall (h : forall (i : ι), Membership.Mem.{u_1, u_1} ι (List.{u_1} ι) (List.hasMem.{u_1} ι) i l) (t : forall (i : ι), Set.{u_2} (α i)), Eq.{max (succ (max u_2 u_3)) 1} (Set.{max u_2 u_3} (List.TProd.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l)) (Set.preimage.{max u_2 u_3, max u_1 u_2} (List.TProd.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l) (forall (i : ι), α i) (List.TProd.elim'.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l (fun (a : ι) (b : ι) => _inst_1 a b) h) (Set.pi.{u_1, u_2} ι (fun (i : ι) => α i) (Set.univ.{u_1} ι) t)) (Set.tprod.{u_1, u_2, u_3} ι (fun (i : ι) => α i) l t))
but is expected to have type
  forall {ι : Type.{u}} {α : ι -> Type.{v}} [_inst_1 : DecidableEq.{succ u} ι] {l : List.{u} ι}, (List.Nodup.{u} ι l) -> (forall (h : forall (i : ι), Membership.mem.{u, u} ι (List.{u} ι) (List.instMembershipList.{u} ι) i l) (t : forall (i : ι), Set.{v} (α i)), Eq.{succ v} (Set.{v} (List.TProd.{u, v} ι (fun (i : ι) => α i) l)) (Set.preimage.{v, max v u} (List.TProd.{u, v} ι (fun (i : ι) => α i) l) (forall (i : ι), α i) (List.TProd.elim'.{u, v} ι (fun (i : ι) => α i) l (fun (a : ι) (b : ι) => _inst_1 a b) h) (Set.pi.{u, v} ι (fun (i : ι) => α i) (Set.univ.{u} ι) t)) (Set.tprod.{u, v} ι (fun (i : ι) => α i) l t))
Case conversion may be inaccurate. Consider using '#align set.elim_preimage_pi Set.elim_preimage_piₓ'. -/
theorem elim_preimage_pi [DecidableEq ι] {l : List ι} (hnd : l.Nodup) (h : ∀ i, i ∈ l)
    (t : ∀ i, Set (α i)) : TProd.elim' h ⁻¹' pi univ t = Set.tprod l t :=
  by
  have : { i | i ∈ l } = univ := by
    ext i
    simp [h]
  rw [← this, ← mk_preimage_tprod, preimage_preimage]
  convert preimage_id
  simp [tprod.mk_elim hnd h, id_def]
#align set.elim_preimage_pi Set.elim_preimage_pi

end Set


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

! This file was ported from Lean 3 source module algebra.star.chsh
! leanprover-community/mathlib commit 468b141b14016d54b479eb7a0fff1e360b7e3cf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Invertible
import Mathbin.Data.Real.Sqrt

/-!
# The Clauser-Horne-Shimony-Holt inequality and Tsirelson's inequality.

We establish a version of the Clauser-Horne-Shimony-Holt (CHSH) inequality
(which is a generalization of Bell's inequality).
This is a foundational result which implies that
quantum mechanics is not a local hidden variable theory.

As usually stated the CHSH inequality requires substantial language from physics and probability,
but it is possible to give a statement that is purely about ordered `*`-algebras.
We do that here, to avoid as many practical and logical dependencies as possible.
Since the algebra of observables of any quantum system is an ordered `*`-algebra
(in particular a von Neumann algebra) this is a strict generalization of the usual statement.

Let `R` be a `*`-ring.

A CHSH tuple in `R` consists of
* four elements `A₀ A₁ B₀ B₁ : R`, such that
* each `Aᵢ` and `Bⱼ` is a self-adjoint involution, and
* the `Aᵢ` commute with the `Bⱼ`.

The physical interpretation is that the four elements are observables (hence self-adjoint)
that take values ±1 (hence involutions), and that the `Aᵢ` are spacelike separated from the `Bⱼ`
(and hence commute).

The CHSH inequality says that when `R` is an ordered `*`-ring
(that is, a `*`-ring which is ordered, and for every `r : R`, `0 ≤ star r * r`),
which is moreover *commutative*, we have
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2`

On the other hand, Tsirelson's inequality says that for any ordered `*`-ring we have
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2√2`

(A caveat: in the commutative case we need 2⁻¹ in the ring,
and in the noncommutative case we need √2 and √2⁻¹.
To keep things simple we just assume our rings are ℝ-algebras.)

The proofs I've seen in the literature either
assume a significant framework for quantum mechanics,
or assume the ring is a `C^*`-algebra.
In the `C^*`-algebra case,
the order structure is completely determined by the `*`-algebra structure:
`0 ≤ A` iff there exists some `B` so `A = star B * B`.
There's a nice proof of both bounds in this setting at
https://en.wikipedia.org/wiki/Tsirelson%27s_bound
The proof given here is purely algebraic.

## Future work

One can show that Tsirelson's inequality is tight.
In the `*`-ring of n-by-n complex matrices, if `A ≤ λ I` for some `λ : ℝ`,
then every eigenvalue has absolute value at most `λ`.
There is a CHSH tuple in 4-by-4 matrices such that
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁` has `2√2` as an eigenvalue.

## References

* [Clauser, Horne, Shimony, Holt,
  *Proposed experiment to test local hidden-variable theories*][zbMATH06785026]
* [Bell, *On the Einstein Podolsky Rosen Paradox*][MR3790629]
* [Tsirelson, *Quantum generalizations of Bell's inequality*][MR577178]

-/

universe u

#print IsCHSHTuple /-
/-- A CHSH tuple in a *-monoid consists of 4 self-adjoint involutions `A₀ A₁ B₀ B₁` such that
the `Aᵢ` commute with the `Bⱼ`.

The physical interpretation is that `A₀` and `A₁` are a pair of boolean observables which
are spacelike separated from another pair `B₀` and `B₁` of boolean observables.
-/
@[nolint has_nonempty_instance]
structure IsCHSHTuple {R} [Monoid R] [StarSemigroup R] (A₀ A₁ B₀ B₁ : R) where
  A₀_inv : A₀ ^ 2 = 1
  A₁_inv : A₁ ^ 2 = 1
  B₀_inv : B₀ ^ 2 = 1
  B₁_inv : B₁ ^ 2 = 1
  A₀_sa : star A₀ = A₀
  A₁_sa : star A₁ = A₁
  B₀_sa : star B₀ = B₀
  B₁_sa : star B₁ = B₁
  A₀B₀_commutes : A₀ * B₀ = B₀ * A₀
  A₀B₁_commutes : A₀ * B₁ = B₁ * A₀
  A₁B₀_commutes : A₁ * B₀ = B₀ * A₁
  A₁B₁_commutes : A₁ * B₁ = B₁ * A₁
#align is_CHSH_tuple IsCHSHTuple
-/

variable {R : Type u}

/- warning: CHSH_id -> CHSH_id is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] {A₀ : R} {A₁ : R} {B₀ : R} {B₁ : R}, (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (Ring.toMonoid.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₀ (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))) -> (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (Ring.toMonoid.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₁ (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))) -> (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (Ring.toMonoid.{u1} R (CommRing.toRing.{u1} R _inst_1)))) B₀ (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))) -> (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (Ring.toMonoid.{u1} R (CommRing.toRing.{u1} R _inst_1)))) B₁ (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))) -> (Eq.{succ u1} R (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (OfNat.ofNat.{u1} R 2 (OfNat.mk.{u1} R 2 (bit0.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1))) (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₀ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₁ B₁)) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (OfNat.ofNat.{u1} R 2 (OfNat.mk.{u1} R 2 (bit0.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1))) (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₀ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₁ B₁))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (OfNat.ofNat.{u1} R 4 (OfNat.mk.{u1} R 4 (bit0.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1))) (bit0.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1))) (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (OfNat.ofNat.{u1} R 2 (OfNat.mk.{u1} R 2 (bit0.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1))) (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₀ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) A₁ B₁))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] {A₀ : R} {A₁ : R} {B₀ : R} {B₁ : R}, (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) A₀ (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (NonAssocRing.toOne.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) -> (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) A₁ (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (NonAssocRing.toOne.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) -> (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) B₀ (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (NonAssocRing.toOne.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) -> (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) B₁ (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (NonAssocRing.toOne.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) -> (Eq.{succ u1} R (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (OfNat.ofNat.{u1} R 2 (instOfNat.{u1} R 2 (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₀ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₁ B₁)) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (OfNat.ofNat.{u1} R 2 (instOfNat.{u1} R 2 (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₀ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₁ B₁))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (OfNat.ofNat.{u1} R 4 (instOfNat.{u1} R 4 (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (OfNat.ofNat.{u1} R 2 (instOfNat.{u1} R 2 (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₀ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) A₁ B₁))))
Case conversion may be inaccurate. Consider using '#align CHSH_id CHSH_idₓ'. -/
theorem CHSH_id [CommRing R] {A₀ A₁ B₀ B₁ : R} (A₀_inv : A₀ ^ 2 = 1) (A₁_inv : A₁ ^ 2 = 1)
    (B₀_inv : B₀ ^ 2 = 1) (B₁_inv : B₁ ^ 2 = 1) :
    (2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁) * (2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁) =
      4 * (2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁) :=
  by
  -- If we had a Gröbner basis algorithm, this would be trivial.
  -- Without one, it is somewhat tedious!
  rw [← sub_eq_zero]
  repeat'
    ring_nf
    simp only [A₁_inv, B₁_inv, sub_eq_add_neg, add_mul, mul_add, sub_mul, mul_sub, add_assoc,
      neg_add, neg_sub, sub_add, sub_sub, neg_mul, ← sq, A₀_inv, B₀_inv, ← sq, ← mul_assoc, one_mul,
      mul_one, add_right_neg, add_zero, sub_eq_add_neg, A₀_inv, mul_one, add_right_neg,
      MulZeroClass.zero_mul]
#align CHSH_id CHSH_id

/- warning: CHSH_inequality_of_comm -> CHSH_inequality_of_comm is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : OrderedCommRing.{u1} R] [_inst_2 : StarOrderedRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (NonUnitalCommRing.toNonUnitalRing.{u1} R (CommRing.toNonUnitalCommRing.{u1} R (OrderedCommRing.toCommRing.{u1} R _inst_1)))) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))] [_inst_3 : Algebra.{0, u1} Real R Real.commSemiring (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))] [_inst_4 : OrderedSMul.{0, u1} Real R Real.orderedSemiring (OrderedSemiring.toOrderedAddCommMonoid.{u1} R (OrderedRing.toOrderedSemiring.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))) (MulActionWithZero.toSMulWithZero.{0, u1} Real R Real.monoidWithZero (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (OrderedAddCommMonoid.toAddCommMonoid.{u1} R (OrderedSemiring.toOrderedAddCommMonoid.{u1} R (OrderedRing.toOrderedSemiring.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))))))) (Module.toMulActionWithZero.{0, u1} Real R Real.semiring (AddCommGroup.toAddCommMonoid.{u1} R (OrderedAddCommGroup.toAddCommGroup.{u1} R (StarOrderedRing.orderedAddCommGroup.{u1} R (NonUnitalCommRing.toNonUnitalRing.{u1} R (CommRing.toNonUnitalCommRing.{u1} R (OrderedCommRing.toCommRing.{u1} R _inst_1))) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))) _inst_2))) (Algebra.toModule.{0, u1} Real R Real.commSemiring (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))) _inst_3)))] (A₀ : R) (A₁ : R) (B₀ : R) (B₁ : R), (IsCHSHTuple.{u1} R (Ring.toMonoid.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))) (StarRing.toStarSemigroup.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (NonUnitalCommRing.toNonUnitalRing.{u1} R (CommRing.toNonUnitalCommRing.{u1} R (OrderedCommRing.toCommRing.{u1} R _inst_1)))) (StarOrderedRing.toStarRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (NonUnitalCommRing.toNonUnitalRing.{u1} R (CommRing.toNonUnitalCommRing.{u1} R (OrderedCommRing.toCommRing.{u1} R _inst_1)))) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))) _inst_2)) A₀ A₁ B₀ B₁) -> (LE.le.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (OrderedAddCommGroup.toPartialOrder.{u1} R (StarOrderedRing.orderedAddCommGroup.{u1} R (NonUnitalCommRing.toNonUnitalRing.{u1} R (CommRing.toNonUnitalCommRing.{u1} R (OrderedCommRing.toCommRing.{u1} R _inst_1))) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))) _inst_2)))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))))) A₀ B₀) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))))) A₁ B₁)) (OfNat.ofNat.{u1} R 2 (OfNat.mk.{u1} R 2 (bit0.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))) (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : OrderedCommRing.{u1} R] [_inst_2 : StarOrderedRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (NonUnitalCommRing.toNonUnitalRing.{u1} R (CommRing.toNonUnitalCommRing.{u1} R (OrderedCommRing.toCommRing.{u1} R _inst_1)))) (OrderedRing.toPartialOrder.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1))] [_inst_3 : Algebra.{0, u1} Real R Real.instCommSemiringReal (OrderedSemiring.toSemiring.{u1} R (OrderedCommSemiring.toOrderedSemiring.{u1} R (OrderedCommRing.toOrderedCommSemiring.{u1} R _inst_1)))] [_inst_4 : OrderedSMul.{0, u1} Real R Real.orderedSemiring (OrderedSemiring.toOrderedAddCommMonoid.{u1} R (OrderedCommSemiring.toOrderedSemiring.{u1} R (OrderedCommRing.toOrderedCommSemiring.{u1} R _inst_1))) (MulActionWithZero.toSMulWithZero.{0, u1} Real R Real.instMonoidWithZeroReal (AddMonoid.toZero.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (OrderedAddCommMonoid.toAddCommMonoid.{u1} R (OrderedSemiring.toOrderedAddCommMonoid.{u1} R (OrderedCommSemiring.toOrderedSemiring.{u1} R (OrderedCommRing.toOrderedCommSemiring.{u1} R _inst_1)))))) (Module.toMulActionWithZero.{0, u1} Real R Real.semiring (OrderedCancelAddCommMonoid.toAddCommMonoid.{u1} R (OrderedAddCommGroup.toOrderedCancelAddCommMonoid.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))) (_private.Mathlib.RingTheory.Ideal.Operations.0.Ideal.instModuleToSemiringToAddCommMonoidToNonUnitalNonAssocSemiringToNonUnitalNonAssocRingToNonUnitalRingToNonUnitalCommRing.{0, u1} Real R Real.instCommSemiringReal (OrderedCommRing.toCommRing.{u1} R _inst_1) _inst_3)))] (A₀ : R) (A₁ : R) (B₀ : R) (B₁ : R), (IsCHSHTuple.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (OrderedSemiring.toSemiring.{u1} R (OrderedCommSemiring.toOrderedSemiring.{u1} R (OrderedCommRing.toOrderedCommSemiring.{u1} R _inst_1))))) (StarRing.toStarSemigroup.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (NonUnitalCommRing.toNonUnitalRing.{u1} R (CommRing.toNonUnitalCommRing.{u1} R (OrderedCommRing.toCommRing.{u1} R _inst_1)))) (StarOrderedRing.toStarRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (NonUnitalCommRing.toNonUnitalRing.{u1} R (CommRing.toNonUnitalCommRing.{u1} R (OrderedCommRing.toCommRing.{u1} R _inst_1)))) (OrderedRing.toPartialOrder.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)) _inst_2)) A₀ A₁ B₀ B₁) -> (LE.le.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (OrderedRing.toPartialOrder.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))))) A₀ B₀) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))))) A₁ B₁)) (OfNat.ofNat.{u1} R 2 (instOfNat.{u1} R 2 (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R (OrderedCommRing.toOrderedRing.{u1} R _inst_1)))) (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))))
Case conversion may be inaccurate. Consider using '#align CHSH_inequality_of_comm CHSH_inequality_of_commₓ'. -/
/-- Given a CHSH tuple (A₀, A₁, B₀, B₁) in a *commutative* ordered `*`-algebra over ℝ,
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2`.

(We could work over ℤ[⅟2] if we wanted to!)
-/
theorem CHSH_inequality_of_comm [OrderedCommRing R] [StarOrderedRing R] [Algebra ℝ R]
    [OrderedSMul ℝ R] (A₀ A₁ B₀ B₁ : R) (T : IsCHSHTuple A₀ A₁ B₀ B₁) :
    A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2 :=
  by
  let P := 2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁
  have i₁ : 0 ≤ P :=
    by
    have idem : P * P = 4 * P := CHSH_id T.A₀_inv T.A₁_inv T.B₀_inv T.B₁_inv
    have idem' : P = (1 / 4 : ℝ) • (P * P) :=
      by
      have h : 4 * P = (4 : ℝ) • P := by simp [Algebra.smul_def]
      rw [idem, h, ← mul_smul]
      norm_num
    have sa : star P = P := by
      dsimp [P]
      simp only [star_add, star_sub, star_mul, star_bit0, star_one, T.A₀_sa, T.A₁_sa, T.B₀_sa,
        T.B₁_sa, mul_comm B₀, mul_comm B₁]
    rw [idem']
    conv_rhs =>
      congr
      skip
      congr
      rw [← sa]
    convert smul_le_smul_of_nonneg (star_mul_self_nonneg : 0 ≤ star P * P) _
    · simp
    · infer_instance
    · norm_num
  apply le_of_sub_nonneg
  simpa only [sub_add_eq_sub_sub, ← sub_add] using i₁
#align CHSH_inequality_of_comm CHSH_inequality_of_comm

/-!
We now prove some rather specialized lemmas in preparation for the Tsirelson inequality,
which we hide in a namespace as they are unlikely to be useful elsewhere.
-/

-- mathport name: «expr√2»
local notation "√2" => (Real.sqrt 2 : ℝ)

namespace tsirelson_inequality

/-!
Before proving Tsirelson's bound,
we prepare some easy lemmas about √2.
-/

/- warning: tsirelson_inequality.tsirelson_inequality_aux -> TsirelsonInequality.tsirelson_inequality_aux is a dubious translation:
lean 3 declaration is
  Eq.{1} Real (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (Real.sqrt (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne))))) (HPow.hPow.{0, 0, 0} Real Nat Real (instHPow.{0, 0} Real Nat (Monoid.Pow.{0} Real Real.monoid)) (Real.sqrt (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne))))) (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (Real.sqrt (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne))))) (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.hasAdd) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne)))) (Inv.inv.{0} Real Real.hasInv (Real.sqrt (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne))))))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (OfNat.ofNat.{0} Real 4 (OfNat.mk.{0} Real 4 (bit0.{0} Real Real.hasAdd (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne))))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (Inv.inv.{0} Real Real.hasInv (Real.sqrt (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne)))))) (Inv.inv.{0} Real Real.hasInv (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne)))))))))
but is expected to have type
  Eq.{1} Real (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (Real.sqrt (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))) (HPow.hPow.{0, 0, 0} Real Nat Real (instHPow.{0, 0} Real Nat (Monoid.Pow.{0} Real Real.instMonoidReal)) (Real.sqrt (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))) (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3)))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (Real.sqrt (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))) (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.instAddReal) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))) (Inv.inv.{0} Real Real.instInvReal (Real.sqrt (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (OfNat.ofNat.{0} Real 4 (instOfNat.{0} Real 4 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (Inv.inv.{0} Real Real.instInvReal (Real.sqrt (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))))) (Inv.inv.{0} Real Real.instInvReal (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))))))))
Case conversion may be inaccurate. Consider using '#align tsirelson_inequality.tsirelson_inequality_aux TsirelsonInequality.tsirelson_inequality_auxₓ'. -/
-- This calculation, which we need for Tsirelson's bound,
-- defeated me. Thanks for the rescue from Shing Tak Lam!
theorem tsirelson_inequality_aux : √2 * √2 ^ 3 = √2 * (2 * √2⁻¹ + 4 * (√2⁻¹ * 2⁻¹)) :=
  by
  ring_nf; field_simp [(@Real.sqrt_pos 2).2 (by norm_num)]
  convert congr_arg (· ^ 2) (@Real.sq_sqrt 2 (by norm_num)) using 1 <;> simp only [← pow_mul] <;>
    norm_num
#align tsirelson_inequality.tsirelson_inequality_aux TsirelsonInequality.tsirelson_inequality_aux

/- warning: tsirelson_inequality.sqrt_two_inv_mul_self -> TsirelsonInequality.sqrt_two_inv_mul_self is a dubious translation:
lean 3 declaration is
  Eq.{1} Real (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (Inv.inv.{0} Real Real.hasInv (Real.sqrt (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne)))))) (Inv.inv.{0} Real Real.hasInv (Real.sqrt (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne))))))) (Inv.inv.{0} Real Real.hasInv (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne)))))
but is expected to have type
  Eq.{1} Real (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (Inv.inv.{0} Real Real.instInvReal (Real.sqrt (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))))) (Inv.inv.{0} Real Real.instInvReal (Real.sqrt (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))))) (Inv.inv.{0} Real Real.instInvReal (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))))
Case conversion may be inaccurate. Consider using '#align tsirelson_inequality.sqrt_two_inv_mul_self TsirelsonInequality.sqrt_two_inv_mul_selfₓ'. -/
theorem sqrt_two_inv_mul_self : √2⁻¹ * √2⁻¹ = (2⁻¹ : ℝ) :=
  by
  rw [← mul_inv]
  norm_num
#align tsirelson_inequality.sqrt_two_inv_mul_self TsirelsonInequality.sqrt_two_inv_mul_self

end tsirelson_inequality

open tsirelson_inequality

/- warning: tsirelson_inequality -> tsirelson_inequality is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : OrderedRing.{u1} R] [_inst_2 : StarOrderedRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R _inst_1))] [_inst_3 : Algebra.{0, u1} Real R Real.commSemiring (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1))] [_inst_4 : OrderedSMul.{0, u1} Real R Real.orderedSemiring (OrderedSemiring.toOrderedAddCommMonoid.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1)) (MulActionWithZero.toSMulWithZero.{0, u1} Real R Real.monoidWithZero (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (OrderedAddCommMonoid.toAddCommMonoid.{u1} R (OrderedSemiring.toOrderedAddCommMonoid.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1)))))) (Module.toMulActionWithZero.{0, u1} Real R Real.semiring (AddCommGroup.toAddCommMonoid.{u1} R (OrderedAddCommGroup.toAddCommGroup.{u1} R (StarOrderedRing.orderedAddCommGroup.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1)) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R _inst_1)) _inst_2))) (Algebra.toModule.{0, u1} Real R Real.commSemiring (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)) _inst_3)))] [_inst_5 : StarModule.{0, u1} Real R (InvolutiveStar.toHasStar.{0} Real (StarAddMonoid.toHasInvolutiveStar.{0} Real (AddCommMonoid.toAddMonoid.{0} Real (NonUnitalNonAssocSemiring.toAddCommMonoid.{0} Real (NonUnitalSemiring.toNonUnitalNonAssocSemiring.{0} Real (NonUnitalRing.toNonUnitalSemiring.{0} Real (NonUnitalCommRing.toNonUnitalRing.{0} Real (CommRing.toNonUnitalCommRing.{0} Real Real.commRing)))))) (StarRing.toStarAddMonoid.{0} Real (NonUnitalRing.toNonUnitalSemiring.{0} Real (NonUnitalCommRing.toNonUnitalRing.{0} Real (CommRing.toNonUnitalCommRing.{0} Real Real.commRing))) Real.starRing))) (InvolutiveStar.toHasStar.{u1} R (StarAddMonoid.toHasInvolutiveStar.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonUnitalSemiring.toNonUnitalNonAssocSemiring.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))))) (StarRing.toStarAddMonoid.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (StarOrderedRing.toStarRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R _inst_1)) _inst_2)))) (SMulZeroClass.toHasSmul.{0, u1} Real R (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))))))) (SMulWithZero.toSmulZeroClass.{0, u1} Real R (MulZeroClass.toHasZero.{0} Real (MulZeroOneClass.toMulZeroClass.{0} Real (MonoidWithZero.toMulZeroOneClass.{0} Real (Semiring.toMonoidWithZero.{0} Real (CommSemiring.toSemiring.{0} Real Real.commSemiring))))) (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))))))) (MulActionWithZero.toSMulWithZero.{0, u1} Real R (Semiring.toMonoidWithZero.{0} Real (CommSemiring.toSemiring.{0} Real Real.commSemiring)) (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))))))) (Module.toMulActionWithZero.{0, u1} Real R (CommSemiring.toSemiring.{0} Real Real.commSemiring) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))) (Algebra.toModule.{0, u1} Real R Real.commSemiring (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)) _inst_3)))))] (A₀ : R) (A₁ : R) (B₀ : R) (B₁ : R), (IsCHSHTuple.{u1} R (Ring.toMonoid.{u1} R (OrderedRing.toRing.{u1} R _inst_1)) (StarRing.toStarSemigroup.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (StarOrderedRing.toStarRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R _inst_1)) _inst_2)) A₀ A₁ B₀ B₁) -> (LE.le.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (OrderedAddCommGroup.toPartialOrder.{u1} R (StarOrderedRing.orderedAddCommGroup.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1)) (OrderedAddCommGroup.toPartialOrder.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R _inst_1)) _inst_2)))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))) A₀ B₀) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))) A₁ B₁)) (SMul.smul.{0, u1} Real R (SMulZeroClass.toHasSmul.{0, u1} Real R (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))))))) (SMulWithZero.toSmulZeroClass.{0, u1} Real R (MulZeroClass.toHasZero.{0} Real (MulZeroOneClass.toMulZeroClass.{0} Real (MonoidWithZero.toMulZeroOneClass.{0} Real (Semiring.toMonoidWithZero.{0} Real (CommSemiring.toSemiring.{0} Real Real.commSemiring))))) (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))))))) (MulActionWithZero.toSMulWithZero.{0, u1} Real R (Semiring.toMonoidWithZero.{0} Real (CommSemiring.toSemiring.{0} Real Real.commSemiring)) (AddZeroClass.toHasZero.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))))))) (Module.toMulActionWithZero.{0, u1} Real R (CommSemiring.toSemiring.{0} Real Real.commSemiring) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))) (Algebra.toModule.{0, u1} Real R Real.commSemiring (Ring.toSemiring.{u1} R (OrderedRing.toRing.{u1} R _inst_1)) _inst_3))))) (HPow.hPow.{0, 0, 0} Real Nat Real (instHPow.{0, 0} Real Nat (Monoid.Pow.{0} Real Real.monoid)) (Real.sqrt (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne))))) (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : OrderedRing.{u1} R] [_inst_2 : StarOrderedRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (OrderedRing.toPartialOrder.{u1} R _inst_1)] [_inst_3 : Algebra.{0, u1} Real R Real.instCommSemiringReal (OrderedSemiring.toSemiring.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1))] [_inst_4 : OrderedSMul.{0, u1} Real R Real.orderedSemiring (OrderedSemiring.toOrderedAddCommMonoid.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1)) (MulActionWithZero.toSMulWithZero.{0, u1} Real R Real.instMonoidWithZeroReal (AddMonoid.toZero.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (OrderedAddCommMonoid.toAddCommMonoid.{u1} R (OrderedSemiring.toOrderedAddCommMonoid.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1))))) (Module.toMulActionWithZero.{0, u1} Real R Real.semiring (OrderedCancelAddCommMonoid.toAddCommMonoid.{u1} R (OrderedAddCommGroup.toOrderedCancelAddCommMonoid.{u1} R (OrderedRing.toOrderedAddCommGroup.{u1} R _inst_1))) (Algebra.toModule.{0, u1} Real R Real.instCommSemiringReal (OrderedSemiring.toSemiring.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1)) _inst_3)))] [_inst_5 : StarModule.{0, u1} Real R (InvolutiveStar.toStar.{0} Real (StarAddMonoid.toInvolutiveStar.{0} Real Real.instAddMonoidReal (StarRing.toStarAddMonoid.{0} Real (NonUnitalRing.toNonUnitalSemiring.{0} Real (NonUnitalCommRing.toNonUnitalRing.{0} Real (CommRing.toNonUnitalCommRing.{0} Real Real.commRing))) Real.instStarRingRealToNonUnitalSemiringToNonUnitalRingToNonUnitalCommRingCommRing))) (InvolutiveStar.toStar.{u1} R (StarAddMonoid.toInvolutiveStar.{u1} R (AddMonoidWithOne.toAddMonoid.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (Ring.toAddGroupWithOne.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))) (StarRing.toStarAddMonoid.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (StarOrderedRing.toStarRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (OrderedRing.toPartialOrder.{u1} R _inst_1) _inst_2)))) (Algebra.toSMul.{0, u1} Real R Real.instCommSemiringReal (OrderedSemiring.toSemiring.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1)) _inst_3)] (A₀ : R) (A₁ : R) (B₀ : R) (B₁ : R), (IsCHSHTuple.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (OrderedSemiring.toSemiring.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1)))) (StarRing.toStarSemigroup.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (StarOrderedRing.toStarRing.{u1} R (NonUnitalRing.toNonUnitalSemiring.{u1} R (Ring.toNonUnitalRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (OrderedRing.toPartialOrder.{u1} R _inst_1) _inst_2)) A₀ A₁ B₀ B₁) -> (LE.le.{u1} R (Preorder.toLE.{u1} R (PartialOrder.toPreorder.{u1} R (OrderedRing.toPartialOrder.{u1} R _inst_1))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (OrderedRing.toRing.{u1} R _inst_1))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))) A₀ B₀) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))) A₀ B₁)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))) A₁ B₀)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1))))) A₁ B₁)) (HSMul.hSMul.{0, u1, u1} Real R R (instHSMul.{0, u1} Real R (Algebra.toSMul.{0, u1} Real R Real.instCommSemiringReal (OrderedSemiring.toSemiring.{u1} R (OrderedRing.toOrderedSemiring.{u1} R _inst_1)) _inst_3)) (HPow.hPow.{0, 0, 0} Real Nat Real (instHPow.{0, 0} Real Nat (Monoid.Pow.{0} Real Real.instMonoidReal)) (Real.sqrt (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))) (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (NonAssocRing.toOne.{u1} R (Ring.toNonAssocRing.{u1} R (OrderedRing.toRing.{u1} R _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align tsirelson_inequality tsirelson_inequalityₓ'. -/
/-- In a noncommutative ordered `*`-algebra over ℝ,
Tsirelson's bound for a CHSH tuple (A₀, A₁, B₀, B₁) is
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2^(3/2) • 1`.

We prove this by providing an explicit sum-of-squares decomposition
of the difference.

(We could work over `ℤ[2^(1/2), 2^(-1/2)]` if we really wanted to!)
-/
theorem tsirelson_inequality [OrderedRing R] [StarOrderedRing R] [Algebra ℝ R] [OrderedSMul ℝ R]
    [StarModule ℝ R] (A₀ A₁ B₀ B₁ : R) (T : IsCHSHTuple A₀ A₁ B₀ B₁) :
    A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ √2 ^ 3 • 1 :=
  by
  -- abel will create `ℤ` multiplication. We will `simp` them away to `ℝ` multiplication.
  have M : ∀ (m : ℤ) (a : ℝ) (x : R), m • a • x = ((m : ℝ) * a) • x := fun m a x => by
    rw [zsmul_eq_smul_cast ℝ, ← mul_smul]
  let P := √2⁻¹ • (A₁ + A₀) - B₀
  let Q := √2⁻¹ • (A₁ - A₀) + B₁
  have w : √2 ^ 3 • 1 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁ = √2⁻¹ • (P ^ 2 + Q ^ 2) :=
    by
    dsimp [P, Q]
    -- distribute out all the powers and products appearing on the RHS
    simp only [sq, sub_mul, mul_sub, add_mul, mul_add, smul_add, smul_sub]
    -- pull all coefficients out to the front, and combine `√2`s where possible
    simp only [Algebra.mul_smul_comm, Algebra.smul_mul_assoc, ← mul_smul, sqrt_two_inv_mul_self]
    -- replace Aᵢ * Aᵢ = 1 and Bᵢ * Bᵢ = 1
    simp only [← sq, T.A₀_inv, T.A₁_inv, T.B₀_inv, T.B₁_inv]
    -- move Aᵢ to the left of Bᵢ
    simp only [← T.A₀B₀_commutes, ← T.A₀B₁_commutes, ← T.A₁B₀_commutes, ← T.A₁B₁_commutes]
    -- collect terms, simplify coefficients, and collect terms again:
    abel
    -- all terms coincide, but the last one. Simplify all other terms
    simp only [M]
    simp only [neg_mul, Int.cast_bit0, one_mul, mul_inv_cancel_of_invertible, Int.cast_one,
      one_smul, Int.cast_neg, add_right_inj, neg_smul, ← add_smul]
    -- just look at the coefficients now:
    congr
    exact mul_left_cancel₀ (by norm_num) tsirelson_inequality_aux
  have pos : 0 ≤ √2⁻¹ • (P ^ 2 + Q ^ 2) :=
    by
    have P_sa : star P = P := by
      dsimp [P]
      simp only [star_smul, star_add, star_sub, star_id_of_comm, T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa]
    have Q_sa : star Q = Q := by
      dsimp [Q]
      simp only [star_smul, star_add, star_sub, star_id_of_comm, T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa]
    have P2_nonneg : 0 ≤ P ^ 2 := by
      rw [sq]
      conv =>
        congr
        skip
        congr
        rw [← P_sa]
      convert(star_mul_self_nonneg : 0 ≤ star P * P)
    have Q2_nonneg : 0 ≤ Q ^ 2 := by
      rw [sq]
      conv =>
        congr
        skip
        congr
        rw [← Q_sa]
      convert(star_mul_self_nonneg : 0 ≤ star Q * Q)
    convert smul_le_smul_of_nonneg (add_nonneg P2_nonneg Q2_nonneg)
        (le_of_lt (show 0 < √2⁻¹ by norm_num))
    -- `norm_num` can't directly show `0 ≤ √2⁻¹`
    simp
  apply le_of_sub_nonneg
  simpa only [sub_add_eq_sub_sub, ← sub_add, w] using Pos
#align tsirelson_inequality tsirelson_inequality


import chapter_1
import chapter_2

namespace surreal

/-
This chapter starts by verifying the proofs written at the end of the stone they found.

> Conway proved that zero was less than or equal to zero
> And he proved that minus one is less than but not equal to zero and zero is less than but not equal to one.
-/

/-
As they say, `0 ≤ 0` is fairly trivial.

> By rule (2), he must show that no element of the empty set is greater than or like 0, and that 0
is not greater than or line any element of the empty set.
-/

lemma zero_le_zero: zero ≤ zero :=
begin
  rw rule_2,
  simp,
  split,
  begin
    intros hx hxl hle,
    rw zero.has_left at hxl,
    exact hxl,
  end,
  begin
    intros hx hxr hle,
    rw zero.has_right at hxr,
    exact hxr,
  end
end

/-
It finally starts being a bit more meaty. How to prove that a number is not equal to another with the existing rules?

> More interesting is how he could prove that -1 is not like 0 (they say "like" instead of "equals" here for a while to avoid getting confused by their existing intuitions aobut equality). The only
way I can think of is that he proved that 0 is not less-than-or-like -1. I mean, we have rule (2) to
tell wether one number is less than or like another; and if x is not less-than-or-like y, it isn't less than y and it isn't like y.

> I see, we want to show at 0 ≤ -1 is false. This is rule (2) with x = 0 and Yᵣ = {0}, so 0 ≤ -1 if
and only if 0 ≱ 0. But 0 is ≥ 0, we know that, so 0 ≰ -1. He was right.

First they use some simple logic to deduce that `¬(0 ≤ -1) → ¬(0 = -1)`.
They go about it like this: `¬(0 ≤ -1) → ¬(0 < -1 ∨ 0 = -1) → ¬(0 < -1) ∧ ¬(0 = -1) → ¬(0 = -1)`

We could easily generalize this to any two numbers, but let's stick to 0 and -1 for now.

Then they prove `¬(0 ≤ -1)` by contradiction using `rule_2`, like this: TODO

There's a couple caveats to proving this with Lean not:
* We don't actually have a < operation defined yet on surreals, and we shoudln't assume it behaves like with other numbers without deriving it from the axioms.
* What we did above was forward reasoing, but it is generally preferred to do backwards proving in Lean, the tools are a bit more mature.

Through my brief experimentation,

**Note**: You might we wondering why I don't make a few aliases like `zero ⇒ 0` to make things cleaner; they do in the book after all. It's mainly because I don't want to give the impression that surreal numbers are like natural numbers or any other common number system. If I showed them like numbers, it would be easier to get confused by our existing intuitions about how they behave. There is a concept of positive and negative (either side of 0), but we will soon discover many more numbers that can't be represented with natural numbers, so let's stick to textual names the whole time so that we don't get confused.
-/

lemma not_le_to_not_eq_zero_minus_one: ¬(zero ≤ minus_one) → ¬(zero = minus_one) :=
begin
  intro hnge,
  sorry
end

end surreal


import data.real.basic

-- BEGIN

example {x y : ℝ} (h₀ : x ≤ y) (h₁ : ¬ y ≤ x) : x ≤ y ∧ x ≠ y :=
begin
  have h : x ≠ y,
  { sorry, },
  exact ⟨h₀, h⟩,
end

example {x y : ℝ} (h₀ : x ≤ y) (h₁ : ¬ y ≤ x) : x ≤ y ∧ x ≠ y :=
begin
  split,
    exact h₀,
  sorry,
end

/- using λ abstraction-/
example {x y : ℝ} (h₀ : x ≤ y) (h₁ : ¬ y ≤ x) : x ≤ y ∧ x ≠ y :=
⟨h₀, λ h, h₁ (by rw h)⟩

-- END


import o_minimal.examples.from_finite_unions

/-
Construction of the "basic" sets of a structure
as finite intersections of "primitive" sets.

For example, in the semialgebraic structure, the basic sets are
finite intersections of "primitive sets" of the two forms
  {x ∈ Rⁿ | f(x) = 0},  {x ∈ Rⁿ | g(x) > 0}.
The semilinear and "minimal" structures also have this form.

Suppose D ("definable"), B ("basic") and P ("primitive")
are classes of subsets of Rⁿ for each n
and the following conditions are satisfied.

* A set is definable if and only if it is a finite union of basic sets.
* A set is basic if and only if it is a finite intersection of primitive sets.
* The complement of a primitive set is definable.
* If A is a primitive set then R × A and A × R are basic.
  TODO: We can weaken this condition to "... are definable" at the cost of a refactor
  (need to construct the boolean subalgebra first,
  then show it is compatible with projections).
  In practice it will even be primitive anyways.
* {x ∈ Rⁿ | x₁ = xₙ} is definable.
* The projection of a basic (not primitive!) set is definable.

Then D forms a structure on R.
Furthermore, TODO (condition to be o-minimal).

-/

namespace o_minimal

open set
open_locale finvec

variables {R : Type*} (D B P : Π ⦃n : ℕ⦄, set (set (finvec n R)))

section struc

/-- Standing hypotheses for this module. -/
structure finite_inter_struc_hypotheses : Prop :=
(definable_iff_finite_union_basic :
  ∀ {n} {s : set (finvec n R)}, D s ↔ s ∈ finite_union_closure (@B n))
(basic_iff_finite_inter_primitive :
  ∀ {n} {s : set (finvec n R)}, B s ↔ s ∈ finite_inter_closure (@P n))
(definable_compl_primitive :
  ∀ {n} {s : set (finvec n R)}, P s → D sᶜ)
(basic_r_prod_primitive :
  ∀ {n} {s : set (finvec n R)}, P s → B (finvec.univ_prod 1 s))
(basic_primitive_prod_r :
  ∀ {n} {s : set (finvec n R)}, P s → B (finvec.prod_univ s 1))
(definable_eq_outer :
  ∀ {n}, D ({x | x 0 = x.last} : set (finvec (n + 1) R)))
(definable_proj1_basic :
  ∀ {n} {s : set (finvec (n + 1) R)}, B s → D (finvec.left '' s))

variables {D B P}

-- Strategy: Conclude `finite_union_struc_hypotheses D B`.
-- First we work under the assumption that `B` actually is `finite_inter_closure P`.

local notation `B₀` := (λ {n : ℕ}, finite_inter_closure (@P n))

private lemma key
  (H : finite_inter_struc_hypotheses D B₀ P) :
  finite_union_struc_hypotheses D B₀ :=
have definable_of_basic : ∀ {n} {s : set (finvec n R)}, B₀ s → D s,
from λ n s hs, -- TODO: Lean bug? `H.definable_iff_finite_union_basic.mpr` should work
  (finite_inter_struc_hypotheses.definable_iff_finite_union_basic H).mpr
    (finite_union_closure.basic hs),
have promote_hypothesis : ∀ {n m : ℕ} (Φ : set (finvec n R) → set (finvec m R))
  (hΦ₀ : Φ univ = univ) (hΦ₂ : ∀ {s t}, Φ (s ∩ t) = Φ s ∩ Φ t),
  (∀ ⦃s⦄, P s → B₀ (Φ s)) → (∀ ⦃s⦄, B₀ s → B₀ (Φ s)),
from λ n m Φ hΦ₀ hΦ₂, preserves_finite_inters.bind { map_univ := @hΦ₀, map_inter := @hΦ₂ },
{ definable_iff_finite_union_basic := H.definable_iff_finite_union_basic,
  definable_univ := λ n, definable_of_basic finite_inter_closure.univ,
  definable_basic_inter_basic := λ n s t hs ht, definable_of_basic (hs.inter ht),
  definable_compl_basic := begin
    -- A basic set is a finite intersection of primitive sets,
    -- so its complement is a finite union of definable sets, hence definable.
    intros n s hs,
    rw H.definable_iff_finite_union_basic,
    obtain ⟨t, ht, hst⟩ := finite_inter_closure_iff_bInter.mp hs,
    classical,
    let t' := finset.image set.compl t,
    have : sᶜ = ⋃ (i ∈ t'), i,
    { rw hst,
      rw [←finset.bInter_coe, ←finset.bUnion_coe],
      rw compl_bInter,
      simp, refl },
    rw this,
    apply closed_under_finite_unions_finite_union_closure.mem_bUnion,
    intros i hi,
    rw ←H.definable_iff_finite_union_basic,
    rw finset.mem_image at hi,
    rcases hi with ⟨j, hj, rfl⟩,
    apply H.definable_compl_primitive,
    exact ht j hj,
  end,
  definable_r_prod_basic := begin
    intros n s hs,
    apply definable_of_basic,
    refine promote_hypothesis (λ s, finvec.univ_prod 1 s) _ _ (λ s h, H.basic_r_prod_primitive h) hs;
    intros; ext; simp [finvec.univ_prod]
  end,
  definable_basic_prod_r := begin
    intros n s hs,
    apply definable_of_basic,
    refine promote_hypothesis (λ s, finvec.prod_univ s 1) _ _ (λ s h, H.basic_primitive_prod_r h) hs;
    intros; ext; simp [finvec.prod_univ]
  end,
  definable_eq_outer := H.definable_eq_outer,
  definable_proj1_basic := H.definable_proj1_basic }

variables (H : finite_inter_struc_hypotheses D B P)
include H

lemma finite_inter_struc_hypotheses.B_eq_finite_inter_closure_P :
  B = λ n, finite_inter_closure (@P n) :=
by { ext, apply H.basic_iff_finite_inter_primitive }

lemma finite_inter_struc_hypotheses.finite_union_struc_hypotheses :
  finite_union_struc_hypotheses D B :=
by { cases H.B_eq_finite_inter_closure_P, exact key H }

def struc_of_finite_inter : struc R :=
struc_of_finite_union H.finite_union_struc_hypotheses

end struc

section o_minimal

variables (D B P) [DUNLO R]

structure finite_inter_o_minimal_hypotheses extends finite_inter_struc_hypotheses D B P : Prop :=
(definable_lt : D {x : finvec 2 R | x 0 < x 1})
(definable_const : ∀ {r}, D {x : finvec 1 R | x 0 = r})
(tame_of_primitive : ∀ {s : set (finvec 1 R)}, P s → tame {r | (λ _, r : finvec 1 R) ∈ s})

variables {D B P} (H : finite_inter_o_minimal_hypotheses D B P)

lemma o_minimal_of_finite_inter :
  o_minimal (struc_of_finite_inter H.to_finite_inter_struc_hypotheses : struc R) :=
o_minimal_of_finite_union
{ definable_lt := H.definable_lt,
  definable_const := H.definable_const,
  tame_of_basic := begin
    change ∀ s, B s → _,
    cases H.to_finite_inter_struc_hypotheses.B_eq_finite_inter_closure_P,
    refine preserves_finite_inters.bind' _ closed_under_finite_inters_tame _,
    { split; intros; simp; refl },
    exact H.tame_of_primitive
  end,
  .. H.to_finite_inter_struc_hypotheses.finite_union_struc_hypotheses }

end o_minimal

end o_minimal


import data.hash_map
import galois.list.fpow

universes u v w

lemma neq_symm {A : Type u} {x y : A}
  (H : x ≠ y) : y ≠ x
:= begin
intros contra,
apply H, symmetry, assumption
end

namespace map

/- Key-value maps. Not necessarily with finite domain.
   For instance, we could implement this with just
   `K → option V`.
-/
class mapc (K : Type u) (V : K → Type v)
   (Map : Type w) :=
  (deceqK : decidable_eq K)
  (empty : Map)
  (find : ∀ (k : K) (m : Map), option (V k))
  (insert : ∀  (k : K) (v : V k), Map → Map)
  (remove : ∀ (k : K), Map → Map)
  (eq_rel : ∀ (m m' : Map),
     (∀ k, find k m = find k m') → m = m')
  (insert_char : ∀ (m : Map) (k : K) (v : V k)
    (k' : K),
     find k' (insert k v m) = if H : k = k'
       then some (eq.rec_on H v)
       else find k' m)
  (remove_char : ∀ (m : Map) (k k' : K),
     find k' (remove k m) = if H : k = k'
       then none
       else find k' m)

instance (K : Type u) (V : K → Type v)
   (Map : Type w) [mapc K V Map] : decidable_eq K
  := mapc.deceqK V Map

/- Key-value maps with finite domain, indicated
   by the fact that their entires can be summarized
   by a Kuratowski-finite powerset.-/
class fmapc (K : Type u) (V : K → Type v) (Map : Type w)
  [deceqK : decidable_eq K]
  [inst : mapc K V Map] :=
  (to_list : Map → fpow (sigma V))
  (to_list_char : ∀ k (v : V k) (m : Map),
     mapc.find V k m = some v ↔ sigma.mk k v ∈ to_list m)

section map_facts
parameters {K : Type u} {V : K → Type v}
  (Map : Type w)
  [mapM : mapc K V Map]

include mapM

def updatef (k : K) (f : V k → V k) (m : Map) : Map
  :=
  match mapc.find V k m with
  | none := m
  | some v := mapc.insert k (f v) m
  end

def permutable (f : ∀ k : K, V k → Map → Map) :=
  ∀ (m : Map) (k k' : K) (v : V k) (v' : V k'),
     k ≠ k' → f k v (f k' v' m) = f k' v' (f k v m)

lemma insert_permutable :
  permutable (@mapc.insert _ _ Map mapM)
:= begin
unfold permutable, intros m k k' v v' Hne,
apply (@mapc.eq_rel _ _ Map mapM),
intros z,
repeat {rw mapc.insert_char},
apply (if Hkz : k = z then _ else _),
{ rw (dif_pos Hkz),
  subst z,
  rw (dif_neg (neq_symm Hne)),
  rw (dif_pos (eq.refl k)) },
{ repeat {rw (dif_neg Hkz)},
}
end

end map_facts

end map

def hash_map_eq {K : Type u} {V : K → Type v}
  [decidable_eq K]
  (m m' : hash_map K V) :=
  ∀ k, m.find k = m'.find k

def hash_map_q (K : Type u) (V : K → Type v) [decidable_eq K]
: Type (max u v) := quot (@hash_map_eq K V _)

namespace hash_map_q
section
parameters {K : Type u} {V : K → Type v} [decidable_eq K]

def empty (hash : K → ℕ) : hash_map_q K V :=
  quot.mk _ (mk_hash_map hash)

def insert (k : K) (v : V k) (m : hash_map_q K V)
  : hash_map_q K V
  :=
begin
fapply (quot.lift_on m),
exact ((λ x, quot.mk _ (x.insert k v))),
intros m m' Heq,
apply quot.sound, unfold hash_map_eq,
intros k',
repeat {rw hash_map.find_insert},
apply (if H : k = k' then _ else _),
repeat {rw (dif_pos H)},
repeat {rw (dif_neg H)}, apply Heq
end

def remove (k : K) (m : hash_map_q K V)
  : hash_map_q K V
:=
begin
fapply (quot.lift_on m),
exact (λ x, quot.mk _ (x.erase k)),
intros m m' Heq, apply quot.sound,
unfold hash_map_eq,
intros k',
repeat {rw hash_map.find_erase},
apply (if H : k = k' then _ else _),
repeat {rw (if_pos H)},
repeat {rw (if_neg H)}, apply Heq
end

def find (k : K) (m : hash_map_q K V)
  : option (V k) :=
begin
fapply (quot.lift_on m),
exact (λ x, x.find k),
intros m m' Heq, apply Heq
end

def to_list (m : hash_map_q K V) : fpow (sigma V)
:= begin
fapply (quot.lift_on m),
exact (λ x, fpow.from_list x.entries),
intros m m' H, apply quot.sound,
unfold same_elements,
intros z, cases z,
repeat {rw <- hash_map.find_iff},
rw (H fst)
end

end
end hash_map_q

instance hash_map_map (K : Type u) (V : K → Type v)
  [decidable_eq K]
  (hash : K → ℕ)
  : map.mapc K V (hash_map_q K V) :=
{ deceqK := by apply_instance
, empty := hash_map_q.empty hash
, find := hash_map_q.find
, insert := hash_map_q.insert
, remove := hash_map_q.remove
, eq_rel := begin
  intros m m' Heq, induction m, induction m',
  apply quot.sound, apply Heq,
  reflexivity, reflexivity,
  end
, insert_char := begin
  intros,
  induction m, simp [hash_map_q.insert],
  simp [hash_map_q.find],
  simp [quot.lift_on],
  apply hash_map.find_insert,
  reflexivity
  end
, remove_char := begin
  intros,
  induction m, simp [hash_map_q.remove],
  simp [hash_map_q.find],
  simp [quot.lift_on],
  apply (if H : k = k' then _ else _),
  repeat {rw (dif_pos H)},
  induction H,
  apply hash_map.find_erase_eq,
  repeat {rw (dif_neg H)},
  apply hash_map.find_erase_ne,
  assumption, reflexivity
  end
}

instance hash_map_fmap (K : Type u) (V : K → Type v)
  [deceqK : decidable_eq K]
  (hash : K → ℕ)
  : @map.fmapc K V (hash_map_q K V) deceqK
    (hash_map_map K V hash) :=
begin
tactic.fconstructor,
{ exact hash_map_q.to_list },
{ intros,
  induction m,
  simp [map.mapc.find, hash_map_q.find,
        hash_map_q.to_list, quot.lift_on],
  apply hash_map.find_iff,
  reflexivity
 }

end


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

import data.finset.basic

/-!
# Finsets of ordered types

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

universes u v w
variables {α : Type u}

theorem directed.finset_le {r : α → α → Prop} [is_trans α r]
  {ι} [hι : nonempty ι] {f : ι → α} (D : directed r f) (s : finset ι) :
  ∃ z, ∀ i ∈ s, r (f i) (f z) :=
show ∃ z, ∀ i ∈ s.1, r (f i) (f z), from
multiset.induction_on s.1 (let ⟨z⟩ := hι in ⟨z, λ _, false.elim⟩) $
λ i s ⟨j, H⟩, let ⟨k, h₁, h₂⟩ := D i j in
⟨k, λ a h, or.cases_on (multiset.mem_cons.1 h)
  (λ h, h.symm ▸ h₁)
  (λ h, trans (H _ h) h₂)⟩

lemma finset.exists_le [nonempty α] [preorder α] [is_directed α (≤)] (s : finset α) :
  ∃ M, ∀ i ∈ s, i ≤ M :=
directed_id.finset_le _