theory conditions_positive
  imports "../boolean_algebra/boolean_algebra_functional"
begin

(** We define and interrelate some useful axiomatic conditions on unary operations (operators)
having a 'w-parametric type @{type "'w \<sigma> \<Rightarrow> 'w \<sigma>"}.
Boolean algebras extended with such operators give us different sorts of topological Boolean algebras.*)

(**Monotonicity (MONO).*)
definition MONO::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MONO")
  where "MONO \<phi> \<equiv> \<forall>A B. A \<preceq> B \<longrightarrow> \<phi> A \<preceq> \<phi> B"

named_theorems cond (*(*to group together axiomatic conditions*)*)
declare MONO_def[cond]

(**MONO is self-dual*)
lemma MONO_dual: "MONO \<phi> = MONO \<phi>\<^sup>d" by (smt (verit) BA_cp MONO_def dual_invol op_dual_def)

(**Expansive/extensive (EXPN) and its dual contractive (CNTR).*)
definition EXPN::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("EXPN")
  where "EXPN \<phi>  \<equiv> \<forall>A. A \<preceq> \<phi> A"
definition CNTR::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("CNTR")
  where "CNTR \<phi> \<equiv> \<forall>A. \<phi> A \<preceq> A"

declare EXPN_def[cond] CNTR_def[cond]

(**EXPN and CNTR are dual to each other *)
lemma EXPN_CNTR_dual1: "EXPN \<phi> = CNTR \<phi>\<^sup>d" unfolding cond by (metis BA_cp BA_dn op_dual_def setequ_ext)
lemma EXPN_CNTR_dual2: "CNTR \<phi> = EXPN \<phi>\<^sup>d" by (simp add: EXPN_CNTR_dual1 dual_invol)

(**Normality (NORM) and its dual (DNRM).*)
definition NORM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("NORM")
  where "NORM \<phi>  \<equiv> (\<phi> \<^bold>\<bottom>) \<approx> \<^bold>\<bottom>"
definition DNRM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("DNRM")
  where "DNRM \<phi> \<equiv> (\<phi> \<^bold>\<top>) \<approx> \<^bold>\<top>"

declare NORM_def[cond] DNRM_def[cond]

(**NORM and DNRM are dual to each other *)
lemma NOR_dual1: "NORM \<phi> = DNRM \<phi>\<^sup>d" unfolding cond by (simp add: bottom_def compl_def op_dual_def setequ_def top_def)
lemma NOR_dual2: "DNRM \<phi> = NORM \<phi>\<^sup>d" by (simp add: NOR_dual1 dual_invol)

(**EXPN (CNTR) entail DNRM (NORM).*)
lemma EXPN_impl_DNRM: "EXPN \<phi> \<longrightarrow> DNRM \<phi>" unfolding cond by (simp add: setequ_def subset_def top_def)
lemma CNTR_impl_NORM: "CNTR \<phi> \<longrightarrow> NORM \<phi>" by (simp add: EXPN_CNTR_dual2 EXPN_impl_DNRM NOR_dual1 dual_invol)

(**Idempotence (IDEM).*)
definition IDEM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("IDEM")
  where "IDEM \<phi>  \<equiv> \<forall>A. \<phi>(\<phi> A) \<approx> (\<phi> A)"
definition IDEM_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("IDEM\<^sup>a")
  where "IDEM\<^sup>a \<phi> \<equiv> \<forall>A. \<phi>(\<phi> A) \<preceq> (\<phi> A)"
definition IDEM_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("IDEM\<^sup>b")
  where "IDEM\<^sup>b \<phi> \<equiv> \<forall>A.  (\<phi> A) \<preceq> \<phi>(\<phi> A)"

declare IDEM_def[cond] IDEM_a_def[cond] IDEM_b_def[cond]

(**IDEM-a and IDEM-b are dual to each other *)
lemma IDEM_dual1: "IDEM\<^sup>a \<phi> = IDEM\<^sup>b \<phi>\<^sup>d" unfolding cond by (metis (mono_tags, opaque_lifting) BA_cp BA_dn op_dual_def setequ_ext)
lemma IDEM_dual2: "IDEM\<^sup>b \<phi> = IDEM\<^sup>a \<phi>\<^sup>d" by (simp add: IDEM_dual1 dual_invol)

lemma IDEM_char: "IDEM \<phi> = (IDEM\<^sup>a \<phi> \<and> IDEM\<^sup>b \<phi>)" unfolding cond setequ_char by blast
lemma IDEM_dual: "IDEM \<phi> = IDEM \<phi>\<^sup>d" using IDEM_char IDEM_dual1 IDEM_dual2 by blast

(**EXPN (CNTR) entail IDEM-b (IDEM-a).*)
lemma EXPN_impl_IDEM_b: "EXPN \<phi> \<longrightarrow> IDEM\<^sup>b \<phi>" by (simp add: EXPN_def IDEM_b_def)
lemma CNTR_impl_IDEM_a: "CNTR \<phi> \<longrightarrow> IDEM\<^sup>a \<phi>" by (simp add: CNTR_def IDEM_a_def)

(**Moreover, IDEM has some other interesting characterizations. For instance, *)
(**as having the property of collapsing the range and the set of fixed-points of an operator*)
lemma IDEM_range_fp_char: "IDEM \<phi> = (\<lbrakk>\<phi> _\<rbrakk> = fp \<phi>)" unfolding cond range_def fixpoints_def by (metis setequ_ext)
(**and via function composition*)
lemma IDEM_fun_comp_char: "IDEM \<phi> = (\<phi> = \<phi> \<circ> \<phi>)" unfolding cond fun_comp_def by (metis setequ_ext)

(**Distribution over joins or additivity (ADDI) and its dual...*)
definition ADDI::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDI")
  where "ADDI \<phi>   \<equiv> \<forall>A B. \<phi>(A \<^bold>\<or> B) \<approx> (\<phi> A) \<^bold>\<or> (\<phi> B)"
definition ADDI_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDI\<^sup>a")
  where "ADDI\<^sup>a \<phi> \<equiv> \<forall>A B. \<phi>(A \<^bold>\<or> B) \<preceq> (\<phi> A) \<^bold>\<or> (\<phi> B)"
definition ADDI_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDI\<^sup>b")
  where "ADDI\<^sup>b \<phi> \<equiv> \<forall>A B.  (\<phi> A) \<^bold>\<or> (\<phi> B) \<preceq> \<phi>(A \<^bold>\<or> B)"

(**... distribution over meets or multiplicativity (MULT).*)
definition MULT::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULT")
  where "MULT \<phi>   \<equiv> \<forall>A B. \<phi>(A \<^bold>\<and> B) \<approx> (\<phi> A) \<^bold>\<and> (\<phi> B)"
definition MULT_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULT\<^sup>a")
  where "MULT\<^sup>a \<phi> \<equiv> \<forall>A B. \<phi>(A \<^bold>\<and> B) \<preceq> (\<phi> A) \<^bold>\<and> (\<phi> B)"
definition MULT_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULT\<^sup>b")
  where "MULT\<^sup>b \<phi> \<equiv> \<forall>A B. (\<phi> A) \<^bold>\<and> (\<phi> B) \<preceq> \<phi>(A \<^bold>\<and> B)"

declare ADDI_def[cond] ADDI_a_def[cond] ADDI_b_def[cond]
        MULT_def[cond] MULT_a_def[cond] MULT_b_def[cond]

lemma ADDI_char: "ADDI \<phi> = (ADDI\<^sup>a \<phi> \<and> ADDI\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
lemma MULT_char: "MULT \<phi> = (MULT\<^sup>a \<phi> \<and> MULT\<^sup>b \<phi>)" unfolding cond using setequ_char by blast

(**MONO, MULT-a and ADDI-b are equivalent.*)
lemma MONO_MULTa: "MULT\<^sup>a \<phi> = MONO \<phi>" unfolding cond by (metis L10 L3 L4 L5 L8 setequ_char setequ_ext)
lemma MONO_ADDIb: "ADDI\<^sup>b \<phi> = MONO \<phi>" unfolding cond by (metis (mono_tags, lifting) L7 L9 join_def setequ_ext subset_def)

(**Below we prove several duality relationships between ADDI(a/b) and MULT(a/b).*)

(**Duality between MULT-a and ADDI-b (an easy corollary from the self-duality of MONO).*)
lemma MULTa_ADDIb_dual1: "MULT\<^sup>a \<phi> = ADDI\<^sup>b \<phi>\<^sup>d" by (metis MONO_ADDIb MONO_MULTa MONO_dual)
lemma MULTa_ADDIb_dual2: "ADDI\<^sup>b \<phi> = MULT\<^sup>a \<phi>\<^sup>d" by (simp add: MULTa_ADDIb_dual1 dual_invol)
(**Duality between ADDI-a and MULT-b.*)
lemma ADDIa_MULTb_dual1: "ADDI\<^sup>a \<phi> = MULT\<^sup>b \<phi>\<^sup>d" unfolding cond op_dual_def by (metis BA_cp BA_deMorgan1 BA_dn setequ_ext)
lemma ADDIa_MULTb_dual2: "MULT\<^sup>b \<phi> = ADDI\<^sup>a \<phi>\<^sup>d" by (simp add: ADDIa_MULTb_dual1 dual_invol)
(**Duality between ADDI and MULT.*)
lemma ADDI_MULT_dual1: "ADDI \<phi> = MULT \<phi>\<^sup>d" using ADDI_char ADDIa_MULTb_dual1 MULT_char MULTa_ADDIb_dual2 by blast
lemma ADDI_MULT_dual2: "MULT \<phi> = ADDI \<phi>\<^sup>d" by (simp add: ADDI_MULT_dual1 dual_invol)

(**We verify properties regarding closure over meets/joins for fixed-points.*)

(**MULT implies meet-closedness of the set of fixed-points (the converse requires additional assumptions)*)
lemma MULT_meetclosed: "MULT \<phi> \<Longrightarrow> meet_closed (fp \<phi>)" by (simp add: MULT_def fixpoints_def meet_closed_def setequ_ext)
lemma "meet_closed (fp \<phi>) \<Longrightarrow> MULT \<phi>" nitpick oops (*countermodel found: needs further assumptions*)
lemma meetclosed_MULT: "MONO \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> IDEM\<^sup>b \<phi> \<Longrightarrow> meet_closed (fp \<phi>) \<Longrightarrow> MULT \<phi>" by (smt (z3) CNTR_def IDEM_b_def MONO_MULTa MONO_def MULT_a_def MULT_def fixpoints_def meet_closed_def meet_def setequ_char setequ_ext subset_def)

(**ADDI implies join-closedness of the set of fixed-points (the converse requires additional assumptions)*)
lemma ADDI_joinclosed: "ADDI \<phi> \<Longrightarrow> join_closed (fp \<phi>)" by (simp add: ADDI_def fixpoints_def join_closed_def setequ_ext)
lemma "join_closed (fp \<phi>) \<Longrightarrow> ADDI \<phi>" nitpick oops (*countermodel found: needs further assumptions*)
lemma joinclosed_ADDI: "MONO \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> IDEM\<^sup>a \<phi> \<Longrightarrow> join_closed (fp \<phi>) \<Longrightarrow> ADDI \<phi>" by (smt (verit, ccfv_threshold) ADDI_MULT_dual1 BA_deMorgan2 EXPN_CNTR_dual1 IDEM_dual1 MONO_dual fp_dual join_closed_def meet_closed_def meetclosed_MULT sdfun_dcompl_def setequ_ext)

(**Assuming MONO, we have that EXPN (CNTR) implies meet-closed (join-closed) for the set of fixed-points.*)
lemma EXPN_meetclosed: "MONO \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> meet_closed (fp \<phi>)" by (smt (verit) EXPN_def MONO_MULTa MULT_a_def fixpoints_def meet_closed_def setequ_char setequ_ext)
lemma CNTR_joinclosed: "MONO \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> join_closed (fp \<phi>)" by (smt (verit, best) ADDI_b_def CNTR_def MONO_ADDIb fixpoints_def join_closed_def setequ_char setequ_ext)

(**Further assuming IDEM the above results can be stated to the whole range of an operator.*)
lemma "MONO \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> IDEM \<phi> \<Longrightarrow> meet_closed (\<lbrakk>\<phi> _\<rbrakk>)" by (simp add: EXPN_meetclosed IDEM_range_fp_char)
lemma "MONO \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> IDEM \<phi> \<Longrightarrow> join_closed (\<lbrakk>\<phi> _\<rbrakk>)" by (simp add: CNTR_joinclosed IDEM_range_fp_char)

end


theory "Mono-Nat-Fun"
imports "HOL-Library.Infinite_Set"
begin

text \<open>
The following lemma proves that a monotonous function from and to the natural numbers is either eventually
constant or unbounded.
\<close>

