(*
    $Id: sol.thy,v 1.3 2011/06/28 18:11:37 webertj Exp $
    Author: Martin Strecker
*)

header {* Searching in Lists *}

(*<*) theory sol imports Main begin (*>*)

text {* Define a function @{text first_pos} that computes the index
of the first element in a list that satisfies a given predicate:

  @{text "first_pos :: ('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> nat"}

The smallest index is @{text 0}.  If no element in the
list satisfies the predicate, the behaviour of @{text first_pos} should
be as described below. *}

primrec first_pos :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> nat" where
  "first_pos P [] = 0"
| "first_pos P (x # xs) = (if P x then 0 else Suc (first_pos P xs))"

text {* Verify your definition by computing
\begin{itemize}
\item the index of the first number equal to @{text 3} in the list
  @{text "[1::nat, 3, 5, 3, 1]"},
\item the index of the first number greater than @{text 4} in the list
  @{text "[1::nat, 3, 5, 7]"},
\item the index of  the first list with more than one element in the list
  @{text "[[], [1, 2], [3]]"}.
\end{itemize}

\emph{Note:} Isabelle does not know the operators @{text ">"} and @{text
"\<ge>"}.  Use @{text "<"} and @{text "\<le>"} instead. *}

lemma "first_pos (\<lambda> x. x = 3) [1::nat, 3, 5, 3, 1] = 1"
  by auto

lemma "first_pos (\<lambda> x. 4 < x) [1::nat, 3, 5, 7] = 2"
  by auto

lemma "first_pos (\<lambda> x. 1 < length x) [[], [1, 2], [3]] = 1"
  by auto

text {* Prove that @{text first_pos} returns the length of the list if
and only if no element in the list satisfies the given predicate. *}

lemma "list_all (\<lambda> x. \<not> P x) xs = (first_pos P xs = length xs)"
  apply (induct xs)
  apply auto
done

text {* Now prove: *}

lemma "list_all (\<lambda> x. \<not> P x) (take (first_pos P xs) xs)"
  apply (induct xs)
  apply auto
done

text {* How can @{text "first_pos (\<lambda> x. P x \<or> Q x) xs"} be computed from
@{text "first_pos P xs"} and @{text "first_pos Q xs"}?  Can something
similar be said for the conjunction of @{text P} and @{text Q}?  Prove
your statement(s). *}

lemma "first_pos (\<lambda> x. P x \<or> Q x) xs = min (first_pos P xs) (first_pos Q xs)"
  apply (induct xs)
  apply auto
done

text {* For @{text "\<and>"}, only a lower bound can be given. *}

lemma "max (first_pos P xs) (first_pos Q xs) \<le> first_pos (\<lambda> x. P x \<and> Q x) xs"
  apply (induct xs)
  apply auto
done

text {* Suppose @{text P} implies @{text Q}. What can be said about the
relation between @{text "first_pos P xs"} and @{text "first_pos Q xs"}?
Prove your statement. *}

lemma "(\<forall>x. P x \<longrightarrow> Q x) \<longrightarrow> first_pos Q xs \<le> first_pos P xs"
  apply (induct xs)
  apply auto
done

text {* Define a function @{text count} that counts the number of
elements in a list that satisfy a given predicate. *}

primrec count :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> nat" where
  "count P [] = 0"
| "count P (x # xs) = (if P x then Suc (count P xs) else (count P xs))"

text {* Show: The number of elements with a given property stays the
same when one reverses a list with @{text rev}.  The proof will require
a lemma. *}

lemma count_append[simp]: "count P (xs @ ys) = count P xs + count P ys"
  apply (induct xs)
  apply auto
done

lemma "count P xs = count P (rev xs)"
  apply (induct xs)
  apply auto
done

text {* Find and prove a connection between the two functions @{text filter}
and @{text count}. *}

lemma "length (filter P xs) = count P xs"
  apply (induct xs)
  apply auto
done

(*<*) end (*>*)


(*  Title:       Deriving class instances for datatypes
    Author:      Christian Sternagel and René Thiemann  <christian.sternagel|rene.thiemann@uibk.ac.at>
    Maintainer:  Christian Sternagel and René Thiemann
    License:     LGPL
*)
section \<open>Comparisons\<close>

subsection \<open>Comparators and Linear Orders\<close>

theory Comparator
imports Main
begin

text \<open>Instead of having to define a strict and a weak linear order, @{term "(op <, op \<le>)"},
 one can alternative use a comparator to define the linear order, which may deliver
 three possible outcomes when comparing two values.\<close>

datatype order = Eq | Lt | Gt

type_synonym 'a comparator = "'a \<Rightarrow> 'a \<Rightarrow> order"

text \<open>In the following, we provide the obvious definitions how to switch between
  linear orders and comparators.\<close>

definition lt_of_comp :: "'a comparator \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" where
  "lt_of_comp acomp x y = (case acomp x y of Lt \<Rightarrow> True | _ \<Rightarrow> False)"

definition le_of_comp :: "'a comparator \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" where
  "le_of_comp acomp x y = (case acomp x y of Gt \<Rightarrow> False | _ \<Rightarrow> True)"

definition comp_of_ords :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a comparator" where
  "comp_of_ords le lt x y = (if lt x y then Lt else if le x y then Eq else Gt)"

