(*  Title:      HOL/Isar_Examples/Summation.thy
    Author:     Makarius
*)

section \<open>Summing natural numbers\<close>

theory Summation
  imports Main
begin

text \<open>
  Subsequently, we prove some summation laws of natural numbers (including
  odds, squares, and cubes). These examples demonstrate how plain natural
  deduction (including induction) may be combined with calculational proof.
\<close>

subsection \<open>Summation laws\<close>

text \<open>
  The sum of natural numbers \<open>0 + \<cdots> + n\<close> equals \<open>n \<times> (n + 1)/2\<close>. Avoiding
  formal reasoning about division we prove this equation multiplied by \<open>2\<close>.
\<close>

theorem sum_of_naturals:
  "2 * (\<Sum>i::nat=0..n. i) = n * (n + 1)"
  (is "?P n" is "?S n = _")
proof (induct n)
  show "?P 0" by simp
next
  fix n have "?S (n + 1) = ?S n + 2 * (n + 1)"
    by simp
  also assume "?S n = n * (n + 1)"
  also have "\<dots> + 2 * (n + 1) = (n + 1) * (n + 2)"
    by simp
  finally show "?P (Suc n)"
    by simp
qed

text \<open>
  The above proof is a typical instance of mathematical induction. The main
  statement is viewed as some \<open>?P n\<close> that is split by the induction method
  into base case \<open>?P 0\<close>, and step case \<open>?P n \<Longrightarrow> ?P (Suc n)\<close> for arbitrary \<open>n\<close>.

  The step case is established by a short calculation in forward manner.
  Starting from the left-hand side \<open>?S (n + 1)\<close> of the thesis, the final
  result is achieved by transformations involving basic arithmetic reasoning
  (using the Simplifier). The main point is where the induction hypothesis \<open>?S
  n = n \<times> (n + 1)\<close> is introduced in order to replace a certain subterm. So the
  ``transitivity'' rule involved here is actual \<^emph>\<open>substitution\<close>. Also note how
  the occurrence of ``\dots'' in the subsequent step documents the position
  where the right-hand side of the hypothesis got filled in.

  \<^medskip>
  A further notable point here is integration of calculations with plain
  natural deduction. This works so well in Isar for two reasons.

    \<^enum> Facts involved in \<^theory_text>\<open>also\<close>~/ \<^theory_text>\<open>finally\<close> calculational chains may be just
    anything. There is nothing special about \<^theory_text>\<open>have\<close>, so the natural deduction
    element \<^theory_text>\<open>assume\<close> works just as well.

    \<^enum> There are two \<^emph>\<open>separate\<close> primitives for building natural deduction
    contexts: \<^theory_text>\<open>fix x\<close> and \<^theory_text>\<open>assume A\<close>. Thus it is possible to start reasoning
    with some new ``arbitrary, but fixed'' elements before bringing in the
    actual assumption. In contrast, natural deduction is occasionally
    formalized with basic context elements of the form \<open>x:A\<close> instead.

  \<^medskip>
  We derive further summation laws for odds, squares, and cubes as follows.
  The basic technique of induction plus calculation is the same as before.
\<close>

theorem sum_of_odds:
  "(\<Sum>i::nat=0..<n. 2 * i + 1) = n^Suc (Suc 0)"
  (is "?P n" is "?S n = _")
proof (induct n)
  show "?P 0" by simp
next
  fix n
  have "?S (n + 1) = ?S n + 2 * n + 1"
    by simp
  also assume "?S n = n^Suc (Suc 0)"
  also have "\<dots> + 2 * n + 1 = (n + 1)^Suc (Suc 0)"
    by simp
  finally show "?P (Suc n)"
    by simp
qed

text \<open>
  Subsequently we require some additional tweaking of Isabelle built-in
  arithmetic simplifications, such as bringing in distributivity by hand.
\<close>

lemmas distrib = add_mult_distrib add_mult_distrib2

theorem sum_of_squares:
  "6 * (\<Sum>i::nat=0..n. i^Suc (Suc 0)) = n * (n + 1) * (2 * n + 1)"
  (is "?P n" is "?S n = _")
proof (induct n)
  show "?P 0" by simp
next
  fix n
  have "?S (n + 1) = ?S n + 6 * (n + 1)^Suc (Suc 0)"
    by (simp add: distrib)
  also assume "?S n = n * (n + 1) * (2 * n + 1)"
  also have "\<dots> + 6 * (n + 1)^Suc (Suc 0) =
      (n + 1) * (n + 2) * (2 * (n + 1) + 1)"
    by (simp add: distrib)
  finally show "?P (Suc n)"
    by simp
qed

theorem sum_of_cubes:
  "4 * (\<Sum>i::nat=0..n. i^3) = (n * (n + 1))^Suc (Suc 0)"
  (is "?P n" is "?S n = _")
proof (induct n)
  show "?P 0" by (simp add: power_eq_if)
next
  fix n
  have "?S (n + 1) = ?S n + 4 * (n + 1)^3"
    by (simp add: power_eq_if distrib)
  also assume "?S n = (n * (n + 1))^Suc (Suc 0)"
  also have "\<dots> + 4 * (n + 1)^3 = ((n + 1) * ((n + 1) + 1))^Suc (Suc 0)"
    by (simp add: power_eq_if distrib)
  finally show "?P (Suc n)"
    by simp
qed

text \<open>
  Note that in contrast to older traditions of tactical proof scripts, the
  structured proof applies induction on the original, unsimplified statement.
  This allows to state the induction cases robustly and conveniently.
  Simplification (or other automated) methods are then applied in terminal
  position to solve certain sub-problems completely.

  As a general rule of good proof style, automatic methods such as \<open>simp\<close> or
  \<open>auto\<close> should normally be never used as initial proof methods with a nested
  sub-proof to address the automatically produced situation, but only as
  terminal ones to solve sub-problems.
\<close>

end


theory 11
  imports Main "~~/src/HOL/Library/Code_Target_Nat"
begin

  (* section 2.5 *)

  (* exercise 2.11 *)
datatype exp = Var | Const int | Add exp exp | Mult exp exp

fun eval :: "exp \<Rightarrow> int \<Rightarrow> int" where
  "eval Var v = v" |
  "eval (Const i) _ = i" |
  "eval (Add el er) v = (eval el v) + (eval er v)"|
  "eval (Mult el er) v = (eval el v) * (eval er v)"

value "eval (Mult (Const 3) Var) 2"

  (* Returns expression for x^p where x is Var*)
fun xToPow :: "nat \<Rightarrow> exp" where
  "xToPow 0 = Const 1"|
  "xToPow (Suc 0) = Var"|
  "xToPow (Suc p) = Mult Var (xToPow p)"

value "xToPow 0"
value "xToPow 1"
value "xToPow 2"

  (* Create an expression from polynomial coefficients. The nat is the power of x to be multiplied
against the head of the list. If list is empty, returns 0. *)
fun createPolyExpression :: "int list \<Rightarrow> nat \<Rightarrow> exp" where
  "createPolyExpression [] _ = Const 0"|
  "createPolyExpression [coeff] pow = Mult (Const coeff) (xToPow pow)"|
  "createPolyExpression (coeff # coeffs) 0 = Add (Const coeff) (createPolyExpression coeffs (Suc 0))"|
  "createPolyExpression (coeff # coeffs) pow = Add (Mult (Const coeff) (xToPow pow)) (createPolyExpression coeffs (Suc pow))"

value "createPolyExpression [4,2,-1] 0"

fun evalPoly' :: "int list \<Rightarrow> int \<Rightarrow> nat \<Rightarrow> int" where
  "evalPoly' [] _ _ = 0"|
  "evalPoly' (c#coeffs) v pow = (c*v^pow) + (evalPoly' coeffs v (Suc pow))"

  (* Define a function evalPoly that evaluates a polynomial at the given value. *)
  (* Evaluate a polynomial, given its coefficients and x. The coefficients are assumed to start at
  x^0, be in order, and contiguous *)
fun evalPoly :: "int list \<Rightarrow> int \<Rightarrow> int" where
  "evalPoly coeffs v = evalPoly' coeffs v 0"

value "evalPoly [1,2,3] 1"
value "evalPoly [1,2,3] 3"

  (* Takes the reversed coefficient list. I.e. [-1, 2, 4] represents 4+2x-x^2   *)
