(******************************************************************************)
(* Project: Isabelle/UTP Toolkit                                              *)
(* File: Countable_Set_Extra.thy                                              *)
(* Authors: Simon Foster and Frank Zeyda                                      *)
(* Emails: simon.foster@york.ac.uk and frank.zeyda@york.ac.uk                 *)
(******************************************************************************)

section \<open> Countable Sets: Extra functions and properties \<close>

theory Countable_Set_Extra
imports
  "HOL-Library.Countable_Set_Type"
  Infinite_Sequence

begin

subsection \<open> Extra syntax \<close>

notation cempty ("{}\<^sub>c")
notation cin (infix "\<in>\<^sub>c" 50)
notation cUn (infixl "\<union>\<^sub>c" 65)
notation cInt (infixl "\<inter>\<^sub>c" 70)
notation cDiff (infixl "-\<^sub>c" 65)
notation cUnion ("\<Union>\<^sub>c_" [900] 900)
notation cimage (infixr "`\<^sub>c" 90)

abbreviation csubseteq :: "'a cset \<Rightarrow> 'a cset \<Rightarrow> bool" ("(_/ \<subseteq>\<^sub>c _)" [51, 51] 50)
where "A \<subseteq>\<^sub>c B \<equiv> A \<le> B"

abbreviation csubset :: "'a cset \<Rightarrow> 'a cset \<Rightarrow> bool" ("(_/ \<subset>\<^sub>c _)" [51, 51] 50)
where "A \<subset>\<^sub>c B \<equiv> A < B"

subsection \<open> Countable set functions \<close>

setup_lifting type_definition_cset

lift_definition cnin :: "'a \<Rightarrow> 'a cset \<Rightarrow> bool" (infix "\<notin>\<^sub>c" 50) is "(\<notin>)" .

definition cBall :: "'a cset \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool" where
"cBall A P = (\<forall>x. x \<in>\<^sub>c A \<longrightarrow> P x)"

definition cBex :: "'a cset \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool" where
"cBex A P = (\<exists>x. x \<in>\<^sub>c A \<longrightarrow> P x)"

declare cBall_def [mono,simp]
declare cBex_def [mono,simp]

syntax
  "_cBall" :: "pttrn => 'a cset => bool => bool" ("(3\<forall> _\<in>\<^sub>c_./ _)" [0, 0, 10] 10)
  "_cBex"  :: "pttrn => 'a cset => bool => bool" ("(3\<exists> _\<in>\<^sub>c_./ _)" [0, 0, 10] 10)

translations
  "\<forall> x\<in>\<^sub>cA. P" == "CONST cBall A (%x. P)"
  "\<exists> x\<in>\<^sub>cA. P" == "CONST cBex  A (%x. P)"

definition cset_Collect :: "('a \<Rightarrow> bool) \<Rightarrow> 'a cset" where
"cset_Collect = (acset o Collect)"

lift_definition cset_Coll :: "'a cset \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a cset" is "\<lambda> A P. {x \<in> A. P x}"
  by (auto)

lemma cset_Coll_equiv: "cset_Coll A P = cset_Collect (\<lambda> x. x \<in>\<^sub>c A \<and> P x)"
  by (simp add:cset_Collect_def cset_Coll_def cin_def)

declare cset_Collect_def [simp]

syntax
  "_cColl" :: "pttrn => bool => 'a cset" ("(1{_./ _}\<^sub>c)")

translations
  "{x . P}\<^sub>c" \<rightleftharpoons> "(CONST cset_Collect) (\<lambda> x . P)"

syntax (xsymbols)
  "_cCollect" :: "pttrn => 'a cset => bool => 'a cset"    ("(1{_ \<in>\<^sub>c/ _./ _}\<^sub>c)")
translations
  "{x \<in>\<^sub>c A. P}\<^sub>c" => "CONST cset_Coll A (\<lambda> x. P)"

lemma cset_CollectI: "P (a :: 'a::countable) \<Longrightarrow> a \<in>\<^sub>c {x. P x}\<^sub>c"
  by (simp add: cin_def)

lemma cset_CollI: "\<lbrakk> a \<in>\<^sub>c A; P a \<rbrakk> \<Longrightarrow> a \<in>\<^sub>c {x \<in>\<^sub>c A. P x}\<^sub>c"
  by (simp add: cin.rep_eq cset_Coll.rep_eq)

lemma cset_CollectD: "(a :: 'a::countable) \<in>\<^sub>c {x. P x}\<^sub>c \<Longrightarrow> P a"
  by (simp add: cin_def)

lemma cset_Collect_cong: "(\<And>x. P x = Q x) ==> {x. P x}\<^sub>c = {x. Q x}\<^sub>c"
  by simp

text \<open> Avoid eta-contraction for robust pretty-printing. \<close>

print_translation \<open>
 [Syntax_Trans.preserve_binder_abs_tr'
   @{const_syntax cset_Collect} @{syntax_const "_cColl"}]
\<close>

lift_definition cset_set :: "'a list \<Rightarrow> 'a cset" is set
  using countable_finite by blast

lemma countable_finite_power:
  "countable(A) \<Longrightarrow> countable {B. B \<subseteq> A \<and> finite(B)}"
  by (metis Collect_conj_eq Int_commute countable_Collect_finite_subset)

lift_definition cInter :: "'a cset cset \<Rightarrow> 'a cset"  ("\<Inter>\<^sub>c_" [900] 900)
  is "\<lambda>A. if A = {} then {} else \<Inter> A"
  using countable_INT [of _ _ id] by auto

abbreviation (input) cINTER :: "'a cset \<Rightarrow> ('a \<Rightarrow> 'b cset) \<Rightarrow> 'b cset"
  where "cINTER A f \<equiv> cInter (cimage f A)"

lift_definition cfinite :: "'a cset \<Rightarrow> bool" is finite .
lift_definition cInfinite :: "'a cset \<Rightarrow> bool" is infinite .
lift_definition clist :: "'a::linorder cset \<Rightarrow> 'a list" is sorted_list_of_set .
lift_definition ccard :: "'a cset \<Rightarrow> nat" is card .
lift_definition cPow :: "'a cset \<Rightarrow> 'a cset cset" is "\<lambda> A. {B. B \<subseteq>\<^sub>c A \<and> cfinite(B)}"
proof -
  fix A
  have "{B :: 'a cset. B \<subseteq>\<^sub>c A \<and> cfinite B} = acset ` {B :: 'a set. B \<subseteq> rcset A \<and> finite B}"
    apply (auto simp add: cfinite.rep_eq cin_def less_eq_cset_def countable_finite)
    using image_iff apply fastforce
    done

  moreover have "countable {B :: 'a set. B \<subseteq> rcset A \<and> finite B}"
    by (auto intro: countable_finite_power)

  ultimately show "countable {B. B \<subseteq>\<^sub>c A \<and> cfinite B}"
    by simp
qed

definition CCollect :: "('a \<Rightarrow> bool option) \<Rightarrow> 'a cset option" where
"CCollect p = (if (None \<notin> range p) then Some (cset_Collect (the \<circ> p)) else None)"

definition cset_mapM :: "'a option cset \<Rightarrow> 'a cset option" where
"cset_mapM A = (if (None \<in>\<^sub>c A) then None else Some (the `\<^sub>c A))"

lemma cset_mapM_Some_image [simp]:
  "cset_mapM (cimage Some A) = Some A"
  apply (auto simp add: cset_mapM_def)
  apply (metis cimage_cinsert cinsertI1 option.sel set_cinsert)
  done

definition CCollect_ext :: "('a \<Rightarrow> 'b option) \<Rightarrow> ('a \<Rightarrow> bool option) \<Rightarrow> 'b cset option" where
"CCollect_ext f p = do { xs \<leftarrow> CCollect p; cset_mapM (f `\<^sub>c xs) }"

lemma the_Some_image [simp]:
  "the ` Some ` xs = xs"
  by (auto simp add:image_iff)

lemma CCollect_ext_Some [simp]:
  "CCollect_ext Some xs = CCollect xs"
  apply (case_tac "CCollect xs")
   apply (auto simp add:CCollect_ext_def)
  done

lift_definition list_of_cset :: "'a :: linorder cset \<Rightarrow> 'a list" is sorted_list_of_set .