lemma comp_of_ords_of_le_lt[simp]: "comp_of_ords (le_of_comp c) (lt_of_comp c) = c"
  by (intro ext, auto simp: comp_of_ords_def le_of_comp_def lt_of_comp_def split: order.split)

lemma lt_of_comp_of_ords: "lt_of_comp (comp_of_ords le lt) = lt"
  by (intro ext, auto simp: comp_of_ords_def le_of_comp_def lt_of_comp_def split: order.split)

lemma le_of_comp_of_ords_gen: "(\<And> x y. lt x y \<Longrightarrow> le x y) \<Longrightarrow> le_of_comp (comp_of_ords le lt) = le"
  by (intro ext, auto simp: comp_of_ords_def le_of_comp_def lt_of_comp_def split: order.split)

lemma le_of_comp_of_ords_linorder: assumes "class.linorder le lt"
  shows "le_of_comp (comp_of_ords le lt) = le"
proof -
  interpret linorder le lt by fact
  show ?thesis by (rule le_of_comp_of_ords_gen) simp
qed

fun invert_order:: "order \<Rightarrow> order" where
  "invert_order Lt = Gt" |
  "invert_order Gt = Lt" |
  "invert_order Eq = Eq"

locale comparator =
  fixes comp :: "'a comparator"
  assumes sym: "invert_order (comp x y) = comp y x"
    and weak_eq: "comp x y = Eq \<Longrightarrow> x = y"
    and trans: "comp x y = Lt \<Longrightarrow> comp y z = Lt \<Longrightarrow> comp x z = Lt"
begin

lemma eq: "(comp x y = Eq) = (x = y)"
proof
  assume "x = y"
  with sym [of y y] show "comp x y = Eq" by (cases "comp x y") auto
qed (rule weak_eq)

lemma comp_same [simp]:
  "comp x x = Eq"
  by (simp add: eq)

abbreviation "lt \<equiv> lt_of_comp comp"
abbreviation "le \<equiv> le_of_comp comp"

lemma linorder: "class.linorder le lt"
proof
  note [simp] = lt_of_comp_def le_of_comp_def
  fix x y z :: 'a
  show "lt x y = (le x y \<and> \<not> le y x)"
    using sym [of x y] by (cases "comp x y") (simp_all)
  show "le x y \<or> le y x"
    using sym [of x y] by (cases "comp x y") (simp_all)
  show "le x x" using eq [of x x] by (simp)
  show "le x y \<Longrightarrow> le y x \<Longrightarrow> x = y"
    using sym [of x y] by (cases "comp x y") (simp_all add: eq)
  show "le x y \<Longrightarrow> le y z \<Longrightarrow> le x z"
    by (cases "comp x y" "comp y z" rule: order.exhaust [case_product order.exhaust])
       (auto dest: trans simp: eq)
qed

sublocale linorder le lt
  by (rule linorder)

lemma Gt_lt_conv: "comp x y = Gt \<longleftrightarrow> lt y x"
  unfolding lt_of_comp_def sym[of x y, symmetric]
  by (cases "comp x y", auto)
lemma Lt_lt_conv: "comp x y = Lt \<longleftrightarrow> lt x y"
  unfolding lt_of_comp_def by (cases "comp x y", auto)
lemma eq_Eq_conv: "comp x y = Eq \<longleftrightarrow> x = y"
  by (rule eq)
lemma nGt_le_conv: "comp x y \<noteq> Gt \<longleftrightarrow> le x y"
  unfolding le_of_comp_def by (cases "comp x y", auto)
lemma nLt_le_conv: "comp x y \<noteq> Lt \<longleftrightarrow> le y x"
  unfolding le_of_comp_def sym[of x y, symmetric] by (cases "comp x y", auto)
lemma nEq_neq_conv: "comp x y \<noteq> Eq \<longleftrightarrow> x \<noteq> y"
  using eq_Eq_conv[of x y] by simp

lemmas le_lt_convs =  nLt_le_conv nGt_le_conv Gt_lt_conv Lt_lt_conv eq_Eq_conv nEq_neq_conv

lemma two_comparisons_into_case_order:
  "(if le x y then (if x = y then P else Q) else R) = (case_order P Q R (comp x y))"
  "(if le x y then (if y = x then P else Q) else R) = (case_order P Q R (comp x y))"
  "(if le x y then (if le y x then P else Q) else R) = (case_order P Q R (comp x y))"
  "(if le x y then (if lt x y then Q else P) else R) = (case_order P Q R (comp x y))"
  "(if lt x y then Q else (if le x y then P else R)) = (case_order P Q R (comp x y))"
  "(if lt x y then Q else (if lt y x then R else P)) = (case_order P Q R (comp x y))"
  "(if lt x y then Q else (if x = y then P else R)) = (case_order P Q R (comp x y))"
  "(if lt x y then Q else (if y = x then P else R)) = (case_order P Q R (comp x y))"
  "(if x = y then P else (if lt y x then R else Q)) = (case_order P Q R (comp x y))"
  "(if x = y then P else (if lt x y then Q else R)) = (case_order P Q R (comp x y))"
  "(if x = y then P else (if le y x then R else Q)) = (case_order P Q R (comp x y))"
  "(if x = y then P else (if le x y then Q else R)) = (case_order P Q R (comp x y))"
  by (auto simp: le_lt_convs split: order.splits)

end

lemma comp_of_ords: assumes "class.linorder le lt"
  shows "comparator (comp_of_ords le lt)"
