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 -
  let ?UB = "UNIV :: bool set" 
  let ?S10 = "{..<10} :: nat set" 
  have sub: "?S \<subseteq> ((\<lambda> x. x * 3) ` ?S10) \<times> ?UB" (is "_ \<subseteq> ?T") by auto
  have finT: "finite ?T" by auto
  from card_mono[OF finT sub]
  have "card ?S \<le> card ?T" .
  also have "\<dots> = card ((\<lambda> x. x * 3) ` ?S10) * card ?UB" unfolding card_cartesian_product ..
  also have "card ((\<lambda> x. x * 3) ` ?S10) = card ?S10" 
    by (rule card_image, auto simp: inj_on_def)
  also have "card ?S10 * card ?UB \<le> 10 * 2" 
    by (rule mult_mono, auto)
  finally show "card ?S \<le> 20" by simp
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^2" 
proof -
  have "\<Sum> {..<n} \<le> (\<Sum>i<n. n)" 
    by (rule sum_mono, auto)
  also have "\<dots> = n * n" by simp
  finally show ?thesis
    by (simp add: power2_eq_square)
qed


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

term set
term hd
value "tl ([] :: nat list)" 
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 set_zip
thm split_list

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



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 insert_t: assumes "ordered t" 
  shows "ordered (insert_t y t) \<and> set_t (insert_t y t) = insert y (set_t t)" 
  using assms
  by (induction, 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 x Leaf = Leaf" 
| "delete x (Node l y r) = (if x < y then Node (delete x l) y r
      else if x > y then Node l y (delete x r)
      else if l = Leaf then r else case delete_right l of (l',z) \<Rightarrow> Node l' z r)" 

lemma delete_right: assumes "ordered t" "t \<noteq> Leaf" "delete_right t = (t',x)" 
  shows "set_t t' = set_t t - {x} \<and> ordered t' \<and> Ball (set_t t') (\<lambda> x. Ball f (A x))" 
  oops
lemma "\<forall> x \<le> zy \<le> z. P x" 

lemma delete: assumes "ordered t"
  shows "ordered (delete y t) \<and> set_t (delete y t) = set_t t - {y}"  
  using assms 
proof (induction)
  case (oNode l r x)
  consider (L) "y < x" | (R) "y > x" | (Le) "x = y" "l = Leaf" | (DR) "x = y" "l \<noteq> Leaf" 
    by fastforce
  then show ?case 
  proof cases
    case L
    print_attributes
    then show ?thesis using oNode.IH(1) oNode.hyps 
      by (auto intro!: ordered.intros) 
  next
    case R
    then show ?thesis using oNode.IH(2) oNode.hyps by (auto intro!: ordered.intros)
  next
    case Le
    then show ?thesis using oNode.hyps by (auto intro!: ordered.intros)
  next
    case DR
    obtain l' z where dr: "delete_right l = (l',z)" by force
    from dr DR show ?thesis apply simp sorry
  qed
qed (auto intro: ordered.intros)


end