lemma nat_mono_characterization:
  fixes f :: "nat \<Rightarrow> nat"
  assumes "mono f"
  obtains n where "\<And>m . n \<le> m \<Longrightarrow> f n = f m" | "\<And> m . \<exists> n . m \<le> f n"
proof (cases "finite (range f)")
  case True
  from Max_in[OF True]
  obtain n where Max: "f n = Max (range f)" by auto
  show thesis
  proof(rule that(1))
    fix m
    assume "n \<le> m"
    hence "f n \<le> f m" using \<open>mono f\<close> by (metis monoD)
    also
    have "f m \<le> f n" unfolding Max by (rule Max_ge[OF True rangeI])
    finally
    show "f n = f m".
  qed
next
  case False
  thus thesis by (fastforce intro: that(2) simp add: infinite_nat_iff_unbounded_le)
qed

end


(*<*)
theory CodeGen imports Main begin
(*>*)

section\<open>Case Study: Compiling Expressions\<close>

text\<open>\label{sec:ExprCompiler}
\index{compiling expressions example|(}%
The task is to develop a compiler from a generic type of expressions (built
from variables, constants and binary operations) to a stack machine.  This
generic type of expressions is a generalization of the boolean expressions in
\S\ref{sec:boolex}.  This time we do not commit ourselves to a particular
type of variables or values but make them type parameters.  Neither is there
a fixed set of binary operations: instead the expression contains the
appropriate function itself.
\<close>

type_synonym 'v binop = "'v \<Rightarrow> 'v \<Rightarrow> 'v"
datatype (dead 'a, 'v) expr = Cex 'v
                      | Vex 'a
                      | Bex "'v binop"  "('a,'v)expr"  "('a,'v)expr"

text\<open>\noindent
The three constructors represent constants, variables and the application of
a binary operation to two subexpressions.

The value of an expression with respect to an environment that maps variables to
values is easily defined:
\<close>

primrec "value" :: "('a,'v)expr \<Rightarrow> ('a \<Rightarrow> 'v) \<Rightarrow> 'v" where
"value (Cex v) env = v" |
"value (Vex a) env = env a" |
"value (Bex f e1 e2) env = f (value e1 env) (value e2 env)"

text\<open>
The stack machine has three instructions: load a constant value onto the
stack, load the contents of an address onto the stack, and apply a
binary operation to the two topmost elements of the stack, replacing them by
the result. As for \<open>expr\<close>, addresses and values are type parameters:
\<close>

datatype (dead 'a, 'v) instr = Const 'v
                       | Load 'a
                       | Apply "'v binop"

text\<open>
The execution of the stack machine is modelled by a function
\<open>exec\<close> that takes a list of instructions, a store (modelled as a
function from addresses to values, just like the environment for
evaluating expressions), and a stack (modelled as a list) of values,
and returns the stack at the end of the execution --- the store remains
unchanged:
\<close>

primrec exec :: "('a,'v)instr list \<Rightarrow> ('a\<Rightarrow>'v) \<Rightarrow> 'v list \<Rightarrow> 'v list"
where
"exec [] s vs = vs" |
"exec (i#is) s vs = (case i of
    Const v  \<Rightarrow> exec is s (v#vs)
  | Load a   \<Rightarrow> exec is s ((s a)#vs)
  | Apply f  \<Rightarrow> exec is s ((f (hd vs) (hd(tl vs)))#(tl(tl vs))))"

text\<open>\noindent
Recall that \<^term>\<open>hd\<close> and \<^term>\<open>tl\<close>
return the first element and the remainder of a list.
Because all functions are total, \cdx{hd} is defined even for the empty
list, although we do not know what the result is. Thus our model of the
machine always terminates properly, although the definition above does not
tell us much about the result in situations where \<^term>\<open>Apply\<close> was executed
with fewer than two elements on the stack.

The compiler is a function from expressions to a list of instructions. Its
definition is obvious:
\<close>

primrec compile :: "('a,'v)expr \<Rightarrow> ('a,'v)instr list" where
"compile (Cex v)       = [Const v]" |
"compile (Vex a)       = [Load a]" |
"compile (Bex f e1 e2) = (compile e2) @ (compile e1) @ [Apply f]"

text\<open>
Now we have to prove the correctness of the compiler, i.e.\ that the
execution of a compiled expression results in the value of the expression:
\<close>
theorem "exec (compile e) s [] = [value e s]"
(*<*)oops(*>*)
text\<open>\noindent
This theorem needs to be generalized:
\<close>

theorem "\<forall>vs. exec (compile e) s vs = (value e s) # vs"

txt\<open>\noindent
It will be proved by induction on \<^term>\<open>e\<close> followed by simplification.
First, we must prove a lemma about executing the concatenation of two
instruction sequences:
\<close>
(*<*)oops(*>*)
lemma exec_app[simp]:
  "\<forall>vs. exec (xs@ys) s vs = exec ys s (exec xs s vs)"

txt\<open>\noindent
This requires induction on \<^term>\<open>xs\<close> and ordinary simplification for the
base cases. In the induction step, simplification leaves us with a formula
that contains two \<open>case\<close>-expressions over instructions. Thus we add
automatic case splitting, which finishes the proof:
\<close>
apply(induct_tac xs, simp, simp split: instr.split)
(*<*)done(*>*)
text\<open>\noindent
Note that because both \methdx{simp_all} and \methdx{auto} perform simplification, they can
be modified in the same way as \<open>simp\<close>.  Thus the proof can be
rewritten as
\<close>
(*<*)
declare exec_app[simp del]

We could now go back and prove \<^prop>\<open>exec (compile e) s [] = [value e s]\<close>
merely by simplification with the generalized version we just proved.
However, this is unnecessary because the generalized version fully subsumes
its instance.%
\index{compiling expressions example|)}
\<close>
(*<*)
theorem "\<forall>vs. exec (compile e) s vs = (value e s) # vs"
by(induct_tac e, auto)
end
(*>*)


theory Exercise_2_11
  imports Main
begin
datatype exp = Var | Const int | Add exp exp | Mult exp exp

fun eval :: "exp \<Rightarrow> int \<Rightarrow> int" where
  "eval Var v = v" |
  "eval (Const a) _ = a" |
  "eval (Add a b) v = (eval a v) + (eval b v)" |
  "eval (Mult a b) v = (eval a v) * (eval b v)"

fun evalp :: "int list \<Rightarrow> int \<Rightarrow> int" where
  "evalp [] v = 0" |
  "evalp (x#xs) v = x + v*(evalp xs v)"

fun mulc :: "int \<Rightarrow> int list \<Rightarrow> int list" where
  "mulc a [] = []" |
  "mulc a (x#xs) = (a*x)#(mulc a xs)"

fun addp :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
  "addp [] [] = []" |
  "addp [] ys = ys" |
  "addp xs [] = xs" |
  "addp (x#xs) (y#ys) = (x+y)#(addp xs ys)"

fun multp :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
  "multp [] [] = []" |
  "multp [] ys = []" |
  "multp xs [] = []" |
  "multp (a#xs) (b#ys) = addp ((a*b)#(addp (mulc b xs) (mulc a ys))) (0#0#(multp xs ys))"

fun coeffs :: "exp \<Rightarrow> int list" where
  "coeffs Var = [0,1]" |
  "coeffs (Const a) = [a]" |
  "coeffs (Add a b) = addp (coeffs a) (coeffs b)" |
  "coeffs (Mult a b) = multp (coeffs a) (coeffs b)"

lemma evalp_addp: "evalp (addp p1 p2) v = (evalp p1 v) + (evalp p2 v)"
  apply(induction p1 rule:addp.induct)
  apply(auto simp add: algebra_simps)
  done

lemma evalp_mulc: "evalp (mulc a p) v = a * (evalp p v)"
  apply(induction p)
  apply(auto simp add: algebra_simps)
  done

lemma evalp_multp: "evalp (multp p1 p2) v = (evalp p1 v) * (evalp p2 v)"
  apply(induction p1 rule:multp.induct)
  apply(auto simp add: algebra_simps simp add:evalp_addp simp add: evalp_mulc)
  done

lemma preserve: "evalp(coeffs e) x = eval e x"
  apply(induction e)
  apply(auto simp add: algebra_simps simp add:evalp_addp simp add: evalp_multp)
  done


theory RegLangs
  imports Main "HOL-Library.Sublist"
begin

section \<open>Sequential Composition of Languages\<close>

definition
  Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
where
  "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"

text \<open>Two Simple Properties about Sequential Composition\<close>

lemma Sequ_empty_string [simp]:
  shows "A ;; {[]} = A"
  and   "{[]} ;; A = A"
by (simp_all add: Sequ_def)

lemma Sequ_empty [simp]:
  shows "A ;; {} = {}"
  and   "{} ;; A = {}"
  by (simp_all add: Sequ_def)

lemma concI[simp,intro]: "u : A \<Longrightarrow> v : B \<Longrightarrow> u@v : A ;; B"
by (auto simp add: Sequ_def)

lemma concE[elim]:
assumes "w \<in> A ;; B"
obtains u v where "u \<in> A" "v \<in> B" "w = u@v"
using assms by (auto simp: Sequ_def)

lemma concI_if_Nil2: "[] \<in> B \<Longrightarrow> xs : A \<Longrightarrow> xs \<in> A ;; B"
by (metis append_Nil2 concI)

lemma conc_assoc: "(A ;; B) ;; C = A ;; (B ;; C)"
by (auto elim!: concE) (simp only: append_assoc[symmetric] concI)

text \<open>Language power operations\<close>

overloading lang_pow == "compow :: nat \<Rightarrow> string set \<Rightarrow> string set"
begin
  primrec lang_pow :: "nat \<Rightarrow> string set \<Rightarrow> string set" where
  "lang_pow 0 A = {[]}" |
  "lang_pow (Suc n) A = A ;; (lang_pow n A)"
end

lemma lang_pow_add: "A ^^ (n + m) = (A ^^ n) ;; (A ^^ m)"
  by (induct n) (auto simp: conc_assoc)

lemma lang_empty:
  fixes A::"string set"
  shows "A ^^ 0 = {[]}"
  by simp

section \<open>Semantic Derivative (Left Quotient) of Languages\<close>

definition
  Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
where
  "Der c A \<equiv> {s. c # s \<in> A}"

definition
  Ders :: "string \<Rightarrow> string set \<Rightarrow> string set"
where
  "Ders s A \<equiv> {s'. s @ s' \<in> A}"

lemma Der_null [simp]:
  shows "Der c {} = {}"
unfolding Der_def
by auto

lemma Der_empty [simp]:
  shows "Der c {[]} = {}"
unfolding Der_def
by auto

lemma Der_char [simp]:
  shows "Der c {[d]} = (if c = d then {[]} else {})"
unfolding Der_def
by auto

lemma Der_union [simp]:
  shows "Der c (A \<union> B) = Der c A \<union> Der c B"
unfolding Der_def
by auto

lemma Der_Sequ [simp]:
  shows "Der c (A ;; B) = (Der c A) ;; B \<union> (if [] \<in> A then Der c B else {})"
unfolding Der_def Sequ_def
by (auto simp add: Cons_eq_append_conv)

section \<open>Kleene Star for Languages\<close>

inductive_set
  Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
  for A :: "string set"
where
  start[intro]: "[] \<in> A\<star>"
| step[intro]:  "\<lbrakk>s1 \<in> A; s2 \<in> A\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> A\<star>"

(* Arden's lemma *)

lemma Star_cases:
  shows "A\<star> = {[]} \<union> A ;; A\<star>"
unfolding Sequ_def
by (auto) (metis Star.simps)

lemma Star_decomp:
  assumes "c # x \<in> A\<star>"
  shows "\<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A\<star>"
using assms
by (induct x\<equiv>"c # x" rule: Star.induct)
   (auto simp add: append_eq_Cons_conv)

lemma Star_Der_Sequ:
  shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>"
unfolding Der_def Sequ_def
by(auto simp add: Star_decomp)

lemma Der_inter[simp]:   "Der a (A \<inter> B) = Der a A \<inter> Der a B"
  and Der_compl[simp]:   "Der a (-A) = - Der a A"
  and Der_Union[simp]:   "Der a (Union M) = Union(Der a ` M)"
  and Der_UN[simp]:      "Der a (UN x:I. S x) = (UN x:I. Der a (S x))"
by (auto simp: Der_def)

lemma Der_star[simp]:
  shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
proof -
  have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"
    by (simp only: Star_cases[symmetric])
  also have "... = Der c (A ;; A\<star>)"
    by (simp only: Der_union Der_empty) (simp)
  also have "... = (Der c A) ;; A\<star> \<union> (if [] \<in> A then Der c (A\<star>) else {})"
    by simp
  also have "... =  (Der c A) ;; A\<star>"
    using Star_Der_Sequ by auto
  finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
qed

lemma Der_pow[simp]:
  shows "Der c (A ^^ n) = (if n = 0 then {} else (Der c A) ;; (A ^^ (n - 1)))"
  apply(induct n arbitrary: A)
   apply(auto simp add: Cons_eq_append_conv)
  by (metis Suc_pred concI_if_Nil2 conc_assoc conc_pow_comm lang_pow.simps(2))

lemma Star_concat:
  assumes "\<forall>s \<in> set ss. s \<in> A"
  shows "concat ss \<in> A\<star>"
using assms by (induct ss) (auto)

lemma Star_split:
  assumes "s \<in> A\<star>"
  shows "\<exists>ss. concat ss = s \<and> (\<forall>s \<in> set ss. s \<in> A \<and> s \<noteq> [])"
using assms
  apply(induct rule: Star.induct)
  using concat.simps(1) apply fastforce
  apply(clarify)
  by (metis append_Nil concat.simps(2) set_ConsD)

section \<open>Regular Expressions\<close>

datatype rexp =
  ZERO
| ONE
| CH char
| SEQ rexp rexp
| ALT rexp rexp
| STAR rexp
| NTIMES rexp nat

section \<open>Semantics of Regular Expressions\<close>

fun
  L :: "rexp \<Rightarrow> string set"
where
  "L (ZERO) = {}"
| "L (ONE) = {[]}"
| "L (CH c) = {[c]}"
| "L (SEQ r1 r2) = (L r1) ;; (L r2)"
| "L (ALT r1 r2) = (L r1) \<union> (L r2)"
| "L (STAR r) = (L r)\<star>"
| "L (NTIMES r n) = (L r) ^^ n"

section \<open>Nullable, Derivatives\<close>

fun
 nullable :: "rexp \<Rightarrow> bool"
where
  "nullable (ZERO) = False"
| "nullable (ONE) = True"
| "nullable (CH c) = False"
| "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
| "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
| "nullable (STAR r) = True"
| "nullable (NTIMES r n) = (if n = 0 then True else nullable r)"

fun
 der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
where
  "der c (ZERO) = ZERO"
| "der c (ONE) = ZERO"
| "der c (CH d) = (if c = d then ONE else ZERO)"
| "der c (ALT r1 r2) = ALT (der c r1) (der c r2)"
| "der c (SEQ r1 r2) =
     (if nullable r1
      then ALT (SEQ (der c r1) r2) (der c r2)
      else SEQ (der c r1) r2)"
| "der c (STAR r) = SEQ (der c r) (STAR r)"
| "der c (NTIMES r n) = (if n = 0 then ZERO else SEQ (der c r) (NTIMES r (n - 1)))"

fun
 ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
where
  "ders [] r = r"
| "ders (c # s) r = ders s (der c r)"

lemma pow_empty_iff:
  shows "[] \<in> (L r) ^^ n \<longleftrightarrow> (if n = 0 then True else [] \<in> (L r))"
  by (induct n) (auto simp add: Sequ_def)

lemma nullable_correctness:
  shows "nullable r  \<longleftrightarrow> [] \<in> (L r)"
  by (induct r) (auto simp add: Sequ_def pow_empty_iff)

lemma der_correctness:
  shows "L (der c r) = Der c (L r)"
  apply (induct r)
        apply(auto simp add: nullable_correctness Sequ_def)
  using Der_def apply force
  using Der_def apply auto[1]
  apply (smt (verit, ccfv_SIG) Der_def append_eq_Cons_conv mem_Collect_eq)
  using Der_def apply force
  using Der_Sequ Sequ_def by auto

lemma ders_correctness:
  shows "L (ders s r) = Ders s (L r)"
  by (induct s arbitrary: r)
     (simp_all add: Ders_def der_correctness Der_def)

lemma ders_append:
  shows "ders (s1 @ s2) r = ders s2 (ders s1 r)"
  by (induct s1 arbitrary: s2 r) (auto)

lemma ders_snoc:
  shows "ders (s @ [c]) r = der c (ders s r)"
  by (simp add: ders_append)

end


(*  Title:      HOL/Examples/Sqrt.thy
    Author:     Makarius
    Author:     Tobias Nipkow, TU Muenchen
*)

section \<open>Square roots of primes are irrational\<close>

theory Sqrt
  imports Complex_Main "HOL-Computational_Algebra.Primes"
begin

text \<open>
  The square root of any prime number (including 2) is irrational.
\<close>

theorem sqrt_prime_irrational:
  fixes p :: nat
  assumes "prime p"
  shows "sqrt p \<notin> \<rat>"
proof
  from \<open>prime p\<close> have p: "p > 1" by (rule prime_gt_1_nat)
  assume "sqrt p \<in> \<rat>"
  then obtain m n :: nat
    where n: "n \<noteq> 0"
      and sqrt_rat: "\<bar>sqrt p\<bar> = m / n"
      and "coprime m n" by (rule Rats_abs_nat_div_natE)
  have eq: "m\<^sup>2 = p * n\<^sup>2"
  proof -
    from n and sqrt_rat have "m = \<bar>sqrt p\<bar> * n" by simp
    then have "m\<^sup>2 = (sqrt p)\<^sup>2 * n\<^sup>2" by (simp add: power_mult_distrib)
    also have "(sqrt p)\<^sup>2 = p" by simp
    also have "\<dots> * n\<^sup>2 = p * n\<^sup>2" by simp
    finally show ?thesis by linarith
  qed
  have "p dvd m \<and> p dvd n"
  proof
    from eq have "p dvd m\<^sup>2" ..
    with \<open>prime p\<close> show "p dvd m" by (rule prime_dvd_power)
    then obtain k where "m = p * k" ..
    with eq have "p * n\<^sup>2 = p\<^sup>2 * k\<^sup>2" by algebra
    with p have "n\<^sup>2 = p * k\<^sup>2" by (simp add: power2_eq_square)
    then have "p dvd n\<^sup>2" ..
    with \<open>prime p\<close> show "p dvd n" by (rule prime_dvd_power)
  qed
  then have "p dvd gcd m n" by simp
  with \<open>coprime m n\<close> have "p = 1" by simp
  with p show False by simp
qed

corollary sqrt_2_not_rat: "sqrt 2 \<notin> \<rat>"
  using sqrt_prime_irrational [of 2] by simp

text \<open>
  Here is an alternative version of the main proof, using mostly linear
  forward-reasoning. While this results in less top-down structure, it is
  probably closer to proofs seen in mathematics.
\<close>

theorem
  fixes p :: nat
  assumes "prime p"
  shows "sqrt p \<notin> \<rat>"
proof
  from \<open>prime p\<close> have p: "p > 1" by (rule prime_gt_1_nat)
  assume "sqrt p \<in> \<rat>"
  then obtain m n :: nat
    where n: "n \<noteq> 0"
      and sqrt_rat: "\<bar>sqrt p\<bar> = m / n"
      and "coprime m n" by (rule Rats_abs_nat_div_natE)
  from n and sqrt_rat have "m = \<bar>sqrt p\<bar> * n" by simp
  then have "m\<^sup>2 = (sqrt p)\<^sup>2 * n\<^sup>2" by (auto simp add: power2_eq_square)
  also have "(sqrt p)\<^sup>2 = p" by simp
  also have "\<dots> * n\<^sup>2 = p * n\<^sup>2" by simp
  finally have eq: "m\<^sup>2 = p * n\<^sup>2" by linarith
  then have "p dvd m\<^sup>2" ..
  with \<open>prime p\<close> have dvd_m: "p dvd m" by (rule prime_dvd_power)
  then obtain k where "m = p * k" ..
  with eq have "p * n\<^sup>2 = p\<^sup>2 * k\<^sup>2" by algebra
  with p have "n\<^sup>2 = p * k\<^sup>2" by (simp add: power2_eq_square)
  then have "p dvd n\<^sup>2" ..
  with \<open>prime p\<close> have "p dvd n" by (rule prime_dvd_power)
  with dvd_m have "p dvd gcd m n" by (rule gcd_greatest)
  with \<open>coprime m n\<close> have "p = 1" by simp
  with p show False by simp
qed

text \<open>
  Another old chestnut, which is a consequence of the irrationality of
  \<^term>\<open>sqrt 2\<close>.
\<close>

lemma "\<exists>a b::real. a \<notin> \<rat> \<and> b \<notin> \<rat> \<and> a powr b \<in> \<rat>" (is "\<exists>a b. ?P a b")
proof (cases "sqrt 2 powr sqrt 2 \<in> \<rat>")
  case True
  with sqrt_2_not_rat have "?P (sqrt 2) (sqrt 2)" by simp
  then show ?thesis by blast
next
  case False
  with sqrt_2_not_rat powr_powr have "?P (sqrt 2 powr sqrt 2) (sqrt 2)" by simp
  then show ?thesis by blast
qed

end


subsubsection \<open>Addition\<close>
theory Nat_Add
  imports Nat_Rec
begin

definition "nat_add m n \<equiv> nat_rec m n succ"

lemma nat_add_type [type]: "nat_add : Nat \<Rightarrow> Nat \<Rightarrow> Nat"
  unfolding nat_add_def by auto

bundle isa_set_nat_add_syntax begin notation nat_add (infixl "+" 65) end
bundle no_isa_set_nat_add_syntax begin no_notation nat_add (infixl "+" 65) end

unbundle no_HOL_groups_syntax
unbundle isa_set_nat_add_syntax

lemma zero_add_eq [iff]: "0 + n = n"
  unfolding nat_add_def by simp

lemma Nat_add_zero_eq [simp]: "n : Nat \<Longrightarrow> n + 0 = n"
  unfolding nat_add_def by (induction n rule: Nat_induct) auto

lemma Nat_add_assoc:
  "\<lbrakk>l : Nat; m : Nat; n: Nat\<rbrakk> \<Longrightarrow> l + m + n = l + (m + n)"
  unfolding nat_add_def by (induction l rule: Nat_induct) auto

lemma Nat_succ_add_eq [simp]: "m : Nat \<Longrightarrow> succ m + n = succ (m + n)"
  unfolding nat_add_def by simp

lemma Nat_add_succ_eq [simp]: "m : Nat \<Longrightarrow> m + succ n = succ (m + n)"
  by (induction m rule: Nat_induct) auto

corollary Nat_succ_add_eq_add_succ: "m : Nat \<Longrightarrow> succ m + n = m + succ n"
  by simp

lemma Nat_add_comm: "m : Nat \<Longrightarrow> n : Nat \<Longrightarrow> m + n = n + m"
  by (induction m rule: Nat_induct) auto

lemma Nat_add_comm_left:
  "\<lbrakk>l : Nat; m : Nat; n: Nat\<rbrakk> \<Longrightarrow> l + (m + n) = m + (l + n)"
  by (induction l rule: Nat_induct) auto

lemmas Nat_add_AC_rules = Nat_add_comm Nat_add_assoc Nat_add_comm_left

lemma Nat_one_add_eq_succ: "1 + n = succ n"
  unfolding nat_one_def by (simp add: nat_add_def)

lemma nat_add_one_eq_succ: "n : Nat \<Longrightarrow> n + 1 = succ n"
  by (simp only: Nat_add_comm Nat_one_add_eq_succ)

lemma Nat_add_ne_zero_if_ne_zero_left:
  assumes "m : Nat"
  and "m \<noteq> 0"
  shows "m + n \<noteq> 0"
  using assms by (cases m rule: NatE) auto

lemma Nat_add_ne_zero_if_ne_zero_right [simp]:
  assumes "m : Nat"
  and "n \<noteq> 0"
  shows "m + n \<noteq> 0"
  using assms by (cases m rule: NatE) auto

lemma Nat_pred_add_eq [simp]:
  "\<lbrakk>m : Nat; n : Nat; m \<noteq> 0\<rbrakk> \<Longrightarrow> pred m + n = pred (m + n)"
  by (cases m rule: NatE) auto

corollary Nat_add_pred_eq [simp]:
  "\<lbrakk>m : Nat; n : Nat; n \<noteq> 0\<rbrakk> \<Longrightarrow> m + pred n = pred (m + n)"
  by (auto simp only: Nat_add_comm[of m] intro: Nat_pred_add_eq)

lemma Nat_succ_add_pred_eq [simp]:
  "\<lbrakk>m : Nat; n : Nat; n \<noteq> 0\<rbrakk> \<Longrightarrow> succ m + pred n = m + n"
  by (cases m rule: NatE) auto

corollary nat_pred_add_succ [simp]:
  "\<lbrakk>m : Nat; n : Nat; m \<noteq> 0\<rbrakk> \<Longrightarrow> pred m + succ n = m + n"
  by (auto simp only: Nat_add_comm[of m] Nat_add_comm[of "pred m"]
    intro: Nat_succ_add_pred_eq)

unbundle no_HOL_order_syntax

lemma Nat_le_add [intro]: "m : Nat \<Longrightarrow> n : Nat \<Longrightarrow> m \<le> m + n"
  by (induction m rule: Nat_induct) auto

lemma Nat_lt_add_if_ne_zero: "\<lbrakk>m : Nat; n : Nat; n \<noteq> 0\<rbrakk> \<Longrightarrow> m < m + n"
  by (induction m rule: Nat_induct) (auto simp: Nat_zero_lt_iff_ne_zero)

lemma Nat_lt_if_add_lt: "\<lbrakk>l : Nat; m : Nat; n: Nat; l + m < n\<rbrakk> \<Longrightarrow> l < n"
  using Nat_lt_if_lt_if_le[OF _ Nat_le_add[of l m]] by auto

lemma Nat_le_if_add_le: "\<lbrakk>l : Nat; m : Nat; n: Nat; l + m \<le> n\<rbrakk> \<Longrightarrow> l \<le> n"
  using Nat_le_trans[OF _ Nat_le_add[of l m]] by auto

lemma Nat_lt_add_if_lt:
  assumes "m : Nat" "n : Nat"
  and "l < m"
  shows "l < m + n"
proof -
  note \<open>l < m\<close>
  moreover have "... \<le> m + n" by auto
  ultimately show "l < m + n" using Nat_lt_if_le_if_lt by auto
(*TODO: Transitivity rules have typing assumptions. Proof should more
  look like this:
  note \<open>l < m\<close>
  also have "... \<le> m + n" by auto
  finally show "l < m + n" .
*)
qed

lemma Nat_add_lt_add_if_lt:
  assumes "m : Nat" "n : Nat"
  and "l < m"
  shows "l + n < m + n"
using \<open>n : Nat\<close>
proof (induction n rule: Nat_induct)
  (*TODO: should be derivable automatically*)
  from assms have "l : Nat" using Nat_if_lt_Nat by auto
  case zero then show "?case" by simp
  case (succ n)
  have "l + succ n = succ (l + n)" by simp
  moreover with succ.IH have "... < succ (m + n)"
    by (auto intro: Nat_succ_lt_succ_if_lt)
  moreover have "... = m + succ n" by simp
  (*TODO: transitivity proofs are ugly at the moment*)
  ultimately show "?case" by (simp only:)
qed

lemma Nat_lt_if_add_lt_add:
  assumes "l : Nat" "m : Nat" "n : Nat"
  shows "l + n < m + n \<Longrightarrow> l < m"
using \<open>n : Nat\<close>
proof (induction n rule: Nat_induct)
  (* case zero then show "?case" by simp *)
  case (succ n)
  have "succ (l + n) = l + succ n" by simp
  moreover have "... < m + succ n" by fact
  moreover have "... = succ (m + n)" by simp
  (*TODO: transitivity proofs are ugly at the moment*)
  ultimately have "succ (l + n) < succ (m + n)" by (simp only:)
  then have "l + n < m + n" by simp
  then show "l < m" by (rule succ.IH)
qed simp

corollary Nat_add_lt_add_iff_lt:
  assumes "l : Nat" "m : Nat" "n : Nat"
  shows "l + n < m + n \<longleftrightarrow> l < m"
using assms Nat_lt_if_add_lt_add Nat_add_lt_add_if_lt by blast

end


(*
   File:     HOL/Analysis/Ball_Volume.thy
   Author:   Manuel Eberl, TU München
*)

section \<open>The Volume of an \<open>n\<close>-Dimensional Ball\<close>

theory Ball_Volume
  imports Gamma_Function Lebesgue_Integral_Substitution
begin

text \<open>
  We define the volume of the unit ball in terms of the Gamma function. Note that the
  dimension need not be an integer; we also allow fractional dimensions, although we do
  not use this case or prove anything about it for now.
\<close>
definition\<^marker>\<open>tag important\<close> unit_ball_vol :: "real \<Rightarrow> real" where
  "unit_ball_vol n = pi powr (n / 2) / Gamma (n / 2 + 1)"

lemma unit_ball_vol_pos [simp]: "n \<ge> 0 \<Longrightarrow> unit_ball_vol n > 0"
  by (force simp: unit_ball_vol_def intro: divide_nonneg_pos)

lemma unit_ball_vol_nonneg [simp]: "n \<ge> 0 \<Longrightarrow> unit_ball_vol n \<ge> 0"
  by (simp add: dual_order.strict_implies_order)

text \<open>
  We first need the value of the following integral, which is at the core of
  computing the measure of an \<open>n + 1\<close>-dimensional ball in terms of the measure of an
  \<open>n\<close>-dimensional one.
\<close>
lemma emeasure_cball_aux_integral:
  "(\<integral>\<^sup>+x. indicator {-1..1} x * sqrt (1 - x\<^sup>2) ^ n \<partial>lborel) =
      ennreal (Beta (1 / 2) (real n / 2 + 1))"
proof -
  have "((\<lambda>t. t powr (-1 / 2) * (1 - t) powr (real n / 2)) has_integral
          Beta (1 / 2) (real n / 2 + 1)) {0..1}"
    using has_integral_Beta_real[of "1/2" "n / 2 + 1"] by simp
  from nn_integral_has_integral_lebesgue[OF _ this] have
     "ennreal (Beta (1 / 2) (real n / 2 + 1)) =
        nn_integral lborel (\<lambda>t. ennreal (t powr (-1 / 2) * (1 - t) powr (real n / 2) *
                                indicator {0^2..1^2} t))"
    by (simp add: mult_ac ennreal_mult' ennreal_indicator)
  also have "\<dots> = (\<integral>\<^sup>+ x. ennreal (x\<^sup>2 powr - (1 / 2) * (1 - x\<^sup>2) powr (real n / 2) * (2 * x) *
                          indicator {0..1} x) \<partial>lborel)"
    by (subst nn_integral_substitution[where g = "\<lambda>x. x ^ 2" and g' = "\<lambda>x. 2 * x"])
       (auto intro!: derivative_eq_intros continuous_intros simp: set_borel_measurable_def)
  also have "\<dots> = (\<integral>\<^sup>+ x. 2 * ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {0..1} x) \<partial>lborel)"
    by (intro nn_integral_cong_AE AE_I[of _ _ "{0}"])
       (auto simp: indicator_def powr_minus powr_half_sqrt field_split_simps ennreal_mult')
  also have "\<dots> = (\<integral>\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {0..1} x) \<partial>lborel) +
                    (\<integral>\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {0..1} x) \<partial>lborel)"
    (is "_ = ?I + _") by (simp add: mult_2 nn_integral_add)
  also have "?I = (\<integral>\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {-1..0} x) \<partial>lborel)"
    by (subst nn_integral_real_affine[of _ "-1" 0])
       (auto simp: indicator_def intro!: nn_integral_cong)
  hence "?I + ?I = \<dots> + ?I" by simp
  also have "\<dots> = (\<integral>\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) *
                    (indicator {-1..0} x + indicator{0..1} x)) \<partial>lborel)"
    by (subst nn_integral_add [symmetric]) (auto simp: algebra_simps)
  also have "\<dots> = (\<integral>\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {-1..1} x) \<partial>lborel)"
    by (intro nn_integral_cong_AE AE_I[of _ _ "{0}"]) (auto simp: indicator_def)
  also have "\<dots> = (\<integral>\<^sup>+ x. ennreal (indicator {-1..1} x * sqrt (1 - x\<^sup>2) ^ n) \<partial>lborel)"
    by (intro nn_integral_cong_AE AE_I[of _ _ "{1, -1}"])
       (auto simp: powr_half_sqrt [symmetric] indicator_def abs_square_le_1
          abs_square_eq_1 powr_def exp_of_nat_mult [symmetric] emeasure_lborel_countable)
  finally show ?thesis ..
qed

lemma real_sqrt_le_iff': "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> sqrt x \<le> y \<longleftrightarrow> x \<le> y ^ 2"
  using real_le_lsqrt sqrt_le_D by blast

lemma power2_le_iff_abs_le: "y \<ge> 0 \<Longrightarrow> (x::real) ^ 2 \<le> y ^ 2 \<longleftrightarrow> abs x \<le> y"
  by (subst real_sqrt_le_iff' [symmetric]) auto

text \<open>
  Isabelle's type system makes it very difficult to do an induction over the dimension
  of a Euclidean space type, because the type would change in the inductive step. To avoid
  this problem, we instead formulate the problem in a more concrete way by unfolding the
  definition of the Euclidean norm.
\<close>
lemma emeasure_cball_aux:
  assumes "finite A" "r > 0"
  shows   "emeasure (Pi\<^sub>M A (\<lambda>_. lborel))
             ({f. sqrt (\<Sum>i\<in>A. (f i)\<^sup>2) \<le> r} \<inter> space (Pi\<^sub>M A (\<lambda>_. lborel))) =
             ennreal (unit_ball_vol (real (card A)) * r ^ card A)"
  using assms
proof (induction arbitrary: r)
  case (empty r)
  thus ?case
    by (simp add: unit_ball_vol_def space_PiM)
next
  case (insert i A r)
  interpret product_sigma_finite "\<lambda>_. lborel"
    by standard
  have "emeasure (Pi\<^sub>M (insert i A) (\<lambda>_. lborel))
            ({f. sqrt (\<Sum>i\<in>insert i A. (f i)\<^sup>2) \<le> r} \<inter> space (Pi\<^sub>M (insert i A) (\<lambda>_. lborel))) =
        nn_integral (Pi\<^sub>M (insert i A) (\<lambda>_. lborel))
          (indicator ({f. sqrt (\<Sum>i\<in>insert i A. (f i)\<^sup>2) \<le> r} \<inter>
          space (Pi\<^sub>M (insert i A) (\<lambda>_. lborel))))"
    by (subst nn_integral_indicator) auto
  also have "\<dots> = (\<integral>\<^sup>+ y. \<integral>\<^sup>+ x. indicator ({f. sqrt ((f i)\<^sup>2 + (\<Sum>i\<in>A. (f i)\<^sup>2)) \<le> r} \<inter>
                                space (Pi\<^sub>M (insert i A) (\<lambda>_. lborel))) (x(i := y))
                   \<partial>Pi\<^sub>M A (\<lambda>_. lborel) \<partial>lborel)"
    using insert.prems insert.hyps by (subst product_nn_integral_insert_rev) auto
  also have "\<dots> = (\<integral>\<^sup>+ (y::real). \<integral>\<^sup>+ x. indicator {-r..r} y * indicator ({f. sqrt ((\<Sum>i\<in>A. (f i)\<^sup>2)) \<le>
               sqrt (r ^ 2 - y ^ 2)} \<inter> space (Pi\<^sub>M A (\<lambda>_. lborel))) x \<partial>Pi\<^sub>M A (\<lambda>_. lborel) \<partial>lborel)"
  proof (intro nn_integral_cong, goal_cases)
    case (1 y f)
    have *: "y \<in> {-r..r}" if "y ^ 2 + c \<le> r ^ 2" "c \<ge> 0" for c
    proof -
      have "y ^ 2 \<le> y ^ 2 + c" using that by simp
      also have "\<dots> \<le> r ^ 2" by fact
      finally show ?thesis
        using \<open>r > 0\<close> by (simp add: power2_le_iff_abs_le abs_if split: if_splits)
    qed
    have "(\<Sum>x\<in>A. (if x = i then y else f x)\<^sup>2) = (\<Sum>x\<in>A. (f x)\<^sup>2)"
      using insert.hyps by (intro sum.cong) auto
    thus ?case using 1 \<open>r > 0\<close>
      by (auto simp: sum_nonneg real_sqrt_le_iff' indicator_def PiE_def space_PiM dest!: *)
  qed
  also have "\<dots> = (\<integral>\<^sup>+ (y::real). indicator {-r..r} y * (\<integral>\<^sup>+ x. indicator ({f. sqrt ((\<Sum>i\<in>A. (f i)\<^sup>2))
                                   \<le> sqrt (r ^ 2 - y ^ 2)} \<inter> space (Pi\<^sub>M A (\<lambda>_. lborel))) x
                  \<partial>Pi\<^sub>M A (\<lambda>_. lborel)) \<partial>lborel)" by (subst nn_integral_cmult) auto
  also have "\<dots> = (\<integral>\<^sup>+ (y::real). indicator {-r..r} y * emeasure (PiM A (\<lambda>_. lborel))
      ({f. sqrt ((\<Sum>i\<in>A. (f i)\<^sup>2)) \<le> sqrt (r ^ 2 - y ^ 2)} \<inter> space (Pi\<^sub>M A (\<lambda>_. lborel))) \<partial>lborel)"
    using \<open>finite A\<close> by (intro nn_integral_cong, subst nn_integral_indicator) auto
  also have "\<dots> = (\<integral>\<^sup>+ (y::real). indicator {-r..r} y * ennreal (unit_ball_vol (real (card A)) *
                                  (sqrt (r ^ 2 - y ^ 2)) ^ card A) \<partial>lborel)"
  proof (intro nn_integral_cong_AE, goal_cases)
    case 1
    have "AE y in lborel. y \<notin> {-r,r}"
      by (intro AE_not_in countable_imp_null_set_lborel) auto
    thus ?case
    proof eventually_elim
      case (elim y)
      show ?case
      proof (cases "y \<in> {-r<..<r}")
        case True
        hence "y\<^sup>2 < r\<^sup>2" by (subst real_sqrt_less_iff [symmetric]) auto
        thus ?thesis by (subst insert.IH) (auto)
      qed (insert elim, auto)
    qed
  qed
  also have "\<dots> = ennreal (unit_ball_vol (real (card A))) *
                    (\<integral>\<^sup>+ (y::real). indicator {-r..r} y * (sqrt (r ^ 2 - y ^ 2)) ^ card A \<partial>lborel)"
    by (subst nn_integral_cmult [symmetric])
       (auto simp: mult_ac ennreal_mult' [symmetric] indicator_def intro!: nn_integral_cong)
  also have "(\<integral>\<^sup>+ (y::real). indicator {-r..r} y * (sqrt (r ^ 2 - y ^ 2)) ^ card A \<partial>lborel) =
               (\<integral>\<^sup>+ (y::real). r ^ card A * indicator {-1..1} y * (sqrt (1 - y ^ 2)) ^ card A
               \<partial>(distr lborel borel ((*) (1/r))))" using \<open>r > 0\<close>
    by (subst nn_integral_distr)
       (auto simp: indicator_def field_simps real_sqrt_divide intro!: nn_integral_cong)
  also have "\<dots> = (\<integral>\<^sup>+ x. ennreal (r ^ Suc (card A)) *
               (indicator {- 1..1} x * sqrt (1 - x\<^sup>2) ^ card A) \<partial>lborel)" using \<open>r > 0\<close>
    by (subst lborel_distr_mult) (auto simp: nn_integral_density ennreal_mult' [symmetric] mult_ac)
  also have "\<dots> = ennreal (r ^ Suc (card A)) * (\<integral>\<^sup>+ x. indicator {- 1..1} x *
                    sqrt (1 - x\<^sup>2) ^ card A \<partial>lborel)"
    by (subst nn_integral_cmult) auto
  also note emeasure_cball_aux_integral
  also have "ennreal (unit_ball_vol (real (card A))) * (ennreal (r ^ Suc (card A)) *
                 ennreal (Beta (1/2) (card A / 2 + 1))) =
               ennreal (unit_ball_vol (card A) * Beta (1/2) (card A / 2 + 1) * r ^ Suc (card A))"
    using \<open>r > 0\<close> by (simp add: ennreal_mult' [symmetric] mult_ac)
  also have "unit_ball_vol (card A) * Beta (1/2) (card A / 2 + 1) = unit_ball_vol (Suc (card A))"
    by (auto simp: unit_ball_vol_def Beta_def Gamma_eq_zero_iff field_simps
          Gamma_one_half_real powr_half_sqrt [symmetric] powr_add [symmetric])
  also have "Suc (card A) = card (insert i A)" using insert.hyps by simp
  finally show ?case .
qed

text \<open>
  We now get the main theorem very easily by just applying the above lemma.
\<close>
context
  fixes c :: "'a :: euclidean_space" and r :: real
  assumes r: "r \<ge> 0"
begin

theorem\<^marker>\<open>tag unimportant\<close> emeasure_cball:
  "emeasure lborel (cball c r) = ennreal (unit_ball_vol (DIM('a)) * r ^ DIM('a))"
proof (cases "r = 0")
  case False
  with r have r: "r > 0" by simp
  have "(lborel :: 'a measure) =
          distr (Pi\<^sub>M Basis (\<lambda>_. lborel)) borel (\<lambda>f. \<Sum>b\<in>Basis. f b *\<^sub>R b)"
    by (rule lborel_eq)
  also have "emeasure \<dots> (cball 0 r) =
               emeasure (Pi\<^sub>M Basis (\<lambda>_. lborel))
               ({y. dist 0 (\<Sum>b\<in>Basis. y b *\<^sub>R b :: 'a) \<le> r} \<inter> space (Pi\<^sub>M Basis (\<lambda>_. lborel)))"
    by (subst emeasure_distr) (auto simp: cball_def)
  also have "{f. dist 0 (\<Sum>b\<in>Basis. f b *\<^sub>R b :: 'a) \<le> r} = {f. sqrt (\<Sum>i\<in>Basis. (f i)\<^sup>2) \<le> r}"
    by (subst euclidean_dist_l2) (auto simp: L2_set_def)
  also have "emeasure (Pi\<^sub>M Basis (\<lambda>_. lborel)) (\<dots> \<inter> space (Pi\<^sub>M Basis (\<lambda>_. lborel))) =
               ennreal (unit_ball_vol (real DIM('a)) * r ^ DIM('a))"
    using r by (subst emeasure_cball_aux) simp_all
  also have "emeasure lborel (cball 0 r :: 'a set) =
               emeasure (distr lborel borel (\<lambda>x. c + x)) (cball c r)"
    by (subst emeasure_distr) (auto simp: cball_def dist_norm norm_minus_commute)
  also have "distr lborel borel (\<lambda>x. c + x) = lborel"
    using lborel_affine[of 1 c] by (simp add: density_1)
  finally show ?thesis .
qed auto

corollary\<^marker>\<open>tag unimportant\<close> content_cball:
  "content (cball c r) = unit_ball_vol (DIM('a)) * r ^ DIM('a)"
  by (simp add: measure_def emeasure_cball r)

corollary\<^marker>\<open>tag unimportant\<close> emeasure_ball:
  "emeasure lborel (ball c r) = ennreal (unit_ball_vol (DIM('a)) * r ^ DIM('a))"
proof -
  from negligible_sphere[of c r] have "sphere c r \<in> null_sets lborel"
    by (auto simp: null_sets_completion_iff negligible_iff_null_sets negligible_convex_frontier)
  hence "emeasure lborel (ball c r \<union> sphere c r :: 'a set) = emeasure lborel (ball c r :: 'a set)"
    by (intro emeasure_Un_null_set) auto
  also have "ball c r \<union> sphere c r = (cball c r :: 'a set)" by auto
  also have "emeasure lborel \<dots> = ennreal (unit_ball_vol (real DIM('a)) * r ^ DIM('a))"
    by (rule emeasure_cball)
  finally show ?thesis ..
qed

corollary\<^marker>\<open>tag important\<close> content_ball:
  "content (ball c r) = unit_ball_vol (DIM('a)) * r ^ DIM('a)"
  by (simp add: measure_def r emeasure_ball)

end

text \<open>
  Lastly, we now prove some nicer explicit formulas for the volume of the unit balls in
  the cases of even and odd integer dimensions.
\<close>
lemma unit_ball_vol_even:
  "unit_ball_vol (real (2 * n)) = pi ^ n / fact n"
  by (simp add: unit_ball_vol_def add_ac powr_realpow Gamma_fact)

lemma unit_ball_vol_odd':
        "unit_ball_vol (real (2 * n + 1)) = pi ^ n / pochhammer (1 / 2) (Suc n)"
  and unit_ball_vol_odd:
        "unit_ball_vol (real (2 * n + 1)) =
           (2 ^ (2 * Suc n) * fact (Suc n)) / fact (2 * Suc n) * pi ^ n"
proof -
  have "unit_ball_vol (real (2 * n + 1)) =
          pi powr (real n + 1 / 2) / Gamma (1 / 2 + real (Suc n))"
    by (simp add: unit_ball_vol_def field_simps)
  also have "pochhammer (1 / 2) (Suc n) = Gamma (1 / 2 + real (Suc n)) / Gamma (1 / 2)"
    by (intro pochhammer_Gamma) auto
  hence "Gamma (1 / 2 + real (Suc n)) = sqrt pi * pochhammer (1 / 2) (Suc n)"
    by (simp add: Gamma_one_half_real)
  also have "pi powr (real n + 1 / 2) / \<dots> = pi ^ n / pochhammer (1 / 2) (Suc n)"
    by (simp add: powr_add powr_half_sqrt powr_realpow)
  finally show "unit_ball_vol (real (2 * n + 1)) = \<dots>" .
  also have "pochhammer (1 / 2 :: real) (Suc n) =
               fact (2 * Suc n) / (2 ^ (2 * Suc n) * fact (Suc n))"
    using fact_double[of "Suc n", where ?'a = real] by (simp add: divide_simps mult_ac)
  also have "pi ^n / \<dots> = (2 ^ (2 * Suc n) * fact (Suc n)) / fact (2 * Suc n) * pi ^ n"
    by simp
  finally show "unit_ball_vol (real (2 * n + 1)) = \<dots>" .
qed

lemma unit_ball_vol_numeral:
  "unit_ball_vol (numeral (Num.Bit0 n)) = pi ^ numeral n / fact (numeral n)" (is ?th1)
  "unit_ball_vol (numeral (Num.Bit1 n)) = 2 ^ (2 * Suc (numeral n)) * fact (Suc (numeral n)) /
    fact (2 * Suc (numeral n)) * pi ^ numeral n" (is ?th2)
proof -
  have "numeral (Num.Bit0 n) = (2 * numeral n :: nat)"
    by (simp only: numeral_Bit0 mult_2 ring_distribs)
  also have "unit_ball_vol \<dots> = pi ^ numeral n / fact (numeral n)"
    by (rule unit_ball_vol_even)
  finally show ?th1 by simp
next
  have "numeral (Num.Bit1 n) = (2 * numeral n + 1 :: nat)"
    by (simp only: numeral_Bit1 mult_2)
  also have "unit_ball_vol \<dots> = 2 ^ (2 * Suc (numeral n)) * fact (Suc (numeral n)) /
                                  fact (2 * Suc (numeral n)) * pi ^ numeral n"
    by (rule unit_ball_vol_odd)
  finally show ?th2 by simp
qed

lemmas eval_unit_ball_vol = unit_ball_vol_numeral fact_numeral

text \<open>
  Just for fun, we compute the volume of unit balls for a few dimensions.
\<close>
lemma unit_ball_vol_0 [simp]: "unit_ball_vol 0 = 1"
  using unit_ball_vol_even[of 0] by simp

lemma unit_ball_vol_1 [simp]: "unit_ball_vol 1 = 2"
  using unit_ball_vol_odd[of 0] by simp

corollary\<^marker>\<open>tag unimportant\<close>
          unit_ball_vol_2: "unit_ball_vol 2 = pi"
      and unit_ball_vol_3: "unit_ball_vol 3 = 4 / 3 * pi"
      and unit_ball_vol_4: "unit_ball_vol 4 = pi\<^sup>2 / 2"
      and unit_ball_vol_5: "unit_ball_vol 5 = 8 / 15 * pi\<^sup>2"
  by (simp_all add: eval_unit_ball_vol)

corollary\<^marker>\<open>tag unimportant\<close> circle_area:
  "r \<ge> 0 \<Longrightarrow> content (ball c r :: (real ^ 2) set) = r ^ 2 * pi"
  by (simp add: content_ball unit_ball_vol_2)

corollary\<^marker>\<open>tag unimportant\<close> sphere_volume:
  "r \<ge> 0 \<Longrightarrow> content (ball c r :: (real ^ 3) set) = 4 / 3 * r ^ 3 * pi"
  by (simp add: content_ball unit_ball_vol_3)

text \<open>
  Useful equivalent forms
\<close>
corollary\<^marker>\<open>tag unimportant\<close> content_ball_eq_0_iff [simp]: "content (ball c r) = 0 \<longleftrightarrow> r \<le> 0"
proof -
  have "r > 0 \<Longrightarrow> content (ball c r) > 0"
    by (simp add: content_ball unit_ball_vol_def)
  then show ?thesis
    by (fastforce simp: ball_empty)
qed

corollary\<^marker>\<open>tag unimportant\<close> content_ball_gt_0_iff [simp]: "0 < content (ball z r) \<longleftrightarrow> 0 < r"
  by (auto simp: zero_less_measure_iff)

corollary\<^marker>\<open>tag unimportant\<close> content_cball_eq_0_iff [simp]: "content (cball c r) = 0 \<longleftrightarrow> r \<le> 0"
proof (cases "r = 0")
  case False
  moreover have "r > 0 \<Longrightarrow> content (cball c r) > 0"
    by (simp add: content_cball unit_ball_vol_def)
  ultimately show ?thesis
    by fastforce
qed auto

corollary\<^marker>\<open>tag unimportant\<close> content_cball_gt_0_iff [simp]: "0 < content (cball z r) \<longleftrightarrow> 0 < r"
  by (auto simp: zero_less_measure_iff)

end


(*  Title:      HOL/SMT_Examples/SMT_Tests.thy
    Author:     Sascha Boehme, TU Muenchen
    Author:     Mathias Fleury, MPII, JKU
*)

section \<open>Tests for the SMT binding\<close>

theory SMT_Tests_Verit
imports Complex_Main
begin

declare [[smt_solver=verit]]
smt_status

text \<open>Most examples are taken from the equivalent Z3 theory called \<^file>\<open>SMT_Tests.thy\<close>,
and have been taken from various Isabelle and HOL4 developments.\<close>

section \<open>Propositional logic\<close>

lemma
  "True"
  "\<not> False"
  "\<not> \<not> True"
  "True \<and> True"
  "True \<or> False"
  "False \<longrightarrow> True"
  "\<not> (False \<longleftrightarrow> True)"
  by smt+

lemma
  "P \<or> \<not> P"
  "\<not> (P \<and> \<not> P)"
  "(True \<and> P) \<or> \<not> P \<or> (False \<and> P) \<or> P"
  "P \<longrightarrow> P"
  "P \<and> \<not> P \<longrightarrow> False"
  "P \<and> Q \<longrightarrow> Q \<and> P"
  "P \<or> Q \<longrightarrow> Q \<or> P"
  "P \<and> Q \<longrightarrow> P \<or> Q"
  "\<not> (P \<or> Q) \<longrightarrow> \<not> P"
  "\<not> (P \<or> Q) \<longrightarrow> \<not> Q"
  "\<not> P \<longrightarrow> \<not> (P \<and> Q)"
  "\<not> Q \<longrightarrow> \<not> (P \<and> Q)"
  "(P \<and> Q) \<longleftrightarrow> (\<not> (\<not> P \<or> \<not> Q))"
  "(P \<and> Q) \<and> R \<longrightarrow> P \<and> (Q \<and> R)"
  "(P \<or> Q) \<or> R \<longrightarrow> P \<or> (Q \<or> R)"
  "(P \<and> Q) \<or> R  \<longrightarrow> (P \<or> R) \<and> (Q \<or> R)"
  "(P \<or> R) \<and> (Q \<or> R) \<longrightarrow> (P \<and> Q) \<or> R"
  "(P \<or> Q) \<and> R \<longrightarrow> (P \<and> R) \<or> (Q \<and> R)"
  "(P \<and> R) \<or> (Q \<and> R) \<longrightarrow> (P \<or> Q) \<and> R"
  "((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P"
  "(P \<longrightarrow> R) \<and> (Q \<longrightarrow> R) \<longleftrightarrow> (P \<or> Q \<longrightarrow> R)"
  "(P \<and> Q \<longrightarrow> R) \<longleftrightarrow> (P \<longrightarrow> (Q \<longrightarrow> R))"
  "((P \<longrightarrow> R) \<longrightarrow> R) \<longrightarrow>  ((Q \<longrightarrow> R) \<longrightarrow> R) \<longrightarrow> (P \<and> Q \<longrightarrow> R) \<longrightarrow> R"
  "\<not> (P \<longrightarrow> R) \<longrightarrow>  \<not> (Q \<longrightarrow> R) \<longrightarrow> \<not> (P \<and> Q \<longrightarrow> R)"
  "(P \<longrightarrow> Q \<and> R) \<longleftrightarrow> (P \<longrightarrow> Q) \<and> (P \<longrightarrow> R)"
  "P \<longrightarrow> (Q \<longrightarrow> P)"
  "(P \<longrightarrow> Q \<longrightarrow> R) \<longrightarrow> (P \<longrightarrow> Q)\<longrightarrow> (P \<longrightarrow> R)"
  "(P \<longrightarrow> Q) \<or> (P \<longrightarrow> R) \<longrightarrow> (P \<longrightarrow> Q \<or> R)"
  "((((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P) \<longrightarrow> Q) \<longrightarrow> Q"
  "(P \<longrightarrow> Q) \<longrightarrow> (\<not> Q \<longrightarrow> \<not> P)"
  "(P \<longrightarrow> Q \<or> R) \<longrightarrow> (P \<longrightarrow> Q) \<or> (P \<longrightarrow> R)"
  "(P \<longrightarrow> Q) \<and> (Q  \<longrightarrow> P) \<longrightarrow> (P \<longleftrightarrow> Q)"
  "(P \<longleftrightarrow> Q) \<longleftrightarrow> (Q \<longleftrightarrow> P)"
  "\<not> (P \<longleftrightarrow> \<not> P)"
  "(P \<longrightarrow> Q) \<longleftrightarrow> (\<not> Q \<longrightarrow> \<not> P)"
  "P \<longleftrightarrow> P \<longleftrightarrow> P \<longleftrightarrow> P \<longleftrightarrow> P \<longleftrightarrow> P \<longleftrightarrow> P \<longleftrightarrow> P \<longleftrightarrow> P \<longleftrightarrow> P"
  by smt+

lemma
  "(if P then Q1 else Q2) \<longleftrightarrow> ((P \<longrightarrow> Q1) \<and> (\<not> P \<longrightarrow> Q2))"
  "if P then (Q \<longrightarrow> P) else (P \<longrightarrow> Q)"
  "(if P1 \<or> P2 then Q1 else Q2) \<longleftrightarrow> (if P1 then Q1 else if P2 then Q1 else Q2)"
  "(if P1 \<and> P2 then Q1 else Q2) \<longleftrightarrow> (if P1 then if P2 then Q1 else Q2 else Q2)"
  "(P1 \<longrightarrow> (if P2 then Q1 else Q2)) \<longleftrightarrow>
   (if P1 \<longrightarrow> P2 then P1 \<longrightarrow> Q1 else P1 \<longrightarrow> Q2)"
  by smt+

lemma
  "case P of True \<Rightarrow> P | False \<Rightarrow> \<not> P"
  "case P of False \<Rightarrow> \<not> P | True \<Rightarrow> P"
  "case \<not> P of True \<Rightarrow> \<not> P | False \<Rightarrow> P"
  "case P of True \<Rightarrow> (Q \<longrightarrow> P) | False \<Rightarrow> (P \<longrightarrow> Q)"
  by smt+

section \<open>First-order logic with equality\<close>

lemma
  "x = x"
  "x = y \<longrightarrow> y = x"
  "x = y \<and> y = z \<longrightarrow> x = z"
  "x = y \<longrightarrow> f x = f y"
  "x = y \<longrightarrow> g x y = g y x"
  "f (f x) = x \<and> f (f (f (f (f x)))) = x \<longrightarrow> f x = x"
  "((if a then b else c) = d) = ((a \<longrightarrow> (b = d)) \<and> (\<not> a \<longrightarrow> (c = d)))"
  by smt+

lemma
  "\<forall>x. x = x"
  "(\<forall>x. P x) \<longleftrightarrow> (\<forall>y. P y)"
  "\<forall>x. P x \<longrightarrow> (\<forall>y. P x \<or> P y)"
  "(\<forall>x. P x \<and> Q x) \<longleftrightarrow> (\<forall>x. P x) \<and> (\<forall>x. Q x)"
  "(\<forall>x. P x) \<or> R \<longleftrightarrow> (\<forall>x. P x \<or> R)"
  "(\<forall>x y z. S x z) \<longleftrightarrow> (\<forall>x z. S x z)"
  "(\<forall>x y. S x y \<longrightarrow> S y x) \<longrightarrow> (\<forall>x. S x y) \<longrightarrow> S y x"
  "(\<forall>x. P x \<longrightarrow> P (f x)) \<and> P d \<longrightarrow> P (f(f(f(d))))"
  "(\<forall>x y. s x y = s y x) \<longrightarrow> a = a \<and> s a b = s b a"
  "(\<forall>s. q s \<longrightarrow> r s) \<and> \<not> r s \<and> (\<forall>s. \<not> r s \<and> \<not> q s \<longrightarrow> p t \<or> q t) \<longrightarrow> p t \<or> r t"
  by smt+

lemma
  "(\<forall>x. P x) \<and> R \<longleftrightarrow> (\<forall>x. P x \<and> R)"
  by smt

lemma
  "\<exists>x. x = x"
  "(\<exists>x. P x) \<longleftrightarrow> (\<exists>y. P y)"
  "(\<exists>x. P x \<or> Q x) \<longleftrightarrow> (\<exists>x. P x) \<or> (\<exists>x. Q x)"
  "(\<exists>x. P x) \<and> R \<longleftrightarrow> (\<exists>x. P x \<and> R)"
  "(\<exists>x y z. S x z) \<longleftrightarrow> (\<exists>x z. S x z)"
  "\<not> ((\<exists>x. \<not> P x) \<and> ((\<exists>x. P x) \<or> (\<exists>x. P x \<and> Q x)) \<and> \<not> (\<exists>x. P x))"
  by smt+

lemma
  "\<exists>x y. x = y"
  "(\<exists>x. P x) \<or> R \<longleftrightarrow> (\<exists>x. P x \<or> R)"
  "\<exists>x. P x \<longrightarrow> P a \<and> P b"
  "(\<exists>x. Q \<longrightarrow> P x) \<longleftrightarrow> (Q \<longrightarrow> (\<exists>x. P x))"
  by smt+

lemma
  "(P False \<or> P True) \<or> \<not> P False"
  by smt

lemma
  "(\<not> (\<exists>x. P x)) \<longleftrightarrow> (\<forall>x. \<not> P x)"
  "(\<exists>x. P x \<longrightarrow> Q) \<longleftrightarrow> (\<forall>x. P x) \<longrightarrow> Q"
  "(\<forall>x y. R x y = x) \<longrightarrow> (\<exists>y. R x y) = R x c"
  "(if P x then \<not> (\<exists>y. P y) else (\<forall>y. \<not> P y)) \<longrightarrow> P x \<longrightarrow> P y"
  "(\<forall>x y. R x y = x) \<and> (\<forall>x. \<exists>y. R x y) = (\<forall>x. R x c) \<longrightarrow> (\<exists>y. R x y) = R x c"
  by smt+

lemma
  "\<forall>x. \<exists>y. f x y = f x (g x)"
  "(\<not> \<not> (\<exists>x. P x)) \<longleftrightarrow> (\<not> (\<forall>x. \<not> P x))"
  "\<forall>u. \<exists>v. \<forall>w. \<exists>x. f u v w x = f u (g u) w (h u w)"
  "\<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))"
  "\<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))"
  "(\<exists>x. \<forall>y. P x \<longleftrightarrow> P y) \<longrightarrow> ((\<exists>x. P x) \<longleftrightarrow> (\<forall>y. P y))"
  "(\<exists>y. \<forall>x. R x y) \<longrightarrow> (\<forall>x. \<exists>y. R x y)"
  by smt+

lemma
  "(\<exists>!x. P x) \<longrightarrow> (\<exists>x. P x)"
  "(\<exists>!x. P x) \<longleftrightarrow> (\<exists>x. P x \<and> (\<forall>y. y \<noteq> x \<longrightarrow> \<not> P y))"
  "P a \<longrightarrow> (\<forall>x. P x \<longrightarrow> x = a) \<longrightarrow> (\<exists>!x. P x)"
  "(\<exists>x. P x) \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> x = y) \<longrightarrow> (\<exists>!x. P x)"
  "(\<exists>!x. P x) \<and> (\<forall>x. P x \<and> (\<forall>y. P y \<longrightarrow> y = x) \<longrightarrow> R) \<longrightarrow> R"
  by smt+

lemma
  "(\<forall>x\<in>M. P x) \<and> c \<in> M \<longrightarrow> P c"
  "(\<exists>x\<in>M. P x) \<or> \<not> (P c \<and> c \<in> M)"
  by smt+

lemma
  "let P = True in P"
  "let P = P1 \<or> P2 in P \<or> \<not> P"
  "let P1 = True; P2 = False in P1 \<and> P2 \<longrightarrow> P2 \<or> P1"
  "(let x = y in x) = y"
  "(let x = y in Q x) \<longleftrightarrow> (let z = y in Q z)"
  "(let x = y1; z = y2 in R x z) \<longleftrightarrow> (let z = y2; x = y1 in R x z)"
  "(let x = y1; z = y2 in R x z) \<longleftrightarrow> (let z = y1; x = y2 in R z x)"
  "let P = (\<forall>x. Q x) in if P then P else \<not> P"
  by smt+

lemma
  "a \<noteq> b \<and> a \<noteq> c \<and> b \<noteq> c \<and> (\<forall>x y. f x = f y \<longrightarrow> y = x) \<longrightarrow> f a \<noteq> f b"
  by smt

lemma
  "(\<forall>x y z. f x y = f x z \<longrightarrow> y = z) \<and> b \<noteq> c \<longrightarrow> f a b \<noteq> f a c"
  "(\<forall>x y z. f x y = f z y \<longrightarrow> x = z) \<and> a \<noteq> d \<longrightarrow> f a b \<noteq> f d b"
  by smt+

section \<open>Guidance for quantifier heuristics: patterns\<close>

lemma
  assumes "\<forall>x.
    SMT.trigger (SMT.Symb_Cons (SMT.Symb_Cons (SMT.pat (f x)) SMT.Symb_Nil) SMT.Symb_Nil)
    (f x = x)"
  shows "f 1 = 1"
  using assms by smt

lemma
  assumes "\<forall>x y.
    SMT.trigger (SMT.Symb_Cons (SMT.Symb_Cons (SMT.pat (f x))
      (SMT.Symb_Cons (SMT.pat (g y)) SMT.Symb_Nil)) SMT.Symb_Nil) (f x = g y)"
  shows "f a = g b"
  using assms by smt

section \<open>Meta-logical connectives\<close>

lemma
  "True \<Longrightarrow> True"
  "False \<Longrightarrow> True"
  "False \<Longrightarrow> False"
  "P' x \<Longrightarrow> P' x"
  "P \<Longrightarrow> P \<or> Q"
  "Q \<Longrightarrow> P \<or> Q"
  "\<not> P \<Longrightarrow> P \<longrightarrow> Q"
  "Q \<Longrightarrow> P \<longrightarrow> Q"
  "\<lbrakk>P; \<not> Q\<rbrakk> \<Longrightarrow> \<not> (P \<longrightarrow> Q)"
  "P' x \<equiv> P' x"
  "P' x \<equiv> Q' x \<Longrightarrow> P' x = Q' x"
  "P' x = Q' x \<Longrightarrow> P' x \<equiv> Q' x"
  "x \<equiv> y \<Longrightarrow> y \<equiv> z \<Longrightarrow> x \<equiv> (z::'a::type)"
  "x \<equiv> y \<Longrightarrow> (f x :: 'b::type) \<equiv> f y"
  "(\<And>x. g x) \<Longrightarrow> g a \<or> a"
  "(\<And>x y. h x y \<and> h y x) \<Longrightarrow> \<forall>x. h x x"
  "(p \<or> q) \<and> \<not> p \<Longrightarrow> q"
  "(a \<and> b) \<or> (c \<and> d) \<Longrightarrow> (a \<and> b) \<or> (c \<and> d)"
  by smt+

section \<open>Natural numbers\<close>

declare [[smt_nat_as_int]]

lemma
  "(0::nat) = 0"
  "(1::nat) = 1"
  "(0::nat) < 1"
  "(0::nat) \<le> 1"
  "(123456789::nat) < 2345678901"
  by smt+

lemma
  "Suc 0 = 1"
  "Suc x = x + 1"
  "x < Suc x"
  "(Suc x = Suc y) = (x = y)"
  "Suc (x + y) < Suc x + Suc y"
  by smt+

lemma
  "(x::nat) + 0 = x"
  "0 + x = x"
  "x + y = y + x"
  "x + (y + z) = (x + y) + z"
  "(x + y = 0) = (x = 0 \<and> y = 0)"
  by smt+

lemma
  "(x::nat) - 0 = x"
  "x < y \<longrightarrow> x - y = 0"
  "x - y = 0 \<or> y - x = 0"
  "(x - y) + y = (if x < y then y else x)"
   "x - y - z = x - (y + z)"
  by smt+

lemma
  "(x::nat) * 0 = 0"
  "0 * x = 0"
  "x * 1 = x"
  "1 * x = x"
  "3 * x = x * 3"
  by smt+

lemma
  "min (x::nat) y \<le> x"
  "min x y \<le> y"
  "min x y \<le> x + y"
  "z < x \<and> z < y \<longrightarrow> z < min x y"
  "min x y = min y x"
  "min x 0 = 0"
  by smt+

lemma
  "max (x::nat) y \<ge> x"
  "max x y \<ge> y"
  "max x y \<ge> (x - y) + (y - x)"
  "z > x \<and> z > y \<longrightarrow> z > max x y"
  "max x y = max y x"
  "max x 0 = x"
  by smt+

lemma
  "0 \<le> (x::nat)"
  "0 < x \<and> x \<le> 1 \<longrightarrow> x = 1"
  "x \<le> x"
  "x \<le> y \<longrightarrow> 3 * x \<le> 3 * y"
  "x < y \<longrightarrow> 3 * x < 3 * y"
  "x < y \<longrightarrow> x \<le> y"
  "(x < y) = (x + 1 \<le> y)"
  "\<not> (x < x)"
  "x \<le> y \<longrightarrow> y \<le> z \<longrightarrow> x \<le> z"
  "x < y \<longrightarrow> y \<le> z \<longrightarrow> x \<le> z"
  "x \<le> y \<longrightarrow> y < z \<longrightarrow> x \<le> z"
  "x < y \<longrightarrow> y < z \<longrightarrow> x < z"
  "x < y \<and> y < z \<longrightarrow> \<not> (z < x)"
  by smt+

declare [[smt_nat_as_int = false]]

section \<open>Integers\<close>

lemma
  "(0::int) = 0"
  "(0::int) = (- 0)"
  "(1::int) = 1"
  "\<not> (-1 = (1::int))"
  "(0::int) < 1"
  "(0::int) \<le> 1"
  "-123 + 345 < (567::int)"
  "(123456789::int) < 2345678901"
  "(-123456789::int) < 2345678901"
  by smt+

lemma
  "(x::int) + 0 = x"
  "0 + x = x"
  "x + y = y + x"
  "x + (y + z) = (x + y) + z"
  "(x + y = 0) = (x = -y)"
  by smt+

lemma
  "(-1::int) = - 1"
  "(-3::int) = - 3"
  "-(x::int) < 0 \<longleftrightarrow> x > 0"
  "x > 0 \<longrightarrow> -x < 0"
  "x < 0 \<longrightarrow> -x > 0"
  by smt+

lemma
  "(x::int) - 0 = x"
  "0 - x = -x"
  "x < y \<longrightarrow> x - y < 0"
  "x - y = -(y - x)"
  "x - y = -y + x"
  "x - y - z = x - (y + z)"
  by smt+

lemma
  "(x::int) * 0 = 0"
  "0 * x = 0"
  "x * 1 = x"
  "1 * x = x"
  "x * -1 = -x"
  "-1 * x = -x"
  "3 * x = x * 3"
  by smt+

lemma
  "\<bar>x::int\<bar> \<ge> 0"
  "(\<bar>x\<bar> = 0) = (x = 0)"
  "(x \<ge> 0) = (\<bar>x\<bar> = x)"
  "(x \<le> 0) = (\<bar>x\<bar> = -x)"
  "\<bar>\<bar>x\<bar>\<bar> = \<bar>x\<bar>"
  by smt+

lemma
  "min (x::int) y \<le> x"
  "min x y \<le> y"
  "z < x \<and> z < y \<longrightarrow> z < min x y"
  "min x y = min y x"
  "x \<ge> 0 \<longrightarrow> min x 0 = 0"
  "min x y \<le> \<bar>x + y\<bar>"
  by smt+

lemma
  "max (x::int) y \<ge> x"
  "max x y \<ge> y"
  "z > x \<and> z > y \<longrightarrow> z > max x y"
  "max x y = max y x"
  "x \<ge> 0 \<longrightarrow> max x 0 = x"
  "max x y \<ge> - \<bar>x\<bar> - \<bar>y\<bar>"
  by smt+

lemma
  "0 < (x::int) \<and> x \<le> 1 \<longrightarrow> x = 1"
  "x \<le> x"
  "x \<le> y \<longrightarrow> 3 * x \<le> 3 * y"
  "x < y \<longrightarrow> 3 * x < 3 * y"
  "x < y \<longrightarrow> x \<le> y"
  "(x < y) = (x + 1 \<le> y)"
  "\<not> (x < x)"
  "x \<le> y \<longrightarrow> y \<le> z \<longrightarrow> x \<le> z"
  "x < y \<longrightarrow> y \<le> z \<longrightarrow> x \<le> z"
  "x \<le> y \<longrightarrow> y < z \<longrightarrow> x \<le> z"
  "x < y \<longrightarrow> y < z \<longrightarrow> x < z"
  "x < y \<and> y < z \<longrightarrow> \<not> (z < x)"
  by smt+

section \<open>Reals\<close>

lemma
  "(0::real) = 0"
  "(0::real) = -0"
  "(0::real) = (- 0)"
  "(1::real) = 1"
  "\<not> (-1 = (1::real))"
  "(0::real) < 1"
  "(0::real) \<le> 1"
  "-123 + 345 < (567::real)"
  "(123456789::real) < 2345678901"
  "(-123456789::real) < 2345678901"
  by smt+

lemma
  "(x::real) + 0 = x"
  "0 + x = x"
  "x + y = y + x"
  "x + (y + z) = (x + y) + z"
  "(x + y = 0) = (x = -y)"
  by smt+

lemma
  "(-1::real) = - 1"
  "(-3::real) = - 3"
  "-(x::real) < 0 \<longleftrightarrow> x > 0"
  "x > 0 \<longrightarrow> -x < 0"
  "x < 0 \<longrightarrow> -x > 0"
  by smt+

lemma
  "(x::real) - 0 = x"
  "0 - x = -x"
  "x < y \<longrightarrow> x - y < 0"
  "x - y = -(y - x)"
  "x - y = -y + x"
  "x - y - z = x - (y + z)"
  by smt+

lemma
  "(x::real) * 0 = 0"
  "0 * x = 0"
  "x * 1 = x"
  "1 * x = x"
  "x * -1 = -x"
  "-1 * x = -x"
  "3 * x = x * 3"
  by smt+

lemma
  "\<bar>x::real\<bar> \<ge> 0"
  "(\<bar>x\<bar> = 0) = (x = 0)"
  "(x \<ge> 0) = (\<bar>x\<bar> = x)"
  "(x \<le> 0) = (\<bar>x\<bar> = -x)"
  "\<bar>\<bar>x\<bar>\<bar> = \<bar>x\<bar>"
  by smt+

lemma
  "min (x::real) y \<le> x"
  "min x y \<le> y"
  "z < x \<and> z < y \<longrightarrow> z < min x y"
  "min x y = min y x"
  "x \<ge> 0 \<longrightarrow> min x 0 = 0"
  "min x y \<le> \<bar>x + y\<bar>"
  by smt+

lemma
  "max (x::real) y \<ge> x"
  "max x y \<ge> y"
  "z > x \<and> z > y \<longrightarrow> z > max x y"
  "max x y = max y x"
  "x \<ge> 0 \<longrightarrow> max x 0 = x"
  "max x y \<ge> - \<bar>x\<bar> - \<bar>y\<bar>"
  by smt+

lemma
  "x \<le> (x::real)"
  "x \<le> y \<longrightarrow> 3 * x \<le> 3 * y"
  "x < y \<longrightarrow> 3 * x < 3 * y"
  "x < y \<longrightarrow> x \<le> y"
  "\<not> (x < x)"
  "x \<le> y \<longrightarrow> y \<le> z \<longrightarrow> x \<le> z"
  "x < y \<longrightarrow> y \<le> z \<longrightarrow> x \<le> z"
  "x \<le> y \<longrightarrow> y < z \<longrightarrow> x \<le> z"
  "x < y \<longrightarrow> y < z \<longrightarrow> x < z"
  "x < y \<and> y < z \<longrightarrow> \<not> (z < x)"
  by smt+

section \<open>Datatypes, records, and typedefs\<close>

subsection \<open>Without support by the SMT solver\<close>

subsubsection \<open>Algebraic datatypes\<close>

lemma
  "x = fst (x, y)"
  "y = snd (x, y)"
  "((x, y) = (y, x)) = (x = y)"
  "((x, y) = (u, v)) = (x = u \<and> y = v)"
  "(fst (x, y, z) = fst (u, v, w)) = (x = u)"
  "(snd (x, y, z) = snd (u, v, w)) = (y = v \<and> z = w)"
  "(fst (snd (x, y, z)) = fst (snd (u, v, w))) = (y = v)"
  "(snd (snd (x, y, z)) = snd (snd (u, v, w))) = (z = w)"
  "(fst (x, y) = snd (x, y)) = (x = y)"
  "p1 = (x, y) \<and> p2 = (y, x) \<longrightarrow> fst p1 = snd p2"
  "(fst (x, y) = snd (x, y)) = (x = y)"
  "(fst p = snd p) = (p = (snd p, fst p))"
  using fst_conv snd_conv prod.collapse
  by smt+

lemma
  "[x] \<noteq> Nil"
  "[x, y] \<noteq> Nil"
  "x \<noteq> y \<longrightarrow> [x] \<noteq> [y]"
  "hd (x # xs) = x"
  "tl (x # xs) = xs"
  "hd [x, y, z] = x"
  "tl [x, y, z] = [y, z]"
  "hd (tl [x, y, z]) = y"
  "tl (tl [x, y, z]) = [z]"
  using list.sel(1,3) list.simps
  by smt+

lemma
  "fst (hd [(a, b)]) = a"
  "snd (hd [(a, b)]) = b"
  using fst_conv snd_conv prod.collapse list.sel(1,3) list.simps
  by smt+

subsubsection \<open>Records\<close>

record point =
  cx :: int
  cy :: int

record bw_point = point +
  black :: bool

lemma
  "\<lparr>cx = x, cy = y\<rparr> = \<lparr>cx = x', cy = y'\<rparr> \<Longrightarrow> x = x' \<and> y = y'"
  using point.simps
  by smt

lemma
  "cx \<lparr> cx = 3, cy = 4 \<rparr> = 3"
  "cy \<lparr> cx = 3, cy = 4 \<rparr> = 4"
  "cx \<lparr> cx = 3, cy = 4 \<rparr> \<noteq> cy \<lparr> cx = 3, cy = 4 \<rparr>"
  "\<lparr> cx = 3, cy = 4 \<rparr> \<lparr> cx := 5 \<rparr> = \<lparr> cx = 5, cy = 4 \<rparr>"
  "\<lparr> cx = 3, cy = 4 \<rparr> \<lparr> cy := 6 \<rparr> = \<lparr> cx = 3, cy = 6 \<rparr>"
  "p = \<lparr> cx = 3, cy = 4 \<rparr> \<longrightarrow> p \<lparr> cx := 3 \<rparr> \<lparr> cy := 4 \<rparr> = p"
  "p = \<lparr> cx = 3, cy = 4 \<rparr> \<longrightarrow> p \<lparr> cy := 4 \<rparr> \<lparr> cx := 3 \<rparr> = p"
  using point.simps
  by smt+

lemma
  "\<lparr>cx = x, cy = y, black = b\<rparr> = \<lparr>cx = x', cy = y', black = b'\<rparr> \<Longrightarrow> x = x' \<and> y = y' \<and> b = b'"
  using point.simps bw_point.simps
  by smt

lemma
  "cx \<lparr> cx = 3, cy = 4, black = b \<rparr> = 3"
  "cy \<lparr> cx = 3, cy = 4, black = b \<rparr> = 4"
  "black \<lparr> cx = 3, cy = 4, black = b \<rparr> = b"
  "cx \<lparr> cx = 3, cy = 4, black = b \<rparr> \<noteq> cy \<lparr> cx = 3, cy = 4, black = b \<rparr>"
  "\<lparr> cx = 3, cy = 4, black = b \<rparr> \<lparr> cx := 5 \<rparr> = \<lparr> cx = 5, cy = 4, black = b \<rparr>"
  "\<lparr> cx = 3, cy = 4, black = b \<rparr> \<lparr> cy := 6 \<rparr> = \<lparr> cx = 3, cy = 6, black = b \<rparr>"
  "p = \<lparr> cx = 3, cy = 4, black = True \<rparr> \<longrightarrow>
     p \<lparr> cx := 3 \<rparr> \<lparr> cy := 4 \<rparr> \<lparr> black := True \<rparr> = p"
  "p = \<lparr> cx = 3, cy = 4, black = True \<rparr> \<longrightarrow>
     p \<lparr> cy := 4 \<rparr> \<lparr> black := True \<rparr> \<lparr> cx := 3 \<rparr> = p"
  "p = \<lparr> cx = 3, cy = 4, black = True \<rparr> \<longrightarrow>
     p \<lparr> black := True \<rparr> \<lparr> cx := 3 \<rparr> \<lparr> cy := 4 \<rparr> = p"
  using point.simps bw_point.simps
  by smt+

lemma
  "\<lparr> cx = 3, cy = 4, black = b \<rparr> \<lparr> black := w \<rparr> = \<lparr> cx = 3, cy = 4, black = w \<rparr>"
  "\<lparr> cx = 3, cy = 4, black = True \<rparr> \<lparr> black := False \<rparr> =
     \<lparr> cx = 3, cy = 4, black = False \<rparr>"
  "p \<lparr> cx := 3 \<rparr> \<lparr> cy := 4 \<rparr> \<lparr> black := True \<rparr> =
     p \<lparr> black := True \<rparr> \<lparr> cy := 4 \<rparr> \<lparr> cx := 3 \<rparr>"
    apply (smt add_One add_inc bw_point.update_convs(1) default_unit_def inc.simps(2) one_plus_BitM
      semiring_norm(6,26))
   apply (smt bw_point.update_convs(1))
  apply (smt bw_point.cases_scheme bw_point.update_convs(1) point.update_convs(1,2))
  done

subsubsection \<open>Type definitions\<close>

typedef int' = "UNIV::int set" by (rule UNIV_witness)

definition n0 where "n0 = Abs_int' 0"
definition n1 where "n1 = Abs_int' 1"
definition n2 where "n2 = Abs_int' 2"
definition plus' where "plus' n m = Abs_int' (Rep_int' n + Rep_int' m)"

lemma
  "n0 \<noteq> n1"
  "plus' n1 n1 = n2"
  "plus' n0 n2 = n2"
  by (smt n0_def n1_def n2_def plus'_def Abs_int'_inverse Rep_int'_inverse UNIV_I)+

subsection \<open>With support by the SMT solver (but without proofs)\<close>

subsubsection \<open>Algebraic datatypes\<close>

lemma
  "x = fst (x, y)"
  "y = snd (x, y)"
  "((x, y) = (y, x)) = (x = y)"
  "((x, y) = (u, v)) = (x = u \<and> y = v)"
  "(fst (x, y, z) = fst (u, v, w)) = (x = u)"
  "(snd (x, y, z) = snd (u, v, w)) = (y = v \<and> z = w)"
  "(fst (snd (x, y, z)) = fst (snd (u, v, w))) = (y = v)"
  "(snd (snd (x, y, z)) = snd (snd (u, v, w))) = (z = w)"
  "(fst (x, y) = snd (x, y)) = (x = y)"
  "p1 = (x, y) \<and> p2 = (y, x) \<longrightarrow> fst p1 = snd p2"
  "(fst (x, y) = snd (x, y)) = (x = y)"
  "(fst p = snd p) = (p = (snd p, fst p))"
  using fst_conv snd_conv prod.collapse
  by smt+

lemma
  "x \<noteq> y \<longrightarrow> [x] \<noteq> [y]"
  "hd (x # xs) = x"
  "tl (x # xs) = xs"
  "hd [x, y, z] = x"
  "tl [x, y, z] = [y, z]"
  "hd (tl [x, y, z]) = y"
  "tl (tl [x, y, z]) = [z]"
  using list.sel(1,3)
  by smt+

lemma
  "fst (hd [(a, b)]) = a"
  "snd (hd [(a, b)]) = b"
  using fst_conv snd_conv prod.collapse list.sel(1,3)
  by smt+

subsubsection \<open>Records\<close>
text \<open>The equivalent theory for Z3 contains more example, but unlike Z3, we are able
to reconstruct the proofs.\<close>

lemma
  "cx \<lparr> cx = 3, cy = 4 \<rparr> = 3"
  "cy \<lparr> cx = 3, cy = 4 \<rparr> = 4"
  "cx \<lparr> cx = 3, cy = 4 \<rparr> \<noteq> cy \<lparr> cx = 3, cy = 4 \<rparr>"
  "\<lparr> cx = 3, cy = 4 \<rparr> \<lparr> cx := 5 \<rparr> = \<lparr> cx = 5, cy = 4 \<rparr>"
  "\<lparr> cx = 3, cy = 4 \<rparr> \<lparr> cy := 6 \<rparr> = \<lparr> cx = 3, cy = 6 \<rparr>"
  "p = \<lparr> cx = 3, cy = 4 \<rparr> \<longrightarrow> p \<lparr> cx := 3 \<rparr> \<lparr> cy := 4 \<rparr> = p"
  "p = \<lparr> cx = 3, cy = 4 \<rparr> \<longrightarrow> p \<lparr> cy := 4 \<rparr> \<lparr> cx := 3 \<rparr> = p"
  using point.simps
  by smt+

lemma
  "cx \<lparr> cx = 3, cy = 4, black = b \<rparr> = 3"
  "cy \<lparr> cx = 3, cy = 4, black = b \<rparr> = 4"
  "black \<lparr> cx = 3, cy = 4, black = b \<rparr> = b"
  "cx \<lparr> cx = 3, cy = 4, black = b \<rparr> \<noteq> cy \<lparr> cx = 3, cy = 4, black = b \<rparr>"
  "\<lparr> cx = 3, cy = 4, black = b \<rparr> \<lparr> cx := 5 \<rparr> = \<lparr> cx = 5, cy = 4, black = b \<rparr>"
  "\<lparr> cx = 3, cy = 4, black = b \<rparr> \<lparr> cy := 6 \<rparr> = \<lparr> cx = 3, cy = 6, black = b \<rparr>"
  "p = \<lparr> cx = 3, cy = 4, black = True \<rparr> \<longrightarrow>
     p \<lparr> cx := 3 \<rparr> \<lparr> cy := 4 \<rparr> \<lparr> black := True \<rparr> = p"
  "p = \<lparr> cx = 3, cy = 4, black = True \<rparr> \<longrightarrow>
     p \<lparr> cy := 4 \<rparr> \<lparr> black := True \<rparr> \<lparr> cx := 3 \<rparr> = p"
  "p = \<lparr> cx = 3, cy = 4, black = True \<rparr> \<longrightarrow>
     p \<lparr> black := True \<rparr> \<lparr> cx := 3 \<rparr> \<lparr> cy := 4 \<rparr> = p"
  using point.simps bw_point.simps
  by smt+

section \<open>Functions\<close>

lemma "\<exists>f. map_option f (Some x) = Some (y + x)"
  by (smt option.map(2))

lemma
  "(f (i := v)) i = v"
  "i1 \<noteq> i2 \<longrightarrow> (f (i1 := v)) i2 = f i2"
  "i1 \<noteq> i2 \<longrightarrow> (f (i1 := v1, i2 := v2)) i1 = v1"
  "i1 \<noteq> i2 \<longrightarrow> (f (i1 := v1, i2 := v2)) i2 = v2"
  "i1 = i2 \<longrightarrow> (f (i1 := v1, i2 := v2)) i1 = v2"
  "i1 = i2 \<longrightarrow> (f (i1 := v1, i2 := v2)) i1 = v2"
  "i1 \<noteq> i2 \<and>i1 \<noteq> i3 \<and>  i2 \<noteq> i3 \<longrightarrow> (f (i1 := v1, i2 := v2)) i3 = f i3"
  using fun_upd_same fun_upd_apply
  by smt+

section \<open>Sets\<close>

lemma Empty: "x \<notin> {}" by simp

lemmas smt_sets = Empty UNIV_I Un_iff Int_iff

lemma
  "x \<notin> {}"
  "x \<in> UNIV"
  "x \<in> A \<union> B \<longleftrightarrow> x \<in> A \<or> x \<in> B"
  "x \<in> P \<union> {} \<longleftrightarrow> x \<in> P"
  "x \<in> P \<union> UNIV"
  "x \<in> P \<union> Q \<longleftrightarrow> x \<in> Q \<union> P"
  "x \<in> P \<union> P \<longleftrightarrow> x \<in> P"
  "x \<in> P \<union> (Q \<union> R) \<longleftrightarrow> x \<in> (P \<union> Q) \<union> R"
  "x \<in> A \<inter> B \<longleftrightarrow> x \<in> A \<and> x \<in> B"
  "x \<notin> P \<inter> {}"
  "x \<in> P \<inter> UNIV \<longleftrightarrow> x \<in> P"
  "x \<in> P \<inter> Q \<longleftrightarrow> x \<in> Q \<inter> P"
  "x \<in> P \<inter> P \<longleftrightarrow> x \<in> P"
  "x \<in> P \<inter> (Q \<inter> R) \<longleftrightarrow> x \<in> (P \<inter> Q) \<inter> R"
  "{x. x \<in> P} = {y. y \<in> P}"
  by (smt smt_sets)+

context
  fixes in_multiset :: "'d \<Rightarrow> 'd_multiset \<Rightarrow> bool" and
    add_mset :: "'d \<Rightarrow> 'd_multiset \<Rightarrow> 'd_multiset" and
    set_mset :: "'d_multiset \<Rightarrow> 'd set"
begin
lemma
  assumes "\<And>a b A. ((a::'d) \<in> insert b A) = (a = b \<or> a \<in> A)"
    "\<And>a A. set_mset (add_mset (a::'d) A) = insert a (set_mset A)"
    "\<And>r. transp (r::'d \<Rightarrow> 'd \<Rightarrow> bool) = (\<forall>x y z. r x y \<longrightarrow> r y z \<longrightarrow> r x z)"
  shows
    "transp (\<lambda>x y. (x::'d) \<in> set_mset (add_mset m M) \<and> y \<in> set_mset (add_mset m M) \<and> R x y) \<Longrightarrow>
     transp (\<lambda>x y. x \<in> set_mset M \<and> y \<in> set_mset M \<and> R x y)"
   by (smt (verit) assms)
end

end