proof -
  interpret linorder le lt by fact
  show ?thesis
    by (unfold_locales, auto simp: comp_of_ords_def split: if_splits)
qed

definition (in linorder) comparator_of :: "'a comparator" where
  "comparator_of x y = (if x < y then Lt else if x = y then Eq else Gt)"

lemma comparator_of: "comparator comparator_of"
  by unfold_locales (auto split: if_splits simp: comparator_of_def)

end


(*  Title:      HOL/Hoare/Examples.thy
    Author:     Norbert Galm
    Copyright   1998 TUM
*)

section \<open>Various examples\<close>

theory Examples
  imports Hoare_Logic Arith2
begin

subsection \<open>Arithmetic\<close>

subsubsection \<open>Multiplication by successive addition\<close>

lemma multiply_by_add: "VARS m s a b
  {a=A \<and> b=B}
  m := 0; s := 0;
  WHILE m\<noteq>a
  INV {s=m*b \<and> a=A \<and> b=B}
  DO s := s+b; m := m+(1::nat) OD
  {s = A*B}"
by vcg_simp

lemma multiply_by_add_time: "VARS m s a b t
  {a=A \<and> b=B \<and> t=0}
  m := 0; t := t+1; s := 0; t := t+1;
  WHILE m\<noteq>a
  INV {s=m*b \<and> a=A \<and> b=B \<and> t = 2*m + 2}
  DO s := s+b; t := t+1; m := m+(1::nat); t := t+1 OD
  {s = A*B \<and> t = 2*A + 2}"
by vcg_simp

lemma multiply_by_add2: "VARS M N P :: int
 {m=M \<and> n=N}
 IF M < 0 THEN M := -M; N := -N ELSE SKIP FI;
 P := 0;
 WHILE 0 < M
 INV {0 \<le> M \<and> (\<exists>p. p = (if m<0 then -m else m) & p*N = m*n & P = (p-M)*N)}
 DO P := P+N; M := M - 1 OD
 {P = m*n}"
apply vcg_simp
 apply (auto simp add:int_distrib)
done

lemma multiply_by_add2_time: "VARS M N P t :: int
 {m=M \<and> n=N \<and> t=0}
 IF M < 0 THEN M := -M; t := t+1; N := -N; t := t+1 ELSE SKIP FI;
 P := 0; t := t+1;
 WHILE 0 < M
 INV {0 \<le> M & (\<exists>p. p = (if m<0 then -m else m) & p*N = m*n & P = (p-M)*N & t \<ge> 0 & t \<le> 2*(p-M)+3)}
 DO P := P+N; t := t+1; M := M - 1; t := t+1 OD
 {P = m*n & t \<le> 2*abs m + 3}"
apply vcg_simp
 apply (auto simp add:int_distrib)
done

subsubsection \<open>Euclid's algorithm for GCD\<close>

lemma Euclid_GCD: "VARS a b
 {0<A & 0<B}
 a := A; b := B;
 WHILE  a \<noteq> b
 INV {0<a & 0<b & gcd A B = gcd a b}
 DO IF a<b THEN b := b-a ELSE a := a-b FI OD
 {a = gcd A B}"
apply vcg
  \<comment> \<open>Now prove the verification conditions\<close>
  apply auto
  apply(simp add: gcd_diff_r less_imp_le)
 apply(simp add: linorder_not_less gcd_diff_l)
apply(erule gcd_nnn)
done

lemma Euclid_GCD_time: "VARS a b t
 {0<A & 0<B & t=0}
 a := A; t := t+1; b := B; t := t+1;
 WHILE  a \<noteq> b
 INV {0<a & 0<b & gcd A B = gcd a b & a\<le>A & b\<le>B & t \<le> max A B - max a b + 2}
 DO IF a<b THEN b := b-a; t := t+1 ELSE a := a-b; t := t+1 FI OD
 {a = gcd A B & t \<le> max A B + 2}"
apply vcg
  \<comment> \<open>Now prove the verification conditions\<close>
  apply auto
  apply(simp add: gcd_diff_r less_imp_le)
 apply(simp add: linorder_not_less gcd_diff_l)
apply(erule gcd_nnn)
done

subsubsection \<open>Dijkstra's extension of Euclid's algorithm for simultaneous GCD and SCM\<close>

text \<open>
  From E.W. Disjkstra. Selected Writings on Computing, p 98 (EWD474),
  where it is given without the invariant. Instead of defining \<open>scm\<close>
  explicitly we have used the theorem \<open>scm x y = x * y / gcd x y\<close> and avoided
  division by mupltiplying with \<open>gcd x y\<close>.
\<close>

lemmas distribs =
  diff_mult_distrib diff_mult_distrib2 add_mult_distrib add_mult_distrib2

lemma gcd_scm: "VARS a b x y
 {0<A & 0<B & a=A & b=B & x=B & y=A}
 WHILE  a ~= b
 INV {0<a & 0<b & gcd A B = gcd a b & 2*A*B = a*x + b*y}
 DO IF a<b THEN (b := b-a; x := x+y) ELSE (a := a-b; y := y+x) FI OD
 {a = gcd A B & 2*A*B = a*(x+y)}"
apply vcg
  apply simp
 apply(simp add: distribs gcd_diff_r linorder_not_less gcd_diff_l)
apply(simp add: distribs gcd_nnn)
done

