section \<open>Demo Theory of Session 12\<close>

theory LiveDemo12
  imports 
    Main
    "HOL-Library.Code_Target_Numeral"
begin

subsection \<open>Document Generation\<close>

text \<open>
This theory (importing @{theory Main}) has two purposes:

  \<^enum> it constitutes, together with the corresponding @{file ROOT} file,
    an example of an Isabelle session, and

  \<^enum> illustrates the usage of document \<open>antiquotations\<close>

In order to produce a PDF run

  @{verbatim "isabelle build -v -D ."}

in the session directory @{dir "."}.

With plain text like this `@{text "Cons x xs"}' we can typeset arbitrary 
terms in Isabelle inner syntax.  
If you want to have Isar keywords treated in a special way use
@{verbatim \<open>@{theory_text "..."}\<close>} instead. Consider, for example:

\begin{center}
  @{theory_text "datatype term but also other words"}
\end{center}

\<close>

subsection \<open>Document Antiquotations\<close>

text \<open>
With \<^emph>\<open>document antiquotations\<close> we can achieve many things. We can typeset:

  \<^item> terms (like @{term "[1,2,3,4]::nat list"})
  \<^item> constants (like @{const Cons})
  \<^item> types (like @{typeof "Cons"} and @{typ "nat set"})
  \<^item> type constructors (like @{type "list"})
  \<^item> theorems (like @{thm HOL.refl} and @{lemma "1 = 1" by (rule refl)})
  \<^item> ...
  \<^item> There are several more antiquotations than those which are 
    described here or in the slides. 
    See a list via @{command print_antiquotations}.

There are usually two version to type antiquotation, e.g., 
obviously \<^term>\<open>(True, x)\<close> and @{term "(True, x)"} are identical.
\<close>


lemma app_assoc: "xs @ (ys @ zs) = (xs @ ys) @ zs" 
  by simp
 
text \<open>
We just proved associativity of @{const append} in @{command lemma} @{thm [source] app_assoc}.
The exact statement of this property is: @{thm app_assoc}.

By the way, did you know that the Isabelle knows the factorial function?
The value of @{term "fact 5 :: int"} is @{value "fact 5 :: int"}.\<close>



subsection \<open>Type Classes\<close>

text \<open>
See also @{doc classes}.
\<close>

subsubsection \<open>Transforming Arbitrary Values to Strings\<close>

class Show =
  fixes 
    "show" :: "'a \<Rightarrow> string"

declare [[show_sorts]]
term "show"
declare [[show_sorts=false]]
term "show" 

text \<open>
Characters are an instance of the @{class Show} class, that is,
they can be transformed into @{typ string}s
\<close>
instantiation char :: Show
begin

definition show_char :: "char \<Rightarrow> string"
  where
    "show_char c = [c]"

instance
  apply (intro_classes)
  done

end

value "show (CHR ''a'')" 

text \<open>
Pairs are an instance of the @{class Show} class.
\<close>
instantiation prod :: (Show, Show) Show
begin

fun show_prod :: "('a \<times> 'b) \<Rightarrow> string"
  where
    "show_prod (x, y) = show (CHR ''('') @ show x @ [CHR '',''] @ show y @ [CHR '')'']"

instance ..

end

value "show ((CHR ''c'', CHR ''d''), CHR ''d'')"

text \<open>
Lists are an instance of @{class Show}.
\<close>
instantiation list :: (Show) Show
begin

fun show_list :: "'a list \<Rightarrow> string"
  where
    "show_list Nil = []"
  | "show_list (x#xs) = show x @ show_list xs"

instance ..

end

value "show ''foo bar?''"


subsubsection \<open>Total Orders\<close>

class partial_order =
  fixes LEQ :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<^bold>\<le>" 50)
  assumes refl: "x \<^bold>\<le> x"
    and antisym: "x \<^bold>\<le> y \<Longrightarrow> y \<^bold>\<le> x \<Longrightarrow> x = y"
    and trans: "x \<^bold>\<le> y \<Longrightarrow> y \<^bold>\<le> z \<Longrightarrow> x \<^bold>\<le> z"
begin

definition LT :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<^bold><" 50)
  where
    "x \<^bold>< y \<longleftrightarrow> x \<^bold>\<le> y \<and> x \<noteq> y"

end

thm antisym

class total_order = partial_order +
  assumes total: "x \<^bold>< y \<or> y \<^bold>< x \<or> x = y"
begin

(* we can reason abstractly within the class *)
lemma not_eq_imp_lt: "x \<noteq> y \<Longrightarrow> x \<^bold>< y \<or> y \<^bold>< x " 
  using total[of x y] by auto

end

(* or outside the class *)
lemma less_lt_trans: fixes x y z :: "'a :: total_order"
  shows "x \<^bold>\<le> y \<Longrightarrow> y \<^bold>< z \<Longrightarrow> x \<^bold>< z"
  by (metis LT_def partial_order_class.antisym partial_order_class.trans)



instantiation nat :: partial_order
begin

fun LEQ_nat :: "nat \<Rightarrow> nat \<Rightarrow> bool"
  where
    "0 \<^bold>\<le> (y::nat) \<longleftrightarrow> True"
  | "Suc x \<^bold>\<le> Suc y \<longleftrightarrow> x \<^bold>\<le> y"
  | "x \<^bold>\<le> (y::nat) \<longleftrightarrow> False"

lemma LEQ_nat_def:
  fixes x y :: nat
  shows "x \<^bold>\<le> y \<longleftrightarrow> (\<exists>n. y = x + n)"
  by (induction x y rule: LEQ_nat.induct) auto

instance
proof (intro_classes, goal_cases)
  case (1 x)
  show "x \<^bold>\<le> x" by (auto simp: LEQ_nat_def)
qed (auto simp: LEQ_nat_def)

end

lemma LEQ_nat_total:
  fixes x y :: nat
  shows "x \<^bold>\<le> y \<or> y \<^bold>\<le> x"
proof (induction x arbitrary: y)
  case (Suc x y)
  then show ?case
    by (cases y) auto
qed simp

instance nat :: total_order
proof
  fix x y :: nat
  show "x \<^bold>< y \<or> y \<^bold>< x \<or> x = y"
    using LEQ_nat_total [of x y]
    unfolding LT_def by blast
qed

subsubsection \<open>Locales\<close>
locale vector_space = 
  fixes scale :: "'a :: field \<Rightarrow> 'v :: ab_group_add \<Rightarrow> 'v" 
  assumes scale_scale: "scale x (scale y v) = scale (x * y) v" 
  and scale_one: "scale 1 v = v"
  and scale_add_right: "scale x (v + w) = scale x v + scale x w" 
  and scale_add_left: "scale (x + y) v = scale x v + scale y v" 

context vector_space
begin
(* reason about abstract vector-spaces *)
lemma scale_0[simp]: "scale 0 v = 0"
  by (metis add.right_neutral add_left_cancel scale_add_left)

(* add definitions for arbitrary vector-space *)
fun linear_combination :: "('a \<times> 'v)list \<Rightarrow> 'v" where
  "linear_combination [] = 0" 
| "linear_combination ((x,v) # list) = scale x v + linear_combination list" 

lemma lincomb_0: "(\<And> x v. (x,v) \<in> set list \<Longrightarrow> x = 0) \<Longrightarrow> linear_combination list = 0" 
  by (induct list; force)
end

interpretation field_vs: vector_space "(*)" (* choose 'v = 'a *)  
  apply (unfold_locales)
     apply (auto simp: field_simps)
  done

(* we could define arbitrary further instances of vector_spaces *)

thm field_vs.scale_0
term field_vs.linear_combination
thm field_vs.lincomb_0

thm vector_space.scale_0
term vector_space.linear_combination
thm vector_space.lincomb_0

  

end