definition cset_count :: "'a cset \<Rightarrow> 'a \<Rightarrow> nat" where
"cset_count A =
  (if (finite (rcset A))
   then (SOME f::'a\<Rightarrow>nat. inj_on f (rcset A))
   else (SOME f::'a\<Rightarrow>nat. bij_betw f (rcset A) UNIV))"

lemma cset_count_inj_seq:
  "inj_on (cset_count A) (rcset A)"
proof (cases "finite (rcset A)")
  case True note fin = this
  obtain count :: "'a \<Rightarrow> nat" where count_inj: "inj_on count (rcset A)"
    by (metis countable_def mem_Collect_eq rcset)
  with fin show ?thesis
    by (metis (poly_guards_query) cset_count_def someI_ex)
next
  case False note inf = this
  obtain count :: "'a \<Rightarrow> nat" where count_bij: "bij_betw count (rcset A) UNIV"
    by (metis countableE_infinite inf mem_Collect_eq rcset)
  with inf have "bij_betw (cset_count A) (rcset A) UNIV"
    by (metis (poly_guards_query) cset_count_def someI_ex)
  thus ?thesis
    by (metis bij_betw_imp_inj_on)
qed

lemma cset_count_infinite_bij:
  assumes "infinite (rcset A)"
  shows "bij_betw (cset_count A) (rcset A) UNIV"
proof -
  from assms obtain count :: "'a \<Rightarrow> nat" where count_bij: "bij_betw count (rcset A) UNIV"
    by (metis countableE_infinite mem_Collect_eq rcset)
  with assms show ?thesis
    by (metis (poly_guards_query) cset_count_def someI_ex)
qed

definition cset_seq :: "'a cset \<Rightarrow> (nat \<rightharpoonup> 'a)" where
"cset_seq A i = (if (i \<in> range (cset_count A) \<and> inv_into (rcset A) (cset_count A) i \<in>\<^sub>c A)
                 then Some (inv_into (rcset A) (cset_count A) i)
                 else None)"

lemma cset_seq_ran: "ran (cset_seq A) = rcset(A)"
  apply (auto simp add: ran_def cset_seq_def cin.rep_eq)
  apply (metis cset_count_inj_seq inv_into_f_f rangeI)
  done

lemma cset_seq_inj: "inj cset_seq"
proof (rule injI)
  fix A B :: "'a cset"
  assume "cset_seq A = cset_seq B"
  thus "A = B"
    by (metis cset_seq_ran rcset_inverse)
qed

lift_definition cset2infseq :: "'a cset \<Rightarrow> 'a infseq"
is "(\<lambda> A i. if (i \<in> cset_count A ` rcset A) then inv_into (rcset A) (cset_count A) i else (SOME x. x \<in>\<^sub>c A))" .

lemma range_cset2infseq:
  "A \<noteq> {}\<^sub>c \<Longrightarrow> range (Rep_infseq (cset2infseq A)) = rcset A"
  by (force intro: someI2 simp add: cset2infseq.rep_eq cset_count_inj_seq bot_cset.rep_eq cin.rep_eq)

lemma infinite_cset_count_surj: "infinite (rcset A) \<Longrightarrow> surj (cset_count A)"
  using bij_betw_imp_surj cset_count_infinite_bij by auto

lemma cset2infseq_inj:
  "inj_on cset2infseq {A. A \<noteq> {}\<^sub>c}"
  apply (rule inj_onI)
  apply (simp)
  apply (metis range_cset2infseq rcset_inject)
  done

lift_definition nat_infseq2set :: "nat infseq \<Rightarrow> nat set" is
"\<lambda> f. prod_encode ` {(x, f x) | x. True}" .

lemma inj_nat_infseq2set: "inj nat_infseq2set"
proof (rule injI, transfer)
  fix f g
  assume "prod_encode ` {(x, f x) |x. True} = prod_encode ` {(x, g x) |x. True}"
  hence "{(x, f x) |x. True} = {(x, g x) |x. True}"
    by (simp add: inj_image_eq_iff[OF inj_prod_encode])
  thus "f = g"
    by (auto simp add: set_eq_iff)
qed

lift_definition bit_infseq_of_nat_set :: "nat set \<Rightarrow> bool infseq"
is "\<lambda> A i. i \<in> A" .

lemma bit_infseq_of_nat_set_inj: "inj bit_infseq_of_nat_set"
  apply (rule injI)
  apply transfer
  apply (auto simp add: fun_eq_iff)
  done

lemma bit_infseq_of_nat_cset_bij: "bij bit_infseq_of_nat_set"
  apply (rule bijI)
   apply (fact bit_infseq_of_nat_set_inj)
  apply transfer
  apply (rule surjI)
  apply auto
  done

text \<open> This function is a partial injection from countable sets of natural sets to natural sets.
        When used with the Schroeder-Bernstein theorem, it can be used to conjure a total
        bijection between these two types. \<close>

definition nat_set_cset_collapse :: "nat set cset \<Rightarrow> nat set" where
"nat_set_cset_collapse = inv bit_infseq_of_nat_set \<circ> infseq_inj \<circ> cset2infseq \<circ> (\<lambda> A. (bit_infseq_of_nat_set `\<^sub>c A))"

lemma nat_set_cset_collapse_inj: "inj_on nat_set_cset_collapse {A. A \<noteq> {}\<^sub>c}"
proof -
  have "(`\<^sub>c) bit_infseq_of_nat_set ` {A. A \<noteq> {}\<^sub>c} \<subseteq> {A. A \<noteq> {}\<^sub>c}"
    by (auto simp add:cimage.rep_eq)
  thus ?thesis
    apply (simp add: nat_set_cset_collapse_def)
    apply (rule comp_inj_on)
     apply (meson bit_infseq_of_nat_set_inj cset.inj_map injD inj_onI)
    apply (rule comp_inj_on)
     apply (metis cset2infseq_inj subset_inj_on)
    apply (rule comp_inj_on)
     apply (rule subset_inj_on)
      apply (rule infseq_inj)
     apply (simp)
    apply (meson UNIV_I bij_imp_bij_inv bij_is_inj bit_infseq_of_nat_cset_bij subsetI subset_inj_on)
    done
qed

lemma inj_csingle:
  "inj csingle"
  by (auto intro: injI simp add: cinsert_def bot_cset.rep_eq)

lemma range_csingle:
  "range csingle \<subseteq> {A. A \<noteq> {}\<^sub>c}"
  by (auto)

lift_definition csets :: "'a set \<Rightarrow> 'a cset set" is
"\<lambda> A. {B. B \<subseteq> A \<and> countable B}" by auto

lemma csets_finite: "finite A \<Longrightarrow> finite (csets A)"
  by (auto simp add: csets_def)

lemma csets_infinite: "infinite A \<Longrightarrow> infinite (csets A)"
  by (auto simp add: csets_def, metis csets.abs_eq csets.rep_eq finite_countable_subset finite_imageI)

lemma csets_UNIV:
  "csets (UNIV :: 'a set) = (UNIV :: 'a cset set)"
  by (auto simp add: csets_def, metis image_iff rcset rcset_inverse)

lemma infinite_nempty_cset:
  assumes "infinite (UNIV :: 'a set)"
  shows "infinite ({A. A \<noteq> {}\<^sub>c} :: 'a cset set)"
proof -
  have "infinite (UNIV :: 'a cset set)"
    by (metis assms csets_UNIV csets_infinite)
  hence "infinite ((UNIV :: 'a cset set) - {{}\<^sub>c})"
    by (rule infinite_remove)
  thus ?thesis
    by (auto)
qed

lemma nat_set_cset_partial_bij:
  obtains f :: "nat set cset \<Rightarrow> nat set" where "bij_betw f {A. A \<noteq> {}\<^sub>c} UNIV"
  using Schroeder_Bernstein[OF nat_set_cset_collapse_inj, of UNIV csingle, simplified, OF inj_csingle range_csingle]
  by (auto)

lemma nat_set_cset_bij:
  obtains f :: "nat set cset \<Rightarrow> nat set" where "bij f"
proof -
  obtain g :: "nat set cset \<Rightarrow> nat set" where "bij_betw g {A. A \<noteq> {}\<^sub>c} UNIV"
    using nat_set_cset_partial_bij by blast
  moreover obtain h :: "nat set cset \<Rightarrow> nat set cset" where "bij_betw h UNIV {A. A \<noteq> {}\<^sub>c}"
  proof -
    have "infinite (UNIV :: nat set cset set)"
      by (metis Finite_Set.finite_set csets_UNIV csets_infinite infinite_UNIV_char_0)
    then obtain h' :: "nat set cset \<Rightarrow> nat set cset" where "bij_betw h' UNIV (UNIV - {{}\<^sub>c})"
      using infinite_imp_bij_betw[of "UNIV :: nat set cset set" "{}\<^sub>c"] by auto
    moreover have "(UNIV :: nat set cset set) - {{}\<^sub>c} = {A. A \<noteq> {}\<^sub>c}"
      by (auto)
    ultimately show ?thesis
      using that by (auto)
  qed
  ultimately have "bij (g \<circ> h)"
    using bij_betw_trans by blast
  with that show ?thesis
    by (auto)
qed

definition "nat_set_cset_bij = (SOME f :: nat set cset \<Rightarrow> nat set. bij f)"

lemma bij_nat_set_cset_bij:
  "bij nat_set_cset_bij"
  by (metis nat_set_cset_bij nat_set_cset_bij_def someI_ex)

lemma inj_on_image_csets:
  "inj_on f A \<Longrightarrow> inj_on ((`\<^sub>c) f) (csets A)"
  by (fastforce simp add: inj_on_def cimage_def cin_def csets_def)

lemma image_csets_surj:
  "\<lbrakk> inj_on f A; f ` A = B \<rbrakk> \<Longrightarrow> (`\<^sub>c) f ` csets A = csets B"
  apply (auto simp add: cimage_def csets_def image_mono map_fun_def)
  apply (simp add: image_comp)
  apply (auto simp add: image_Collect)
  apply (erule subset_imageE)
  using countable_image_inj_on subset_inj_on by blast

lemma bij_betw_image_csets:
  "bij_betw f A B \<Longrightarrow> bij_betw ((`\<^sub>c) f) (csets A) (csets B)"
  by (simp add: bij_betw_def inj_on_image_csets image_csets_surj)
end


(***********************************************************************
* HiVe theory files
*
* Copyright (C) 2015 Commonwealth of Australia as represented by Defence Science and Technology
* Group (DST Group)
*
* All rights reserved.
*
* The HiVe theory files are free software: released for redistribution and use, and/or modification,
* under the BSD License, details of which can be found in the LICENSE file included in the
* distribution.
************************************************************************)

theory
  Z_Sets

imports
  Z_Exp
  Z_Rel_Chap

begin

section {* The Set Order *}

text {*

The empty set, universal set and subset relations~\cite[p 90]{Spivey:ZRef}\cite[p 95]{ZStand02}
are defined as operators in HOL. We make use of the existing, type-generic operators,
with appropriate Z-style syntax.

*}

lemma Z_empty_def:
  "\<emptyset> = { x | \<False> }"
  by (auto)

lemma Z_UNIV_def:
  "\<univ> = { x | \<True> }"
  by (auto)

lemma Z_subseteq_def:
  "S \<subseteq> T \<defs> (\<forall> x \<bullet> x \<in> S \<Rightarrow> x \<in> T)"
  apply (rule eq_reflection)
  apply (auto)
  done

lemma Z_subset_def:
  "S \<subset> T \<defs> S \<subseteq> T \<and> S \<noteq> T"
  apply (rule eq_reflection)
  apply (auto)
  done

text {*

The non-empty power set~\cite[p 90]{Spivey:ZRef}\cite[p 96]{ZStand02}
we define as an operator on sets.

*}

definition
  Pow1 :: "'a set \<rightarrow> 'a set set"
where
  Z_Pow1_def: "Pow1 X \<defs> { S | S \<in> \<pset> X \<and> S \<noteq> \<emptyset> }"

notation (xsymbols)
  Pow1 ("\<pset>\<subone>")

lemma Z_notin_empty:
  "x \<notin> \<emptyset>"
  by (auto)

lemma Z_subset_Pow:
  "S \<subseteq> T \<Leftrightarrow> S \<in> \<pset> T"
  by (auto)

lemma Z_subset_refl:
  "S \<subseteq> S"
  by (rule order_refl)

lemma Z_subset_antisym:
  "S \<subseteq> T \<and> T \<subseteq> S \<Leftrightarrow> S = T"
  by (auto intro: order_antisym)

lemma Z_subset_trans:
  "S \<subseteq> T \<and> T \<subseteq> V \<Rightarrow> S \<subseteq> V"
  by (auto)

lemma Z_psubset_not_refl:
  "\<not>\<^zid>{:(S \<subset> S):}"
  by (auto)

lemma Z_psubset_chained:
  "\<not>(S \<subset> T \<and> T \<subset> S)"
  by (auto)

lemma Z_psubset_trans:
  "S \<subset> T \<and> T \<subset> V \<Rightarrow> S \<subset> V"
  by (auto)

lemma Z_empty_subset:
  "\<emptyset> \<subseteq> S"
  by (auto)

lemma Z_empty_psubset:
  "\<emptyset> \<subset> S \<Leftrightarrow> S \<noteq> \<emptyset>"
  by (auto)

lemma Z_Pow1_empty:
  "\<pset>\<subone> X = \<emptyset> \<Leftrightarrow> X = \<emptyset>"
  by (auto simp add: Z_Pow1_def)

lemma Z_nempty_Pow1:
  "X \<noteq> \<emptyset> \<Leftrightarrow> X \<in> \<pset>\<subone> X"
  by (auto simp add: Z_Pow1_def)

section {* Set operators *}

text {*

Set union, intersection, and difference~\cite[p 91]{Spivey:ZRef}\cite[p 97]{ZStand02}
are already defined in HOL.
We make use of the existing, type-generic operators,
with appropriate Z-style syntax.

Difference is type generic in Isabelle, so we provide a specialised syntax for the
set instantiation.

*}

abbreviation
  set_minus :: "['a set, 'a set] \<rightarrow> 'a set" (infixl "\<setminus>" 55)
where
  "S \<setminus> T \<defs> S - T"

(*

BPM [130408]: I think this is now unnecessary.

syntax (xsymbols output)
  "_Z_Sets\<ZZ>setsub" :: "[logic, logic] \<fun> logic" (infixl "\<setminus>" 55)

syntax (zed)
  "_Z_Sets\<ZZ>setsub" :: "[logic, logic] \<fun> logic" (infixl "\<setminus>" 55)

translations
  "X \<setminus> Y" \<rightharpoonup> "(X::_ set) - Y"

typed_print_translation {*

let
  fun is_setT (Type("fun", [Type("fun", [_, Type("bool", _)]), _])) = true
   |  is_setT _ = false;
  fun trT' flag typ [a, b] =
    if is_setT (typ) then
      Const("_Z_Sets\<ZZ>setsub", typ) $ a $ b
    else
      raise Match;
in
  [("\<^const>HOL.minus_class.minus", trT')]
end;
*}

*)

lemma Z_set_operations_def:
  "\<forall> S T \<bullet>
     S \<union> T = { x | x \<in> S \<or> x \<in> T} \<and>
     S \<inter> T = { x | x \<in> S \<and> x \<in> T} \<and>
     S \<setminus> T = { x | x \<in> S \<and> x \<notin> T}"
  by (auto)

lemma Z_union_def:
  "S \<union> T = { x | x \<in> S \<or> x \<in> T}"
  by (auto simp add: Un_def)

lemma Z_inter_def:
  "S \<inter> T = { x | x \<in> S \<and> x \<in> T}"
  by (auto simp add: Int_def)

lemma Z_set_diff_def:
  "S \<setminus> T = { x | x \<in> S \<and> x \<notin> T}"
  by (auto)

lemma Z_set_identities:
  shows
    set_union_idem: "S \<union> S = S" and
    set_union_empty: "S \<union> \<emptyset> = S" and
    set_inter_idem: "S \<inter> S = S" and
    set_diff_empty: "S \<setminus> \<emptyset> = S"
  by (auto)

lemma Z_empty_identities:
  shows
    set_inter_empty: "S \<inter> \<emptyset> = \<emptyset>" and
    set_diff_set: "S \<setminus> S = \<emptyset>" and
    empty_diff: "\<emptyset> \<setminus> S = \<emptyset>"
  by (auto)

lemma Z_union_comm:
  "S \<union> T = T \<union> S"
  by (auto)

lemma Z_union_assoc:
  "S \<union> (T \<union> V) = (S \<union> T) \<union> V"
  by (auto)

lemma Z_inter_comm:
  "S \<inter> T = T \<inter> S"
  by (auto)

lemma Z_inter_assoc:
  "S \<inter> (T \<inter> V) = (S \<inter> T) \<inter> V"
  by (auto)

lemma Z_union_dist:
  "S \<union> (T \<inter> V) = (S \<union> T) \<inter> (S \<union> V)"
  by (auto)

lemma Z_inter_dist:
  "S \<inter> (T \<union> V) = (S \<inter> T) \<union> (S \<inter> V)"
  by (auto)

lemma Z_partition:
  "(S \<inter> T) \<union> (S \<setminus> T) = S"
  by (auto)

lemma Z_diff_disjoint:
  "(S \<setminus> T) \<inter> T = \<emptyset>"
  by (auto)

lemma Z_union_diff:
  "S \<union> (T \<setminus> V) = (S \<union> T) \<setminus> (V \<setminus> S)"
  by (auto)

lemma Z_inter_diff:
  "S \<inter> (T \<setminus> V) = (S \<inter> T) \<setminus> V"
  by (auto)

lemma Z_diff_diff1:
  "S \<setminus> (T \<setminus> V) = (S \<setminus> T) \<union> (S \<inter> V)"
  by (auto)

lemma Z_diff_diff2:
  "(S \<setminus> T) \<setminus> V = S \<setminus> (T \<union> V)"
  by (auto)

lemma Z_diff_union:
  "(S \<union> T) \<setminus> V = (S \<setminus> V) \<union> (T \<setminus> V)"
  by (auto)

lemma Z_diff_inter:
  "S \<setminus> (T \<inter> V) = (S \<setminus> T) \<union> (S \<setminus> V)"
  by (auto)

text {*

The symmetric set difference operator~\cite[p 97]{ZStand02} is not already defined in HOL.
We define it as a binary set operator.

*}

definition
  sym_diff :: "['a set, 'a set] \<rightarrow> 'a set"
where
  sym_diff_def: "sym_diff X Y \<defs> { x | x \<in> X \<xor> x \<in> Y }"

notation (xsymbols)
  sym_diff (infixl "\<ominus>" 60)

lemma Z_union_inter_diff_idem:
  "\<lch> S \<union> S \<chEq> S \<union> \<emptyset> \<chEq> S \<inter> S \<chEq> S \<setminus> \<emptyset> \<chEq> S \<rch>"
  by (simp add: set_union_idem set_union_empty set_inter_idem)

lemma Z_inter_diff_empty:
  "\<lch> S \<inter> \<emptyset> \<chEq> S \<setminus> S \<chEq> \<emptyset> \<setminus> S \<chEq> \<emptyset> \<rch>"
  by (simp add: set_inter_empty set_diff_set empty_diff)

text {*

Generalised union and intersection~\cite[p 92]{Spivey:ZRef}\cite[p 97]{ZStand02}
are defined as operators in HOL.
We make use of the existing, type-generic operators,
with appropriate Z-style syntax.

*}

lemma Z_Union_Inter_def:
  "\<forall> A \<bullet>
    \<Union>A = { x | (\<exists> S | S \<in> A \<bullet> x \<in> S) } \<and>
    \<Inter>A = { x | (\<forall> S | S \<in> A \<bullet> x \<in> S) }"
  by (auto)

lemma Z_Union_def:
  "\<Union>A = { x | (\<exists> S | S \<in> A \<bullet> x \<in> S) }"
  by (auto simp add: Union_eq)

lemma Z_Inter_def:
  "\<Inter>A = { x | (\<forall> S | S \<in> A \<bullet> x \<in> S) }"
  by (auto simp add: Inter_eq)

lemma Z_Union_union_dist:
  "\<Union>(A \<union> B) = (\<Union>A) \<union> (\<Union>B)"
  by (auto)

lemma Z_Inter_union_dist:
  "\<Inter>(A \<union> B) = (\<Inter>A) \<inter> (\<Inter>B)"
  by (auto)

lemma Z_Union_empty:
  "\<Union>\<emptyset> = \<emptyset>"
  by (auto)

text {*

Since generalised intersection is type generic, so the intersection of the empty
set is the whole type, rather than the set generic.

*}

lemma Z_Inter_empty:
  "\<Inter>\<emptyset> = \<univ>"
  by (auto)

lemma Z_inter_Union_dist:
  "S \<inter> (\<Union>A) = (\<Union> T | T \<in> A \<bullet> S \<inter> T)"
  by (auto simp add: eind_def)

lemma Z_union_Inter_dist:
  "S \<union> (\<Inter>A) = (\<Inter> T | T \<in> A \<bullet> S \<union> T)"
  by (auto)+

lemma Z_Union_diff_dist:
  "(\<Union>A) \<setminus> S = (\<Union> T | T \<in> A \<bullet> T \<setminus> S)"
  by (auto)+

lemma Z_diff_Inter_dist:
  "S \<setminus> (\<Inter>A) = (\<Union> T | T \<in> A \<bullet> S \<setminus> T)"
  by (auto)+

lemma Z_diff_Union_dist:
  "A \<noteq> \<emptyset> \<Rightarrow> S \<setminus> (\<Union>A) = (\<Inter> T | T \<in> A \<bullet> S \<setminus> T)"
  by (auto)+

lemma Z_Inter_diff_dist:
  "A \<noteq> \<emptyset> \<Rightarrow> (\<Inter>A) \<setminus> S = (\<Inter> T | T \<in> A \<bullet> T \<setminus> S)"
  by (auto)+

lemma Z_Union_mono:
  "A \<subseteq> B \<Rightarrow> \<Union>A \<subseteq> \<Union>B"
  by (auto)

lemma Z_Inter_antimono:
  "A \<subseteq> B \<Rightarrow> \<Inter>B \<subseteq> \<Inter>A"
  by (auto)

section {* Finite Sets *}

text {*

We introduce finite subsets and finite non-empty
subsets~\cite[p 111]{Spivey:ZRef}\cite[p 97]{ZStand02} as set operators.
We define them as restrictions of the existing HOL finite set operator,
giving the semantics.

*}

definition
  fin_pow :: "'a set \<rightarrow> 'a set set"
where
  fin_pow_def: "fin_pow X \<defs> { Y | Y \<in> \<pset> X \<and> finite Y }"

notation (xsymbols)
  fin_pow ("\<fset>")

definition
  fin_pow1 :: "'a set \<rightarrow> 'a set set"
where
  fin_pow1_def: "fin_pow1 X \<defs> \<fset> X \<setminus> {\<emptyset>}"

notation (zed)
  fin_pow1 ("\<fset>\<subone>")

lemma fin_pow_induct [induct set: fin_pow]:
  assumes
    a1: "S \<in> \<fset> X" and
    a2: "P \<emptyset>" and
    a3: "\<And> x S \<bullet> \<lbrakk> S \<in> \<fset> X; P S; x \<in> X; x \<notin> S \<rbrakk>  \<turnstile> P (insert x S)"
  shows "P S"
proof -
  from a1 have
    b1: "finite S"
    by (simp add: fin_pow_def)
  from b1 have
    "S \<subseteq> X \<Rightarrow> P S"
    apply (induct set: finite)
    using a2 a3
    apply (auto simp add: fin_pow_def)
    done
  with a1 show "P S"
    by (simp add: fin_pow_def)
qed

text {*

Finally we introduce some results about the set order~\cite[p 94]{Spivey:ZRef}.

*}

lemma Z_union_lub:
  shows
    union_ub1: "S \<subseteq> S \<union> T" and
    union_ub2: "T \<subseteq> S \<union> T" and
    union_least: "S \<subseteq> W \<and> T \<subseteq> W \<Rightarrow> S \<union> T \<subseteq> W"
  by (auto)

lemma Z_Union_lub:
  shows
    Union_ub: "S \<in> A \<Rightarrow> S \<subseteq> (\<Union>A)" and
    Union_least: "(\<forall> S | S \<in> A \<bullet> S \<subseteq> W) \<Rightarrow> (\<Union>A) \<subseteq> W"
  by (auto)

lemma Z_inter_glb:
  shows
    inter_lb1: "S \<inter> T \<subseteq> S" and
    inter_lb2: "S \<inter> T \<subseteq> T" and
    inter_greatest: "W \<subseteq> S \<and> W \<subseteq> T \<Rightarrow> W \<subseteq> S \<inter> T"
  by (auto)

lemma Z_Inter_glb:
  shows
    Z_Inter_lb: "S \<in> A \<Rightarrow> (\<Inter>A) \<subseteq> S" and
    Z_Inter_greatest: "(\<forall> S | S \<in> A \<bullet> W \<subseteq> S) \<Rightarrow> W \<subseteq> (\<Inter>A)"
  by (auto)

lemma diff_gdlb:
  shows
    diff_lb: "S \<setminus> T \<subseteq> S" and
    diff_disjoint: "(S \<setminus> T) \<inter> T = \<emptyset>" and
    diff_greatest: "W \<subseteq> S \<and> W \<inter> T = \<emptyset> \<Rightarrow> W \<subseteq> S \<setminus> T"
  by (auto)

end


(*  Title:      HOL/Nunchaku_Examples/Core_Nuns.thy
    Author:     Jasmin Blanchette, Inria Nancy, LORIA, MPII
    Copyright   2009-2015

Examples featuring Nunchaku's functional core.
*)

section {* Examples Featuring Nunchaku's Functional Core *}

theory Core_Nuns
imports "../Nunchaku"
begin

nunchaku_params [verbose, max_potential = 0, timeout = 240]

subsection {* Curry in a Hurry *}

lemma "(\<lambda>f x y. (curry o case_prod) f x y) = (\<lambda>f x y. (\<lambda>x. x) f x y)"
nunchaku [expect = none]
by auto

lemma "(\<lambda>f p. (case_prod o curry) f p) = (\<lambda>f p. (\<lambda>x. x) f p)"
nunchaku [expect = none]
by auto

lemma "case_prod (curry f) = f"
nunchaku [expect = none]
by auto

lemma "curry (case_prod f) = f"
nunchaku [expect = none]
by auto

lemma "case_prod (\<lambda>x y. f (x, y)) = f"
nunchaku [expect = none]
by auto

subsection {* Representations *}

lemma "\<exists>f. f = (\<lambda>x. x) \<and> f y = y"
nunchaku [expect = none]
by auto

lemma "(\<exists>g. \<forall>x. g (f x) = x) \<longrightarrow> (\<forall>y. \<exists>x. y = f x)"
nunchaku [card 'a = 25, card 'b = 24, expect = genuine]
nunchaku [mono, expect = none]
oops

lemma "\<exists>f. f = (\<lambda>x. x) \<and> f y \<noteq> y"
nunchaku [expect = genuine]
oops

lemma "P (\<lambda>x. x)"
nunchaku [expect = genuine]
oops

lemma "{(a :: 'a \<times> 'a, b :: 'b)}^-1 = {(b, a)}"
nunchaku [expect = none]
by auto

lemma "fst (a, b) = a"
nunchaku [expect = none]
by auto

lemma "\<exists>P. P = Id"
nunchaku [expect = none]
by auto

lemma "(a :: 'a \<Rightarrow> 'b, a) \<in> Id\<^sup>*"
nunchaku [expect = none]
by auto

lemma "(a :: 'a \<times> 'a, a) \<in> Id\<^sup>* \<union> {(a, b)}\<^sup>*"
nunchaku [expect = none]
by auto

lemma "(a, a) \<in> Id"
nunchaku [expect = none]
by (auto simp: Id_def)

lemma "((a :: 'a, b :: 'a), (a, b)) \<in> Id"
nunchaku [expect = none]
by (auto simp: Id_def)

lemma "(x :: 'a \<times> 'a) \<in> UNIV"
nunchaku [expect = none]
sorry

lemma "{} = A - A"
nunchaku [expect = none]
by auto

lemma "g = Let (A \<or> B)"
nunchaku [expect = genuine]
oops

lemma "(let a_or_b = A \<or> B in a_or_b \<or> \<not> a_or_b)"
nunchaku [expect = none]
by auto

lemma "A \<subseteq> B"
nunchaku [expect = genuine]
oops

lemma "A = {b}"
nunchaku [expect = genuine]
oops

lemma "{a, b} = {b}"
nunchaku [expect = genuine]
oops

lemma "(a :: 'a \<times> 'a, a :: 'a \<times> 'a) \<in> R"
nunchaku [expect = genuine]
oops

lemma "f (g :: 'a \<Rightarrow> 'a) = x"
nunchaku [expect = genuine]
oops

lemma "f (a, b) = x"
nunchaku [expect = genuine]
oops

lemma "f (a, a) = f (c, d)"
nunchaku [expect = genuine]
oops

lemma "(x :: 'a) = (\<lambda>a. \<lambda>b. \<lambda>c. if c then a else b) x x True"
nunchaku [expect = none]
by auto

lemma "\<exists>F. F a b = G a b"
nunchaku [expect = none]
by auto

lemma "f = case_prod"
nunchaku [expect = genuine]
oops

lemma "(A :: 'a \<times> 'a, B :: 'a \<times> 'a) \<in> R \<Longrightarrow> (A, B) \<in> R"
nunchaku [expect = none]
by auto

lemma "(A, B) \<in> R \<or> (\<exists>C. (A, C) \<in> R \<and> (C, B) \<in> R) \<Longrightarrow>
       A = B \<or> (A, B) \<in> R \<or> (\<exists>C. (A, C) \<in> R \<and> (C, B) \<in> R)"
nunchaku [expect = none]
by auto

lemma "f = (\<lambda>x :: 'a \<times> 'b. x)"
nunchaku [expect = genuine]
oops

subsection {* Quantifiers *}

lemma "x = y"
nunchaku [expect = genuine]
oops

lemma "\<forall>x. x = y"
nunchaku [expect = genuine]
oops

lemma "\<forall>x :: 'a \<Rightarrow> bool. x = y"
nunchaku [expect = genuine]
oops

lemma "\<exists>x :: 'a \<Rightarrow> bool. x = y"
nunchaku [expect = unknown]
by auto

lemma "\<exists>x y :: 'a \<Rightarrow> bool. x = y"
nunchaku [expect = unknown]
by auto

lemma "\<forall>x. \<exists>y. f x y = f x (g x)"
nunchaku [expect = none]
by auto

lemma "\<forall>u. \<exists>v. \<forall>w. \<exists>x. f u v w x = f u (g u) w (h u w)"
nunchaku [expect = none]
by auto

lemma "\<forall>u. \<exists>v. \<forall>w. \<exists>x. f u v w x = f u (g u w) w (h u)"
nunchaku [expect = genuine]
oops

lemma "\<forall>u. \<exists>v. \<forall>w. \<exists>x. \<forall>y. \<exists>z. f u v w x y z = f u (g u) w (h u w) y (k u w y)"
nunchaku [expect = none]
by auto

lemma "\<forall>u. \<exists>v. \<forall>w. \<exists>x. \<forall>y. \<exists>z. f u v w x y z = f u (g u) w (h u w y) y (k u w y)"
nunchaku [expect = genuine]
oops

lemma "\<forall>u. \<exists>v. \<forall>w. \<exists>x. \<forall>y. \<exists>z. f u v w x y z = f u (g u w) w (h u w) y (k u w y)"
nunchaku [expect = genuine]
oops

lemma "\<forall>u :: 'a \<times> 'b. \<exists>v :: 'c. \<forall>w :: 'd. \<exists>x :: 'e \<times> 'f. f u v w x = f u (g u) w (h u w)"
nunchaku [expect = none]
by blast

lemma "\<forall>u :: 'a \<times> 'b. \<exists>v :: 'c. \<forall>w :: 'd. \<exists>x :: 'e \<times> 'f. f u v w x = f u (g u w) w (h u)"
nunchaku [expect = genuine]
oops

lemma "\<forall>u :: 'a \<Rightarrow> 'b. \<exists>v :: 'c. \<forall>w :: 'd. \<exists>x :: 'e \<Rightarrow> 'f. f u v w x = f u (g u) w (h u w)"
nunchaku [expect = none]
by blast

lemma "\<forall>u :: 'a \<Rightarrow> 'b. \<exists>v :: 'c. \<forall>w :: 'd. \<exists>x :: 'e \<Rightarrow> 'f. f u v w x = f u (g u w) w (h u)"
nunchaku [expect = genuine]
oops

lemma "\<forall>x. if \<forall>y. x = y then False else True"
nunchaku [expect = genuine]
oops

lemma "\<forall>x :: 'a \<times> 'b. if \<forall>y. x = y then False else True"
nunchaku [expect = genuine]
oops

lemma "\<forall>x. if \<exists>y. x = y then True else False"
nunchaku [expect = none]
by simp

lemma "(\<exists>x :: 'a. \<forall>y. P x y) \<or> (\<exists>x :: 'a \<times> 'a. \<forall>y. P y x)"
nunchaku [expect = genuine]
oops

lemma "\<exists>x. if x = y then \<forall>y. y = x \<or> y \<noteq> x else \<forall>y. y = (x, x) \<or> y \<noteq> (x, x)"
nunchaku [expect = none]
by auto

lemma "\<exists>x. if x = y then \<exists>y. y = x \<or> y \<noteq> x else \<exists>y. y = (x, x) \<or> y \<noteq> (x, x)"
nunchaku [expect = none]
by auto

lemma "let x = (\<forall>x. P x) in if x then x else \<not> x"
nunchaku [expect = none]
by auto

lemma "let x = (\<forall>x :: 'a \<times> 'b. P x) in if x then x else \<not> x"
nunchaku [expect = none]
by auto

subsection {* Schematic Variables *}

schematic_goal "x = ?x"
nunchaku [expect = none]
by auto

schematic_goal "\<forall>x. x = ?x"
nunchaku [expect = genuine]
oops

schematic_goal "\<exists>x. x = ?x"
nunchaku [expect = none]
by auto

schematic_goal "\<exists>x :: 'a \<Rightarrow> 'b. x = ?x"
nunchaku [expect = unknown]
by auto

schematic_goal "\<forall>x. ?x = ?y"
nunchaku [expect = none]
by auto

schematic_goal "\<exists>x. ?x = ?y"
nunchaku [expect = none]
by auto

subsection {* Known Constants *}

lemma "\<And>x. f x y = f x y"
nunchaku [expect = none]
oops

lemma "\<And>x. f x y = f y x"
nunchaku [expect = genuine]
oops

lemma "P x \<equiv> P x"
nunchaku [expect = none]
by auto

lemma "P x \<equiv> Q x \<Longrightarrow> P x = Q x"
nunchaku [expect = none]
by auto

lemma "P x = Q x \<Longrightarrow> P x \<equiv> Q x"
nunchaku [expect = none]
by auto

lemma "P x \<Longrightarrow> P x"
nunchaku [expect = none]
by auto

lemma "True \<Longrightarrow> True" "False \<Longrightarrow> True" "False \<Longrightarrow> False"
nunchaku [expect = none]
by auto

lemma "True \<Longrightarrow> False"
nunchaku [expect = genuine]
oops

lemma "x = Not"
nunchaku [expect = genuine]
oops

lemma "I = (\<lambda>x. x) \<Longrightarrow> Not = (\<lambda>x. Not (I x))"
nunchaku [expect = none]
by auto

lemma "x = True"
nunchaku [expect = genuine]
oops

lemma "x = False"
nunchaku [expect = genuine]
oops

lemma "x = undefined"
nunchaku [expect = genuine]
oops

lemma "(False, ()) = undefined \<Longrightarrow> ((), False) = undefined"
nunchaku [expect = genuine]
oops

lemma "undefined = undefined"
nunchaku [expect = none]
by auto

lemma "f undefined = f undefined"
nunchaku [expect = none]
by auto

lemma "f undefined = g undefined"
nunchaku [expect = genuine]
oops

lemma "\<exists>!x. x = undefined"
nunchaku [expect = none]
by auto

lemma "\<forall>x. f x y = f x y"
nunchaku [expect = none]
oops

lemma "\<forall>x. f x y = f y x"
nunchaku [expect = genuine]
oops

lemma "All (\<lambda>x. f x y = f x y) = True"
nunchaku [expect = none]
by auto

lemma "All (\<lambda>x. f x y = f x y) = False"
nunchaku [expect = genuine]
oops

lemma "x = Ex \<Longrightarrow> False"
nunchaku [expect = genuine]
oops

lemma "\<exists>x. f x y = f x y"
nunchaku [expect = none]
oops

lemma "\<exists>x. f x y = f y x"
nunchaku [expect = none]
oops

lemma "Ex (\<lambda>x. f x y = f x y) = True"
nunchaku [expect = none]
by auto

lemma "Ex (\<lambda>x. f x y = f y x) = True"
nunchaku [expect = none]
by auto

lemma "Ex (\<lambda>x. f x y = f x y) = False"
nunchaku [expect = genuine]
oops

lemma "Ex (\<lambda>x. f x y \<noteq> f x y) = False"
nunchaku [expect = none]
by auto

lemma "I = (\<lambda>x. x) \<Longrightarrow> Ex P = Ex (\<lambda>x. P (I x))"
nunchaku [expect = none]
by auto

lemma "x = y \<Longrightarrow> y = x"
nunchaku [expect = none]
by auto

lemma "x = y \<Longrightarrow> f x = f y"
nunchaku [expect = none]
by auto

lemma "x = y \<and> y = z \<Longrightarrow> x = z"
nunchaku [expect = none]
by auto

lemma
  "I = (\<lambda>x. x) \<Longrightarrow> (op \<and>) = (\<lambda>x. op \<and> (I x))"
  "I = (\<lambda>x. x) \<Longrightarrow> (op \<and>) = (\<lambda>x y. x \<and> (I y))"
nunchaku [expect = none]
by auto

lemma "(a \<and> b) = (\<not> (\<not> a \<or> \<not> b))"
nunchaku [expect = none]
by auto

lemma "a \<and> b \<Longrightarrow> a" "a \<and> b \<Longrightarrow> b"
nunchaku [expect = none]
by auto

lemma "(op \<longrightarrow>) = (\<lambda>x. op \<longrightarrow> x)" "(op \<longrightarrow> ) = (\<lambda>x y. x \<longrightarrow> y)"
nunchaku [expect = none]
by auto

lemma "((if a then b else c) = d) = ((a \<longrightarrow> (b = d)) \<and> (\<not> a \<longrightarrow> (c = d)))"
nunchaku [expect = none]
by auto

lemma "(if a then b else c) = (THE d. (a \<longrightarrow> (d = b)) \<and> (\<not> a \<longrightarrow> (d = c)))"
nunchaku [expect = none]
by auto

lemma "fst (x, y) = x"
nunchaku [expect = none]
by simp

lemma "snd (x, y) = y"
nunchaku [expect = none]
by simp

lemma "fst (x :: 'a \<Rightarrow> 'b, y) = x"
nunchaku [expect = none]
by simp

lemma "snd (x :: 'a \<Rightarrow> 'b, y) = y"
nunchaku [expect = none]
by simp

lemma "fst (x, y :: 'a \<Rightarrow> 'b) = x"
nunchaku [expect = none]
by simp

lemma "snd (x, y :: 'a \<Rightarrow> 'b) = y"
nunchaku [expect = none]
by simp

lemma "fst (x :: 'a \<times> 'b, y) = x"
nunchaku [expect = none]
by simp

lemma "snd (x :: 'a \<times> 'b, y) = y"
nunchaku [expect = none]
by simp

lemma "fst (x, y :: 'a \<times> 'b) = x"
nunchaku [expect = none]
by simp

lemma "snd (x, y :: 'a \<times> 'b) = y"
nunchaku [expect = none]
by simp

lemma "I = (\<lambda>x. x) \<Longrightarrow> fst = (\<lambda>x. fst (I x))"
nunchaku [expect = none]
by auto

lemma "fst (x, y) = snd (y, x)"
nunchaku [expect = none]
by auto

lemma "(x, x) \<in> Id"
nunchaku [expect = none]
by auto

lemma "(x, y) \<in> Id \<Longrightarrow> x = y"
nunchaku [expect = none]
by auto

lemma "I = (\<lambda>x. x) \<Longrightarrow> Id = {x. I x \<in> Id}"
nunchaku [expect = none]
by auto

lemma "{} = {x. False}"
nunchaku [expect = none]
by simp

lemma "x \<in> {}"
nunchaku [expect = genuine]
oops

lemma "{a, b} = {b}"
nunchaku [expect = genuine]
oops

lemma "{a, b} \<noteq> {b}"
nunchaku [expect = genuine]
oops

lemma "{a} = {b}"
nunchaku [expect = genuine]
oops

lemma "{a} \<noteq> {b}"
nunchaku [expect = genuine]
oops

lemma "{a, b, c} = {c, b, a}"
nunchaku [expect = unknown]
by auto

lemma "UNIV = {x. True}"
nunchaku [expect = none]
by simp

lemma "x \<in> UNIV \<longleftrightarrow> True"
nunchaku [expect = none]
by simp

lemma "x \<notin> UNIV"
nunchaku [expect = genuine]
oops

lemma "I = (\<lambda>x. x) \<Longrightarrow> op \<in> = (\<lambda>x. (op \<in> (I x)))"
nunchaku [expect = none]
apply (rule ext)
apply (rule ext)
by simp

lemma "insert = (\<lambda>x y. insert x (y \<union> y))"
nunchaku [expect = none]
by simp

lemma "I = (\<lambda>x. x) \<Longrightarrow> trancl = (\<lambda>x. trancl (I x))"
nunchaku [expect = none]
by auto

lemma "rtrancl = (\<lambda>x. rtrancl x \<union> {(y, y)})"
nunchaku [expect = none]
apply (rule ext)
by auto

lemma "(x, x) \<in> rtrancl {(y, y)}"
nunchaku [expect = none]
by auto

lemma "((x, x), (x, x)) \<in> rtrancl {}"
nunchaku [expect = none]
by auto

lemma "I = (\<lambda>x. x) \<Longrightarrow> op \<union> = (\<lambda>x. op \<union> (I x))"
nunchaku [expect = none]
by auto

lemma "a \<in> A \<Longrightarrow> a \<in> A \<union> B" "b \<in> B \<Longrightarrow> b \<in> A \<union> B"
nunchaku [expect = none]
by auto

lemma "I = (\<lambda>x. x) \<Longrightarrow> op \<inter> = (\<lambda>x. op \<inter> (I x))"
nunchaku [expect = none]
by auto

lemma "a \<notin> A \<Longrightarrow> a \<notin> A \<inter> B" "b \<notin> B \<Longrightarrow> b \<notin> A \<inter> B"
nunchaku [expect = none]
by auto

lemma "x \<in> ((A :: 'a set) - B) \<longleftrightarrow> x \<in> A \<and> x \<notin> B"
nunchaku [expect = none]
by auto

lemma "I = (\<lambda>x. x) \<Longrightarrow> op \<subset> = (\<lambda>x. op \<subset> (I x))"
nunchaku [expect = none]
by auto

lemma "A \<subset> B \<Longrightarrow> (\<forall>a \<in> A. a \<in> B) \<and> (\<exists>b \<in> B. b \<notin> A)"
nunchaku [expect = none]
by auto

lemma "A \<subseteq> B \<Longrightarrow> \<forall>a \<in> A. a \<in> B"
nunchaku [expect = none]
by auto

lemma "A \<subseteq> B \<Longrightarrow> A \<subset> B"
nunchaku [expect = genuine]
oops

lemma "A \<subset> B \<Longrightarrow> A \<subseteq> B"
nunchaku [expect = none]
by auto

lemma "I = (\<lambda>x :: 'a set. x) \<Longrightarrow> uminus = (\<lambda>x. uminus (I x))"
nunchaku [expect = none]
by auto

lemma "A \<union> - A = UNIV"
nunchaku [expect = none]
by auto

lemma "A \<inter> - A = {}"
nunchaku [expect = none]
by auto

lemma "A = - A"
nunchaku [expect = genuine]
oops

lemma "finite A"
nunchaku [expect = none]
oops

lemma "finite A \<Longrightarrow> finite B"
nunchaku [expect = none]
oops

lemma "All finite"
nunchaku [expect = none]
oops

subsection {* The and Eps *}

lemma "x = The"
nunchaku [expect = genuine]
oops

lemma "\<exists>x. x = The"
nunchaku [expect = none]
oops

lemma "P x \<Longrightarrow> P (The P)"
nunchaku [expect = genuine]
oops

lemma "(\<forall>x. \<not> P x) \<longrightarrow> The P = y"
nunchaku [expect = genuine]
oops

lemma "I = (\<lambda>x. x) \<Longrightarrow> The = (\<lambda>x. The (I x))"
nunchaku [expect = none]
by auto

lemma "x = Eps"
nunchaku [expect = genuine]
oops

lemma "\<exists>x. x = Eps"
nunchaku [expect = none]
by auto

lemma "P x \<and> (\<forall>y. P y \<longrightarrow> y = x) \<longrightarrow> Eps P = x"
nunchaku [expect = none]
by auto

lemma "P x \<and> P y \<and> x \<noteq> y \<longrightarrow> Eps P = z"
nunchaku [expect = genuine]
apply auto
oops

lemma "P x \<Longrightarrow> P (Eps P)"
nunchaku [expect = none]
by (metis exE_some)

lemma "\<forall>x. \<not> P x \<longrightarrow> Eps P = y"
nunchaku [expect = genuine]
oops

lemma "P (Eps P)"
nunchaku [expect = genuine]
oops

lemma "Eps (\<lambda>x. x \<in> P) \<in> (P :: nat set)"
nunchaku [expect = genuine]
oops

lemma "\<not> P (Eps P)"
nunchaku [expect = genuine]
oops

lemma "\<not> (P :: nat \<Rightarrow> bool) (Eps P)"
nunchaku [expect = genuine]
oops

lemma "P \<noteq> bot \<Longrightarrow> P (Eps P)"
nunchaku [expect = none]
sorry

lemma "(P :: nat \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> P (Eps P)"
nunchaku [expect = none]
sorry

lemma "P (The P)"
nunchaku [expect = genuine]
oops

lemma "(P :: nat \<Rightarrow> bool) (The P)"
nunchaku [expect = genuine]
oops

lemma "\<not> P (The P)"
nunchaku [expect = genuine]
oops

lemma "\<not> (P :: nat \<Rightarrow> bool) (The P)"
nunchaku [expect = genuine]
oops

lemma "The P \<noteq> x"
nunchaku [expect = genuine]
oops

lemma "The P \<noteq> (x :: nat)"
nunchaku [expect = genuine]
oops

lemma "P x \<Longrightarrow> P (The P)"
nunchaku [expect = genuine]
oops

lemma "P (x :: nat) \<Longrightarrow> P (The P)"
nunchaku [expect = genuine]
oops

lemma "P = {x} \<Longrightarrow> (THE x. x \<in> P) \<in> P"
nunchaku [expect = none]
oops

lemma "P = {x :: nat} \<Longrightarrow> (THE x. x \<in> P) \<in> P"
nunchaku [expect = none]
oops

consts Q :: 'a

lemma "Q (Eps Q)"
nunchaku [expect = genuine]
oops

lemma "(Q :: nat \<Rightarrow> bool) (Eps Q)"
nunchaku [expect = genuine]
oops

lemma "\<not> (Q :: nat \<Rightarrow> bool) (Eps Q)"
nunchaku [expect = genuine]
oops

lemma "\<not> (Q :: nat \<Rightarrow> bool) (Eps Q)"
nunchaku [expect = genuine]
oops

lemma "(Q :: 'a \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> (Q :: 'a \<Rightarrow> bool) (Eps Q)"
nunchaku [expect = none]
sorry

lemma "(Q :: nat \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> (Q :: nat \<Rightarrow> bool) (Eps Q)"
nunchaku [expect = none]
sorry

lemma "Q (The Q)"
nunchaku [expect = genuine]
oops

lemma "(Q :: nat \<Rightarrow> bool) (The Q)"
nunchaku [expect = genuine]
oops

lemma "\<not> Q (The Q)"
nunchaku [expect = genuine]
oops

lemma "\<not> (Q :: nat \<Rightarrow> bool) (The Q)"
nunchaku [expect = genuine]
oops

lemma "The Q \<noteq> x"
nunchaku [expect = genuine]
oops

lemma "The Q \<noteq> (x :: nat)"
nunchaku [expect = genuine]
oops

lemma "Q x \<Longrightarrow> Q (The Q)"
nunchaku [expect = genuine]
oops

lemma "Q (x :: nat) \<Longrightarrow> Q (The Q)"
nunchaku [expect = genuine]
oops

lemma "Q = (\<lambda>x :: 'a. x = a) \<Longrightarrow> (Q :: 'a \<Rightarrow> bool) (The Q)"
nunchaku [expect = none]
sorry

lemma "Q = (\<lambda>x :: nat. x = a) \<Longrightarrow> (Q :: nat \<Rightarrow> bool) (The Q)"
nunchaku [expect = none]
sorry

lemma "(THE j. j > Suc 2 \<and> j \<le> 3) \<noteq> 0"
nunchaku [expect = genuine]
oops

lemma "(THE j. j > Suc 2 \<and> j \<le> 4) = x \<Longrightarrow> x \<noteq> 0"
nunchaku [expect = none]
sorry

lemma "(THE j. j > Suc 2 \<and> j \<le> 4) = x \<Longrightarrow> x = 4"
nunchaku [expect = none]
sorry

lemma "(THE j. j > Suc 2 \<and> j \<le> 5) = x \<Longrightarrow> x = 4"
nunchaku [expect = genuine]
oops

lemma "(THE j. j > Suc 2 \<and> j \<le> 5) = x \<Longrightarrow> x = 4 \<or> x = 5"
nunchaku [expect = genuine]
oops

lemma "(SOME j. j > Suc 2 \<and> j \<le> 3) \<noteq> 0"
nunchaku [expect = genuine]
oops

lemma "(SOME j. j > Suc 2 \<and> j \<le> 4) = x \<Longrightarrow> x \<noteq> 0"
nunchaku [expect = none]
sorry

lemma "(SOME j. j > Suc 2 \<and> j \<le> 4) = x \<Longrightarrow> x = 4"
nunchaku [expect = none]
sorry

lemma "(SOME j. j > Suc 2 \<and> j \<le> 5) = x \<Longrightarrow> x = 4"
nunchaku [expect = genuine]
oops

lemma "(SOME j. j > Suc 2 \<and> j \<le> 5) = x \<Longrightarrow> x = 4 \<or> x = 5"
nunchaku [expect = none]
sorry

subsection {* Destructors and Recursors *}

lemma "(x :: 'a) = (case True of True \<Rightarrow> x | False \<Rightarrow> x)"
nunchaku [expect = none]
by auto

lemma "x = (case (x, y) of (x', y') \<Rightarrow> x')"
nunchaku [expect = none]
by auto

end


(*  Title:       The Cauchy-Schwarz Inequality
    Author:      Benjamin Porter <Benjamin.Porter at gmail.com>, 2006
    Maintainer:  Benjamin Porter <Benjamin.Porter at gmail.com>
*)

chapter \<open>The Cauchy-Schwarz Inequality\<close>

theory CauchySchwarz
imports Complex_Main
begin

(*<*)

(* Some basic results that don't need to be in the final doc ..*)

lemmas real_sq = power2_eq_square [where 'a = real, symmetric]

lemmas real_sq_exp = power_mult_distrib [where 'a = real and ?n = 2]

lemma double_sum_equiv:
  fixes f::"nat \<Rightarrow> real"
  shows
  "(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
   (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f j * g k))"
  by (rule sum.swap)

(*>*)

section \<open>Abstract\<close>

text \<open>The following document presents a formalised proof of the
Cauchy-Schwarz Inequality for the specific case of $R^n$. The system
used is Isabelle/Isar.

{\em Theorem:} Take $V$ to be some vector space possessing a norm and
inner product, then for all $a,b \in V$ the following inequality
holds: \<open>\<bar>a\<cdot>b\<bar> \<le> \<parallel>a\<parallel>*\<parallel>b\<parallel>\<close>. Specifically, in the Real case, the
norm is the Euclidean length and the inner product is the standard dot
product.\<close>

section \<open>Formal Proof\<close>

subsection \<open>Vector, Dot and Norm definitions.\<close>

text \<open>This section presents definitions for a real vector type, a
dot product function and a norm function.\<close>

subsubsection \<open>Vector\<close>

text \<open>We now define a vector type to be a tuple of (function,
length). Where the function is of type @{typ "nat\<Rightarrow>real"}. We also
define some accessor functions and appropriate notation.\<close>

type_synonym vector = "(nat\<Rightarrow>real) * nat"

definition
  ith :: "vector \<Rightarrow> nat \<Rightarrow> real" ("((_)\<^bsub>_\<^esub>)" [80,100] 100) where
  "ith v i = fst v i"

definition
  vlen :: "vector \<Rightarrow> nat" where
  "vlen v = snd v"

text \<open>Now to access the second element of some vector $v$ the syntax
is $v_2$.\<close>

subsubsection \<open>Dot and Norm\<close>

text \<open>We now define the dot product and norm operations.\<close>

definition
  dot :: "vector \<Rightarrow> vector \<Rightarrow> real" (infixr "\<cdot>" 60) where
  "dot a b = (\<Sum>j\<in>{1..(vlen a)}. a\<^bsub>j\<^esub>*b\<^bsub>j\<^esub>)"

definition
  norm :: "vector \<Rightarrow> real"                  ("\<parallel>_\<parallel>" 100) where
  "norm v = sqrt (\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2)"

text \<open>Another definition of the norm is @{term "\<parallel>v\<parallel> = sqrt
(v\<cdot>v)"}. We show that our definition leads to this one.\<close>

lemma norm_dot:
 "\<parallel>v\<parallel> = sqrt (v\<cdot>v)"
proof -
  have "sqrt (v\<cdot>v) = sqrt (\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>*v\<^bsub>j\<^esub>)" unfolding dot_def by simp
  also with real_sq have "\<dots> = sqrt (\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2)" by simp
  also have "\<dots> = \<parallel>v\<parallel>" unfolding norm_def by simp
  finally show ?thesis ..
qed

text \<open>A further important property is that the norm is never negative.\<close>

lemma norm_pos:
  "\<parallel>v\<parallel> \<ge> 0"
proof -
  have "\<forall>j. v\<^bsub>j\<^esub>^2 \<ge> 0" unfolding ith_def by auto
  have "(\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2) \<ge> 0" by (simp add: sum_nonneg)
  with real_sqrt_ge_zero have "sqrt (\<Sum>j\<in>{1..(vlen v)}. v\<^bsub>j\<^esub>^2) \<ge> 0" .
  thus ?thesis unfolding norm_def .
qed

text \<open>We now prove an intermediary lemma regarding double summation.\<close>

lemma double_sum_aux:
  fixes f::"nat \<Rightarrow> real"
  shows
  "(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
   (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (f k * g j + f j * g k) / 2))"
proof -
  have
    "2 * (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) +
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j))"
    by simp
  also have
    "\<dots> =
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) +
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f j * g k))"
    by (simp only: double_sum_equiv)
  also have
    "\<dots> =
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j + f j * g k))"
    by (auto simp add: sum.distrib)
  finally have
    "2 * (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
    (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j + f j * g k))" .
  hence
    "(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. f k * g j)) =
     (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (f k * g j + f j * g k)))*(1/2)"
    by auto
  also have
    "\<dots> =
     (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (f k * g j + f j * g k)*(1/2)))"
    by (simp add: sum_distrib_left mult.commute)
  finally show ?thesis by (auto simp add: inverse_eq_divide)