subsubsection \<open>Power by iterated squaring and multiplication\<close>

lemma power_by_mult: "VARS a b c
 {a=A & b=B}
 c := (1::nat);
 WHILE b ~= 0
 INV {A^B = c * a^b}
 DO  WHILE b mod 2 = 0
     INV {A^B = c * a^b}
     DO  a := a*a; b := b div 2 OD;
     c := c*a; b := b - 1
 OD
 {c = A^B}"
apply vcg_simp
apply(case_tac "b")
 apply simp
apply simp
done

subsubsection \<open>Factorial\<close>

lemma factorial: "VARS a b
 {a=A}
 b := 1;
 WHILE a > 0
 INV {fac A = b * fac a}
 DO b := b*a; a := a - 1 OD
 {b = fac A}"
apply vcg_simp
apply(clarsimp split: nat_diff_split)
done

lemma factorial_time: "VARS a b t
 {a=A & t=0}
 b := 1; t := t+1;
 WHILE a > 0
 INV {fac A = b * fac a & a \<le> A & t = 2*(A-a)+1}
 DO b := b*a; t := t+1; a := a - 1; t := t+1 OD
 {b = fac A & t = 2*A + 1}"
apply vcg_simp
apply(clarsimp split: nat_diff_split)
done

lemma factorial2: "VARS i f
 {True}
 i := (1::nat); f := 1;
 WHILE i <= n INV {f = fac(i - 1) & 1 <= i & i <= n+1}
 DO f := f*i; i := i+1 OD
 {f = fac n}"
apply vcg_simp
apply(subgoal_tac "i = Suc n")
apply simp
apply arith
done

lemma factorial2_time: "VARS i f t
 {t=0}
 i := (1::nat); t := t+1; f := 1; t := t+1;
 WHILE i \<le> n INV {f = fac(i - 1) & 1 \<le> i & i \<le> n+1 & t = 2*(i-1)+2}
 DO f := f*i; t := t+1; i := i+1; t := t+1 OD
 {f = fac n & t = 2*n+2}"
apply vcg_simp
 apply auto
apply(subgoal_tac "i = Suc n")
 apply simp
apply arith
done

subsubsection \<open>Square root\<close>

\<comment> \<open>the easy way:\<close>

lemma sqrt: "VARS r x
 {True}
 r := (0::nat);
 WHILE (r+1)*(r+1) <= X
 INV {r*r \<le> X}
 DO r := r+1 OD
 {r*r <= X & X < (r+1)*(r+1)}"
apply vcg_simp
done

lemma sqrt_time: "VARS r t
 {t=0}
 r := (0::nat); t := t+1;
 WHILE (r+1)*(r+1) <= X
 INV {r*r \<le> X & t = r+1}
 DO r := r+1; t := t+1 OD
 {r*r <= X & X < (r+1)*(r+1) & (t-1)*(t-1) \<le> X}"
apply vcg_simp
done

\<comment> \<open>without multiplication\<close>
lemma sqrt_without_multiplication: "VARS u w r
 {x=X}
 u := 1; w := 1; r := (0::nat);
 WHILE w <= X
 INV {u = r+r+1 & w = (r+1)*(r+1) & r*r <= X}
 DO r := r + 1; w := w + u + 2; u := u + 2 OD
 {r*r <= X & X < (r+1)*(r+1)}"
apply vcg_simp
done

subsection \<open>Lists\<close>

