theory Demo07
  imports 
    Main
begin

section \<open>Inductive Definitions\<close>

subsection \<open>Early examples\<close>

definition injective :: "('a \<Rightarrow> 'b) \<Rightarrow> bool" where 
  "injective f \<longleftrightarrow> (\<forall>x y. f x = f y \<longrightarrow> x = y)"

lemma injectiveI[intro]: "(\<And> x y. f x = f y \<Longrightarrow> x = y) \<Longrightarrow> injective f" 
  unfolding injective_def by auto

lemma injectiveD[dest]: "injective f \<Longrightarrow> f x = f y \<Longrightarrow> x = y"
  unfolding injective_def by auto

text \<open>We might hide the internal definition of @{const injective} at this point.

  Advantage: add abstraction-layer (use @{thm injectiveI} and @{thm injectiveD} to reason
    about injectivity, but not internal definition.)\<close>
hide_fact injective_def

thm injective_def (* no longer available *)

text \<open>Example of Function-Definition via Non-Recursive-Definitions\<close>

fun len1 :: "'a list \<Rightarrow> nat" where
  "len1 [] = 0"
| "len1 (x # xs) = Suc (len1 xs)" 

thm len1_def (* does not exists, i.e., hidden from user *)

text \<open>Tell Isabelle to make internal definitions visible to the user.\<close>
declare [[function_internals = true, inductive_internals = true]]

fun len2 :: "'a list \<Rightarrow> nat" where
  "len2 [] = 0"
| "len2 (x # xs) = Suc (len2 xs)" 

text \<open>The recursive definition of @{const len2} is internally modeled via three non-recursive definitions.\<close>
thm len2_def
thm len2_sumC_def
thm len2_graph_def

declare [[function_internals = false, inductive_internals = false]]


subsection \<open>Examples of Inductive Definitions\<close>

type_synonym var = string
type_synonym val = nat
type_synonym state = "var \<Rightarrow> val" 

datatype prog = 
  Skip
  | Update "state \<Rightarrow> state" 
  | Sequence prog prog
  | While "state \<Rightarrow> bool" prog

text \<open>Attempt 1: model as function\<close>

function eval_1 :: "prog \<Rightarrow> state \<Rightarrow> state" where
  "eval_1 Skip s = s" 
| "eval_1 (Update f) s = f s" 
| "eval_1 (Sequence p q) s = (eval_1 q (eval_1 p s))" 
| "eval_1 (While c p) s = (if c s then eval_1 (While c p) (eval_1 p s) else s)" 
  by pat_completeness auto

termination oops (* does not terminate *)

text \<open>Attempt 2: model via auxiliary fuel-argument, here: number of allowed loop-iterations\<close>

fun eval_2_b :: "nat \<Rightarrow> prog \<Rightarrow> state \<Rightarrow> state option" where
  "eval_2_b n Skip s = Some s" 
| "eval_2_b n (Update f) s = Some (f s)" 
| "eval_2_b n (Sequence p q) s = (Option.bind (eval_2_b n p s) (eval_2_b n q))" 
| "eval_2_b n (While c p) s = (if c s then 
    if n = 0 then None \<comment> \<open>out of iterations\<close>
      else Option.bind (eval_2_b n p s) (eval_2_b (n - 1) (While c p))
    else Some s)" 

definition eval_2 :: "prog \<Rightarrow> state \<Rightarrow> state option" where
  "eval_2 p s = (if \<exists> n. eval_2_b n p s \<noteq> None 
    then eval_2_b (SOME n. eval_2_b n p s \<noteq> None) p s 
    else None)" 

text \<open>Natural modeling via inductive predicate\<close>

inductive eval :: "prog \<Rightarrow> state \<Rightarrow> state \<Rightarrow> bool" where
  skip: "eval Skip s s" 
| update: "eval (Update f) s (f s)" 
| sequence: "eval p s t \<Longrightarrow> eval q t u \<Longrightarrow> eval (Sequence p q) s u" 
| while_false: "\<not> c s \<Longrightarrow> eval (While c p) s s" 
| while_true: "c s \<Longrightarrow> eval p s t \<Longrightarrow> eval (While c p) t u \<Longrightarrow> eval (While c p) s u" 



inductive is_odd :: "nat \<Rightarrow> bool"
  where
    "is_odd 1"
  | "is_odd n \<Longrightarrow> is_odd (n + 2)"
print_theorems


section \<open>Rule Inversion and Rule Induction\<close>

text \<open>Rule Inversion\<close>

lemma is_odd0:
  "is_odd 0 = False"
proof -
  {
    assume "is_odd 0"
    hence False by cases auto
    text \<open>since @{thm \<open>is_odd 0\<close>} is first assumed fact, 
      rule inversion using @{thm is_odd.cases} is done implicitly by @{method cases}\<close>

    text \<open>same proof where cases are listed explicitly\<close>
    from \<open>is_odd 0\<close> have False
    proof cases
      case 1
      then show ?thesis by auto
    next
      case (2 n)
      then show ?thesis by auto
    qed
  }
  have "is_odd 0 \<Longrightarrow> False" 
    by (cases rule: is_odd.cases) auto
  text \<open>here @{term \<open>is_odd 0\<close>} is not explicitly assumed, so @{method cases} must be parametrized
    by correct rule inversion rule, i.e., @{thm is_odd.cases}\<close>

  then show ?thesis by auto