fun hornerHelper :: "int list \<Rightarrow> int \<Rightarrow> int" where
  "hornerHelper [] _ = 0"|
  "hornerHelper (rc # rcs) v = rc * v^(length rcs) + (hornerHelper rcs v)"

  (* Evaluate a polynomial (using Horner's method) *)
fun evalPolyHorner :: "int list \<Rightarrow> int \<Rightarrow> int" where
  "evalPolyHorner coeffs v = hornerHelper (rev coeffs) v"

value "evalPolyHorner [4,2,-1,3] 3"

  (* A helper for simplify. Collapses (const + const) and (const * const). Returns other expressions
  unchanged *)
fun simplifyNonrecursive :: "exp \<Rightarrow> exp" where
  "simplifyNonrecursive (Add (Const l) (Const r)) = Const (l + r)"|
  "simplifyNonrecursive (Mult (Const l) (Const r)) = Const (l * r)"|
  "simplifyNonrecursive x = x"

lemma simplifyNonrecursive_preserves_eval[simp]: "eval (simplifyNonrecursive expr) x = eval expr x"
  apply(induction expr rule: simplifyNonrecursive.induct) apply(auto)
  done

    (* Perform algebraic simplification of constants. AKA do constant folding   *)
fun simplify :: "exp \<Rightarrow> exp" where
  "simplify Var = Var"|
  "simplify (Const i) = Const i"|
  "simplify (Add (Const l) (Const r)) = Const (l + r)"|
  "simplify (Mult (Const l) (Const r)) = Const (l * r)"|
  "simplify (Add l r) =
    (let simpleL = simplify l;
         simpleR = simplify r
     in  simplifyNonrecursive (Add simpleL simpleR))" |
  "simplify (Mult l r) =
    (let simpleL = simplify l;
         simpleR = simplify r
     in  simplifyNonrecursive (Mult simpleL simpleR))"

value "simplify (Add (Mult (Const 4) (Const 1)) (Add (Mult (Add (Const 0) (Const 2)) Var) (Mult (Const (- 1)) (Mult Var Var))))"

lemma simplify_preserves[simp]: "eval (simplify expr) x = eval expr x"
  apply(induction expr rule: simplify.induct) apply(auto)
  done

    (* Define a function coeffs that transforms an expression into a polynomial. I'm going to limit my
function to handling canonical expressions only. I assume 0 coefficients are included,
e.g. (Mult (Const 0) Var) *)
    (* TODO/done sort the adds by number of nested multiplies *)
    (* TODO/done I think coeffs needs to do algebraic simplification of constants *)
    (* TODO insert 0 coefficients (probably best done while in exp list form, after sorting.) *)
(* fun coeffsOld :: "exp \<Rightarrow> int list" where
  "coeffsOld (Const i) = [i]"|
  "coeffsOld (Add l r) = coeffsOld l @ coeffsOld r"|
  "coeffsOld (Mult l r) = coeffsOld l @ coeffsOld r"|
  "coeffsOld Var = []"

value "coeffsOld (createPolyExpression [4,2,-1] 0)"
value "coeffsOld (createPolyExpression [4,2,-1,3] 0)" *)

  (* TODO implement using zip and map   *)
fun addCoeffs :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
  "addCoeffs [] r = r" |
  "addCoeffs l [] = l" |
  "addCoeffs (l#ls) (r#rs) = (l+r) # addCoeffs ls rs"

lemma addCoeffs_eval_01[simp]:
  "evalPoly' (addCoeffs r []) x p = evalPoly' r x p"
  apply(induction r)
   apply(auto)
  done

lemma addCoeffs_eval[simp]:
  "evalPoly'(addCoeffs a b) x p = evalPoly' a x p + evalPoly' b x p"
  apply(induction a arbitrary: p rule:addCoeffs.induct)
    apply(auto simp add: algebra_simps)
  done

lemma addCoeffs_zeros[simp]:
  shows "addCoeffs (replicate (length cs - 1) 0) cs = cs"
proof(induction cs)
  case Nil
  then show ?case by simp
next
  case (Cons c cs)
  have "addCoeffs (replicate (length (c # cs) - 1) 0) (c # cs)
      = addCoeffs (replicate (length cs) 0) (c # cs)"
    by simp
  also have "... = addCoeffs (0 # replicate (length cs - 1) 0) (c # cs)"
  proof(induction cs)
    case Nil
    then show ?case by simp
  next
    case (Cons a cs)
    then show ?case by simp
  qed
  also have "... = c # addCoeffs (replicate (length cs - 1) 0) cs" by simp
  also have "... = c # cs"
    using Cons.IH by auto
  finally show ?case by simp
qed

lemma length_addCoeffs:
  shows "length(addCoeffs xs ys) = max (length xs) (length ys)"
proof(induction xs arbitrary: ys)
  case Nil
  then show ?case by simp
next
  case (Cons x xs)
  then show ?case
  proof -
    have "\<forall>is. is = [] \<or> (\<exists>i isa. is = (i::int) # isa)"
      by (meson list.exhaust)
    then obtain ii :: "int list \<Rightarrow> int" and iis :: "int list \<Rightarrow> int list" where
      f1: "\<forall>is. is = [] \<or> is = ii is # iis is"
      by (metis (no_types))
    have f2: "\<forall>i is ia isa. addCoeffs (i # is) (ia # isa) = (ia + i) # addCoeffs is isa"
      by force
    have f3: "ii ys + x = x + ii ys"
      by linarith
    then have f4: "addCoeffs [x] (ii ys # iis ys) = (x + ii ys) # addCoeffs [] (iis ys)"
      using f2 by presburger
    have f5: "\<forall>is. length (addCoeffs xs is) = max (length xs) (length is)"
      using local.Cons by blast
    have f6: "length ([]::int list) + Suc 0 = Suc 0"
      by auto
    have "\<forall>n na nb. max (n::nat) na + nb = max (n + nb) (na + nb)"
      by (metis nat_add_max_left)
    then have f7: "ys = ii ys # iis ys \<and> xs = ii xs # iis xs \<and> addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<longrightarrow> length (addCoeffs (x # xs) ys) = max (length (x # xs)) (length ys)"
      using f5 f3 f2 by (metis (no_types) list.size(4))
    have f8: "ys = [] \<or> ys = ii ys # iis ys"
      using f1 by metis
    have f9: "addCoeffs (x # xs) (ii ys # iis ys) = (x + ii ys) # addCoeffs xs (iis ys)"
      using f3 f2 by presburger
    { assume "length (addCoeffs (x # xs) ys) \<noteq> max (length (x # xs)) (length ys)"
      { assume "addCoeffs (x # xs) ys \<noteq> []"
        moreover
        { assume "addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<and> length (addCoeffs (x # xs) ys) \<noteq> max (length (x # xs)) (length ys)"
          moreover
          { assume "addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<and> length (addCoeffs (x # xs) ys) \<noteq> max (0 + (length ([]::int list) + Suc 0)) (length (iis ys) + (length ([]::int list) + Suc 0))"
            moreover
            { assume "addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<and> max 0 (length (iis ys)) + (length ([]::int list) + Suc 0) \<noteq> length (addCoeffs [] (iis ys)) + Suc 0"
              moreover
              { assume "addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<and> max 0 (length (iis ys)) \<noteq> length (addCoeffs xs (iis ys))"
                then have "addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<and> xs \<noteq> []"
                  by fastforce }
              ultimately have "addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<and> xs \<noteq> []"
                by simp }
            ultimately have "addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<and> xs \<noteq> [] \<or> addCoeffs (x # xs) ys = ii (addCoeffs (x # xs) ys) # iis (addCoeffs (x # xs) ys) \<and> ys \<noteq> ii ys # iis ys"
              using f4 by fastforce }
          ultimately have ?thesis
            using f7 f6 f1 by (metis (full_types) addCoeffs.simps(2) list.size(3) list.size(4) max_0R) }
        ultimately have ?thesis
          using f1 by blast }
      then have ?thesis
        using f9 f8 by fastforce }
    then show ?thesis
      by metis
  qed
qed

lemma addCoeffs_commutative[simp]:
  shows "addCoeffs xs ys = addCoeffs ys xs"
proof(induction xs arbitrary: ys)
  case Nil
  then show ?case by (metis addCoeffs.simps(1) addCoeffs.simps(2) list.exhaust)
next
  case (Cons x xs)
  show ?case
  proof(cases ys)
    case Nil
    then show ?thesis by simp
  next
    case (Cons yh yts)
    then show ?thesis by (simp add: Cons.IH)
  qed
qed

  (* left, right, prefix (a list of some 0s)   *)
fun multCoeffsHelper :: "int list \<Rightarrow> int list \<Rightarrow> int list \<Rightarrow> int list" where
  "multCoeffsHelper [] _  _ = []" |
  "multCoeffsHelper _  [] _ = []" |
  "multCoeffsHelper (l#ls) rs prefix =
    (let this = prefix @ (map (\<lambda>ri. l*ri) rs);
          next = multCoeffsHelper ls rs (0 # prefix)
      in addCoeffs this next)"

lemma multCoeffsHelper_01:
  "evalPoly (multCoeffsHelper [] coeffs2 []) = evalPoly (multCoeffsHelper coeffs2 [] [])"
  apply(induction coeffs2) by auto

fun multCoeffs :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
  "multCoeffs l r = multCoeffsHelper l r []"

fun multCoeffs_v2 :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
  "multCoeffs_v2 [] _  = []" |
  "multCoeffs_v2 _  [] = []" |
  "multCoeffs_v2 [l] rs = map (\<lambda>x. l*x) rs"| (* TODO remove? helper for proofs. Not sure if it's useful *)
  "multCoeffs_v2 (l#ls) (r#rs) =
    (let l_times_rs = (map (op * l) rs);
         ls_times_rrs = multCoeffs_v2 ls (r#rs)
      in (l*r) # addCoeffs l_times_rs ls_times_rrs)"

lemma multCoeffs_v2_emptylist_commutative[simp]:
  "evalPoly (multCoeffs_v2 [] coeffs2) = evalPoly (multCoeffs_v2 coeffs2 [])"
  apply(induction coeffs2) by auto

  (* 3rd arg is (power + 1) *)
(* fun multCoeffs_v3_helper :: "int list \<Rightarrow> int list \<Rightarrow> nat \<Rightarrow> int list" where
  "multCoeffs_v3_helper [] _  _ = []" |
  "multCoeffs_v3_helper _  [] _ = []" |
  "multCoeffs_v3_helper xs ys _ = []"

fun multCoeffs_v3 :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
  "multCoeffs_v3 xs ys = multCoeffs_v3_helper xs ys 1" *)

(* Multiply each value in coefficient list by s
equivalent to map (op * s), but supposedly easier to prove things. *)
fun multCoeffs_by_scalar :: "int \<Rightarrow> int list \<Rightarrow> int list" where
  "multCoeffs_by_scalar _ [] = []" |
  "multCoeffs_by_scalar s (x#xs) = x*s # multCoeffs_by_scalar s xs"

lemma multCoeffs_by_scalar_0[simp]:
  shows "multCoeffs_by_scalar 0 cs = replicate (length cs) 0"
proof(induction cs)
  case Nil
  then show ?case by simp
next
  case (Cons c cs)
  then show ?case by simp
qed

lemma multCoeffs_by_scalar_1[simp]:
  shows "multCoeffs_by_scalar 1 cs = cs"
proof(induction cs)
  case Nil
  then show ?case by simp
next
  case (Cons c cs)
  then show ?case by simp
qed

fun multCoeffs_v4 :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
  "multCoeffs_v4 [] _  = []" |
  "multCoeffs_v4 (l#ls) rs =
    (let mult_l = multCoeffs_by_scalar l rs;
         rest = multCoeffs_v4 ls (0 # rs)
      in addCoeffs mult_l rest)"

lemma multCoeffs_v4_by_list0[simp]:
  shows"multCoeffs_v4 [0] cr = replicate (length cr) 0"
proof(induction cr)
  case Nil
  then show ?case by simp
next
  case (Cons c cr)
  then show ?case by simp
qed

lemma multCoeffs_v4_by_list1[simp]:
  shows"multCoeffs_v4 [1] cr = cr"
proof(induction cr)
  case Nil
  then show ?case by simp
next
  case (Cons c cr)
  then show ?case by simp
qed

lemma multCoeffs_by_scalar_distributes[simp]: "evalPoly' (multCoeffs_by_scalar a xs) x d = a * (evalPoly' xs x d)"
  apply(induction xs arbitrary: d)
   apply simp
  apply auto
  apply(auto simp add: algebra_simps)
  done

lemma multiplying_by_x_extends_coeff_list: "x * evalPoly' a x d = evalPoly' (0 # a) x d"
  apply(induction a arbitrary: d)
   apply(auto simp add: algebra_simps)
  done

lemma succ_of_exponent_is_times_x: "evalPoly' a x (Suc d) = x * evalPoly' a x d"
  apply(induction d)
   apply (simp add: multiplying_by_x_extends_coeff_list)
  by (simp add: multiplying_by_x_extends_coeff_list)

lemma evalp_mult_can_swap: "evalPoly' a x 0 * evalPoly' b x n = evalPoly' b x 0 * evalPoly' a x n"
  apply(induction n)
   apply auto
  by (simp add: succ_of_exponent_is_times_x)

lemma mult_is_star: "evalPoly' (multCoeffs_v4 a b) x 0 = (evalPoly' a x 0) * (evalPoly' b x 0)"
  apply(induction a arbitrary: b)
   apply simp
  apply auto
  apply(simp add: algebra_simps evalp_mult_can_swap)
  done

value "multCoeffs_v4 [1,2] [3,4]"

fun coeffs :: "exp \<Rightarrow> int list" where
  "coeffs Var = [0, 1]"  |
  "coeffs (Const i) = [i]"|
  "coeffs (Add l r) = addCoeffs (coeffs l) (coeffs r)" |
  "coeffs (Mult l r) = multCoeffs_v4 (coeffs l) (coeffs r)"

value "coeffs (createPolyExpression [4,2,-1] 0)"
value "coeffs (Mult (createPolyExpression [1,2,3] 0) (createPolyExpression [4,5] 0))"

theorem ceoffs_preserves_eval[simp]: "evalPoly(coeffs expr) x = eval expr x"
  apply(induction expr)
     apply(auto)
  by (simp add: mult_is_star)

end


(*  Title:      HOL/Isar_Examples/Summation.thy
    Author:     Makarius
*)

section \<open>Summing natural numbers\<close>

theory Summation
  imports MainRLT
begin

text \<open>
  Subsequently, we prove some summation laws of natural numbers (including
  odds, squares, and cubes). These examples demonstrate how plain natural
  deduction (including induction) may be combined with calculational proof.
\<close>

subsection \<open>Summation laws\<close>

text \<open>
  The sum of natural numbers \<open>0 + \<cdots> + n\<close> equals \<open>n \<times> (n + 1)/2\<close>. Avoiding
  formal reasoning about division we prove this equation multiplied by \<open>2\<close>.
\<close>

theorem sum_of_naturals:
  "2 * (\<Sum>i::nat=0..n. i) = n * (n + 1)"
  (is "?P n" is "?S n = _")
proof (induct n)
  show "?P 0" by simp
next
  fix n have "?S (n + 1) = ?S n + 2 * (n + 1)"
    by simp
  also assume "?S n = n * (n + 1)"
  also have "\<dots> + 2 * (n + 1) = (n + 1) * (n + 2)"
    by simp
  finally show "?P (Suc n)"
    by simp
qed

text \<open>
  The above proof is a typical instance of mathematical induction. The main
  statement is viewed as some \<open>?P n\<close> that is split by the induction method
  into base case \<open>?P 0\<close>, and step case \<open>?P n \<Longrightarrow> ?P (Suc n)\<close> for arbitrary \<open>n\<close>.

  The step case is established by a short calculation in forward manner.
  Starting from the left-hand side \<open>?S (n + 1)\<close> of the thesis, the final
  result is achieved by transformations involving basic arithmetic reasoning
  (using the Simplifier). The main point is where the induction hypothesis \<open>?S
  n = n \<times> (n + 1)\<close> is introduced in order to replace a certain subterm. So the
  ``transitivity'' rule involved here is actual \<^emph>\<open>substitution\<close>. Also note how
  the occurrence of ``\dots'' in the subsequent step documents the position
  where the right-hand side of the hypothesis got filled in.

  \<^medskip>
  A further notable point here is integration of calculations with plain
  natural deduction. This works so well in Isar for two reasons.

    \<^enum> Facts involved in \<^theory_text>\<open>also\<close>~/ \<^theory_text>\<open>finally\<close> calculational chains may be just
    anything. There is nothing special about \<^theory_text>\<open>have\<close>, so the natural deduction
    element \<^theory_text>\<open>assume\<close> works just as well.

    \<^enum> There are two \<^emph>\<open>separate\<close> primitives for building natural deduction
    contexts: \<^theory_text>\<open>fix x\<close> and \<^theory_text>\<open>assume A\<close>. Thus it is possible to start reasoning
    with some new ``arbitrary, but fixed'' elements before bringing in the
    actual assumption. In contrast, natural deduction is occasionally
    formalized with basic context elements of the form \<open>x:A\<close> instead.

  \<^medskip>
  We derive further summation laws for odds, squares, and cubes as follows.
  The basic technique of induction plus calculation is the same as before.
\<close>

theorem sum_of_odds:
  "(\<Sum>i::nat=0..<n. 2 * i + 1) = n^Suc (Suc 0)"
  (is "?P n" is "?S n = _")
proof (induct n)
  show "?P 0" by simp
next
  fix n
  have "?S (n + 1) = ?S n + 2 * n + 1"
    by simp
  also assume "?S n = n^Suc (Suc 0)"
  also have "\<dots> + 2 * n + 1 = (n + 1)^Suc (Suc 0)"
    by simp
  finally show "?P (Suc n)"
    by simp
qed

text \<open>
  Subsequently we require some additional tweaking of Isabelle built-in
  arithmetic simplifications, such as bringing in distributivity by hand.
\<close>

lemmas distrib = add_mult_distrib add_mult_distrib2

theorem sum_of_squares:
  "6 * (\<Sum>i::nat=0..n. i^Suc (Suc 0)) = n * (n + 1) * (2 * n + 1)"
  (is "?P n" is "?S n = _")
proof (induct n)
  show "?P 0" by simp
next
  fix n
  have "?S (n + 1) = ?S n + 6 * (n + 1)^Suc (Suc 0)"
    by (simp add: distrib)
  also assume "?S n = n * (n + 1) * (2 * n + 1)"
  also have "\<dots> + 6 * (n + 1)^Suc (Suc 0) =
      (n + 1) * (n + 2) * (2 * (n + 1) + 1)"
    by (simp add: distrib)
  finally show "?P (Suc n)"
    by simp
qed

theorem sum_of_cubes:
  "4 * (\<Sum>i::nat=0..n. i^3) = (n * (n + 1))^Suc (Suc 0)"
  (is "?P n" is "?S n = _")
proof (induct n)
  show "?P 0" by (simp add: power_eq_if)
next
  fix n
  have "?S (n + 1) = ?S n + 4 * (n + 1)^3"
    by (simp add: power_eq_if distrib)
  also assume "?S n = (n * (n + 1))^Suc (Suc 0)"
  also have "\<dots> + 4 * (n + 1)^3 = ((n + 1) * ((n + 1) + 1))^Suc (Suc 0)"
    by (simp add: power_eq_if distrib)
  finally show "?P (Suc n)"
    by simp
qed

text \<open>
  Note that in contrast to older traditions of tactical proof scripts, the
  structured proof applies induction on the original, unsimplified statement.
  This allows to state the induction cases robustly and conveniently.
  Simplification (or other automated) methods are then applied in terminal
  position to solve certain sub-problems completely.

  As a general rule of good proof style, automatic methods such as \<open>simp\<close> or
  \<open>auto\<close> should normally be never used as initial proof methods with a nested
  sub-proof to address the automatically produced situation, but only as
  terminal ones to solve sub-problems.
\<close>

end


theory Ex3_1
  imports Main
begin

primrec pow :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "pow _ 0 = 1"|
  "pow b (Suc e) = b * pow b e"

lemma lem1 : "pow 1 n = 1" by (induction n ; simp)

lemma lem2 : "pow x (n + m) = pow x n * pow x m"
proof (induction n arbitrary : m)
  case 0
  then show ?case by simp
next
  case (Suc n)
    assume hyp:"\<And> m . pow x (n + m) = pow x n * pow x m"
  then show ?case by simp
qed

lemma lem3 :  "pow (x * y) n = pow x n * pow y n" by (induction n; simp)

theorem pow_mult : "pow x (m * n) = pow (pow x m) n"
proof (induction m)
  case 0
  then show ?case using lem1 by simp
next
  case (Suc m)
  assume hyp:"pow x (m * n) = pow (pow x m) n"
  have "pow x (Suc m * n) = pow x ((m + 1) * n)" by simp
  also have "\<dots> = pow x (m * n + n)" by (simp add: semiring_normalization_rules(2))
  also have "\<dots> = pow x (m * n) * pow x n"  by (simp add : lem2)
  also have "\<dots> =  pow (pow x m) n * pow x n" by (simp add : hyp)
  finally have tmp:"pow x (Suc m * n) = pow (pow x m) n * pow x n" by assumption
  have "pow (pow x (Suc m)) n = pow (x * pow x  m) n" by simp
  also have "\<dots> = pow x n * pow (pow x m) n" using lem3 by simp
  finally show ?case using tmp by simp
qed

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

lemma lem4 : "sum (xs @ ys) = sum xs + sum ys" by (induction xs ; simp)

theorem sum_rev : "sum (rev ns) = sum ns"  by (induction ns ; simp add : lem4)

primrec Sum :: "(nat \<Rightarrow> nat ) \<Rightarrow> nat \<Rightarrow> nat" where
  "Sum f 0 = 0"|
  "Sum f (Suc k) = f k + Sum f k"

theorem "Sum (\<lambda>i . f i + g i) k  = Sum f k + Sum g k" by (induction k ; simp)

theorem "Sum f (k + l) = Sum f k + Sum (\<lambda>x .f  (k + x)) l" by (induction l; simp)

theorem "Sum f k = sum (map f [0 ..<k])"
proof (induction k)
  case 0
  then show ?case by simp
next
  case (Suc k)
  then show ?case by (simp add: lem4)
qed


theory Searching imports Main begin

text \<open> Define a function @{text first_pos} that computes the index
of the first element in a list that satisfies a given predicate: \<close>

(*<*) consts (*>*)
  first_pos' :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> nat"

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

text \<open> 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. \<close>

text \<open> 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. \<close>

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

text \<open> Prove that @{text first_pos} returns the length of the list if
and only if no element in the list satisfies the given predicate. \<close>

lemma "((first_pos P xs) = (length xs)) = (\<not>(list_ex P xs))"
  apply (induction xs) by auto

text \<open> Now prove: \<close>

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

text \<open> 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). \<close>

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

text \<open> 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. \<close>

lemma "(\<And> x. (P x \<Longrightarrow> Q x)) \<Longrightarrow> (first_pos Q xs \<le> first_pos P xs)"
  apply (induction xs) by auto

text \<open> Define a function @{text count} that counts the number of
elements in a list that satisfy a given predicate. \<close>

(*<*) consts (*>*)
  count' :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> nat"

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

text \<open> 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. \<close>

lemma "count P (rev xs) = count P xs"
  apply (induction xs) by auto

text \<open> Find and prove a connection between the two functions @{text filter}
and @{text count}. \<close>

lemma "length (filter P xs) = count P xs"
  apply (induction xs) by auto

(*<*) end (*>*)


header {* Solutions to Chapter 5 of "Concrete Semantics" *}

theory Chap_five imports Main begin

declare [[names_short]]

(* 5.1 *)

lemma assumes T: "\<forall> x y. T x y \<or> T y x"
 and A: "\<forall> x y. A x y \<and> A y x \<longrightarrow> x = y"
 and TA: "\<forall> x y. T x y \<longrightarrow> A x y" and "A x y"
 shows "T x y"
proof (rule ccontr)
  assume "\<not> T x y"
  from this and T have "T y x" by (blast)
  from this and TA have "A y x" by (blast)
  from this and `A x y` and A have "x = y" by (blast)
  from this and `\<not> T x y` and `T y x` show "False" by (blast)
qed

(* 5.2 *)

lemma "(\<exists> ys zs. xs = ys @ zs \<and> length ys = length zs) \<or>
 (\<exists> ys zs. xs = ys @ zs \<and> length ys = length zs + 1)" (is "?T \<or> ?S")
proof cases
 assume "2 dvd (length xs)"
 then obtain k where xsk: "(length xs) = 2*k" by (auto simp add: dvd_def)
 obtain ys where ys:"ys = take k xs" by auto
 obtain zs where zzs:"zs = drop k xs" by auto
 have "length ys = k" using ys and xsk by auto
 then have "xs = ys @ zs" using ys and zzs by (metis append_eq_conv_conj)
 moreover have "length ys = length zs" using zzs and ys and xsk by auto
 ultimately show ?thesis by auto
next
 assume "\<not> 2 dvd (length xs)"
 hence "\<exists> k. length xs = 2 * k + 1" by arith
 then obtain k where xsk: "length xs = 2 * k + 1" by blast
 obtain ys where yys:"ys = take (Suc k) xs" by auto
 obtain zs where zzs:"zs = drop (Suc k) xs" by auto
 have "length ys = Suc k" using yys and xsk by auto
 hence "xs = ys @ zs" using yys and zzs by (metis append_eq_conv_conj)
 moreover have "length ys = length zs + 1" using zzs and yys and xsk by auto
 ultimately show ?thesis by auto
qed

(* 5.3 *)

inductive ev :: "nat \<Rightarrow> bool" where
ev0: "ev 0" |
evSS: "ev n \<Longrightarrow> ev(Suc(Suc n))"

lemma assumes a: "ev (Suc (Suc n))" shows "ev n"
proof -
 show ?thesis using a
 proof cases
  case evSS
  thus ?thesis by auto
 qed
qed

(* 5.4 *)

lemma "\<not> ev (Suc (Suc (Suc 0)))" (is "\<not> ?P")
proof
 assume "?P"
 hence "ev (Suc 0)" by cases
 thus False by cases
qed

(* 5.5 *)

inductive star :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow>  bool" for r where
refl: "star r x x" |
step: "r x y \<Longrightarrow> star r y z  \<Longrightarrow> star r x z"

inductive iter :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" where
it0: "iter r 0 x x" |
it_SS: "r x y \<Longrightarrow> iter r n y z \<Longrightarrow> iter r (Suc n) x z"

lemma "iter r n x y \<Longrightarrow> star r x y"
proof (induction rule: iter.induct)
 case it0
 show ?case by (rule star.refl)
next
 case it_SS
 thus ?case by (auto intro: star.step)
qed

(* 4.6 *)

fun elems :: "'a list \<Rightarrow> 'a set" where
"elems [] = {}" |
"elems (a # xs) = {a} \<union> elems xs"

lemma fixes x :: 'a shows "x \<in> elems xs \<Longrightarrow> \<exists> ys zs. xs = ys @ x # zs \<and> x \<notin> elems ys"
proof (induction xs)
 case Nil
 thus ?case by auto
next
 case (Cons a xs)
 show ?case
 proof cases
  assume "a = x"
  obtain ys where ys: "(ys :: 'a list) = []" by auto
  obtain zs where zs: "zs = xs" by auto
  have "a \<notin> elems ys" using ys by auto
  thus ?thesis using ys zs `a = x` by blast
 next
  assume "a \<noteq> x"
  hence "x \<in> elems xs" using Cons.prems by auto
  then obtain old_ys ys zs where
   "ys = a # old_ys" "xs = old_ys @ x # zs \<and> x \<notin> elems old_ys" using Cons.IH by auto
  hence "a # xs = ys @ x # zs \<and> x \<notin> elems ys" using `a \<noteq> x` by auto
  thus ?thesis by auto
 qed
qed


theory Exercises3_01
  imports Main
begin

(*---------------- Exercise 3.1----------------*)
(* tree datatype *)
datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"

(* return elements of tree in a set *)
fun set :: "'a tree \<Rightarrow> 'a set" where
"set Tip = {}" |
"set (Node l a r) = {a} \<union> (set l) \<union> (set r)"

(* find max among two int options *)
fun max_opt :: "int option \<Rightarrow> int option \<Rightarrow> int option" where
"max_opt None None = None" |
"max_opt (Some a) None = Some a" |
"max_opt None (Some b) = Some b" |
"max_opt (Some a) (Some b) = Some(max a b)"

(* find min among two int options *)
fun min_opt :: "int option \<Rightarrow> int option \<Rightarrow> int option" where
"min_opt None None = None" |
"min_opt (Some a) None = Some a" |
"min_opt None (Some b) = Some b" |
"min_opt (Some a) (Some b) = Some (min a b)"

(* check if int option in lesser than int*)
fun less_opt :: "int option \<Rightarrow> int \<Rightarrow> bool" where
"less_opt None _ = True" |
"less_opt (Some a) b = (a \<le> b)"

(* check if int option is greater than int*)
fun greater_opt :: "int option \<Rightarrow> int \<Rightarrow> bool" where
"greater_opt None _ = True" |
"greater_opt (Some a) b = (a \<ge> b)"

(* find max element in subtree *)
fun max_tree :: "int tree \<Rightarrow> int option" where
"max_tree Tip = None" |
"max_tree (Node l a r) = max_opt (Some a) (max_opt (max_tree l) (max_tree r))"

(* find min element in subtree*)
fun min_tree :: "int tree \<Rightarrow> int option" where
"min_tree Tip = None" |
"min_tree (Node l a r) = min_opt (Some a) (min_opt (min_tree l) (min_tree r))"

(* check if tree is ordered *)
fun ord :: "int tree \<Rightarrow> bool" where
"ord Tip = True" |
"ord (Node l a r) = ((less_opt (max_tree l) a) \<and> (greater_opt (min_tree r) a) \<and> (ord l) \<and> (ord r))"

(* insert element in binary ordered tree
NOTE: element is always inserted as a leaf*)
fun ins :: "int \<Rightarrow> int tree \<Rightarrow> int tree" where
"ins e Tip = (Node Tip e Tip)" |
"ins e (Node l a r) = (if (a=e) then (Node l a r) else (if (e < a) then (Node (ins e l) a r) else (Node l a (ins e r))))"

(* theorems for insertion correctness*)
(* theorem 1: correct addition of element *)
theorem insert_correctness : "set (ins x t) = {x} \<union> (set t)"
  apply(induction t)
   apply(auto)
  done

lemma max_opt_some_y : "max_opt (Some a) y = max_opt y (Some a)"
  apply(induction y)
   apply(auto)
  done

lemma max_opt_some_xy : "max_opt (max_opt x (Some a)) y = max_opt x (max_opt y (Some a))"
  apply(induction x; induction y)
     apply(auto)
  done

lemma max_opt_cover : "max_opt (max_opt x y) z = max_opt x (max_opt y z)"
  apply(induction x; induction y; induction z)
         apply(auto)
  done

lemma max_insert : "max_tree (ins i t) = max_opt (Some i) (max_tree t)"
  apply(induction t)
   apply(auto simp add:max_opt_some_y)
    apply(auto simp add:max_opt_some_xy)
   apply(auto simp add:max_opt_cover)
  done

lemma less_max_opt : "less_opt x z \<Longrightarrow> less_opt y z \<Longrightarrow> less_opt (max_opt x y) z"
  apply(induction x; induction y)
     apply(auto)
  done

lemma min_opt_some_y : "min_opt (Some a) y = min_opt y (Some a)"
  apply(induction y)
   apply(auto)
  done

lemma min_opt_some_xy : "min_opt (min_opt x (Some a)) y = min_opt x (min_opt y (Some a))"
  apply(induction x; induction y)
     apply(auto)
  done

lemma min_opt_cover : "min_opt (min_opt x y) z = min_opt x (min_opt y z)"
  apply(induction x; induction y; induction z)
         apply(auto)
  done

lemma min_insert : "min_tree (ins i t) = min_opt (Some i) (min_tree t)"
  apply(induction t)
   apply(auto simp add:min_opt_some_y)
    apply(auto simp add:min_opt_some_xy)
   apply(auto simp add:min_opt_cover)
  done

lemma greater_min_opt : "greater_opt x z \<Longrightarrow> greater_opt y z \<Longrightarrow> greater_opt (min_opt x y) z"
  apply(induction x; induction y)
     apply(auto)
  done

(* theorem 2: preservation of order*)
theorem order_correctness : "ord t \<Longrightarrow> ord (ins i t)"
  apply(induction t)
   apply(auto)
   apply(auto simp add:max_insert)
   apply(auto simp add:less_max_opt)
  apply(auto simp add:min_insert)
  apply(auto simp add:greater_min_opt)
  done

end


(*  Title:      HOL/ex/NatSum.thy
    Author:     Tobias Nipkow
*)

section \<open>Summing natural numbers\<close>

theory NatSum
  imports Main
begin

text \<open>
  Summing natural numbers, squares, cubes, etc.

  Thanks to Sloane's On-Line Encyclopedia of Integer Sequences,
  \<^url>\<open>https://oeis.org\<close>.
\<close>

lemmas [simp] =
  ring_distribs
  diff_mult_distrib diff_mult_distrib2 \<comment> \<open>for type nat\<close>

text \<open>\<^medskip> The sum of the first \<open>n\<close> odd numbers equals \<open>n\<close> squared.\<close>

lemma sum_of_odds: "(\<Sum>i=0..<n. Suc (i + i)) = n * n"
  by (induct n) auto

text \<open>\<^medskip> The sum of the first \<open>n\<close> odd squares.\<close>

lemma sum_of_odd_squares:
  "3 * (\<Sum>i=0..<n. Suc(2*i) * Suc(2*i)) = n * (4 * n * n - 1)"
  by (induct n) auto

text \<open>\<^medskip> The sum of the first \<open>n\<close> odd cubes.\<close>

lemma sum_of_odd_cubes:
  "(\<Sum>i=0..<n. Suc (2*i) * Suc (2*i) * Suc (2*i)) =
    n * n * (2 * n * n - 1)"
  by (induct n) auto

text \<open>\<^medskip> The sum of the first \<open>n\<close> positive integers equals \<open>n (n + 1) / 2\<close>.\<close>

lemma sum_of_naturals: "2 * (\<Sum>i=0..n. i) = n * Suc n"
  by (induct n) auto

lemma sum_of_squares: "6 * (\<Sum>i=0..n. i * i) = n * Suc n * Suc (2 * n)"
  by (induct n) auto

lemma sum_of_cubes: "4 * (\<Sum>i=0..n. i * i * i) = n * n * Suc n * Suc n"
  by (induct n) auto

text \<open>\<^medskip> A cute identity:\<close>

lemma sum_squared: "(\<Sum>i=0..n. i)^2 = (\<Sum>i=0..n. i^3)" for n :: nat
proof (induct n)
  case 0
  show ?case by simp
next
  case (Suc n)
  have "(\<Sum>i = 0..Suc n. i)^2 =
        (\<Sum>i = 0..n. i^3) + (2*(\<Sum>i = 0..n. i)*(n+1) + (n+1)^2)"
    (is "_ = ?A + ?B")
    using Suc by (simp add: eval_nat_numeral)
  also have "?B = (n+1)^3"
    using sum_of_naturals by (simp add: eval_nat_numeral)
  also have "?A + (n+1)^3 = (\<Sum>i=0..Suc n. i^3)" by simp
  finally show ?case .
qed

text \<open>\<^medskip> Sum of fourth powers: three versions.\<close>

lemma sum_of_fourth_powers:
  "30 * (\<Sum>i=0..n. i * i * i * i) =
    n * Suc n * Suc (2 * n) * (3 * n * n + 3 * n - 1)"
proof (induct n)
  case 0
  show ?case by simp
next
  case (Suc n)
  then show ?case
    by (cases n)  \<comment> \<open>eliminates the subtraction\<close>
      simp_all
qed

text \<open>
  Two alternative proofs, with a change of variables and much more
  subtraction, performed using the integers.
\<close>

lemma int_sum_of_fourth_powers:
  "30 * int (\<Sum>i=0..<m. i * i * i * i) =
    int m * (int m - 1) * (int(2 * m) - 1) *
    (int(3 * m * m) - int(3 * m) - 1)"
  by (induct m) simp_all

lemma of_nat_sum_of_fourth_powers:
  "30 * of_nat (\<Sum>i=0..<m. i * i * i * i) =
    of_nat m * (of_nat m - 1) * (of_nat (2 * m) - 1) *
    (of_nat (3 * m * m) - of_nat (3 * m) - (1::int))"
  by (induct m) simp_all

text \<open>\<^medskip> Sums of geometric series: \<open>2\<close>, \<open>3\<close> and the general case.\<close>

lemma sum_of_2_powers: "(\<Sum>i=0..<n. 2^i) = 2^n - (1::nat)"
  by (induct n) auto

lemma sum_of_3_powers: "2 * (\<Sum>i=0..<n. 3^i) = 3^n - (1::nat)"
  by (induct n) auto

lemma sum_of_powers: "0 < k \<Longrightarrow> (k - 1) * (\<Sum>i=0..<n. k^i) = k^n - 1"
  for k :: nat
  by (induct n) auto

end


theory Chapter2
  imports Main
begin

fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"add 0 n = n" |
"add (Suc m) n = Suc (add m n)"

lemma add_02 [simp]: "add m 0 = m"
  apply(induction m)
  apply(auto)
  done

(* Exercise 2.1: Use the value command to evaluate the following expressions: *)
value "1 + (2::nat)"
value "1 + (2::int)"
value "1 - (2::nat)"
value "1 - (2::int)"

(* Exercise 2.2: Start from the definition of add given above. Prove that add
   is associative and commutative. Define a recursive function double :: nat \<Rightarrow> nat
   and prove double m = add m m. *)
lemma add_assoc [simp]: "add (add a b) c = add a (add b c)"
  apply(induction a)
  apply(auto)
  done

lemma add_assoc1 [simp]: "add n (Suc m) = add (Suc n) m"
  apply(induction n)
   apply(auto)
  done

lemma add_comm: "add a b = add b a"
  apply(induction a)
   apply(auto)
  done

fun double :: "nat \<Rightarrow> nat" where
"double 0 = 0" |
"double (Suc n) = Suc (Suc (double n))"

lemma double_eq_add_itself: "double n = add n n"
  apply(induction n)
   apply(auto)
  done

(* Exercise 2.3: Define a function count :: 'a \<Rightarrow> 'a list \<Rightarrow> nat that counts the number
   of occurrences of an element in a list. Prove count x xs \<le> length xs. *)
fun count :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
"count _ [] = 0" |
"count x (y # xs) = (if x = y then Suc (count x xs) else count x xs)"

lemma never_count_more_than_len: "count x xs \<le> length xs"
  apply(induction xs)
   apply(auto)
  done

(* Exercise 2.4: Define a recursive function snoc : 'a list \<Rightarrow> 'a \<Rightarrow> 'a list
   that appends an element to the end of a list. With the help of snoc define a recursive function
   reverse :: 'a list \<Rightarrow> 'a list that reverses a list. Prove reverse (reverse xs) = xs. *)
fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
"snoc [] e = [e]" |
"snoc (x # xs) e = x # (snoc xs e)"

fun reverse :: "'a list \<Rightarrow> 'a list" where
"reverse [] = []" |
"reverse (x # xs) = snoc (reverse xs) x"

lemma reverse_app [simp]: "reverse (snoc xs y) = y # (reverse xs)"
  apply(induction xs)
  apply(auto)
  done

lemma reverse_twice: "reverse (reverse xs) = xs"
  apply(induction xs)
   apply(auto)
  done

(* Exercise 2.5: Define a recursive function sum_upto :: nat \<Rightarrow> nat such that
   sum_upto n = 0 + ... + n and prove sum_upto n = n * (n + 1_) div 2. *)
fun sum_upto :: "nat \<Rightarrow> nat" where
"sum_upto 0 = 0" |
"sum_upto (Suc n) = (Suc n) + sum_upto n"

lemma gauss: "sum_upto n = n * (n + 1) div 2"
  apply(induction n)
  apply(auto)
  done

(* Exercise 2.6. Starting from the type \<Zprime>a tree defined in the text, define a function
   contents :: \<Zprime>a tree \<Rightarrow> \<Zprime>a list that collects all values in a tree in a list, in any order,
   without removing duplicates. Then define a function sum_tree :: nat tree \<Rightarrow> nat that sums up
   all values in a tree of natural numbers and prove sum_tree t = sum_list (contents t)
   (where sum_list is predefined). *)
datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"

fun contents :: "'a tree \<Rightarrow> 'a list" where
"contents Tip = []" |
"contents (Node l v r) = contents l @ (v # contents r)"

fun sum_tree :: "nat tree \<Rightarrow> nat" where
"sum_tree Tip = 0" |
"sum_tree (Node l v r) = sum_tree l + v + sum_tree r"

lemma sum_tree_lemma: "sum_tree t = sum_list (contents t)"
  apply(induction t)
  apply(auto)
  done

(* Exercise 2.7. Define the two functions pre_order and post_order of type \<Zprime>a tree \<Rightarrow> \<Zprime>a list
   that traverse a tree and collect all stored values in the respective order in a list.
   Prove pre_order (mirror t) = rev (post_order t). *)
fun mirror :: "'a tree \<Rightarrow> 'a tree" where
"mirror Tip = Tip" |
"mirror (Node l a r) = Node (mirror r) a (mirror l)"

fun pre_order :: "'a tree \<Rightarrow> 'a list" where
"pre_order Tip = []" |
"pre_order (Node l a r) = a # (pre_order l) @ (pre_order r)"

fun post_order :: "'a tree \<Rightarrow> 'a list" where
"post_order Tip = []" |
"post_order (Node l v r) = post_order l @ post_order r @ [v]"

lemma pre_order_of_mirror_eq_rev_post_order: "pre_order (mirror t) = rev (post_order t)"
  apply(induction t)
   apply(auto)
  done

(* Exercise 2.8. Define a function intersperse :: \<Zprime>a \<Rightarrow> \<Zprime>a list \<Rightarrow> \<Zprime>a list such that
   intersperse a [x1, ..., xn] = [x1, a, x2, a, ..., a, xn]. Now prove that
   map f (intersperse a xs) = intersperse (f a) (map f xs). *)
fun intersperse :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"intersperse a [] = []" |
"intersperse a [x] = [x]" |
"intersperse a (x # xs) = x # (a # (intersperse a xs))"

lemma map_comm: "map f (intersperse a xs) = intersperse (f a) (map f xs)"
  apply(induction xs rule: intersperse.induct)
    apply(auto)
  done

(* Exercise 2.9. Write a tail-recursive variant of the add function on nat: itadd.
   Tail-recursive means that in the recursive case, itadd needs to call itself
   directly: itadd (Suc m) n = itadd .... Prove itadd m n = add m n. *)
fun itadd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"itadd 0 n = n" |
"itadd (Suc m) n = itadd m (Suc n)"

lemma itadd_works: "itadd m n = add m n"
  apply(induction m arbitrary: n)
   apply(auto)
  done

(* Exercise 2.10. Define a datatype tree0 of binary tree skeletons which do not
   store any information, neither in the inner nodes nor in the leaves. Define a
   function nodes :: tree0 \<Rightarrow> nat that counts the number of all nodes (inner nodes
   and leaves) in such a tree. *)
datatype tree0 = Tip | Node tree0 tree0

fun nodes :: "tree0 \<Rightarrow> nat" where
"nodes Tip = 1" |
"nodes (Node l r) = Suc (nodes l + nodes r)"

fun explode :: "nat \<Rightarrow> tree0 \<Rightarrow> tree0" where
"explode 0 t = t" |
"explode (Suc n) t = explode n (Node t t)"

abbreviation  exp_nodes :: "tree0 \<Rightarrow> nat \<Rightarrow> nat" where
"exp_nodes t n \<equiv> nodes t ^ n" (* WIP *)

(* Find an equation expressing the size of a tree after exploding it
   (nodes (explode n t)) as a function of nodes t and n. Prove your equation.
   You may use the usual arithmetic operators, including the exponentiation
   operator “^”. For example, 2 ^ 2 = 4.
   Hint: simplifying with the list of theorems algebra_simps takes care of
   common algebraic properties of the arithmetic operators. *)

lemma nodes_01: "nodes (explode n t) = exp_nodes t n"
  apply (induction t)
  apply(auto) (* WIP *)

end


section \<open>Weighted Directed Graphs\<close>
theory Directed_Graph
imports Common
begin

text \<open>
  A weighted graph is represented by a function from edges to weights.

  For simplicity, we use @{typ enat} as weights, @{term \<open>\<infinity>\<close>} meaning
  that there is no edge.
\<close>

type_synonym ('v) wgraph = "('v \<times> 'v) \<Rightarrow> enat"

text \<open>We encapsulate weighted graphs into a locale that fixes a graph\<close>
locale WGraph = fixes w :: "'v wgraph"
begin
text \<open>Set of edges with finite weight\<close>
definition "edges \<equiv> {(u,v) . w (u,v) \<noteq> \<infinity>}"

subsection \<open>Paths\<close>
text \<open>A path between nodes \<open>u\<close> and \<open>v\<close> is a list of edge weights
  of a sequence of edges from \<open>u\<close> to \<open>v\<close>.

  Note that a path may also contain edges with weight \<open>\<infinity>\<close>.
\<close>

fun path :: "'v \<Rightarrow> enat list \<Rightarrow> 'v \<Rightarrow> bool" where
  "path u [] v \<longleftrightarrow> u=v"
| "path u (l#ls) v \<longleftrightarrow> (\<exists>uh. l = w (u,uh) \<and> path uh ls v)"

lemma path_append[simp]:
  "path u (ls1@ls2) v \<longleftrightarrow> (\<exists>w. path u ls1 w \<and> path w ls2 v)"
  by (induction ls1 arbitrary: u) auto

text \<open>There is a singleton path between every two nodes
  (it's weight might be \<open>\<infinity>\<close>).\<close>
lemma triv_path: "path u [w (u,v)] v" by auto

text \<open>Shortcut for the set of all paths between two nodes\<close>
definition "paths u v \<equiv> {p . path u p v}"

lemma paths_ne: "paths u v \<noteq> {}" using triv_path unfolding paths_def by blast

text \<open>If there is a path from a node inside a set \<open>S\<close>, to a node outside
  a set \<open>S\<close>, this path must contain an edge from inside \<open>S\<close> to outside \<open>S\<close>.
\<close>
lemma find_leave_edgeE:
  assumes "path u p v"
  assumes "u\<in>S" "v\<notin>S"
  obtains p1 x y p2
    where "p = p1@w (x,y)#p2" "x\<in>S" "y\<notin>S" "path u p1 x" "path y p2 v"
proof -
  have "\<exists>p1 x y p2. p = p1@w (x,y)#p2 \<and> x\<in>S \<and> y\<notin>S \<and> path u p1 x \<and> path y p2 v"
    using assms
  proof (induction p arbitrary: u)
    case Nil
    then show ?case by auto
  next
    case (Cons a p)
    from Cons.prems obtain x where [simp]: "a=w (u,x)" and PX: "path x p v"
      by auto

    show ?case proof (cases "x\<in>S")
      case False with PX \<open>u\<in>S\<close> show ?thesis by fastforce
    next
      case True from Cons.IH[OF PX True \<open>v\<notin>S\<close>] show ?thesis
        by clarsimp (metis WGraph.path.simps(2) append_Cons)
    qed
  qed
  thus ?thesis by (fast intro: that)
qed

subsection \<open>Distance\<close>

text \<open>The (minimum) distance between two nodes \<open>u\<close> and \<open>v\<close> is called \<open>\<delta> u v\<close>.\<close>

definition "\<delta> u v \<equiv> LEAST w::enat. w\<in>sum_list`paths u v"

lemma obtain_shortest_path:
  obtains p where "path s p u" "\<delta> s u = sum_list p"
  unfolding \<delta>_def using paths_ne
  by (smt Collect_empty_eq LeastI_ex WGraph.paths_def imageI image_iff
          mem_Collect_eq paths_def)

lemma shortest_path_least:
  "path s p u \<Longrightarrow> \<delta> s u \<le> sum_list p"
  unfolding \<delta>_def paths_def
  by (simp add: Least_le)

lemma distance_refl[simp]: "\<delta> s s = 0"
  using shortest_path_least[of s "[]" s] by auto

lemma distance_direct: "\<delta> s u \<le> w (s, u)"
  using shortest_path_least[of s "[w (s,u)]" u] by auto

text \<open>Triangle inequality: The distance from \<open>s\<close> to \<open>v\<close> is shorter than
  the distance from \<open>s\<close> to \<open>u\<close> and the edge weight from \<open>u\<close> to \<open>v\<close>. \<close>
lemma triangle: "\<delta> s v \<le> \<delta> s u + w (u,v)"
proof -
  have "path s (p@[w (u,v)]) v" if "path s p u" for p using that by auto
  then have "(+) (w (u,v)) ` sum_list ` paths s u \<subseteq> sum_list ` paths s v"
    by (fastforce simp: paths_def image_iff simp del: path.simps path_append)
  from least_antimono[OF _ this] paths_ne have
    "(LEAST y::enat. y \<in> sum_list ` paths s v)
    \<le> (LEAST x::enat. x \<in> (+) (w (u,v)) ` sum_list ` paths s u)"
    by (auto simp: paths_def)
  also have "\<dots> = (LEAST x. x \<in> sum_list ` paths s u) + w (u,v)"
    apply (subst Least_mono[of "(+) (w (u,v))" "sum_list`paths s u"])
    subgoal by (auto simp: mono_def)
    subgoal by simp (metis paths_def mem_Collect_eq
                          obtain_shortest_path shortest_path_least)
    subgoal by auto
    done
  finally show ?thesis unfolding \<delta>_def .
qed

text \<open>Any prefix of a shortest path is a shortest path itself.
  Note: The \<open>< \<infinity>\<close> conditions are required to avoid saturation in adding to \<open>\<infinity>\<close>!
\<close>
lemma shortest_path_prefix:
  assumes "path s p\<^sub>1 x" "path x p\<^sub>2 u"
  and DSU: "\<delta> s u = sum_list p\<^sub>1 + sum_list p\<^sub>2" "\<delta> s u < \<infinity>"
  shows "\<delta> s x = sum_list p\<^sub>1" "\<delta> s x < \<infinity>"
proof -
  have "\<delta> s x \<le> sum_list p\<^sub>1" using assms shortest_path_least by blast
  moreover have "\<not>\<delta> s x < sum_list p\<^sub>1" proof
    assume "\<delta> s x < sum_list p\<^sub>1"
    then obtain p\<^sub>1' where "path s p\<^sub>1' x" "sum_list p\<^sub>1' < sum_list p\<^sub>1"
      by (auto intro: obtain_shortest_path[of s x])
    with \<open>path x p\<^sub>2 u\<close> shortest_path_least[of s "p\<^sub>1'@p\<^sub>2" u] DSU show False
      by fastforce
  qed
  ultimately show "\<delta> s x = sum_list p\<^sub>1" by auto
  with DSU show "\<delta> s x < \<infinity>" using le_iff_add by fastforce
qed

end

end


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

Various examples.
*)

theory Examples imports Hoare_Logic Arith2 begin

(*** ARITHMETIC ***)

(** multiplication by successive addition **)

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

lemma "VARS M N P :: int
 {m=M & n=N}
 IF M < 0 THEN M := -M; N := -N ELSE SKIP FI;
 P := 0;
 WHILE 0 < M
 INV {0 <= M & (EX 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 (simp add:int_distrib)
apply clarsimp
apply(rule conjI)
 apply clarsimp
apply clarsimp
done

(** Euclid's algorithm for GCD **)

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
(*Now prove the verification conditions*)
  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

(** Dijkstra's extension of Euclid's algorithm for simultaneous GCD and SCM **)
(* From E.W. Disjkstra. Selected Writings on Computing, p 98 (EWD474),
   where it is given without the invariant. Instead of defining scm
   explicitly we have used the theorem scm x y = x*y/gcd x y and avoided
   division by mupltiplying with gcd x y.
*)

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

(** Power by iterated squaring and multiplication **)

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

(** Factorial **)

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 "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

(** Square root **)

(* the easy way: *)

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

(* without multiplication *)

lemma sqrt_without_multiplication: "VARS u w r x
 {True}
 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 & x=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

(*** LISTS ***)

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_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

(*** ARRAYS ***)

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

(*
The `partition' procedure for quicksort.
`A' is the array to be sorted (modelled as a list).
Elements of A 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 := being used
both for assignment and list update.
*)
lemma lem: "m - Suc 0 < n ==> m < Suc n"
by arith

lemma Partition:
"[| leq == %A i. !k. k<i --> A!k <= pivot;
    geq == %A i. !k. i<k & k<length A --> pivot <= A!k |] ==>
 VARS A u l
 {0 < length(A::('a::order)list)}
 l := 0; u := length A - Suc 0;
 WHILE l <= u
  INV {leq A l & geq A u & u<length A & l<=length A}
  DO WHILE l < length A & A!l <= pivot
     INV {leq A l & geq A u & u<length A & l<=length A}
     DO l := l+1 OD;
     WHILE 0 < u & pivot <= A!u
     INV {leq A l & geq A u  & u<length A & l<=length A}
     DO u := u - 1 OD;
     IF l <= u THEN A := A[l := A!u, u := A!l] ELSE SKIP FI
  OD
 {leq A u & (!k. u<k & k<l --> A!k = pivot) & geq A l}"
(* expand and delete abbreviations first *)
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


theory GabrielaLimonta
imports Main
begin

(** Score: 10/10 *)

(* Homework 1.1 *)

fun pow2 :: "nat \<Rightarrow> nat" where
  "pow2 0       = 1"
| "pow2 (Suc n) = 2 * pow2 n"

value "pow2 3 = 8"

(*
   Informal proof of "pow2 (n + m) = pow2 n * pow2 m"

   We use induction over n.
   Base case n=0:
   pow2 (0 + m) = pow2 0 * pow2 m
 =  < 0 + m = m >
   pow2 m = pow2 0 * pow2 m
 =  < pow2 0 = 1 >
   pow2 m = 1 * pow2 m
 =  < 1 * m = m, in which [m:=pow2 m] >
   pow2 m = pow2 m

   Inductive case:
   (IH): pow2 (n + m) = pow2 n * pow2 m

   pow2 ((Suc n) + m) = pow2 (Suc n) * pow2 m
 =  < pow2 (Suc n) = 2 * pow2 n >
   pow2 ((Suc n) + m) = (2 * pow2 n) * pow2 m >
 =  < (a*b)*c = a*(b*c), in which [a,b,c:=2,pow2 n, pow2 m] >
   pow2 ((Suc n) + m) = 2 * (pow2 n * pow2 m)
 =  < Using Inductive Hypothesis (IH) >
   pow2 ((Suc n) + m) = 2 * pow2 (n + m)
 =  < (Suc n) + m = Suc(n + m) >
   pow2 (Suc(n + m)) = 2 * pow2 (n + m)
 =  < pow2 (Suc n() = 2 * pow2 n, in which [n:=n+m] >
   2 * pow2 (n + m) = 2 * pow2 (n + m)

*)

lemma "pow2 (n + m) = pow2 n * pow2 m"
  apply(induction n)
  apply(auto)
  done

(* Homework 1.2 *)

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

value "double []"
value "double [a,b,c,d]"

lemma aux: "double(xs @ [x]) = double xs @ [x,x]"
  apply(induction xs)
  apply(auto)
  done

lemma rev_double: "rev(double xs) = double(rev xs)"
  apply(induction xs)
  apply(auto simp: aux)
  done

end


theory Exercises2_11
  imports Main
begin

(*---------------- Exercise 2.11----------------*)
(* expression datatype*)
datatype exp = Var | Const int | Add exp exp | Mult exp exp

(* eval function *)
(* evaluates an expression at a given value*)
fun eval :: "exp \<Rightarrow> int \<Rightarrow> int" where
"eval Var v = v" |
"eval (Const e) v = e" |
"eval (Add e f) v = (eval e v) + (eval f v)" |
"eval (Mult e f) v = (eval e v) * (eval f v)"

(* evalp function *)
(* evaluates a polynomial at a given value*)
fun evalp :: "int list \<Rightarrow> int \<Rightarrow> int" where
"evalp Nil v = 0" |
"evalp (Cons x xs) v = x + v * (evalp xs v)"

(* add coefficients for two lists
Examples: (addition is from the left)
[2,3,4] + [4,5] = [6,7,4]
[5,6] + [3,2,6] = [8,8,6]
*)
fun add_coeff :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
"add_coeff Nil Nil = Nil" |
"add_coeff Nil ys = ys" |
"add_coeff xs Nil = xs" |
"add_coeff (x#xs) (y#ys) = (x+y)#(add_coeff xs ys)"

lemma evalp_add[simp] : "evalp (add_coeff xs ys) x = (evalp xs x) + (evalp ys x)"
  apply(induction xs rule: add_coeff.induct)
     apply(auto simp add: algebra_simps)
  done

(* multiply all items in a list with a number
Example:
4 * [3,4,2] = [12,16,8]
*)
fun mult :: "int \<Rightarrow> int list \<Rightarrow> int list" where
"mult n Nil = Nil" |
"mult n (x#xs) = (n*x)#(mult n xs)"

lemma evalp_mul[simp] : "evalp (mult n xs) v = n * (evalp xs v)"
  apply(induction xs)
   apply(auto simp add:algebra_simps)
  done

(* multiply coefficients for two lists
Example:
[1,2,3]*[4,5] = [4,13,22,15]
[1,1,1]*[1,1] = [1,2,2,1]
*)
fun mult_coeff :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
"mult_coeff Nil ys = Nil" |
"mult_coeff (x#xs) ys = add_coeff (mult x ys) (0#(mult_coeff xs ys))"

lemma evalp_mult[simp] : "evalp (mult_coeff xs ys) x = (evalp xs x) * (evalp ys x)"
  apply(induction xs)
   apply(auto simp add: algebra_simps)
  done

(* coeff function *)
(* transforms an expression to a polynomial*)
fun coeff :: "exp \<Rightarrow> int list" where
"coeff Var = [0,1]" |
"coeff (Const i) = [i]" |
"coeff (Add e f) = add_coeff (coeff e) (coeff f)" |
"coeff (Mult e f) = mult_coeff (coeff e) (coeff f)"

theorem preservation : "evalp (coeff e) x = eval e x"
  apply(induction e arbitrary: x)
     apply(auto)
  done

end


theory Exercise2
  imports Main
begin
declare [[names_short]]
(* 2.1 *)
value "1 + (2::nat)"
value "1 + (2::int)"
value "1 - (2::nat)"
value "1 - (2::int)"

(* 2.2 *)

fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"add 0 n = n" |
"add (Suc m) n = Suc (add m n)"

theorem add_assoc [simp]: "add (add l m) n = add l (add m n)"
  apply(induction l)
  apply(auto)
  done

lemma add_0 [simp]: "add m 0 = m"
  apply(induction m)
  apply(auto)
  done

lemma add_suc [simp]: "add n (Suc m) = Suc (add n m)"
  apply(induction n)
  apply(auto)
  done

theorem add_commut [simp]: "add m n = add n m"
  apply(induction m)
  apply(auto)
  done

fun double :: "nat \<Rightarrow> nat" where
  "double 0 = 0" |
  "double (Suc n) = Suc (Suc (double n))"

theorem double_add [simp]: "double m = add m m"
  apply(induction m)
  apply(auto)
  done

(* 2.3 *)

fun count :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
  "count x [] = 0" |
  "count x (y # xs) = add (count x xs) (if x=y then 1 else 0)"

theorem count_length_constraint: "count x xs \<le> length xs"
  apply(induction xs)
  apply(auto)
  done

(* 2.4*)

fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
  "snoc [] x = [x]" |
  "snoc (y # ys) x = y # (snoc ys x)"

fun reverse :: "'a list \<Rightarrow> 'a list" where
  "reverse [] = []" |
  "reverse (x # xs) = snoc (reverse xs) x"

lemma reverse_snoc [simp]: "reverse (snoc xs a) = a # (reverse xs)"
  apply(induction xs)
  apply(auto)
  done

lemma rev_snoc [simp]: "rev (snoc xs a) = a # (rev xs)"
  apply(induction xs)
  apply(auto)
  done

theorem reverse_reverse [simp]: "reverse(reverse xs) = xs"
  apply(induction xs)
  apply(auto)
  done

(* 2.5 *)

fun sum_upto :: "nat \<Rightarrow> nat" where
  "sum_upto 0 = 0" |
  "sum_upto (Suc n) = (Suc n) + (sum_upto n)"

theorem sum_upto_closed_form [simp]: "sum_upto n = n * (n+1) div 2"
  apply(induction n)
  apply(auto)
  done

(* 2.6 *)

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

fun contents :: "'a tree \<Rightarrow> 'a list" where
  "contents Tip = []" |
  "contents (Node l a r) = a # (contents l) @ (contents r)"

fun sum_tree :: "nat tree \<Rightarrow> nat" where
  "sum_tree Tip = 0" |
  "sum_tree (Node l n r) = n + (sum_tree l) + (sum_tree r)"

theorem contents_sum_tree_rel: "sum_tree t = sum_list (contents t)"
  apply(induction t)
  apply(auto)
  done

(* 2.7 *)

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

fun mirror :: "'a tree2 \<Rightarrow> 'a tree2" where
"mirror (Leaf x) = Leaf x" |
(* "mirror (Node l x r) = Node r x l" *)
"mirror (Node l x r) = Node (mirror r) x (mirror l)"

(* https://www.geeksforgeeks.org/tree-traversals-inorder-preorder-and-postorder/ *)

fun pre_order :: "'a tree2 \<Rightarrow> 'a list" where
"pre_order (Leaf x) = [x]" |
"pre_order (Node l x r) = x # (pre_order l) @ (pre_order r)"

fun post_order :: "'a tree2 \<Rightarrow> 'a list" where
"post_order (Leaf x) = [x]" |
"post_order (Node l x r) = snoc (post_order l @ post_order r) x"
(*"post_order (Node l x r) = post_order l @ post_order r @ [x]"*)

(* example case *)
value "(Node (Node (Leaf 4) 2 (Leaf 5)) (1::nat) (Leaf 3))"
value "mirror (Node (Node (Leaf 4) 2 (Leaf 5)) (1::nat) (Leaf 3))"
(* 1 2 4 5 3 *)
value "pre_order (Node (Node (Leaf 4) 2 (Leaf 5)) (1::nat) (Leaf 3))"
(* 4 5 2 3 1 *)
value "post_order (Node (Node (Leaf 4) 2 (Leaf 5)) (1::nat) (Leaf 3))"

(* why snoc version doesn't work? *)
(*It was due the reverse_snoc lemma only simplifies reverse and snoc
not rev and snoc after prove the equivalent theorem for rev and snoc
it works as expected.*)
(*Which invoked me to test with reverse version*)
(*Which needs additional lemma as expected. Now we can prove \<down> first
and then*)

lemma reverse_snoc2[simp]: "xs @ snoc ys a = snoc (xs @ ys) a"
  apply(induction xs)
  apply(simp_all)
  done

lemma reverse_app[simp]: "(reverse xs) @ (reverse ys) = reverse (ys @ xs)"
 apply(induction ys)
 apply(auto)
 done

lemma pre_post_rel: "pre_order (mirror t) = reverse (post_order t)"
  apply(induction t)
  apply(auto)
  done

(* done! *)

(* 2.8 *)

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

lemma intersperse_map:
 "map f (intersperse a xs) =intersperse (f a) (map f xs)"
  apply(induction xs)
  apply(auto)
  done

(* 2.9 *)

fun itadd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "itadd 0 n = n" |
  "itadd (Suc m) n = itadd m (Suc n)"

lemma itadd_really_add: "itadd m n = add m n"
  (* apply(induction m) *)
  (* apply(auto) *)
    (* \<up> we need generalization to allow the n to be free variable. *)
  apply(induction m arbitrary: n)
  apply(auto)
  done

(*2.10*)

datatype tree0 = Tip | Node tree0 tree0

fun nodes :: "tree0 \<Rightarrow> nat" where
  "nodes Tip = 1" |
  "nodes (Node l r) = 1 + (nodes l) + (nodes r)"

fun explode :: "nat \<Rightarrow> tree0 \<Rightarrow> tree0" where
  "explode 0 t = t"|
  "explode (Suc n) t = explode n (Node t t)"

(*experiment with some example*)

value "nodes (explode 5 (Node Tip Tip))"
value "nodes (explode 9 Tip)"

(*by the above experiment we guess that when t=Tip,
the return number = 2^(n+1) - 1 *)

(*by solving the differential equation--f_(n+1) = 2 f_n + 1-- we get
f_n = (f_0 + 1)*2^n -1*)

theorem node_number_explode[simp]:
  "nodes (explode n t) = 2^n * ((nodes t) + 1) - 1"
  apply(induction n arbitrary: t)
  apply(auto simp add: algebra_simps)
  done

(*Exercise 2.11*)
datatype exp = Var | Const int | Add exp exp | Mult exp exp

fun eval :: "exp \<Rightarrow> int \<Rightarrow> int" where
"eval (Const num) _ = num" |
"eval Var x = x " |
"eval (Add l r) x = (eval l x) + (eval r x)" |
"eval (Mult l r) x = (eval l x) * (eval r x)"

(*fun itevalp :: "int list \<Rightarrow> int \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int" where
"itevalp [] _ _ result = result" |
"itevalp (c#cs) x n result = itevalp cs x (n+1) (result + c*x^n)"

fun evalp_recur :: "int list \<Rightarrow> int \<Rightarrow> nat \<Rightarrow> int" where
"evalp_recur [] _ _  = 0" |
"evalp_recur (c#cs) x n = c*x^n + evalp_recur cs x (n+1)"

definition evalp :: "int list \<Rightarrow> int \<Rightarrow> int" where
"evalp cs x = itevalp cs x 0 0"*)
(*"evalp cs x = evalp_recur cs x 0"*)

fun evalp :: "int list \<Rightarrow> int \<Rightarrow> int" where
"evalp [] x  = 0"|
"evalp (c # cs) x = c + x*(evalp cs x)"

(*test*)
(*value "evalp [4, 2, -1, 3] 5"*)
(*works*)

fun intList_add :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
"intList_add [] ys = ys"|
"intList_add xs [] = xs"|
"intList_add (x#xs) (y#ys) = (x + y) # intList_add xs ys"

(*test*)
(*value "intList_add [2, 1, 5] [1, -2]"*)

fun intList_times_int :: "int list \<Rightarrow> int \<Rightarrow> int list" where
"intList_times_int [] _ = []"|
"intList_times_int (x#xs) c = (c * x) # (intList_times_int xs c)"

(*fun pad_ntime :: "int list \<Rightarrow> nat \<Rightarrow> int list" where
"pad_ntime xs 0 = xs"|
"pad_ntime [] _ = []"|
"pad_ntime xs (Suc n) = 0 # (pad_ntime xs n)"

fun itIntListMul :: "int list \<Rightarrow> int list \<Rightarrow> nat \<Rightarrow> int list \<Rightarrow> int list" where
"itIntListMul xs [] _ result = result"|
"itIntListMul xs (y#ys) n result =
itIntListMul xs ys (n + 1)
(if y\<noteq>0 then
(intList_add (intList_times_int (pad_ntime xs n) y) result)
else result)"

definition intList_mul :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
"intList_mul xs ys = itIntListMul xs ys 0 []"*)

fun intList_mult :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
"intList_mult xs [] = []"|
"intList_mult xs (y#ys) = intList_add (intList_times_int xs y)
(0 # (intList_mult xs ys))"

fun coeffs :: "exp \<Rightarrow> int list" where
"coeffs Var = [0, 1]"|
"coeffs (Const num) = [num]"|
"coeffs (Add l r) = intList_add (coeffs l) (coeffs r)"|
"coeffs (Mult l r) = intList_mult (coeffs l) (coeffs r)"

(*value "coeffs (Add Var (Mult Var Var))"*)

(*Hint: consider the hint in Exercise 2.10*)

lemma evalp_add_coeffs [simp]: "evalp (intList_add xs ys) a = (evalp xs a) + (evalp ys a)"
  apply(induction rule: intList_add.induct)
  apply(auto simp add:algebra_simps)
  done

lemma evalp_scala_coeffs [simp]: "evalp (intList_times_int xs c) a = (evalp xs a) * c"
apply(induction xs)
apply(auto simp add: algebra_simps)
done

lemma evalp_mul_coeffs [simp]: "evalp (intList_mult xs ys) a = (evalp xs a) * (evalp ys a)"
apply(induction ys)
apply(auto simp add: algebra_simps)
done

theorem evalp_coeffs [simp]: "evalp (coeffs e) x = eval e x"
  apply(induction e)
  apply(auto)
  done


theory Shweta_Exercises
imports Main
begin

(*2.2 :Addition and properties*)

fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "add 0 n = n"
| "add (Suc m) n = Suc(add m n)"

lemma add_Assoc: "add (add m n) p = add m (add n p)"
  by (induction m, auto)

lemma add_Zero: "add m 0 = m"
  by (induction m, auto)

lemma add_Suc: "Suc(add m n) = add m (Suc n)"
  by (induction m, auto)

lemma add_Comm: "add m n = add n m"
  by (induction m, simp add: add_Zero, simp add: add_Suc)

primrec double :: "nat \<Rightarrow>  nat" where
  "double 0  = 0"
| "double (Suc m) = Suc (Suc (double m))"

lemma add_double: "double m = add m m"
  by (induction m, auto, simp add: add_Suc)

(*2.3: No. of occurences of element in a list*)

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

lemma length: "count x xs \<le> length xs"
  by (induction xs, auto)

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

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

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

lemma app_Assoc: "(xs @  ys) @ zs = xs @ (ys @ zs)"
  by (induction xs, auto)

lemma append_snoc: "snoc xs x = xs @ [x]"
  by (induction xs, auto)

(*lemma reverse_reverse : "reverse (reverse xs) = xs"
  by (induction xs, auto, simp add:append_snoc)*)

(*2.5:Function sum_upto*)

primrec sum_upto  :: "nat \<Rightarrow> nat" where
 "sum_upto 0 = 0"
|"sum_upto (Suc n) = (n + (sum_upto n)) + 1"

lemma sum_upto_law: "sum_upto n = n * (n + 1) div 2"
  by (induction n, auto)

(*2.6*)
(*Contents  collects all values in a tree in a list,
in any order, without removing duplicates*)

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

primrec contents :: "'a tree \<Rightarrow> 'a list" where
 "contents Tip = []"
|"contents (Node l a r) = a#((contents l) @ (contents r))"

(*sum_tree sums up all values in a tree of natural numbers*)

primrec sum_tree :: "nat tree\<Rightarrow> nat" where
 "sum_tree Tip = 0"
|"sum_tree (Node l a r) = a + (sum_tree l) + (sum_tree r)"

(*sum_list is pre-defined*)

lemma sum_tree_list: "sum_tree t = sum_list (contents t)"
  by (induction t, auto)

(*2.7*)
(*pre and post_order traverse a tree and collect all stored values in the
respective order in a list*)

primrec pre_order :: "'a tree \<Rightarrow> 'a list" where
 "pre_order Tip = []"
|"pre_order (Node l a r) =[a]@((pre_order l)@(pre_order r))"

primrec post_order :: "'a tree \<Rightarrow> 'a list" where
 "post_order Tip = []"
|"post_order (Node l a r) = ((post_order l)@(post_order r))@[a]"

primrec mirror :: "'a tree \<Rightarrow>'a tree" where
 "mirror Tip = Tip"
|"mirror (Node l a r) = Node (mirror r) a (mirror l)"

lemma pre_mirror_post :"pre_order (mirror t) = rev (post_order t)"
  by (induction t, auto)

(*2.8: intersperse a [x 1 , ..., x n ] = [x 1 , a, x 2 , a, ..., a, x n ]*)

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

lemma mapintersperse: "map f (intersperse a xs) = intersperse (f a) (map f xs)"
  by (induction xs, auto)

(*2.9:tail-recursive variant of add*)
fun itadd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "itadd 0 n  = n"
|"itadd (Suc 0) n = Suc n"
|"itadd (Suc m) n = itadd (Suc 0) (itadd m n)"

(*lemma itadd_add: "itadd n m = add n m", not proven*)

(*2.10:tree0 are binary tree skeletons which do not
store any information, nodes counts no of nodes*)

datatype tree0 = Tip' | Node' "tree0" "tree0"

primrec nodes :: "tree0 \<Rightarrow> nat" where
 "nodes Tip' = 1"
|"nodes (Node' l r) = 1 + nodes l + nodes r"

primrec explode :: "nat\<Rightarrow> tree0 \<Rightarrow> tree0" where
 "explode 0 t = t"
|"explode (Suc n) t = explode n (Node' t t)"

(* equation expressing the size of a tree after exploding it not proven.*)

(*Not excercises*)
primrec pow :: "nat => nat => nat" where
  "pow x 0       = Suc 0"
| "pow x (Suc n) = x * pow x n"

lemma pow_add: "pow x (y + z) = pow x y * pow x z"
  by (induction z, auto)

theorem pow_mult: "pow x (m * n) = pow (pow x m) n"
  by (induction n, auto simp add: pow_add)

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

lemma sum_append: "sum (xs @ ys) = sum xs + sum ys"
  by (induction xs, auto)

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

theorem sum_rev: "sum (rev xs) = sum xs"
  by (induction xs,auto simp add: sum_append)


theory Naturales
imports Main
begin

section {* Ejemplo de definición recursiva sobre los naturales: suma. *}

text {* (suma m n) es la suma de los números naturales m y n. Por
  ejemplo,
     suma (Suc (Suc 0)) (Suc (Suc (Suc 0)))
     = Suc (Suc (Suc (Suc (Suc 0))))
*}
fun suma :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
  "suma 0 n       = n"
| "suma (Suc m) n = Suc (suma m n)"

value "suma (Suc (Suc 0)) (Suc (Suc (Suc 0)))"
lemma "suma (Suc (Suc 0)) (Suc (Suc (Suc 0)))
       = Suc (Suc (Suc (Suc (Suc 0))))" by simp

section {* Ejemplo de demostración pos inducción sobre los naturales. *}

text {* En esta sección se demuestra, por inducción sobre los naturales,
  que 0 es el nuetro por la derecha de la suma. *}

text {* Demostración aplicativa *}
lemma suma_0:
  "suma m 0 = m"
apply (induction m)
apply auto
done

text {* Demostración estructurada *}
lemma suma_0':
  "suma m 0 = m"
by (induction m) auto

end


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

chapter \<open>Various examples\<close>

theory Examples imports Hoare_Logic Arith2 begin

section \<open>ARITHMETIC\<close>

subsection \<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

subsection \<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

subsection \<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

subsection \<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

subsection \<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

subsection \<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

section \<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

section \<open>ARRAYS\<close>

subsection \<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


theory Prog_Prove_2_5
  imports Main
begin

datatype tree0 = Tip | Node "tree0" "tree0"

fun nodes :: "tree0 \<Rightarrow> nat" where
"nodes Tip = 1" |
"nodes (Node l r) = nodes r + nodes l"

fun explode :: "nat \<Rightarrow> tree0 \<Rightarrow> tree0" where
"explode 0 t = t" |
"explode (Suc n) t = explode n (Node t t)"

lemma "nodes (explode n t) = (2 ^ n) * nodes t "
  apply(induction n arbitrary: t)
  apply(auto)
  done

datatype exp = Var | Const int | Add exp exp | Mult exp exp

fun eval :: "exp \<Rightarrow> int \<Rightarrow> int" where
"eval Var x = x" |
"eval (Const a) x = a" |
"eval (Add a b) x = (eval a x) + (eval b x)" |
"eval (Mult a b) x = (eval a x) * (eval b x)"

fun evalp :: "int list \<Rightarrow> int \<Rightarrow> int" where
"evalp [] y = 0" |
"evalp (x#xs) y = x + y * (evalp xs y)"

fun a_coeffs :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
"a_coeffs Nil Nil = Nil" |
"a_coeffs Nil ys = ys" |
"a_coeffs xs Nil = xs" |
"a_coeffs (x#xs) (y#ys) = (x + y) # (a_coeffs xs ys)"

fun multi_dist_list:: "int \<Rightarrow> int list \<Rightarrow> int list" where
"multi_dist_list n Nil = Nil" |
"multi_dist_list n (x#xs) = (n*x)#(multi_dist_list n xs)"

fun m_coeffs :: "int list \<Rightarrow> int list \<Rightarrow> int list" where
"m_coeffs Nil ys = Nil" |
"m_coeffs (x#xs) ys = a_coeffs (multi_dist_list x ys)  (0 # m_coeffs xs ys)"

fun coeffs :: "exp \<Rightarrow> int list" where
"coeffs Var = [0,1]" |
"coeffs (Const a) = [a]" |
"coeffs (Add a b) = a_coeffs (coeffs(a)) (coeffs(b))" |
"coeffs (Mult a b) = m_coeffs (coeffs(a)) (coeffs(b))"

lemma evalp_coeffs_to_eval_add[simp] :
  "evalp (a_coeffs xs ys) x = evalp xs x + evalp ys x"
  apply(induction xs rule: a_coeffs.induct)
  apply(auto simp add: algebra_simps)
  done

lemma evalp_m_d_l[simp]:" evalp (multi_dist_list a ys) x = a * evalp ys x"
  apply(induction ys)
  apply(auto simp add: algebra_simps)
  done

lemma evalp_coeffs_to_eval_multi[simp]:
  "evalp (m_coeffs xs ys) x = evalp xs x * evalp ys x"
  apply(induction xs)
  apply(auto simp add: algebra_simps)
  done

lemma evalp_coeffs_eval: "evalp (coeffs e) x = eval e x"
  apply(induction e arbitrary: x)
  apply(auto)
  done


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

header {* Folding Lists and Trees *}

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

subsubsection {* Some more list functions *}

text {* Recall the summation function *}

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

text {* In the Isabelle library, you will find (in the theory {\tt List.thy})
the functions @{text foldr} and @{text foldl}, which allow you to define some
list functions, among them @{text sum} and @{text length}.  Show the following:
*}

lemma sum_foldr: "sum xs = foldr (op +) xs 0"
  apply (induct xs)
  apply auto
done

lemma length_foldr: "length xs = foldr (\<lambda> x res. 1 + res) xs 0"
  apply (induct xs)
  apply auto
done

text {* Repeated application of @{text foldr} and @{text map} has the
disadvantage that a list is traversed several times.  A single traversal is
sufficient, as illustrated by the following example: *}

lemma "sum (map (\<lambda> x. x + 3) xs) = foldr h xs b"
(*<*) oops (*>*)

text {* Find terms @{text h} and @{text b} which solve this equation. *}

lemma "sum (map (\<lambda> x. x + 3) xs) = foldr (\<lambda> x y. x + y + 3) xs 0"
  apply (induct xs)
  apply auto
done

text {* Generalize this result, i.e.\ show for appropriate @{text h} and @{text
b}: *}

lemma "foldr g (map f xs) a = foldr h xs b"
(*<*) oops (*>*)

text {* Hint: Isabelle can help you find the solution if you use the equalities
arising during a proof attempt. *}

lemma "foldr g (map f xs) a = foldr (\<lambda>x acc. g (f x) acc) xs a"
  apply (induct xs)
  apply auto
done

text {* The following function @{text rev_acc} reverses a list in linear time:
*}

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

text {* Show that @{text rev_acc} can be defined by means of @{text foldl}. *}

lemma rev_acc_foldl_aux [rule_format]:
  "\<forall>a. rev_acc xs a = foldl (\<lambda> ys x. x # ys) a xs"
  apply (induct xs)
  apply auto
done

lemma rev_acc_foldl: "rev_acc xs a = foldl (\<lambda> ys x. x # ys) a xs"
  by (rule rev_acc_foldl_aux)

text {* Prove the following distributivity property for @{text sum}: *}

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

text {* Prove a similar property for @{text foldr}, i.e.\ something like @{text
"foldr f (xs @ ys) a = f (foldr f xs a) (foldr f ys a)"}.  However, you will
have to strengthen the premises by taking into account algebraic properties of
@{text f} and @{text a}. *}

definition
  left_neutral :: "['a \<Rightarrow> 'b \<Rightarrow> 'b, 'a] \<Rightarrow> bool" where
  "left_neutral f a == (\<forall> x. (f a x = x))"

definition
  assoc :: "['a \<Rightarrow> 'a \<Rightarrow> 'a] \<Rightarrow> bool" where
  "assoc f == (\<forall> x y z. f (f x y) z = f x (f y z))"

lemma foldr_append:
  "\<lbrakk> left_neutral f a; assoc f \<rbrakk> \<Longrightarrow> foldr f (xs @ ys) a = f (foldr f xs a) (foldr f ys a)"
  apply (induct xs)
    apply (simp add: left_neutral_def)
  apply (simp add: assoc_def)
done

text {* Now, define the function @{text prod}, which computes the product of
all list elements *}

(*<*) consts (*>*)
  prod :: "nat list \<Rightarrow> nat"

defs
  prod_def: "prod xs == foldr (op *) xs 1"

text {* directly with the aid of a fold and prove the following: *}

lemma "prod (xs @ ys) = prod xs * prod ys"
  apply (simp only: prod_def)
  apply (rule foldr_append)
    apply (simp add: left_neutral_def)
  apply (simp add: assoc_def)
done

subsubsection {* Functions on Trees *}

text {* Consider the following type of binary trees: *}

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

text {* Define functions which convert a tree into a list by traversing it in
pre-, resp.\ postorder: *}

primrec preorder :: "'a tree \<Rightarrow> 'a list" where
  "preorder Tip          = []"
| "preorder (Node l x r) = x # ((preorder l) @ (preorder r))"

primrec postorder :: "'a tree \<Rightarrow> 'a list" where
  "postorder Tip          = []"
| "postorder (Node l x r) =  (postorder l) @ (postorder r) @ [x]"

text {* You have certainly realized that computation of postorder traversal can
be efficiently realized with an accumulator, in analogy to @{text rev_acc}: *}

primrec postorder_acc :: "['a tree, 'a list] \<Rightarrow> 'a list" where
  "postorder_acc Tip          xs = xs"
| "postorder_acc (Node l x r) xs = (postorder_acc l (postorder_acc r (x#xs)))"

text {* Define this function and show: *}

lemma postorder_acc_aux [rule_format]:
  "\<forall>xs. postorder_acc t xs = (postorder t) @ xs"
  apply (induct t)
  apply auto
done

lemma "postorder_acc t xs = (postorder t) @ xs"
  by (rule postorder_acc_aux)

text {* @{text postorder_acc} is the instance of a function @{text foldl_tree},
which is similar to @{text foldl}. *}

primrec foldl_tree :: "('b => 'a => 'b) \<Rightarrow> 'b \<Rightarrow> 'a tree \<Rightarrow> 'b" where
  "foldl_tree f a Tip          = a"
| "foldl_tree f a (Node l x r) = (foldl_tree f (foldl_tree f (f a x) r) l)"

text {* Show the following: *}

lemma "\<forall> a. postorder_acc t a = foldl_tree (\<lambda> xs x. Cons x xs) a t"
  apply (induct t)
  apply auto
done

text {* Define a function @{text tree_sum} that computes the sum of the
elements of a tree of natural numbers: *}

primrec tree_sum :: "nat tree \<Rightarrow> nat" where
  "tree_sum Tip          = 0"
| "tree_sum (Node l x r) = (tree_sum l) + x + (tree_sum r)"

text {* and show that this function satisfies *}

lemma "tree_sum t = sum (preorder t)"
  apply (induct t)
  apply auto
done

(*<*) end (*>*)