lemma imperative_reverse: "VARS y x
 {x=X}
 y:=[];
 WHILE x ~= []
 INV {rev(x)@y = rev(X)}
 DO y := (hd x # y); x := tl x OD
 {y=rev(X)}"
apply vcg_simp
 apply(simp add: neq_Nil_conv)
 apply auto
done

lemma imperative_reverse_time: "VARS y x t
 {x=X & t=0}
 y:=[]; t := t+1;
 WHILE x ~= []
 INV {rev(x)@y = rev(X) & t = 2*(length y) + 1}
 DO y := (hd x # y); t := t+1; x := tl x; t := t+1 OD
 {y=rev(X) & t = 2*length X + 1}"
apply vcg_simp
 apply(simp add: neq_Nil_conv)
 apply auto
done

lemma imperative_append: "VARS x y
 {x=X & y=Y}
 x := rev(x);
 WHILE x~=[]
 INV {rev(x)@y = X@Y}
 DO y := (hd x # y);
    x := tl x
 OD
 {y = X@Y}"
apply vcg_simp
apply(simp add: neq_Nil_conv)
apply auto
done

lemma imperative_append_time_no_rev: "VARS x y t
 {x=X & y=Y}
 x := rev(x); t := 0;
 WHILE x~=[]
 INV {rev(x)@y = X@Y & length x \<le> length X & t = 2 * (length X - length x)}
 DO y := (hd x # y); t := t+1;
    x := tl x; t := t+1
 OD
 {y = X@Y & t = 2 * length X}"
apply vcg_simp
apply(simp add: neq_Nil_conv)
apply auto
done

subsection \<open>Arrays\<close>

subsubsection \<open>Search for a key\<close>

lemma zero_search: "VARS A i
 {True}
 i := 0;
 WHILE i < length A & A!i \<noteq> key
 INV {\<forall>j. j<i --> A!j \<noteq> key}
 DO i := i+1 OD
 {(i < length A --> A!i = key) &
  (i = length A --> (\<forall>j. j < length A \<longrightarrow> A!j \<noteq> key))}"
apply vcg_simp
apply(blast elim!: less_SucE)
done

lemma zero_search_time: "VARS A i t
 {t=0}
 i := 0; t := t+1;
 WHILE i < length A \<and> A!i \<noteq> key
 INV {(\<forall>j. j<i \<longrightarrow> A!j \<noteq> key) \<and> i \<le> length A \<and> t = i+1}
 DO i := i+1; t := t+1 OD
 {(i < length A \<longrightarrow> A!i = key) \<and>
  (i = length A \<longrightarrow> (\<forall>j. j < length A --> A!j \<noteq> key)) \<and> t \<le> length A + 1}"
apply vcg_simp
apply(blast elim!: less_SucE)
done

text \<open>
  The \<open>partition\<close> procedure for quicksort.
    \<^item> \<open>A\<close> is the array to be sorted (modelled as a list).
    \<^item> Elements of \<open>A\<close> must be of class order to infer at the end
      that the elements between u and l are equal to pivot.

  Ambiguity warnings of parser are due to \<open>:=\<close> being used
  both for assignment and list update.
\<close>
lemma lem: "m - Suc 0 < n ==> m < Suc n"
by arith

lemma Partition:
"[| leq == \<lambda>A i. \<forall>k. k<i \<longrightarrow> A!k \<le> pivot;
    geq == \<lambda>A i. \<forall>k. i<k \<and> k<length A \<longrightarrow> pivot \<le> A!k |] ==>
 VARS A u l
 {0 < length(A::('a::order)list)}
 l := 0; u := length A - Suc 0;
 WHILE l \<le> u
  INV {leq A l \<and> geq A u \<and> u<length A \<and> l\<le>length A}
  DO WHILE l < length A \<and> A!l \<le> pivot
     INV {leq A l & geq A u \<and> u<length A \<and> l\<le>length A}
     DO l := l+1 OD;
     WHILE 0 < u & pivot \<le> A!u
     INV {leq A l & geq A u  \<and> u<length A \<and> l\<le>length A}
     DO u := u - 1 OD;
     IF l \<le> u THEN A := A[l := A!u, u := A!l] ELSE SKIP FI
  OD
 {leq A u & (\<forall>k. u<k \<and> k<l --> A!k = pivot) \<and> geq A l}"
\<comment> \<open>expand and delete abbreviations first\<close>
apply (simp)
apply (erule thin_rl)+
apply vcg_simp
   apply (force simp: neq_Nil_conv)
  apply (blast elim!: less_SucE intro: Suc_leI)
 apply (blast elim!: less_SucE intro: less_imp_diff_less dest: lem)
apply (force simp: nth_list_update)
done

end


(*  Title:       Binary Search Trees, Tactic-Style
    Author:      Viktor Kuncak, MIT CSAIL, November 2003
    Maintainer:  Larry Paulson <Larry.Paulson at cl.cam.ac.uk>
    License:     LGPL
*)

header {* Tactic-Style Reasoning for Binary Tree Operations *}
theory BinaryTree_TacticStyle imports Main begin

text {* This example theory illustrates automated proofs of correctness
   for binary tree operations using tactic-style reasoning.
   The current proofs for remove operation are by Tobias Nipkow,
   some modifications and the remaining tree operations are
   by Viktor Kuncak. *}

(*============================================================*)
section {* Definition of a sorted binary tree *}
(*============================================================*)

datatype tree = Tip | Nd tree nat tree

primrec set_of :: "tree => nat set"
-- {* The set of nodes stored in a tree. *}
where
  "set_of Tip = {}"
| "set_of(Nd l x r) = set_of l Un set_of r  Un {x}"

primrec sorted :: "tree => bool"
-- {* Tree is sorted *}
where
  "sorted Tip = True"
| "sorted(Nd l y r) =
    (sorted l & sorted r & (ALL x:set_of l. x < y) & (ALL z:set_of r. y < z))"

(*============================================================*)
section {* Tree Membership *}
(*============================================================*)

primrec
  memb :: "nat => tree => bool"
where
  "memb e Tip = False"
| "memb e (Nd t1 x t2) =
   (if e < x then memb e t1
    else if x < e then memb e t2
    else True)"

lemma member_set: "sorted t --> memb e t = (e : set_of t)"
by (induct t) auto

(*============================================================*)
section {* Insertion operation *}
(*============================================================*)

primrec binsert :: "nat => tree => tree"
-- {* Insert a node into sorted tree. *}
where
  "binsert x Tip = (Nd Tip x Tip)"
| "binsert x (Nd t1 y t2) = (if x < y then
                                 (Nd (binsert x t1) y t2)
                             else
                               (if y < x then
                                 (Nd t1 y (binsert x t2))
                                else (Nd t1 y t2)))"

theorem set_of_binsert [simp]: "set_of (binsert x t) = set_of t Un {x}"
by (induct t) auto

theorem binsert_sorted: "sorted t --> sorted (binsert x t)"
by (induct t) (auto simp add: set_of_binsert)

corollary binsert_spec:  (* summary specification of binsert *)
"sorted t ==>
   sorted (binsert x t) &
   set_of (binsert x t) = set_of t Un {x}"
by (simp add: binsert_sorted)

(*============================================================*)
section {* Remove operation *}
(*============================================================*)

primrec
  rm :: "tree => nat" -- {* find the rightmost element in the tree *}
where
  "rm(Nd l x r) = (if r = Tip then x else rm r)"
primrec
  rem :: "tree => tree" -- {* find the tree without the rightmost element *}
where
  "rem(Nd l x r) = (if r=Tip then l else Nd l x (rem r))"

primrec
  remove:: "nat => tree => tree" -- {* remove a node from sorted tree *}
where
  "remove x Tip = Tip"
| "remove x (Nd l y r) =
    (if x < y then Nd (remove x l) y r else
     if y < x then Nd l y (remove x r) else
     if l = Tip then r
     else Nd (rem l) (rm l) r)"

lemma rm_in_set_of: "t ~= Tip ==> rm t : set_of t"
by (induct t) auto

lemma set_of_rem: "t ~= Tip ==> set_of t = set_of(rem t) Un {rm t}"
by (induct t) auto

lemma sorted_rem: "[| t ~= Tip; x \<in> set_of(rem t); sorted t |] ==> x < rm t"
by (induct t) (auto simp add:set_of_rem split:if_splits)

theorem set_of_remove [simp]: "sorted t ==> set_of(remove x t) = set_of t - {x}"
apply(induct t)
 apply simp
apply simp
apply(rule conjI)
 apply fastforce
apply(rule impI)
apply(rule conjI)
 apply fastforce
apply(fastforce simp:set_of_rem)
done

theorem remove_sorted: "sorted t ==> sorted(remove x t)"
by (induct t) (auto intro: less_trans rm_in_set_of sorted_rem)

corollary remove_spec: -- {* summary specification of remove *}
"sorted t ==>
   sorted (remove x t) &
   set_of (remove x t) = set_of t - {x}"
by (simp add: remove_sorted)

text {* Finally, note that rem and rm can be computed
        using a single tree traversal given by remrm. *}

primrec remrm :: "tree => tree * nat"
where
"remrm(Nd l x r) = (if r=Tip then (l,x) else
                    let (r',y) = remrm r in (Nd l x r',y))"

lemma "t ~= Tip ==> remrm t = (rem t, rm t)"
by (induct t) (auto simp:Let_def)

text {* We can test this implementation by generating code. *}

definition "test = memb 4 (remove (3::nat) (binsert 4 (binsert 3 Tip)))"

export_code test
  in SML module_name BinaryTree_TacticStyle_Code file "BinaryTree_TacticStyle_Code.ML"

end


(*  Title:      HOL/Library/Indicator_Function.thy
    Author:     Johannes Hoelzl (TU Muenchen)
*)

section \<open>Indicator Function\<close>

theory Indicator_Function
imports Complex_Main Disjoint_Sets
begin

definition "indicator S x = (if x \<in> S then 1 else 0)"

lemma indicator_simps[simp]:
  "x \<in> S \<Longrightarrow> indicator S x = 1"
  "x \<notin> S \<Longrightarrow> indicator S x = 0"
  unfolding indicator_def by auto

lemma indicator_pos_le[intro, simp]: "(0::'a::linordered_semidom) \<le> indicator S x"
  and indicator_le_1[intro, simp]: "indicator S x \<le> (1::'a::linordered_semidom)"
  unfolding indicator_def by auto

lemma indicator_abs_le_1: "\<bar>indicator S x\<bar> \<le> (1::'a::linordered_idom)"
  unfolding indicator_def by auto

lemma indicator_eq_0_iff: "indicator A x = (0::'a::zero_neq_one) \<longleftrightarrow> x \<notin> A"
  by (auto simp: indicator_def)

lemma indicator_eq_1_iff: "indicator A x = (1::'a::zero_neq_one) \<longleftrightarrow> x \<in> A"
  by (auto simp: indicator_def)

lemma indicator_UNIV [simp]: "indicator UNIV = (\<lambda>x. 1)"
  by auto

lemma indicator_leI:
  "(x \<in> A \<Longrightarrow> y \<in> B) \<Longrightarrow> (indicator A x :: 'a::linordered_nonzero_semiring) \<le> indicator B y"
  by (auto simp: indicator_def)

lemma split_indicator: "P (indicator S x) \<longleftrightarrow> ((x \<in> S \<longrightarrow> P 1) \<and> (x \<notin> S \<longrightarrow> P 0))"
  unfolding indicator_def by auto

lemma split_indicator_asm: "P (indicator S x) \<longleftrightarrow> (\<not> (x \<in> S \<and> \<not> P 1 \<or> x \<notin> S \<and> \<not> P 0))"
  unfolding indicator_def by auto

lemma indicator_inter_arith: "indicator (A \<inter> B) x = indicator A x * (indicator B x::'a::semiring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_union_arith:
  "indicator (A \<union> B) x = indicator A x + indicator B x - indicator A x * (indicator B x :: 'a::ring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_inter_min: "indicator (A \<inter> B) x = min (indicator A x) (indicator B x::'a::linordered_semidom)"
  and indicator_union_max: "indicator (A \<union> B) x = max (indicator A x) (indicator B x::'a::linordered_semidom)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_disj_union:
  "A \<inter> B = {} \<Longrightarrow> indicator (A \<union> B) x = (indicator A x + indicator B x :: 'a::linordered_semidom)"
  by (auto split: split_indicator)

lemma indicator_compl: "indicator (- A) x = 1 - (indicator A x :: 'a::ring_1)"
  and indicator_diff: "indicator (A - B) x = indicator A x * (1 - indicator B x ::'a::ring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_times:
  "indicator (A \<times> B) x = indicator A (fst x) * (indicator B (snd x) :: 'a::semiring_1)"
  unfolding indicator_def by (cases x) auto

lemma indicator_sum:
  "indicator (A <+> B) x = (case x of Inl x \<Rightarrow> indicator A x | Inr x \<Rightarrow> indicator B x)"
  unfolding indicator_def by (cases x) auto

lemma indicator_image: "inj f \<Longrightarrow> indicator (f ` X) (f x) = (indicator X x::_::zero_neq_one)"
  by (auto simp: indicator_def inj_on_def)

lemma indicator_vimage: "indicator (f -` A) x = indicator A (f x)"
  by (auto split: split_indicator)

lemma  (* FIXME unnamed!? *)
  fixes f :: "'a \<Rightarrow> 'b::semiring_1"
  assumes "finite A"
  shows sum_mult_indicator[simp]: "(\<Sum>x \<in> A. f x * indicator B x) = (\<Sum>x \<in> A \<inter> B. f x)"
    and sum_indicator_mult[simp]: "(\<Sum>x \<in> A. indicator B x * f x) = (\<Sum>x \<in> A \<inter> B. f x)"
  unfolding indicator_def
  using assms by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm)

lemma sum_indicator_eq_card:
  assumes "finite A"
  shows "(\<Sum>x \<in> A. indicator B x) = card (A Int B)"
  using sum_mult_indicator [OF assms, of "\<lambda>x. 1::nat"]
  unfolding card_eq_sum by simp

lemma sum_indicator_scaleR[simp]:
  "finite A \<Longrightarrow>
    (\<Sum>x \<in> A. indicator (B x) (g x) *\<^sub>R f x) = (\<Sum>x \<in> {x\<in>A. g x \<in> B x}. f x :: 'a::real_vector)"
  by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm simp: indicator_def)

lemma LIMSEQ_indicator_incseq:
  assumes "incseq A"
  shows "(\<lambda>i. indicator (A i) x :: 'a::{topological_space,one,zero}) \<longlonglongrightarrow> indicator (\<Union>i. A i) x"
proof (cases "\<exists>i. x \<in> A i")
  case True
  then obtain i where "x \<in> A i"
    by auto
  then have *:
    "\<And>n. (indicator (A (n + i)) x :: 'a) = 1"
    "(indicator (\<Union>i. A i) x :: 'a) = 1"
    using incseqD[OF \<open>incseq A\<close>, of i "n + i" for n] \<open>x \<in> A i\<close> by (auto simp: indicator_def)
  show ?thesis
    by (rule LIMSEQ_offset[of _ i]) (use * in simp)
next
  case False
  then show ?thesis by (simp add: indicator_def)
qed

lemma LIMSEQ_indicator_UN:
  "(\<lambda>k. indicator (\<Union>i<k. A i) x :: 'a::{topological_space,one,zero}) \<longlonglongrightarrow> indicator (\<Union>i. A i) x"
proof -
  have "(\<lambda>k. indicator (\<Union>i<k. A i) x::'a) \<longlonglongrightarrow> indicator (\<Union>k. \<Union>i<k. A i) x"
    by (intro LIMSEQ_indicator_incseq) (auto simp: incseq_def intro: less_le_trans)
  also have "(\<Union>k. \<Union>i<k. A i) = (\<Union>i. A i)"
    by auto
  finally show ?thesis .
qed

lemma LIMSEQ_indicator_decseq:
  assumes "decseq A"
  shows "(\<lambda>i. indicator (A i) x :: 'a::{topological_space,one,zero}) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x"
proof (cases "\<exists>i. x \<notin> A i")
  case True
  then obtain i where "x \<notin> A i"
    by auto
  then have *:
    "\<And>n. (indicator (A (n + i)) x :: 'a) = 0"
    "(indicator (\<Inter>i. A i) x :: 'a) = 0"
    using decseqD[OF \<open>decseq A\<close>, of i "n + i" for n] \<open>x \<notin> A i\<close> by (auto simp: indicator_def)
  show ?thesis
    by (rule LIMSEQ_offset[of _ i]) (use * in simp)
next
  case False
  then show ?thesis by (simp add: indicator_def)
qed

lemma LIMSEQ_indicator_INT:
  "(\<lambda>k. indicator (\<Inter>i<k. A i) x :: 'a::{topological_space,one,zero}) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x"
proof -
  have "(\<lambda>k. indicator (\<Inter>i<k. A i) x::'a) \<longlonglongrightarrow> indicator (\<Inter>k. \<Inter>i<k. A i) x"
    by (intro LIMSEQ_indicator_decseq) (auto simp: decseq_def intro: less_le_trans)
  also have "(\<Inter>k. \<Inter>i<k. A i) = (\<Inter>i. A i)"
    by auto
  finally show ?thesis .
qed

lemma indicator_add:
  "A \<inter> B = {} \<Longrightarrow> (indicator A x::_::monoid_add) + indicator B x = indicator (A \<union> B) x"
  unfolding indicator_def by auto

lemma of_real_indicator: "of_real (indicator A x) = indicator A x"
  by (simp split: split_indicator)

lemma real_of_nat_indicator: "real (indicator A x :: nat) = indicator A x"
  by (simp split: split_indicator)

lemma abs_indicator: "\<bar>indicator A x :: 'a::linordered_idom\<bar> = indicator A x"
  by (simp split: split_indicator)

lemma mult_indicator_subset:
  "A \<subseteq> B \<Longrightarrow> indicator A x * indicator B x = (indicator A x :: 'a::comm_semiring_1)"
  by (auto split: split_indicator simp: fun_eq_iff)

lemma indicator_sums:
  assumes "\<And>i j. i \<noteq> j \<Longrightarrow> A i \<inter> A j = {}"
  shows "(\<lambda>i. indicator (A i) x::real) sums indicator (\<Union>i. A i) x"
proof (cases "\<exists>i. x \<in> A i")
  case True
  then obtain i where i: "x \<in> A i" ..
  with assms have "(\<lambda>i. indicator (A i) x::real) sums (\<Sum>i\<in>{i}. indicator (A i) x)"
    by (intro sums_finite) (auto split: split_indicator)
  also have "(\<Sum>i\<in>{i}. indicator (A i) x) = indicator (\<Union>i. A i) x"
    using i by (auto split: split_indicator)
  finally show ?thesis .
next
  case False
  then show ?thesis by simp
qed

text \<open>
  The indicator function of the union of a disjoint family of sets is the
  sum over all the individual indicators.
\<close>

lemma indicator_UN_disjoint:
  "finite A \<Longrightarrow> disjoint_family_on f A \<Longrightarrow> indicator (UNION A f) x = (\<Sum>y\<in>A. indicator (f y) x)"
  by (induct A rule: finite_induct)
    (auto simp: disjoint_family_on_def indicator_def split: if_splits)

end


(*<*) theory ex1_6 imports Main begin (*>*)

text{* Define a function @{text sum}, which computes the sum of
elements of a list of natural numbers. *}

primrec  sum :: "nat list \<Rightarrow> nat" where
"sum [] =0"
|"sum (x#xs) = x + sum xs"

text{* Then, define a function @{text flatten} which flattens a list
of lists by appending the member lists. *}

primrec  flatten :: "'a list list \<Rightarrow> 'a list" where
"flatten [] = []"
|" flatten (x#xs) = x@ (flatten xs)"

text{* Test your functions by applying them to the following example lists: *}

lemma "sum [2::nat, 4, 8] = 14"
  apply auto
  done

lemma "flatten [[2::nat, 3], [4, 5], [7, 9]] = [2,3,4,5,7,9]"
  apply auto
  done

text{* Prove the following statements, or give a counterexample: *}

lemma "length (flatten xs) = sum (map length xs)"
  apply (induct xs)
   apply auto
  done

lemma sum_append: "sum (xs @ ys) = sum xs + sum ys"
  apply (induct xs)
   apply auto
  done

lemma flatten_append[simp]: "flatten (xs @ ys) = flatten xs @ flatten ys"
  apply (induct xs)
  apply auto
  done

lemma "flatten (map rev (rev xs)) = rev (flatten xs)"
  apply (induct xs)
   apply (auto )

  oops

lemma "flatten (rev (map rev xs)) = rev (flatten xs)"
  apply(induct xs)
   apply auto
  done

lemma "list_all (list_all P) xs = list_all P (flatten xs)"
  apply (induct xs)
   apply auto
  done

lemma "flatten (rev xs) = flatten xs"
  quickcheck oops

lemma [simp] :"sum (x@xs) = sum x + sum xs"
  apply (induct x)
   apply auto
  done
lemma "sum (rev xs) = sum xs"
  apply (induct xs)
   apply auto
  done

text{* Find a (non-trivial) predicate @{text P} which satisfies *}

lemma "list_all (\<lambda>x. 0<x) xs \<longrightarrow> length xs \<le> sum xs"
  apply(induct xs)
   apply auto
  done

text{* Define, by means of primitive recursion, a function @{text
list_exists} which checks whether an element satisfying a given property
is contained in the list: *}

primrec
  list_exists :: "('a \<Rightarrow> bool) \<Rightarrow> ('a list \<Rightarrow> bool)" where
"list_exists f [] = False"
|"list_exists f (x#xs) = (f x \<or> list_exists f xs)"

text{* Test your function on the following examples: *}

lemma "list_exists (\<lambda> n. n < 3) [4::nat, 3, 7] = False"
  apply auto
done

lemma "list_exists (\<lambda> n. n < 4) [4::nat, 3, 7] = True"
  apply auto done

text{* Prove the following statements: *}

lemma list_exists_append[simp]:
  "list_exists P (xs @ ys) = (list_exists P xs \<or> list_exists P ys)"
  apply (induct xs)
   apply auto
  done

lemma "list_exists (list_exists P) xs = list_exists P (flatten xs)"
  apply (induct xs)
   apply auto
  done

text{* You could have defined @{text list_exists} only with the aid of
@{text list_all}.  Do this now, i.e. define a function @{text
list_exists2} and show that it is equivalent to @{text list_exists}. *}

fun list_exists2 :: "('a \<Rightarrow> bool) \<Rightarrow> ('a list \<Rightarrow> bool)" where
"list_exists2 f xs =(\<not> ((list_all (\<lambda>x. \<not>(f x)) xs )))"

lemma "list_exists2 f xs = list_exists f xs"
  apply (induct xs)
   apply auto
  done

(*<*) end (*>*)