qed

text \<open>The final theorem can now be proven. It is a simple forward
proof that uses properties of double summation and the preceding
lemma.\<close>

theorem CauchySchwarzReal:
  fixes x::vector
  assumes "vlen x = vlen y"
  shows "\<bar>x\<cdot>y\<bar> \<le> \<parallel>x\<parallel>*\<parallel>y\<parallel>"
proof -
  have "\<bar>x\<cdot>y\<bar>^2 \<le> (\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2"
  proof -
    txt \<open>We can rewrite the goal in the following form ...\<close>
    have "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 - \<bar>x\<cdot>y\<bar>^2 \<ge> 0"
    proof -
      obtain n where nx: "n = vlen x" by simp
      with \<open>vlen x = vlen y\<close> have ny: "n = vlen y" by simp
      {
        txt \<open>Some preliminary simplification rules.\<close>
        have "(\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2) \<ge> 0" by (simp add: sum_nonneg)
        hence xp: "(sqrt (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2))^2 = (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2)"
          by (rule real_sqrt_pow2)

        have "(\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2) \<ge> 0" by (simp add: sum_nonneg)
        hence yp: "(sqrt (\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2))^2 = (\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2)"
          by (rule real_sqrt_pow2)

        txt \<open>The main result of this section is that \<open>(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2\<close> can be written as a double sum.\<close>
        have
          "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 = \<parallel>x\<parallel>^2 * \<parallel>y\<parallel>^2"
          by (simp add: real_sq_exp)
        also from nx ny have
          "\<dots> = (sqrt (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2))^2 * (sqrt (\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2))^2"
          unfolding norm_def by auto
        also from xp yp have
          "\<dots> = (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>^2)*(\<Sum>j\<in>{1..n}. y\<^bsub>j\<^esub>^2)"
          by simp
        also from sum_product have
          "\<dots> = (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>^2)*(y\<^bsub>j\<^esub>^2)))" .
        finally have
          "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 = (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>^2)*(y\<^bsub>j\<^esub>^2)))" .
      }
      moreover
      {
        txt \<open>We also show that \<open>\<bar>x\<cdot>y\<bar>^2\<close> can be expressed as a double sum.\<close>
        have
          "\<bar>x\<cdot>y\<bar>^2 = (x\<cdot>y)^2"
          by simp
        also from nx have
          "\<dots> = (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)^2"
          unfolding dot_def by simp
        also from real_sq have
          "\<dots> = (\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)*(\<Sum>j\<in>{1..n}. x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)"
          by simp
        also from sum_product have
          "\<dots> = (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))" .
        finally have
          "\<bar>x\<cdot>y\<bar>^2 = (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))" .
      }
      txt \<open>We now manipulate the double sum expressions to get the
      required inequality.\<close>
      ultimately have
        "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 - \<bar>x\<cdot>y\<bar>^2 =
         (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>^2)*(y\<^bsub>j\<^esub>^2))) -
         (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))"
        by simp
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. ((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))/2)) -
         (\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))"
        by (simp only: double_sum_aux)
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. ((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))/2 - (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))"
        by (auto simp add: sum_subtractf)
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. (inverse 2)*2*
         (((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))*(1/2) - (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>))))"
        by auto
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. (inverse 2)*(2*
        (((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))*(1/2) - (x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))))"
        by (simp only: mult.assoc)
      also have
        "\<dots> =
         (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. (inverse 2)*
        ((((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2))*2*(inverse 2) - 2*(x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))))"
        by (auto simp add: distrib_right mult.assoc ac_simps)
      also have
        "\<dots> =
        (\<Sum>k\<in>{1..n}.  (\<Sum>j\<in>{1..n}. (inverse 2)*
        ((((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2)) - 2*(x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>)))))"
        by (simp only: mult.assoc, simp)
      also have
        "\<dots> =
         (inverse 2)*(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}.
         (((x\<^bsub>k\<^esub>^2*y\<^bsub>j\<^esub>^2) + (x\<^bsub>j\<^esub>^2*y\<^bsub>k\<^esub>^2)) - 2*(x\<^bsub>k\<^esub>*y\<^bsub>k\<^esub>)*(x\<^bsub>j\<^esub>*y\<^bsub>j\<^esub>))))"
        by (simp only: sum_distrib_left)
      also have
        "\<dots> =
         (inverse 2)*(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>j\<^esub> - x\<^bsub>j\<^esub>*y\<^bsub>k\<^esub>)^2))"
        by (simp only: power2_diff real_sq_exp, auto simp add: ac_simps)
      also have "\<dots> \<ge> 0"
      proof -
        have "(\<Sum>k\<in>{1..n}. (\<Sum>j\<in>{1..n}. (x\<^bsub>k\<^esub>*y\<^bsub>j\<^esub> - x\<^bsub>j\<^esub>*y\<^bsub>k\<^esub>)^2)) \<ge> 0"
          by (simp add: sum_nonneg)
        thus ?thesis by simp
      qed
      finally show "(\<parallel>x\<parallel>*\<parallel>y\<parallel>)^2 - \<bar>x\<cdot>y\<bar>^2 \<ge> 0" .
    qed
    thus ?thesis by simp
  qed
  moreover have "0 \<le> \<parallel>x\<parallel>*\<parallel>y\<parallel>"
    by (auto simp add: norm_pos)
  ultimately show ?thesis by (rule power2_le_imp_le)
qed

end