theory LiveDemo08 imports Main begin section \Sets and Lists in Isabelle\ term "(\)" (* membership *) term "(\)" (* subset *) term "(\)" (* strict subset *) term Ball (* all elements satisfy predicate *) term Bex (* at least one element satisfies predicate *) term "(\)" (* union *) term "(\)" (* intersection *) term "\" (* big-union *) term "\" (* 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 \ ?'b) \ ?'b set \ ?'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 \ u \ 5 \ 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 \ bool | x y. x < 10 \ P y } \ 20" (is "card ?S \ _") proof - have "?S \ { (x * 3, y) | x y. x < 10}" by auto also have "\ \ (\ (x, y). (x * 3, y)) ` ({ x. x < 10 } \ UNIV)" by auto also have "\ \ (\ (x, y). (x * 3, y)) ` ({0 .. 9} \ UNIV)" (is "_ \ ?f ` ?T") by auto finally have ST: "?S \ ?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 \ card (?f ` ?T)" using ST card_mono by blast also have "\ \ card ?T" using finT by (metis card_image_le) also have "\ = 20" by simp finally show ?thesis . qed lemma "infinite S \ prod f S = 1 \ sum f S = 0" by auto lemma "sum (\ i. i) {..< (n :: nat)} \ n * (n - 1)" proof - have "sum (\ i. i) {..< (n :: nat)} \ sum (\ i. n - 1) {..< (n :: nat)}" by (rule sum_mono, auto) find_theorems "sum _ _ \ sum _ _" also have "\ = n * (n - 1)" by simp finally show ?thesis by (simp add: power2_eq_square) qed text \Functions on Lists\ 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 _ (_ \ _) = _ + _" lemma "\ ( \ f :: nat \ (int \ bool). f ` UNIV = UNIV) " sorry section \Binary Search Trees\ datatype 'a tree = Leaf | Node "'a tree" 'a "'a tree" fun set_t :: "'a tree \ 'a set" where "set_t Leaf = {}" | "set_t (Node l x r) = set_t l \ {x} \ set_t r" inductive ordered :: "'a :: linorder tree \ bool" where oLeaf: "ordered Leaf" | oNode: "ordered l \ ordered r \ Ball (set_t l) (\ y. y < x) \ Ball (set_t r) (\ y. y > x) \ ordered (Node l x r)" fun member:: "'a :: linorder \ 'a tree \ 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 \ member x t = (x \ set_t t)" by (induction rule: ordered.induct, auto) fun insert_t :: "'a :: linorder \ 'a tree \ '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 \ 'a tree \ 'a" where "delete_right (Node l x Leaf) = (l, x)" | "delete_right (Node l x r) = (case delete_right r of (r', y) \ (Node l x r', y))" fun delete :: "'a :: linorder \ 'a tree \ '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) \ Node l' z r)" lemma delete: "ordered t \ ordered (delete y t) \ 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 \ 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