qed


text \<open>Rule Induction\<close>


text \<open>similar observation as in rule inversion:
   one has to provide induction rule, but not if predicate is assumed first\<close>
lemma is_odd_odd1: "is_odd x \<Longrightarrow> odd x"
  by (induction rule: is_odd.induct) auto

lemma is_odd_odd2: "is_odd x \<Longrightarrow> odd x"
proof -
  assume "is_odd x" 
  thus "odd x" by induction auto
qed

text \<open>A version which uses new Isar-elements: \<open>assumes\<close> and \<open>shows\<close> and \<open>assms\<close>\<close>
lemma is_odd_odd3: assumes "is_odd x" 
  shows "odd x" 
  using assms by induction auto


inductive_set star :: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set" for R
  where
    refl [simp]: "(x, x) \<in> star R"
  | step: "(x, y) \<in> R \<Longrightarrow> (y, z) \<in> star R \<Longrightarrow> (x, z) \<in> star R"
print_theorems (* implicitly also the predicate starp is created, and you have access to that *)

lemma star_trans1: assumes xy: "(x, y) \<in> star R" and 
  yz: "(y, z) \<in> star R"
shows "(x, z) \<in> star R"
  using xy yz
proof induction
  case (step x y' y)
  from step.hyps (* the hypothesis, i.e., preconditions in inference rule step *)
  have "(x, y') \<in> R" "(y', y) \<in> star R" .
  from step.prems (* premises in the goal statement; here the fact yz *) 
  have "(y,z) \<in> star R" .
  from step.IH (* the induction hypotheses *)
  have "(y, z) \<in> star R \<Longrightarrow> (y', z) \<in> star R" .
  from this[OF \<open>(y, z) \<in> star R\<close>] have "(y', z) \<in> star R" by auto
  from star.step[OF \<open>(x, y') \<in> R\<close> this]
  show ?case .
next
  case (refl x)
  from refl.prems
  show ?case .
qed 

lemma star_trans2: "(x, y) \<in> star R \<Longrightarrow> (y, z) \<in> star R \<Longrightarrow> (x, z) \<in> star R"
  by (induction x y rule: star.induct, auto intro: star.step)


section \<open>Sets in Isabelle\<close>

term "(\<in>)" (* membership *)
term "(\<subseteq>)" (* subset *)
term "(\<subset>)" (* strict subset *)
term Ball  (* all elements satisfy predicate *)
term Bex   (* at least one element satisfies predicate *)
term "(\<union>)" (* union *)
term "(\<inter>)" (* intersection *)
term "\<Union>"   (* big-union *)
term "\<Inter>"   (* big-intersection *)
term "- (A :: 'a set)" (* complement *)
term "A - (B :: 'a set)" (* difference *)
term "{}"   (* empty set *)
term "UNIV :: 'a set" (* all elements (of a specific type) *)
term "{x}"  (* singleton *)
term insert (* add single element *)
term finite (* is set finite? *)
term card   (* cardinality (0 for infinite sets *)
term "(`)"  (* image, apply function to all set elements *)
term Collect (* convert predicate to set *)
term "{x . P x}"  (* basic set comprehension *)
term "{ (x,y + z) | x y z u . x - y = u \<and> u \<le> 5 \<and> P z}"  (* more complex set comprehension *)
term "sum f A" (* sum_{a in A} f(a) *)
term "prod"    (* product, similar to sum *)


lemma "A \<inter> (B \<union> C) \<subseteq> (A \<inter> B) \<union> (A \<inter> C)" by auto

lemma "A \<inter> (B \<union> C) \<subseteq> (A \<inter> B) \<union> (A \<inter> C)" 
proof 
  fix x
  assume "x \<in> A \<inter> (B \<union> C)" 
  hence xA: "x \<in> A" and choice: "x \<in> B \<or> x \<in> C" by auto
  from choice show "x \<in> (A \<inter> B) \<union> (A \<inter> C)" 
  proof
    assume "x \<in> B" 
    from xA this have "x \<in> A \<inter> B" ..
    thus ?thesis ..
  qed (insert xA, auto) (* other case similar *)
qed


section \<open>Binary Search Trees\<close>

datatype 'a tree = Leaf | Node "'a tree" 'a "'a tree" 

fun set_t :: "'a tree \<Rightarrow> 'a set" where
  "set_t Leaf = {}" 
| "set_t (Node l x r) = set_t l \<union> {x} \<union> set_t r" 

inductive ordered :: "'a :: linorder tree \<Rightarrow> bool" where
  oLeaf: "ordered Leaf" 
| oNode: "ordered l \<Longrightarrow> ordered r 
  \<Longrightarrow> Ball (set_t l) (\<lambda> y. y < x)
  \<Longrightarrow> Ball (set_t r) (\<lambda> y. y > x)
  \<Longrightarrow> ordered (Node l x r)" 

fun member:: "'a :: linorder \<Rightarrow> 'a tree \<Rightarrow> bool" where
  "member x Leaf = False" 
| "member y (Node l x r) = (if x = y then True else if y < x then member y l else member y r)" 

lemma member_correct: "ordered t \<Longrightarrow> member x t = (x \<in> set_t t)" 
  by (induction rule: ordered.induct, auto)

  
end