theory LiveDemo08
  imports 
    Main
begin

section \<open>Sets and Lists 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 "(-`)" (* inverse image, detected via: *) find_consts "(?'a \<Rightarrow> ?'b) \<Rightarrow> ?'b set \<Rightarrow> ?'a set"  
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 *)
term "Max A"   (* maximum of finite non-empty set *)
term "Min A"   (* minimum of finite non-empty set *)


lemma "card { (x * 3, y) :: nat \<times> bool | x y. x < 10 \<and> P y } \<le> 20" 
  (is "card ?S \<le> _")
proof -
  have "?S \<subseteq> { (x * 3, y) | x y. x < 10}" by auto
  also have "\<dots> \<subseteq> (\<lambda> (x, y). (x * 3, y)) ` ({ x. x < 10 } \<times> UNIV)" by auto
  also have "\<dots> \<subseteq> (\<lambda> (x, y). (x * 3, y)) ` ({0 .. 9} \<times> UNIV)" (is "_ \<subseteq> ?f ` ?T") by auto
  finally have ST: "?S \<subseteq> ?f ` ?T" by auto
  have finT: "finite (?f ` ?T)" "finite ?T" by auto
  from this(1) ST have finS: "finite ?S" by (meson finite_subset)
  from finT have "card ?S \<le> card (?f ` ?T)" 
    using ST card_mono by blast
  also have "\<dots> \<le> card ?T" using finT by (metis card_image_le)
  also have "\<dots> = 20" by simp
  finally show ?thesis .
qed
  
lemma "infinite S \<Longrightarrow> prod f S = 1 \<and> sum f S = 0"  by auto

lemma "sum (\<lambda> i. i) {..< (n :: nat)} \<le> n * (n - 1)" 
proof -
  have "sum (\<lambda> i. i) {..< (n :: nat)} \<le> sum (\<lambda> i. n - 1) {..< (n :: nat)}" 
    by (rule sum_mono, auto)
  find_theorems "sum _ _ \<le> sum _ _" 
  also have "\<dots> = n * (n - 1)" by simp
  finally show ?thesis by (simp add: power2_eq_square)
qed


text \<open>Functions on Lists\<close>

term set
term hd
term tl
term take
term drop
term append term "(@)" 
term filter
term map
term foldr
term foldl
term nth term "(!)" 
term concat
term distinct
term sorted
term sorted_list_of_set
term sum_list
term prod_list
term list_update  term "xs [ i := n ]" 
term "f (x := n)" 

term "[ (a, 2 * b) .  a <- [0 ..< n], even a, b <- [2 .. 5]]"

thm sum.cong
thm sum_mono
thm sum.neutral
thm nth_equalityI
thm set_conv_nth
thm split_list

find_theorems "sum _ (_ \<union> _) = _ + _"

lemma "\<not> ( \<exists> f :: nat \<Rightarrow> (int \<Rightarrow> bool). f ` UNIV = UNIV) " sorry



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)

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

lemma set_insert_t[simp]: "set_t (insert_t x t) = insert x (set_t t)" 
  by (induct x t rule: insert_t.induct, auto)

lemma insert_t: assumes "ordered t" 
  shows "ordered (insert_t y t)" 
  using assms
  by (induction rule: ordered.induct, auto intro!: ordered.intros)

fun delete_right :: "'a :: linorder tree \<Rightarrow> 'a tree \<times> 'a" where
  "delete_right (Node l x Leaf) = (l, x)"  
| "delete_right (Node l x r) = (case delete_right r of 
      (r', y) \<Rightarrow> (Node l x r', y))" 

fun delete :: "'a :: linorder \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
  "delete y Leaf = Leaf"
| "delete y (Node l x r) = (if y < x then Node (delete y l) x r
      else if y > x then Node l x (delete y r)
      else if l = Leaf then r
      else case delete_right l of (l', z) \<Rightarrow> Node l' z r)" 
  


lemma delete: "ordered t \<Longrightarrow> ordered (delete y t) \<and> set_t (delete y t) = set_t t - {y}" 
proof (induction rule: ordered.induct)
  case oLeaf
  then show ?case by (auto intro: ordered.intros)
next
  case (oNode l r x)
  consider (left) "y < x" | (right) "y > x" | (eqSimple) "y = x" "l = Leaf" | (eqComplex) "y = x" "l \<noteq> Leaf" 
    by (cases "y < x"; cases "y = x"; cases "y > x"; auto)
  thus ?case
  proof cases
    case left
    then show ?thesis using oNode by (auto intro: ordered.oNode)
  next
    case right
    hence res: "delete y (Node l x r) = Node l x (delete y r)" by auto
    from oNode have IH: "ordered (delete y r)" "set_t (delete y r) = set_t r - {y}" by auto
    have set: "set_t (Node l x (delete y r)) = set_t (Node l x r) - {y}" using IH right oNode by auto
    show ?thesis unfolding res set
      by (intro conjI refl ordered.oNode, insert IH right oNode, auto)
  next
    case eqSimple
    then show ?thesis using oNode by (auto intro: ordered.oNode)
  next
    case eqComplex
    then show ?thesis sorry
  qed
qed


end