theory "4_1to4_5"
  imports Main "~~/src/HOL/Library/Code_Target_Nat"
begin

section "Exercise 4.1"

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

fun to_set :: "'a tree \<Rightarrow> 'a set" where
  "to_set Tip = {}" |
  "to_set (Node lc x rc) = {x} \<union> to_set lc \<union> to_set rc"

value "to_set Tip"
value "to_set (Node Tip 0 (Node (Node Tip 2 Tip) 1 Tip)) :: int set"

  (* A tree is ordered iff:
at a node, the value is > all values in the left child
and < all values in the right child
and both of the node's children are ordered*)
fun ord :: "int tree \<Rightarrow> bool" where
  "ord Tip = True" |
  "ord (Node lc x rc) = (
    let gt_left = (\<forall>y \<in> (to_set lc). x > y);
        lt_right = (\<forall>y \<in> (to_set rc). x < y)
    in gt_left \<and> lt_right \<and> ord lc \<and> ord rc)"

value "ord (Node (Node Tip 2 Tip) 3 Tip)"
value "ord (Node Tip 0 (Node (Node Tip 1 Tip) 2 Tip))"

  (* Insert element into ordered int tree, preserving order   *)
fun ins :: "int \<Rightarrow> int tree \<Rightarrow> int tree" where
  "ins x Tip = Node Tip x Tip" |
  "ins x (Node lc tx rc) = (
    if x < tx
    then Node (ins x lc) tx rc
    else (
      if x > tx
      then Node lc tx (ins x rc)
      else (Node lc tx rc)))"

value "ins 1 (Node (Node Tip 2 Tip) 4 Tip)"
value "ins 2 (Node (Node Tip 2 Tip) 4 Tip)"
value "ins 3 (Node (Node Tip 2 Tip) 4 Tip)"
value "ins 5 (Node (Node Tip 2 Tip) 4 Tip)"

value "ord (ins 1 (Node (Node Tip 2 Tip) 4 Tip))"
value "ord (ins 2 (Node (Node Tip 2 Tip) 4 Tip))"
value "ord (ins 3 (Node (Node Tip 2 Tip) 4 Tip))"
value "ord (ins 5 (Node (Node Tip 2 Tip) 4 Tip))"

theorem ins_tree_like_insert_set:"to_set (ins x tree) = {x} \<union> to_set tree"
  apply(induction tree)
  by auto

theorem ins_preserves_order: "ord tree \<Longrightarrow> ord (ins x tree)"
  (* I thought arbitrary x would be needed. It's not. *)
  apply(induction tree)
   apply(simp)
  apply(simp)
  using ins_tree_like_insert_set by simp

lemma "\<lbrakk> (a::nat)\<le>b; b\<le>c; c\<le>d; d\<le>e \<rbrakk> \<Longrightarrow> a\<le>e"
  (* by linarith *)
  by (blast intro:le_trans)

lemma "Suc(Suc(Suc a)) \<le> b \<Longrightarrow> a \<le> b"
  by (blast dest: Suc_leD)

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

section "Exercises from Software Foundations, Inductively Defined Propositions"

lemma n_doubled_is_even:"ev (n * 2)"
  apply(induction n)
   apply (simp add: ev0)
  by (simp add: evSS)

lemma "ev (Suc (Suc n)) \<Longrightarrow> ev n"
  using ev.simps by blast

lemma even_implies_doubled:"ev n \<Longrightarrow> \<exists>k. n = (k * 2)"
  apply(induction rule: ev.induct)
   apply simp
  by arith

lemma even_equivalent_doubled: "ev n \<longleftrightarrow> (\<exists>k. n = (k * 2))"
  apply(rule)
   apply(simp add:even_implies_doubled)
  using n_doubled_is_even by auto

lemma "ev n \<Longrightarrow> ev m \<Longrightarrow> ev (n + m)"
  apply(induction rule: ev.induct)
   apply simp
  apply(simp)
  by (simp add: evSS)

lemma ev_n_ev_m_plus:"ev n \<Longrightarrow> ev m \<Longrightarrow> ev (n+m)"
  apply(induction rule:ev.induct)
   apply simp
  apply(simp)
  by (simp add: evSS)

inductive ev' :: "nat \<Rightarrow> bool" where
  ev'0: "ev' 0" |
  ev'2: "ev' 2" |
  ev'sum: "ev' n \<Longrightarrow> ev' m \<Longrightarrow> ev' (n+m)"

lemma ev_equivalent_ev':"ev n \<longleftrightarrow> ev' n"
  apply(rule)
   apply(induction rule:ev.induct)
    apply (simp add: ev'0)
  using ev'2 ev'sum apply force
  apply(induction rule:ev'.induct)
    apply (simp add: ev0)
   apply (simp add: ev0 evSS numeral_2_eq_2)
  using ev_n_ev_m_plus by simp

    (* if stuck, flip order of premises *)
lemma ev_n_plus_m:"ev (n+m) \<Longrightarrow> ev n \<Longrightarrow> ev m"
  apply(induction rule:ev.induct)
   apply(simp_all)
  oops

lemma ev_n_plus_m:"ev n \<Longrightarrow> ev (n+m) \<Longrightarrow> ev m"
  apply(induction rule:ev.induct)
   apply(simp_all)
  using ev.simps by blast

section "Exercises from Software Foundations, inductive relations"

inductive le :: "nat \<Rightarrow> nat \<Rightarrow> bool" where
  eq: "le x x" |
  grow: "le x y \<Longrightarrow> le x (Suc y)"

  (* test: inductive le *)
lemma "le 2 2"
  by (metis eq)
lemma "le 1 2"
  by (metis Suc_1 eq grow)

definition lt :: "nat \<Rightarrow> nat \<Rightarrow> bool" where
  "lt x y = le (Suc x) y"

lemma "lt 1 2"
  by (simp add: eq lt_def numeral_2_eq_2)

section "End exercises from Software Foundations"

fun evn :: "nat \<Rightarrow> bool" where
  "evn 0 = True"|
  "evn (Suc 0) = False"|
  "evn (Suc(Suc n)) = evn n"

lemma "ev(Suc(Suc(Suc(Suc 0))))"
  apply(rule evSS)
  apply(rule evSS)
  apply(rule ev0)
  done

lemma ev_to_evn:"ev m \<Longrightarrow> evn m"
  (*   apply(induction m)
    Bad because it creates this goal:
    2. \<And>m. (ev m \<Longrightarrow> evn m) \<Longrightarrow> ev (Suc m) \<Longrightarrow> evn (Suc m) *)
  apply(induction rule: ev.induct)
  by simp_all

lemma evn_to_ev:"evn n \<Longrightarrow> ev n"
  apply(induction rule: evn.induct)
  by(simp_all add: ev0 evSS)

lemma "evn n = ev n"
  (*   find_theorems intro
using [[rule_trace]] apply(rule HOL.iffI) *)
  apply(rule)
   apply(metis evn_to_ev)
  apply(metis ev_to_evn)
  done

declare ev.intros[simp,intro]

  (* The “for r” in the header is merely a hint to Isabelle that r is a fixed parameter of star, in
contrast to the further parameters of star, which change. As a result, Isabelle generates a simpler
induction rule *)
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"

lemma star_transitive: "star r a b \<Longrightarrow> star r b c \<Longrightarrow> star r a c"
  apply(induction rule: star.induct)
   apply(assumption)
  apply(simp)
    (* by(metis step) *)
  by(metis star.step)

subsection "Exercise 4.2"

inductive palindrome :: "'a list \<Rightarrow> bool" where
  empty: "palindrome []"|
  singleton: "palindrome [x]"|
  step: "palindrome xs \<Longrightarrow> palindrome (a # xs @ [a])"

lemma "palindrome xs \<Longrightarrow> rev xs = xs"
  apply(induction rule: palindrome.induct)
  by(simp_all)

subsection "exercise 4.3"

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

(* This version is hard (impossible?) to prove   *)
lemma starp_transitive:"star' r x y \<Longrightarrow> star' r y z \<Longrightarrow> star' r x z"
  apply(induction rule: star'.induct)
   apply(simp)
  oops

(* By flipping the assumption order so that rule induction is applied to (star' r y z), this is easy
to prove *)
lemma starp_transitive:"star' r y z \<Longrightarrow> star' r x y \<Longrightarrow> star' r x z"
  apply(induction rule: star'.induct)
   apply(simp)
  apply(simp)
  by (metis star'.step')

lemma starp_implies_star:"star' r x y \<Longrightarrow> star r x y"
  apply(induction rule: star'.induct)
   apply(metis star.refl)
  by(metis star.refl star.step star_transitive)

lemma star_implies_starp:"star r x y \<Longrightarrow> star' r x y"
  apply(induction rule: star.induct)
   apply(metis star'.refl')
  by (metis refl' starp_transitive step')

subsection "exercise 4.4"

inductive iter :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" for r where
  refl: "iter r 0 x x" |
  (* will the order of the premises make proving harder? *)
  (* step: "iter r n x y \<Longrightarrow> r y z \<Longrightarrow> iter r (Suc n) x z" *)
 step: "r x y \<Longrightarrow> iter r n y z \<Longrightarrow> iter r (Suc n) x z"

lemma iter_implies_star:"iter r n x y \<Longrightarrow> star r x y"
  apply(induction rule: iter.induct)
   apply (metis star.refl)
  by (metis star.step)

lemma star_implies_some_iter:"star r x y \<Longrightarrow> \<exists>n. iter r n x y "
  apply(induction rule: star.induct)
   apply (metis iter.refl)
  by (metis iter.step)

subsection "exercise 4.5"

datatype alpha = a | b

inductive gram_S :: "alpha list \<Rightarrow> bool" where
  empty: "gram_S []" |
  aSb: "gram_S w \<Longrightarrow> gram_S (a # w @ [b])" |
  SS: "gram_S w\<^sub>0 \<Longrightarrow> gram_S w\<^sub>1 \<Longrightarrow> gram_S (w\<^sub>0 @ w\<^sub>1)"

inductive gram_T :: "alpha list \<Rightarrow> bool" where
  empty: "gram_T []" |
  TaTb: "gram_T w\<^sub>0 \<Longrightarrow> gram_T w\<^sub>1 \<Longrightarrow> gram_T (w\<^sub>0 @ [a] @ w\<^sub>1 @ [b])"

lemma T_implies_S: "gram_T w \<Longrightarrow> gram_S w"
  apply(induction rule: gram_T.induct)
   apply(simp add: gram_S.empty)
  by (simp add: SS aSb)

lemma T_append_T:"gram_T w\<^sub>1 \<Longrightarrow> gram_T w\<^sub>0 \<Longrightarrow> gram_T (w\<^sub>0 @ w\<^sub>1)"
  apply(induction rule: gram_T.induct)
   apply(simp add: gram_T.empty)
    (* apply simp This will break the proof*)
  by (metis append.assoc gram_T.simps)

lemma T_like_aSb: "gram_T w \<Longrightarrow> gram_T (a # w @ [b])"
  using TaTb gram_T.empty by fastforce

lemma S_implies_T: "gram_S w \<Longrightarrow> gram_T w"
  apply(induction rule: gram_S.induct)
    apply(simp add: gram_T.empty)
  using T_like_aSb apply simp
  using T_append_T by simp

lemma S_equiv_T: "gram_S w \<longleftrightarrow> gram_T w"
  apply(rule)
   apply(simp add: S_implies_T)
  by (simp add: T_implies_S)

end


theory Homework4_2sol
imports Main
begin
  (* Path with length *)

  (*
    In a directed graph, we have a path of length n from u to v,
    if we can go from u to v using exactly n edges.

    Specify an inductive predicate pol E x n y, which is true if and only
    if there is a path of length n from x to y.
  *)

  inductive pol :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> bool"
  (*<*)
    where
    refl: "pol E x 0 x"
  | trans: "\<lbrakk> E x y; pol E y l z \<rbrakk> \<Longrightarrow> pol E x (Suc l) z"
  (*>*)

  (* Show that two paths can be appended. Their length is the sum of the two lengths.
    Hint: Make sure the premises are in the right order,
      as rule induction will pick the first matching premise.
      If not, use rotate_tac.
  *)
  lemma pol_append: "\<lbrakk>pol E x k y; pol E y l z\<rbrakk> \<Longrightarrow> pol E x (k+l) z"
  (*<*)
    apply (induction rule: pol.induct)
    by (auto intro: pol.intros)
  (*>*)

  (**
    Note: In general, you should write the conclusions of intro-rules
    such that they do not simplify any more wrt the default simpset ...

    Try, e.g.:
  *)

  inductive pol' :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> bool"
  (*<*)
    where
    refl': "pol' E x 0 x"
  | trans': "\<lbrakk> E x y; pol' E y l z \<rbrakk> \<Longrightarrow> pol' E x (l+1) z"
  (*>*)

  lemma pol'_append: "\<lbrakk>pol' E x k y; pol' E y l z\<rbrakk> \<Longrightarrow> pol' E x (k+l) z"
    apply (induction rule: pol'.induct)
    apply (auto intro: pol.intros) (** Does not solve the goal \<dots> in this case, sledgehammer helps you out, however *)
    (** The reason here is, that the conclusion of rule trans' (_+1)
      does not syntactically match (Suc (_+_)).

      The Suc comes in, as the simplifier will rewrite any _+1 on nat to Suc _.

      Thus, the best way to get around this, is to modify your trans'-rule and let it use Suc, too.
    *)
    using trans' by fastforce

  (* You can do a quick check of your rules \<dots> *)
  thm trans' trans'[simplified] -- \<open>Observe the changes introduced by the simplifier\<close>

  thm trans trans[simplified] -- \<open>No changes here ... \<close>

  (* Note that this check does not cover all cases:
    If your rules fail this check, they are unlikely to match any simplified goal
    But: If your rules pass the check, they may still fail to apply the goal.
      Consider, e.g. the introduction rule: \<dots> \<Longrightarrow> P (a+b)
        and the goal: P (a+0)
      This will simplify to P a, and your intro-rule does not match any more.
  *)

  (* Usually, you can solve these problems also on Isar-level,
    e.g., by forward reasoning:
  *)
  lemma "\<lbrakk>pol' E x k y; pol' E y l z\<rbrakk> \<Longrightarrow> pol' E x (k+l) z"
  proof (induction rule: pol'.induct)
    case (refl' E x)
    then show ?case by (simp)
  next
    case (trans' E x y k zz)
    hence "pol' E y (k + l) z" by blast
    from pol'.trans'[OF \<open>E x y\<close> this] show ?case by simp
  qed

  (*
    Write a recursive function that checks whether there is a path of length n.
    Hint: Recursion over n! Use an \<exists>-quantifier to obtain a next state.
  *)

  fun fpol :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> bool"
    (*<*)
    where
    "fpol E x 0 y \<longleftrightarrow> x=y"
  | "fpol E x (Suc n) z \<longleftrightarrow> (\<exists>y. E x y \<and> fpol E y n z)"
    (*>*)

  (* Show that the function is equivalent to the inductive version! *)
  lemma fpol_imp_pol: "fpol E x l y \<Longrightarrow> pol E x l y"
    (*<*)
    apply (induction l arbitrary: x)
    apply (auto intro: pol.intros)
    done
    (*>*)

  lemma pol_imp_fpol: "pol E x l y \<Longrightarrow> fpol E x l y"
    (*<*)
    apply (induction rule: pol.induct)
    apply auto
    done
    (*>*)

  lemma fpol_eq_pol: "fpol = pol"
    (*<*)
    apply (intro ext)
    using fpol_imp_pol pol_imp_fpol by auto
    (*>*)

  (* Using fpol, show that a path can be split *)

  lemma fpol_split: "fpol E x (l1+l2) z \<Longrightarrow> (\<exists>y. fpol E x l1 y \<and> fpol E y l2 z)"
    (*<*)
    by (induction l1 arbitrary: x) force+
    (*>*)

  (* Combine the split and append lemma *)
  lemma pol_append_conv: "pol E x (l1+l2) z \<longleftrightarrow> (\<exists>y. pol E x l1 y \<and> pol E y l2 z)"
    (*<*)
    using pol_append fpol_split by (auto simp: fpol_eq_pol)
    (*>*)

end


(*  Title:      HOL/Old_Number_Theory/Legacy_GCD.thy
    Author:     Christophe Tabacznyj and Lawrence C Paulson
    Copyright   1996  University of Cambridge
*)

section {* The Greatest Common Divisor *}

theory Legacy_GCD
imports Main
begin

text {*
  See @{cite davenport92}. \bigskip
*}

subsection {* Specification of GCD on nats *}

definition
  is_gcd :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where -- {* @{term gcd} as a relation *}
  "is_gcd m n p \<longleftrightarrow> p dvd m \<and> p dvd n \<and>
    (\<forall>d. d dvd m \<longrightarrow> d dvd n \<longrightarrow> d dvd p)"

text {* Uniqueness *}

lemma is_gcd_unique: "is_gcd a b m \<Longrightarrow> is_gcd a b n \<Longrightarrow> m = n"
  by (simp add: is_gcd_def) (blast intro: dvd_antisym)

text {* Connection to divides relation *}

lemma is_gcd_dvd: "is_gcd a b m \<Longrightarrow> k dvd a \<Longrightarrow> k dvd b \<Longrightarrow> k dvd m"
  by (auto simp add: is_gcd_def)

text {* Commutativity *}

lemma is_gcd_commute: "is_gcd m n k = is_gcd n m k"
  by (auto simp add: is_gcd_def)

subsection {* GCD on nat by Euclid's algorithm *}

fun gcd :: "nat => nat => nat"
  where "gcd m n = (if n = 0 then m else gcd n (m mod n))"

lemma gcd_induct [case_names "0" rec]:
  fixes m n :: nat
  assumes "\<And>m. P m 0"
    and "\<And>m n. 0 < n \<Longrightarrow> P n (m mod n) \<Longrightarrow> P m n"
  shows "P m n"
proof (induct m n rule: gcd.induct)
  case (1 m n)
  with assms show ?case by (cases "n = 0") simp_all
qed

lemma gcd_0 [simp, algebra]: "gcd m 0 = m"
  by simp

lemma gcd_0_left [simp,algebra]: "gcd 0 m = m"
  by simp

lemma gcd_non_0: "n > 0 \<Longrightarrow> gcd m n = gcd n (m mod n)"
  by simp

lemma gcd_1 [simp, algebra]: "gcd m (Suc 0) = Suc 0"
  by simp

lemma nat_gcd_1_right [simp, algebra]: "gcd m 1 = 1"
  unfolding One_nat_def by (rule gcd_1)

declare gcd.simps [simp del]

text {*
  \medskip @{term "gcd m n"} divides @{text m} and @{text n}.  The
  conjunctions don't seem provable separately.
*}

lemma gcd_dvd1 [iff, algebra]: "gcd m n dvd m"
  and gcd_dvd2 [iff, algebra]: "gcd m n dvd n"
  apply (induct m n rule: gcd_induct)
     apply (simp_all add: gcd_non_0)
  apply (blast dest: dvd_mod_imp_dvd)
  done

text {*
  \medskip Maximality: for all @{term m}, @{term n}, @{term k}
  naturals, if @{term k} divides @{term m} and @{term k} divides
  @{term n} then @{term k} divides @{term "gcd m n"}.
*}

lemma gcd_greatest: "k dvd m \<Longrightarrow> k dvd n \<Longrightarrow> k dvd gcd m n"
  by (induct m n rule: gcd_induct) (simp_all add: gcd_non_0 dvd_mod)

text {*
  \medskip Function gcd yields the Greatest Common Divisor.
*}

lemma is_gcd: "is_gcd m n (gcd m n) "
  by (simp add: is_gcd_def gcd_greatest)

subsection {* Derived laws for GCD *}

lemma gcd_greatest_iff [iff, algebra]: "k dvd gcd m n \<longleftrightarrow> k dvd m \<and> k dvd n"
  by (blast intro!: gcd_greatest intro: dvd_trans)

lemma gcd_zero[algebra]: "gcd m n = 0 \<longleftrightarrow> m = 0 \<and> n = 0"
  by (simp only: dvd_0_left_iff [symmetric] gcd_greatest_iff)

lemma gcd_commute: "gcd m n = gcd n m"
  apply (rule is_gcd_unique)
   apply (rule is_gcd)
  apply (subst is_gcd_commute)
  apply (simp add: is_gcd)
  done

lemma gcd_assoc: "gcd (gcd k m) n = gcd k (gcd m n)"
  apply (rule is_gcd_unique)
   apply (rule is_gcd)
  apply (simp add: is_gcd_def)
  apply (blast intro: dvd_trans)
  done

lemma gcd_1_left [simp, algebra]: "gcd (Suc 0) m = Suc 0"
  by (simp add: gcd_commute)

lemma nat_gcd_1_left [simp, algebra]: "gcd 1 m = 1"
  unfolding One_nat_def by (rule gcd_1_left)

text {*
  \medskip Multiplication laws
*}

lemma gcd_mult_distrib2: "k * gcd m n = gcd (k * m) (k * n)"
    -- {* @{cite \<open>page 27\<close> davenport92} *}
  apply (induct m n rule: gcd_induct)
   apply simp
  apply (case_tac "k = 0")
   apply (simp_all add: gcd_non_0)
  done

lemma gcd_mult [simp, algebra]: "gcd k (k * n) = k"
  apply (rule gcd_mult_distrib2 [of k 1 n, simplified, symmetric])
  done

lemma gcd_self [simp, algebra]: "gcd k k = k"
  apply (rule gcd_mult [of k 1, simplified])
  done

lemma relprime_dvd_mult: "gcd k n = 1 ==> k dvd m * n ==> k dvd m"
  apply (insert gcd_mult_distrib2 [of m k n])
  apply simp
  apply (erule_tac t = m in ssubst)
  apply simp
  done

lemma relprime_dvd_mult_iff: "gcd k n = 1 ==> (k dvd m * n) = (k dvd m)"
  by (auto intro: relprime_dvd_mult dvd_mult2)

lemma gcd_mult_cancel: "gcd k n = 1 ==> gcd (k * m) n = gcd m n"
  apply (rule dvd_antisym)
   apply (rule gcd_greatest)
    apply (rule_tac n = k in relprime_dvd_mult)
     apply (simp add: gcd_assoc)
     apply (simp add: gcd_commute)
    apply (simp_all add: mult.commute)
  done

text {* \medskip Addition laws *}

lemma gcd_add1 [simp, algebra]: "gcd (m + n) n = gcd m n"
  by (cases "n = 0") (auto simp add: gcd_non_0)

lemma gcd_add2 [simp, algebra]: "gcd m (m + n) = gcd m n"
proof -
  have "gcd m (m + n) = gcd (m + n) m" by (rule gcd_commute)
  also have "... = gcd (n + m) m" by (simp add: add.commute)
  also have "... = gcd n m" by simp
  also have  "... = gcd m n" by (rule gcd_commute)
  finally show ?thesis .
qed

lemma gcd_add2' [simp, algebra]: "gcd m (n + m) = gcd m n"
  apply (subst add.commute)
  apply (rule gcd_add2)
  done

lemma gcd_add_mult[algebra]: "gcd m (k * m + n) = gcd m n"
  by (induct k) (simp_all add: add.assoc)

lemma gcd_dvd_prod: "gcd m n dvd m * n"
  using mult_dvd_mono [of 1] by auto

text {*
  \medskip Division by gcd yields rrelatively primes.
*}

lemma div_gcd_relprime:
  assumes nz: "a \<noteq> 0 \<or> b \<noteq> 0"
  shows "gcd (a div gcd a b) (b div gcd a b) = 1"
proof -
  let ?g = "gcd a b"
  let ?a' = "a div ?g"
  let ?b' = "b div ?g"
  let ?g' = "gcd ?a' ?b'"
  have dvdg: "?g dvd a" "?g dvd b" by simp_all
  have dvdg': "?g' dvd ?a'" "?g' dvd ?b'" by simp_all
  from dvdg dvdg' obtain ka kb ka' kb' where
      kab: "a = ?g * ka" "b = ?g * kb" "?a' = ?g' * ka'" "?b' = ?g' * kb'"
    unfolding dvd_def by blast
  from this(3-4) [symmetric] have "?g * ?a' = (?g * ?g') * ka'" "?g * ?b' = (?g * ?g') * kb'"
    by (simp_all only: ac_simps mult.left_commute [of _ "gcd a b"])
  then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b"
    by (auto simp add: dvd_mult_div_cancel [OF dvdg(1)]
      dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
  have "?g \<noteq> 0" using nz by (simp add: gcd_zero)
  then have gp: "?g > 0" by simp
  from gcd_greatest [OF dvdgg'] have "?g * ?g' dvd ?g" .
  with dvd_mult_cancel1 [OF gp] show "?g' = 1" by simp
qed

lemma gcd_unique: "d dvd a\<and>d dvd b \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
proof(auto)
  assume H: "d dvd a" "d dvd b" "\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d"
  from H(3)[rule_format] gcd_dvd1[of a b] gcd_dvd2[of a b]
  have th: "gcd a b dvd d" by blast
  from dvd_antisym[OF th gcd_greatest[OF H(1,2)]]  show "d = gcd a b" by blast
qed

lemma gcd_eq: assumes H: "\<forall>d. d dvd x \<and> d dvd y \<longleftrightarrow> d dvd u \<and> d dvd v"
  shows "gcd x y = gcd u v"
proof-
  from H have "\<forall>d. d dvd x \<and> d dvd y \<longleftrightarrow> d dvd gcd u v" by simp
  with gcd_unique[of "gcd u v" x y]  show ?thesis by auto
qed

lemma ind_euclid:
  assumes c: " \<forall>a b. P (a::nat) b \<longleftrightarrow> P b a" and z: "\<forall>a. P a 0"
  and add: "\<forall>a b. P a b \<longrightarrow> P a (a + b)"
  shows "P a b"
proof(induct "a + b" arbitrary: a b rule: less_induct)
  case less
  have "a = b \<or> a < b \<or> b < a" by arith
  moreover {assume eq: "a= b"
    from add[rule_format, OF z[rule_format, of a]] have "P a b" using eq
    by simp}
  moreover
  {assume lt: "a < b"
    hence "a + b - a < a + b \<or> a = 0" by arith
    moreover
    {assume "a =0" with z c have "P a b" by blast }
    moreover
    {assume "a + b - a < a + b"
      also have th0: "a + b - a = a + (b - a)" using lt by arith
      finally have "a + (b - a) < a + b" .
      then have "P a (a + (b - a))" by (rule add[rule_format, OF less])
      then have "P a b" by (simp add: th0[symmetric])}
    ultimately have "P a b" by blast}
  moreover
  {assume lt: "a > b"
    hence "b + a - b < a + b \<or> b = 0" by arith
    moreover
    {assume "b =0" with z c have "P a b" by blast }
    moreover
    {assume "b + a - b < a + b"
      also have th0: "b + a - b = b + (a - b)" using lt by arith
      finally have "b + (a - b) < a + b" .
      then have "P b (b + (a - b))" by (rule add[rule_format, OF less])
      then have "P b a" by (simp add: th0[symmetric])
      hence "P a b" using c by blast }
    ultimately have "P a b" by blast}
ultimately  show "P a b" by blast
qed

lemma bezout_lemma:
  assumes ex: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x = b * y + d \<or> b * x = a * y + d)"
  shows "\<exists>d x y. d dvd a \<and> d dvd a + b \<and> (a * x = (a + b) * y + d \<or> (a + b) * x = a * y + d)"
using ex
apply clarsimp
apply (rule_tac x="d" in exI, simp)
apply (case_tac "a * x = b * y + d" , simp_all)
apply (rule_tac x="x + y" in exI)
apply (rule_tac x="y" in exI)
apply algebra
apply (rule_tac x="x" in exI)
apply (rule_tac x="x + y" in exI)
apply algebra
done

lemma bezout_add: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x = b * y + d \<or> b * x = a * y + d)"
apply(induct a b rule: ind_euclid)
apply blast
apply clarify
apply (rule_tac x="a" in exI, simp)
apply clarsimp
apply (rule_tac x="d" in exI)
apply (case_tac "a * x = b * y + d", simp_all)
apply (rule_tac x="x+y" in exI)
apply (rule_tac x="y" in exI)
apply algebra
apply (rule_tac x="x" in exI)
apply (rule_tac x="x+y" in exI)
apply algebra
done

lemma bezout: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x - b * y = d \<or> b * x - a * y = d)"
using bezout_add[of a b]
apply clarsimp
apply (rule_tac x="d" in exI, simp)
apply (rule_tac x="x" in exI)
apply (rule_tac x="y" in exI)
apply auto
done

text {* We can get a stronger version with a nonzeroness assumption. *}
lemma divides_le: "m dvd n ==> m <= n \<or> n = (0::nat)" by (auto simp add: dvd_def)

lemma bezout_add_strong: assumes nz: "a \<noteq> (0::nat)"
  shows "\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d"
proof-
  from nz have ap: "a > 0" by simp
 from bezout_add[of a b]
 have "(\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d) \<or> (\<exists>d x y. d dvd a \<and> d dvd b \<and> b * x = a * y + d)" by blast
 moreover
 {fix d x y assume H: "d dvd a" "d dvd b" "a * x = b * y + d"
   from H have ?thesis by blast }
 moreover
 {fix d x y assume H: "d dvd a" "d dvd b" "b * x = a * y + d"
   {assume b0: "b = 0" with H  have ?thesis by simp}
   moreover
   {assume b: "b \<noteq> 0" hence bp: "b > 0" by simp
     from divides_le[OF H(2)] b have "d < b \<or> d = b" using le_less by blast
     moreover
     {assume db: "d=b"
       from nz H db have ?thesis apply simp
         apply (rule exI[where x = b], simp)
         apply (rule exI[where x = b])
        by (rule exI[where x = "a - 1"], simp add: diff_mult_distrib2)}
    moreover
    {assume db: "d < b"
        {assume "x=0" hence ?thesis using nz H by simp }
        moreover
        {assume x0: "x \<noteq> 0" hence xp: "x > 0" by simp

          from db have "d \<le> b - 1" by simp
          hence "d*b \<le> b*(b - 1)" by simp
          with xp mult_mono[of "1" "x" "d*b" "b*(b - 1)"]
          have dble: "d*b \<le> x*b*(b - 1)" using bp by simp
          from H (3) have "a * ((b - 1) * y) + d * (b - 1 + 1) = d + x*b*(b - 1)" by algebra
          hence "a * ((b - 1) * y) = d + x*b*(b - 1) - d*b" using bp by simp
          hence "a * ((b - 1) * y) = d + (x*b*(b - 1) - d*b)"
            by (simp only: diff_add_assoc[OF dble, of d, symmetric])
          hence "a * ((b - 1) * y) = b*(x*(b - 1) - d) + d"
            by (simp only: diff_mult_distrib2 ac_simps)
          hence ?thesis using H(1,2)
            apply -
            apply (rule exI[where x=d], simp)
            apply (rule exI[where x="(b - 1) * y"])
            by (rule exI[where x="x*(b - 1) - d"], simp)}
        ultimately have ?thesis by blast}
    ultimately have ?thesis by blast}
  ultimately have ?thesis by blast}
 ultimately show ?thesis by blast
qed

lemma bezout_gcd: "\<exists>x y. a * x - b * y = gcd a b \<or> b * x - a * y = gcd a b"
proof-
  let ?g = "gcd a b"
  from bezout[of a b] obtain d x y where d: "d dvd a" "d dvd b" "a * x - b * y = d \<or> b * x - a * y = d" by blast
  from d(1,2) have "d dvd ?g" by simp
  then obtain k where k: "?g = d*k" unfolding dvd_def by blast
  from d(3) have "(a * x - b * y)*k = d*k \<or> (b * x - a * y)*k = d*k" by blast
  hence "a * x * k - b * y*k = d*k \<or> b * x * k - a * y*k = d*k"
    by (algebra add: diff_mult_distrib)
  hence "a * (x * k) - b * (y*k) = ?g \<or> b * (x * k) - a * (y*k) = ?g"
    by (simp add: k mult.assoc)
  thus ?thesis by blast
qed

lemma bezout_gcd_strong: assumes a: "a \<noteq> 0"
  shows "\<exists>x y. a * x = b * y + gcd a b"
proof-
  let ?g = "gcd a b"
  from bezout_add_strong[OF a, of b]
  obtain d x y where d: "d dvd a" "d dvd b" "a * x = b * y + d" by blast
  from d(1,2) have "d dvd ?g" by simp
  then obtain k where k: "?g = d*k" unfolding dvd_def by blast
  from d(3) have "a * x * k = (b * y + d) *k " by algebra
  hence "a * (x * k) = b * (y*k) + ?g" by (algebra add: k)
  thus ?thesis by blast
qed

lemma gcd_mult_distrib: "gcd(a * c) (b * c) = c * gcd a b"
by(simp add: gcd_mult_distrib2 mult.commute)

lemma gcd_bezout: "(\<exists>x y. a * x - b * y = d \<or> b * x - a * y = d) \<longleftrightarrow> gcd a b dvd d"
  (is "?lhs \<longleftrightarrow> ?rhs")
proof-
  let ?g = "gcd a b"
  {assume H: ?rhs then obtain k where k: "d = ?g*k" unfolding dvd_def by blast
    from bezout_gcd[of a b] obtain x y where xy: "a * x - b * y = ?g \<or> b * x - a * y = ?g"
      by blast
    hence "(a * x - b * y)*k = ?g*k \<or> (b * x - a * y)*k = ?g*k" by auto
    hence "a * x*k - b * y*k = ?g*k \<or> b * x * k - a * y*k = ?g*k"
      by (simp only: diff_mult_distrib)
    hence "a * (x*k) - b * (y*k) = d \<or> b * (x * k) - a * (y*k) = d"
      by (simp add: k[symmetric] mult.assoc)
    hence ?lhs by blast}
  moreover
  {fix x y assume H: "a * x - b * y = d \<or> b * x - a * y = d"
    have dv: "?g dvd a*x" "?g dvd b * y" "?g dvd b*x" "?g dvd a * y"
      using dvd_mult2[OF gcd_dvd1[of a b]] dvd_mult2[OF gcd_dvd2[of a b]] by simp_all
    from dvd_diff_nat[OF dv(1,2)] dvd_diff_nat[OF dv(3,4)] H
    have ?rhs by auto}
  ultimately show ?thesis by blast
qed

lemma gcd_bezout_sum: assumes H:"a * x + b * y = d" shows "gcd a b dvd d"
proof-
  let ?g = "gcd a b"
    have dv: "?g dvd a*x" "?g dvd b * y"
      using dvd_mult2[OF gcd_dvd1[of a b]] dvd_mult2[OF gcd_dvd2[of a b]] by simp_all
    from dvd_add[OF dv] H
    show ?thesis by auto
qed

lemma gcd_mult': "gcd b (a * b) = b"
by (simp add: mult.commute[of a b])

lemma gcd_add: "gcd(a + b) b = gcd a b"
  "gcd(b + a) b = gcd a b" "gcd a (a + b) = gcd a b" "gcd a (b + a) = gcd a b"
by (simp_all add: gcd_commute)

lemma gcd_sub: "b <= a ==> gcd(a - b) b = gcd a b" "a <= b ==> gcd a (b - a) = gcd a b"
proof-
  {fix a b assume H: "b \<le> (a::nat)"
    hence th: "a - b + b = a" by arith
    from gcd_add(1)[of "a - b" b] th  have "gcd(a - b) b = gcd a b" by simp}
  note th = this
{
  assume ab: "b \<le> a"
  from th[OF ab] show "gcd (a - b)  b = gcd a b" by blast
next
  assume ab: "a \<le> b"
  from th[OF ab] show "gcd a (b - a) = gcd a b"
    by (simp add: gcd_commute)}
qed

subsection {* LCM defined by GCD *}

definition
  lcm :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
  lcm_def: "lcm m n = m * n div gcd m n"

lemma prod_gcd_lcm:
  "m * n = gcd m n * lcm m n"
  unfolding lcm_def by (simp add: dvd_mult_div_cancel [OF gcd_dvd_prod])

lemma lcm_0 [simp]: "lcm m 0 = 0"
  unfolding lcm_def by simp

lemma lcm_1 [simp]: "lcm m 1 = m"
  unfolding lcm_def by simp

lemma lcm_0_left [simp]: "lcm 0 n = 0"
  unfolding lcm_def by simp

lemma lcm_1_left [simp]: "lcm 1 m = m"
  unfolding lcm_def by simp

lemma dvd_pos:
  fixes n m :: nat
  assumes "n > 0" and "m dvd n"
  shows "m > 0"
using assms by (cases m) auto

lemma lcm_least:
  assumes "m dvd k" and "n dvd k"
  shows "lcm m n dvd k"
proof (cases k)
  case 0 then show ?thesis by auto
next
  case (Suc _) then have pos_k: "k > 0" by auto
  from assms dvd_pos [OF this] have pos_mn: "m > 0" "n > 0" by auto
  with gcd_zero [of m n] have pos_gcd: "gcd m n > 0" by simp
  from assms obtain p where k_m: "k = m * p" using dvd_def by blast
  from assms obtain q where k_n: "k = n * q" using dvd_def by blast
  from pos_k k_m have pos_p: "p > 0" by auto
  from pos_k k_n have pos_q: "q > 0" by auto
  have "k * k * gcd q p = k * gcd (k * q) (k * p)"
    by (simp add: ac_simps gcd_mult_distrib2)
  also have "\<dots> = k * gcd (m * p * q) (n * q * p)"
    by (simp add: k_m [symmetric] k_n [symmetric])
  also have "\<dots> = k * p * q * gcd m n"
    by (simp add: ac_simps gcd_mult_distrib2)
  finally have "(m * p) * (n * q) * gcd q p = k * p * q * gcd m n"
    by (simp only: k_m [symmetric] k_n [symmetric])
  then have "p * q * m * n * gcd q p = p * q * k * gcd m n"
    by (simp add: ac_simps)
  with pos_p pos_q have "m * n * gcd q p = k * gcd m n"
    by simp
  with prod_gcd_lcm [of m n]
  have "lcm m n * gcd q p * gcd m n = k * gcd m n"
    by (simp add: ac_simps)
  with pos_gcd have "lcm m n * gcd q p = k" by simp
  then show ?thesis using dvd_def by auto
qed

lemma lcm_dvd1 [iff]:
  "m dvd lcm m n"
proof (cases m)
  case 0 then show ?thesis by simp
next
  case (Suc _)
  then have mpos: "m > 0" by simp
  show ?thesis
  proof (cases n)
    case 0 then show ?thesis by simp
  next
    case (Suc _)
    then have npos: "n > 0" by simp
    have "gcd m n dvd n" by simp
    then obtain k where "n = gcd m n * k" using dvd_def by auto
    then have "m * n div gcd m n = m * (gcd m n * k) div gcd m n" by (simp add: ac_simps)
    also have "\<dots> = m * k" using mpos npos gcd_zero by simp
    finally show ?thesis by (simp add: lcm_def)
  qed
qed

lemma lcm_dvd2 [iff]:
  "n dvd lcm m n"
proof (cases n)
  case 0 then show ?thesis by simp
next
  case (Suc _)
  then have npos: "n > 0" by simp
  show ?thesis
  proof (cases m)
    case 0 then show ?thesis by simp
  next
    case (Suc _)
    then have mpos: "m > 0" by simp
    have "gcd m n dvd m" by simp
    then obtain k where "m = gcd m n * k" using dvd_def by auto
    then have "m * n div gcd m n = (gcd m n * k) * n div gcd m n" by (simp add: ac_simps)
    also have "\<dots> = n * k" using mpos npos gcd_zero by simp
    finally show ?thesis by (simp add: lcm_def)
  qed
qed

lemma gcd_add1_eq: "gcd (m + k) k = gcd (m + k) m"
  by (simp add: gcd_commute)

lemma gcd_diff2: "m \<le> n ==> gcd n (n - m) = gcd n m"
  apply (subgoal_tac "n = m + (n - m)")
  apply (erule ssubst, rule gcd_add1_eq, simp)
  done

subsection {* GCD and LCM on integers *}

definition
  zgcd :: "int \<Rightarrow> int \<Rightarrow> int" where
  "zgcd i j = int (gcd (nat (abs i)) (nat (abs j)))"

lemma zgcd_zdvd1 [iff, algebra]: "zgcd i j dvd i"
by (simp add: zgcd_def int_dvd_iff)

lemma zgcd_zdvd2 [iff, algebra]: "zgcd i j dvd j"
by (simp add: zgcd_def int_dvd_iff)

lemma zgcd_pos: "zgcd i j \<ge> 0"
by (simp add: zgcd_def)

lemma zgcd0 [simp,algebra]: "(zgcd i j = 0) = (i = 0 \<and> j = 0)"
by (simp add: zgcd_def gcd_zero)

lemma zgcd_commute: "zgcd i j = zgcd j i"
unfolding zgcd_def by (simp add: gcd_commute)

lemma zgcd_zminus [simp, algebra]: "zgcd (- i) j = zgcd i j"
unfolding zgcd_def by simp

lemma zgcd_zminus2 [simp, algebra]: "zgcd i (- j) = zgcd i j"
unfolding zgcd_def by simp

  (* should be solved by algebra*)
lemma zrelprime_dvd_mult: "zgcd i j = 1 \<Longrightarrow> i dvd k * j \<Longrightarrow> i dvd k"
  unfolding zgcd_def
proof -
  assume "int (gcd (nat \<bar>i\<bar>) (nat \<bar>j\<bar>)) = 1" "i dvd k * j"
  then have g: "gcd (nat \<bar>i\<bar>) (nat \<bar>j\<bar>) = 1" by simp
  from `i dvd k * j` obtain h where h: "k*j = i*h" unfolding dvd_def by blast
  have th: "nat \<bar>i\<bar> dvd nat \<bar>k\<bar> * nat \<bar>j\<bar>"
    unfolding dvd_def
    by (rule_tac x= "nat \<bar>h\<bar>" in exI, simp add: h nat_abs_mult_distrib [symmetric])
  from relprime_dvd_mult [OF g th] obtain h' where h': "nat \<bar>k\<bar> = nat \<bar>i\<bar> * h'"
    unfolding dvd_def by blast
  from h' have "int (nat \<bar>k\<bar>) = int (nat \<bar>i\<bar> * h')" by simp
  then have "\<bar>k\<bar> = \<bar>i\<bar> * int h'" by (simp add: int_mult)
  then show ?thesis
    apply (subst abs_dvd_iff [symmetric])
    apply (subst dvd_abs_iff [symmetric])
    apply (unfold dvd_def)
    apply (rule_tac x = "int h'" in exI, simp)
    done
qed

lemma int_nat_abs: "int (nat (abs x)) = abs x" by arith

lemma zgcd_greatest:
  assumes "k dvd m" and "k dvd n"
  shows "k dvd zgcd m n"
proof -
  let ?k' = "nat \<bar>k\<bar>"
  let ?m' = "nat \<bar>m\<bar>"
  let ?n' = "nat \<bar>n\<bar>"
  from `k dvd m` and `k dvd n` have dvd': "?k' dvd ?m'" "?k' dvd ?n'"
    unfolding zdvd_int by (simp_all only: int_nat_abs abs_dvd_iff dvd_abs_iff)
  from gcd_greatest [OF dvd'] have "int (nat \<bar>k\<bar>) dvd zgcd m n"
    unfolding zgcd_def by (simp only: zdvd_int)
  then have "\<bar>k\<bar> dvd zgcd m n" by (simp only: int_nat_abs)
  then show "k dvd zgcd m n" by simp
qed

lemma div_zgcd_relprime:
  assumes nz: "a \<noteq> 0 \<or> b \<noteq> 0"
  shows "zgcd (a div (zgcd a b)) (b div (zgcd a b)) = 1"
proof -
  from nz have nz': "nat \<bar>a\<bar> \<noteq> 0 \<or> nat \<bar>b\<bar> \<noteq> 0" by arith
  let ?g = "zgcd a b"
  let ?a' = "a div ?g"
  let ?b' = "b div ?g"
  let ?g' = "zgcd ?a' ?b'"
  have dvdg: "?g dvd a" "?g dvd b" by simp_all
  have dvdg': "?g' dvd ?a'" "?g' dvd ?b'" by simp_all
  from dvdg dvdg' obtain ka kb ka' kb' where
   kab: "a = ?g*ka" "b = ?g*kb" "?a' = ?g'*ka'" "?b' = ?g' * kb'"
    unfolding dvd_def by blast
  from this(3-4) [symmetric] have "?g* ?a' = (?g * ?g') * ka'" "?g* ?b' = (?g * ?g') * kb'"
    by (simp_all only: ac_simps mult.left_commute [of _ "zgcd a b"])
  then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b"
    by (auto simp add: dvd_mult_div_cancel [OF dvdg(1)]
      dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
  have "?g \<noteq> 0" using nz by simp
  then have gp: "?g \<noteq> 0" using zgcd_pos[where i="a" and j="b"] by arith
  from zgcd_greatest [OF dvdgg'] have "?g * ?g' dvd ?g" .
  with zdvd_mult_cancel1 [OF gp] have "\<bar>?g'\<bar> = 1" by simp
  with zgcd_pos show "?g' = 1" by simp
qed

lemma zgcd_0 [simp, algebra]: "zgcd m 0 = abs m"
  by (simp add: zgcd_def abs_if)

lemma zgcd_0_left [simp, algebra]: "zgcd 0 m = abs m"
  by (simp add: zgcd_def abs_if)

lemma zgcd_non_0: "0 < n ==> zgcd m n = zgcd n (m mod n)"
  apply (frule_tac b = n and a = m in pos_mod_sign)
  apply (simp del: pos_mod_sign add: zgcd_def abs_if nat_mod_distrib)
  apply (auto simp add: gcd_non_0 nat_mod_distrib [symmetric] zmod_zminus1_eq_if)
  apply (frule_tac a = m in pos_mod_bound)
  apply (simp del: pos_mod_bound add: nat_diff_distrib gcd_diff2 nat_le_eq_zle)
  done

lemma zgcd_eq: "zgcd m n = zgcd n (m mod n)"
  apply (cases "n = 0", simp)
  apply (auto simp add: linorder_neq_iff zgcd_non_0)
  apply (cut_tac m = "-m" and n = "-n" in zgcd_non_0, auto)
  done

lemma zgcd_1 [simp, algebra]: "zgcd m 1 = 1"
  by (simp add: zgcd_def abs_if)

lemma zgcd_0_1_iff [simp, algebra]: "zgcd 0 m = 1 \<longleftrightarrow> \<bar>m\<bar> = 1"
  by (simp add: zgcd_def abs_if)

lemma zgcd_greatest_iff[algebra]: "k dvd zgcd m n = (k dvd m \<and> k dvd n)"
  by (simp add: zgcd_def abs_if int_dvd_iff dvd_int_iff nat_dvd_iff)

lemma zgcd_1_left [simp, algebra]: "zgcd 1 m = 1"
  by (simp add: zgcd_def)

lemma zgcd_assoc: "zgcd (zgcd k m) n = zgcd k (zgcd m n)"
  by (simp add: zgcd_def gcd_assoc)

lemma zgcd_left_commute: "zgcd k (zgcd m n) = zgcd m (zgcd k n)"
  apply (rule zgcd_commute [THEN trans])
  apply (rule zgcd_assoc [THEN trans])
  apply (rule zgcd_commute [THEN arg_cong])
  done

lemmas zgcd_ac = zgcd_assoc zgcd_commute zgcd_left_commute
  -- {* addition is an AC-operator *}

lemma zgcd_zmult_distrib2: "0 \<le> k ==> k * zgcd m n = zgcd (k * m) (k * n)"
  by (simp del: minus_mult_right [symmetric]
      add: minus_mult_right nat_mult_distrib zgcd_def abs_if
          mult_less_0_iff gcd_mult_distrib2 [symmetric] of_nat_mult)

lemma zgcd_zmult_distrib2_abs: "zgcd (k * m) (k * n) = abs k * zgcd m n"
  by (simp add: abs_if zgcd_zmult_distrib2)

lemma zgcd_self [simp]: "0 \<le> m ==> zgcd m m = m"
  by (cut_tac k = m and m = 1 and n = 1 in zgcd_zmult_distrib2, simp_all)

lemma zgcd_zmult_eq_self [simp]: "0 \<le> k ==> zgcd k (k * n) = k"
  by (cut_tac k = k and m = 1 and n = n in zgcd_zmult_distrib2, simp_all)

lemma zgcd_zmult_eq_self2 [simp]: "0 \<le> k ==> zgcd (k * n) k = k"
  by (cut_tac k = k and m = n and n = 1 in zgcd_zmult_distrib2, simp_all)

definition "zlcm i j = int (lcm(nat(abs i)) (nat(abs j)))"

lemma dvd_zlcm_self1[simp, algebra]: "i dvd zlcm i j"
by(simp add:zlcm_def dvd_int_iff)

lemma dvd_zlcm_self2[simp, algebra]: "j dvd zlcm i j"
by(simp add:zlcm_def dvd_int_iff)

lemma dvd_imp_dvd_zlcm1:
  assumes "k dvd i" shows "k dvd (zlcm i j)"
proof -
  have "nat(abs k) dvd nat(abs i)" using `k dvd i`
    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
  thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
qed

lemma dvd_imp_dvd_zlcm2:
  assumes "k dvd j" shows "k dvd (zlcm i j)"
proof -
  have "nat(abs k) dvd nat(abs j)" using `k dvd j`
    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
  thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
qed

lemma zdvd_self_abs1: "(d::int) dvd (abs d)"
by (case_tac "d <0", simp_all)

lemma zdvd_self_abs2: "(abs (d::int)) dvd d"
by (case_tac "d<0", simp_all)

(* lcm a b is positive for positive a and b *)

lemma lcm_pos:
  assumes mpos: "m > 0"
    and npos: "n>0"
  shows "lcm m n > 0"
proof (rule ccontr, simp add: lcm_def gcd_zero)
  assume h:"m*n div gcd m n = 0"
  from mpos npos have "gcd m n \<noteq> 0" using gcd_zero by simp
  hence gcdp: "gcd m n > 0" by simp
  with h
  have "m*n < gcd m n"
    by (cases "m * n < gcd m n") (auto simp add: div_if[OF gcdp, where m="m*n"])
  moreover
  have "gcd m n dvd m" by simp
  with mpos dvd_imp_le have t1:"gcd m n \<le> m" by simp
  with npos have t1:"gcd m n *n \<le> m*n" by simp
  have "gcd m n \<le> gcd m n*n" using npos by simp
  with t1 have "gcd m n \<le> m*n" by arith
  ultimately show "False" by simp
qed

lemma zlcm_pos:
  assumes anz: "a \<noteq> 0"
  and bnz: "b \<noteq> 0"
  shows "0 < zlcm a b"
proof-
  let ?na = "nat (abs a)"
  let ?nb = "nat (abs b)"
  have nap: "?na >0" using anz by simp
  have nbp: "?nb >0" using bnz by simp
  have "0 < lcm ?na ?nb" by (rule lcm_pos[OF nap nbp])
  thus ?thesis by (simp add: zlcm_def)
qed

lemma zgcd_code [code]:
  "zgcd k l = \<bar>if l = 0 then k else zgcd l (\<bar>k\<bar> mod \<bar>l\<bar>)\<bar>"
  by (simp add: zgcd_def gcd.simps [of "nat \<bar>k\<bar>"] nat_mod_distrib)

end


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

text{*
\subsection{Definition}
\label{sec:fun-examples}

Here is a simple example, the \rmindex{Fibonacci function}:
*}

fun fib :: "nat \<Rightarrow> nat" where
"fib 0 = 0" |
"fib (Suc 0) = 1" |
"fib (Suc(Suc x)) = fib x + fib (Suc x)"

text{*\noindent
This resembles ordinary functional programming languages. Note the obligatory
\isacommand{where} and \isa{|}. Command \isacommand{fun} declares and
defines the function in one go. Isabelle establishes termination automatically
because @{const fib}'s argument decreases in every recursive call.

Slightly more interesting is the insertion of a fixed element
between any two elements of a list:
*}

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

text{*\noindent
This time the length of the list decreases with the
recursive call; the first argument is irrelevant for termination.

Pattern matching\index{pattern matching!and \isacommand{fun}}
need not be exhaustive and may employ wildcards:
*}

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

text{*
Overlapping patterns are disambiguated by taking the order of equations into
account, just as in functional programming:
*}

fun sep1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"sep1 a (x#y#zs) = x # a # sep1 a (y#zs)" |
"sep1 _ xs       = xs"

text{*\noindent
To guarantee that the second equation can only be applied if the first
one does not match, Isabelle internally replaces the second equation
by the two possibilities that are left: @{prop"sep1 a [] = []"} and
@{prop"sep1 a [x] = [x]"}.  Thus the functions @{const sep} and
@{const sep1} are identical.

Because of its pattern matching syntax, \isacommand{fun} is also useful
for the definition of non-recursive functions:
*}

fun swap12 :: "'a list \<Rightarrow> 'a list" where
"swap12 (x#y#zs) = y#x#zs" |
"swap12 zs       = zs"

text{*
After a function~$f$ has been defined via \isacommand{fun},
its defining equations (or variants derived from them) are available
under the name $f$@{text".simps"} as theorems.
For example, look (via \isacommand{thm}) at
@{thm[source]sep.simps} and @{thm[source]sep1.simps} to see that they define
the same function. What is more, those equations are automatically declared as
simplification rules.

\subsection{Termination}

Isabelle's automatic termination prover for \isacommand{fun} has a
fixed notion of the \emph{size} (of type @{typ nat}) of an
argument. The size of a natural number is the number itself. The size
of a list is its length. For the general case see \S\ref{sec:general-datatype}.
A recursive function is accepted if \isacommand{fun} can
show that the size of one fixed argument becomes smaller with each
recursive call.

More generally, \isacommand{fun} allows any \emph{lexicographic
combination} of size measures in case there are multiple
arguments. For example, the following version of \rmindex{Ackermann's
function} is accepted: *}

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

text{* The order of arguments has no influence on whether
\isacommand{fun} can prove termination of a function. For more details
see elsewhere~@{cite bulwahnKN07}.

\subsection{Simplification}
\label{sec:fun-simplification}

Upon a successful termination proof, the recursion equations become
simplification rules, just as with \isacommand{primrec}.
In most cases this works fine, but there is a subtle
problem that must be mentioned: simplification may not
terminate because of automatic splitting of @{text "if"}.
\index{*if expressions!splitting of}
Let us look at an example:
*}

fun gcd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"gcd m n = (if n=0 then m else gcd n (m mod n))"

text{*\noindent
The second argument decreases with each recursive call.
The termination condition
@{prop[display]"n ~= (0::nat) ==> m mod n < n"}
is proved automatically because it is already present as a lemma in
HOL\@.  Thus the recursion equation becomes a simplification
rule. Of course the equation is nonterminating if we are allowed to unfold
the recursive call inside the @{text else} branch, which is why programming
languages and our simplifier don't do that. Unfortunately the simplifier does
something else that leads to the same problem: it splits
each @{text "if"}-expression unless its
condition simplifies to @{term True} or @{term False}.  For
example, simplification reduces
@{prop[display]"gcd m n = k"}
in one step to
@{prop[display]"(if n=0 then m else gcd n (m mod n)) = k"}
where the condition cannot be reduced further, and splitting leads to
@{prop[display]"(n=0 --> m=k) & (n ~= 0 --> gcd n (m mod n)=k)"}
Since the recursive call @{term"gcd n (m mod n)"} is no longer protected by
an @{text "if"}, it is unfolded again, which leads to an infinite chain of
simplification steps. Fortunately, this problem can be avoided in many
different ways.

The most radical solution is to disable the offending theorem
@{thm[source]if_split},
as shown in \S\ref{sec:AutoCaseSplits}.  However, we do not recommend this
approach: you will often have to invoke the rule explicitly when
@{text "if"} is involved.

If possible, the definition should be given by pattern matching on the left
rather than @{text "if"} on the right. In the case of @{term gcd} the
following alternative definition suggests itself:
*}

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

text{*\noindent
The order of equations is important: it hides the side condition
@{prop"n ~= (0::nat)"}.  Unfortunately, not all conditionals can be
expressed by pattern matching.

A simple alternative is to replace @{text "if"} by @{text case},
which is also available for @{typ bool} and is not split automatically:
*}

fun gcd2 :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"gcd2 m n = (case n=0 of True \<Rightarrow> m | False \<Rightarrow> gcd2 n (m mod n))"

text{*\noindent
This is probably the neatest solution next to pattern matching, and it is
always available.

A final alternative is to replace the offending simplification rules by
derived conditional ones. For @{term gcd} it means we have to prove
these lemmas:
*}

lemma [simp]: "n \<noteq> 0 \<Longrightarrow> gcd m n = gcd n (m mod n)"
apply(simp)
done

text{*\noindent
Simplification terminates for these proofs because the condition of the @{text
"if"} simplifies to @{term True} or @{term False}.
Now we can disable the original simplification rule:
*}

declare gcd.simps [simp del]

text{*
\index{induction!recursion|(}
\index{recursion induction|(}

\subsection{Induction}
\label{sec:fun-induction}

Having defined a function we might like to prove something about it.
Since the function is recursive, the natural proof principle is
again induction. But this time the structural form of induction that comes
with datatypes is unlikely to work well --- otherwise we could have defined the
function by \isacommand{primrec}. Therefore \isacommand{fun} automatically
proves a suitable induction rule $f$@{text".induct"} that follows the
recursion pattern of the particular function $f$. We call this
\textbf{recursion induction}. Roughly speaking, it
requires you to prove for each \isacommand{fun} equation that the property
you are trying to establish holds for the left-hand side provided it holds
for all recursive calls on the right-hand side. Here is a simple example
involving the predefined @{term"map"} functional on lists:
*}

lemma "map f (sep x xs) = sep (f x) (map f xs)"

txt{*\noindent
Note that @{term"map f xs"}
is the result of applying @{term"f"} to all elements of @{term"xs"}. We prove
this lemma by recursion induction over @{term"sep"}:
*}

apply(induct_tac x xs rule: sep.induct)

txt{*\noindent
The resulting proof state has three subgoals corresponding to the three
clauses for @{term"sep"}:
@{subgoals[display,indent=0]}
The rest is pure simplification:
*}

apply simp_all
done

text{*\noindent The proof goes smoothly because the induction rule
follows the recursion of @{const sep}.  Try proving the above lemma by
structural induction, and you find that you need an additional case
distinction.

In general, the format of invoking recursion induction is
\begin{quote}
\isacommand{apply}@{text"(induct_tac"} $x@1 \dots x@n$ @{text"rule:"} $f$@{text".induct)"}
\end{quote}\index{*induct_tac (method)}%
where $x@1~\dots~x@n$ is a list of free variables in the subgoal and $f$ the
name of a function that takes $n$ arguments. Usually the subgoal will
contain the term $f x@1 \dots x@n$ but this need not be the case. The
induction rules do not mention $f$ at all. Here is @{thm[source]sep.induct}:
\begin{isabelle}
{\isasymlbrakk}~{\isasymAnd}a.~P~a~[];\isanewline
~~{\isasymAnd}a~x.~P~a~[x];\isanewline
~~{\isasymAnd}a~x~y~zs.~P~a~(y~\#~zs)~{\isasymLongrightarrow}~P~a~(x~\#~y~\#~zs){\isasymrbrakk}\isanewline
{\isasymLongrightarrow}~P~u~v%
\end{isabelle}
It merely says that in order to prove a property @{term"P"} of @{term"u"} and
@{term"v"} you need to prove it for the three cases where @{term"v"} is the
empty list, the singleton list, and the list with at least two elements.
The final case has an induction hypothesis:  you may assume that @{term"P"}
holds for the tail of that list.
\index{induction!recursion|)}
\index{recursion induction|)}
*}
(*<*)
end
(*>*)


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

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

theory NatSum
  imports MainRLT
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 PowSum
  imports Main
begin

subsubsection \<open> Power \<close>

text \<open> Define a primitive recursive function $pow~x~n$ that
computes $x^n$ on natural numbers. \<close>

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

lemma pow_add:"pow x (m + n) = pow x m * pow x n"
  apply (induction m) by auto

lemma pow_0[simp]:"pow 0 (Suc n) = 0"
  by auto

lemma pow_1[simp]:"pow 1 n = 1"
  apply (induction n) by auto

lemma pow_same_num:"pow x n * pow y n = pow (x * y) n"
  apply (induction n) by auto

text \<open> Prove the well known equation $x^{m \cdot n} = (x^m)^n$: \<close>

theorem pow_mult: "pow x (m * n) = pow (pow x m) n"
  apply (induction m)
  using pow_1 pow_add pow_same_num apply auto
  done

text \<open> Hint: prove a suitable lemma first.  If you need to appeal to
associativity and commutativity of multiplication: the corresponding
simplification rules are named @{text mult_ac}. \<close>

subsubsection \<open> Summation \<close>

text \<open> Define a (primitive recursive) function $sum~ns$ that sums a list
of natural numbers: $sum [n_1, \dots, n_k] = n_1 + \cdots + n_k$. \<close>

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

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

text \<open> Show that $sum$ is compatible with $rev$. You may need a lemma. \<close>

theorem sum_rev: "sum (rev ns) = sum ns"
  apply (induction ns) by auto

text \<open> Define a function $Sum~f~k$ that sums $f$ from $0$ up to $k-1$:
$Sum~f~k = f~0 + \cdots + f(k - 1)$. \<close>

primrec Sum :: "(nat => nat) => nat => nat"
  where
"Sum _ 0 = 0" |
"Sum f (Suc n) = (f n) + Sum f n"

text \<open> Show the following equations for the pointwise summation of functions.
Determine first what the expression @{text whatever} should be. \<close>

theorem Sum_plus:"Sum (\<lambda>i. f i + g i) k = Sum f k + Sum g k"
  apply (induction k) by auto

theorem "Sum f (k + l) = Sum f k + Sum (\<lambda>i. f (k + i)) l"
  apply (induction l) by (auto simp add: Sum_plus)

text \<open> What is the relationship between @{term sum} and @{text Sum}?
Prove the following equation, suitably instantiated. \<close>

theorem "Sum f k = sum (map f [0..<k])"
  apply (induction k) by auto

text \<open> Hint: familiarize yourself with the predefined functions @{term map}
and @{text"[i..<j]"} on lists in theory List. \<close>

end


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

subsection{*Mutually Inductive Definitions*}

text{*
Just as there are datatypes defined by mutual recursion, there are sets defined
by mutual induction. As a trivial example we consider the even and odd
natural numbers:
*}

inductive_set
  Even :: "nat set" and
  Odd  :: "nat set"
where
  zero:  "0 \<in> Even"
| EvenI: "n \<in> Odd \<Longrightarrow> Suc n \<in> Even"
| OddI:  "n \<in> Even \<Longrightarrow> Suc n \<in> Odd"

text{*\noindent
The mutually inductive definition of multiple sets is no different from
that of a single set, except for induction: just as for mutually recursive
datatypes, induction needs to involve all the simultaneously defined sets. In
the above case, the induction rule is called @{thm[source]Even_Odd.induct}
(simply concatenate the names of the sets involved) and has the conclusion
@{text[display]"(?x \<in> Even \<longrightarrow> ?P ?x) \<and> (?y \<in> Odd \<longrightarrow> ?Q ?y)"}

If we want to prove that all even numbers are divisible by two, we have to
generalize the statement as follows:
*}

lemma "(m \<in> Even \<longrightarrow> 2 dvd m) \<and> (n \<in> Odd \<longrightarrow> 2 dvd (Suc n))"

txt{*\noindent
The proof is by rule induction. Because of the form of the induction theorem,
it is applied by @{text rule} rather than @{text erule} as for ordinary
inductive definitions:
*}

apply(rule Even_Odd.induct)

txt{*
@{subgoals[display,indent=0]}
The first two subgoals are proved by simplification and the final one can be
proved in the same manner as in \S\ref{sec:rule-induction}
where the same subgoal was encountered before.
We do not show the proof script.
*}
(*<*)
  apply simp
 apply simp
apply(simp add: dvd_def)
apply(clarify)
apply(rule_tac x = "Suc k" in exI)
apply simp
done
(*>*)

subsection{*Inductively Defined Predicates\label{sec:ind-predicates}*}

text{*\index{inductive predicates|(}
Instead of a set of even numbers one can also define a predicate on @{typ nat}:
*}

inductive evn :: "nat \<Rightarrow> bool" where
zero: "evn 0" |
step: "evn n \<Longrightarrow> evn(Suc(Suc n))"

text{*\noindent Everything works as before, except that
you write \commdx{inductive} instead of \isacommand{inductive\_set} and
@{prop"evn n"} instead of @{prop"n : Even"}.
When defining an n-ary relation as a predicate, it is recommended to curry
the predicate: its type should be \mbox{@{text"\<tau>\<^sub>1 \<Rightarrow> \<dots> \<Rightarrow> \<tau>\<^sub>n \<Rightarrow> bool"}}
rather than
@{text"\<tau>\<^sub>1 \<times> \<dots> \<times> \<tau>\<^sub>n \<Rightarrow> bool"}. The curried version facilitates inductions.

When should you choose sets and when predicates? If you intend to combine your notion with set theoretic notation, define it as an inductive set. If not, define it as an inductive predicate, thus avoiding the @{text"\<in>"} notation. But note that predicates of more than one argument cannot be combined with the usual set theoretic operators: @{term"P \<union> Q"} is not well-typed if @{text"P, Q :: \<tau>\<^sub>1 \<Rightarrow> \<tau>\<^sub>2 \<Rightarrow> bool"}, you have to write @{term"%x y. P x y & Q x y"} instead.
\index{inductive predicates|)}
*}

(*<*)end(*>*)


(*
    $Id: sol.thy,v 1.3 2011/06/28 18:11:39 webertj Exp $
    Author: Stefan Berghofer, Tobias Nipkow
*)

header {* Representation of Propositional Formulae by Polynomials *}

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

text {*
Let the following data type for propositional formulae be given:
*}

datatype form = T | Var nat | And form form | Xor form form

text {*
Here @{term "T"} denotes a formula that is always true, @{term "Var n"} denotes
a propositional variable, its name given by a natural number, @{term "And f1
f2"} denotes the AND combination, and @{term "Xor f1 f2"} the XOR (exclusive or)
combination of two formulae.  A constructor @{term "F"} for a formula that is
always false is not necessary, since @{term "F"} can be expressed by @{term "Xor
T T"}.

{\bf Exercise 1:} Define a function

  @{term "evalf :: (nat \<Rightarrow> bool) \<Rightarrow> form \<Rightarrow> bool"}

that evaluates a formula under a given variable assignment.
*}

definition
  xor :: "bool \<Rightarrow> bool \<Rightarrow> bool" where
  "xor x y \<equiv>  (x \<and> \<not> y) \<or> (\<not> x \<and> y)"

primrec evalf :: "(nat \<Rightarrow> bool) \<Rightarrow> form \<Rightarrow> bool" where
  "evalf e T = True"
| "evalf e (Var i) = e i"
| "evalf e (And f1 f2) = (evalf e f1 \<and> evalf e f2)"
| "evalf e (Xor f1 f2) = xor (evalf e f1) (evalf e f2)"

text {*
Propositional formulae can be represented by so-called {\it polynomials}.  A
polynomial is a list of lists of propositional variables, i.e.\ an element of
type @{typ "nat list list"}.  The inner lists (the so-called {\it monomials})
are interpreted as conjunctive combination of variables, whereas the outer list
is interpreted as exclusive-or combination of the inner lists.

{\bf Exercise 2:} Define two functions

  @{text "evalm :: (nat \<Rightarrow> bool) \<Rightarrow> nat list \<Rightarrow> bool"}\\
  @{text "evalp :: (nat \<Rightarrow> bool) \<Rightarrow> nat list list \<Rightarrow> bool"}

for evaluation of monomials and polynomials under a given variable assignment.
In particular think about how empty lists have to be evaluated.
*}

primrec evalm :: "(nat \<Rightarrow> bool) \<Rightarrow> nat list \<Rightarrow> bool" where
  "evalm e [] = True"
| "evalm e (x # xs) = (e x \<and> evalm e xs)"

primrec evalp :: "(nat \<Rightarrow> bool) \<Rightarrow> nat list list \<Rightarrow> bool" where
  "evalp e [] = False"
| "evalp e (m # p) = xor (evalm e m) (evalp e p)"

text {*
{\bf Exercise 3:} Define a function

  @{text "poly :: form \<Rightarrow> nat list list"}

that turns a formula into a polynomial.  You will need an auxiliary function

  @{text "mulpp :: nat list list \<Rightarrow> nat list list \<Rightarrow> nat list list"}

to ``multiply'' two polynomials, i.e.\ to compute
\[
((v^1_1 \mathbin{\odot} \cdots \mathbin{\odot} v^1_{m_1}) \mathbin{\oplus} \cdots \mathbin{\oplus} (v^k_1 \mathbin{\odot} \cdots \mathbin{\odot} v^k_{m_k})) \mathbin{\odot}
((w^1_1 \mathbin{\odot} \cdots \mathbin{\odot} w^1_{n_1}) \mathbin{\oplus} \cdots \mathbin{\oplus} (w^l_1 \mathbin{\odot} \cdots \mathbin{\odot} w^l_{n_l}))
\]
where $\mathbin{\oplus}$ denotes ``exclusive or'', and $\mathbin{\odot}$ denotes
``and''.  This is done using the usual calculation rules for addition and
multiplication.
*}

primrec mulpp :: "nat list list \<Rightarrow> nat list list \<Rightarrow> nat list list" where
  "mulpp [] q = []"
| "mulpp (m # p) q = map (op @ m) q @ (mulpp p q)"

primrec poly :: "form \<Rightarrow> nat list list" where
  "poly T = [[]]"
| "poly (Var i) = [[i]]"
| "poly (Xor f1 f2) = poly f1 @ poly f2"
| "poly (And f1 f2) = mulpp (poly f1) (poly f2)"

text {*
{\bf Exercise 4:} Now show correctness of your function @{term "poly"}:
*}

theorem poly_correct: "evalf e f = evalp e (poly f)"
(*<*) oops (*>*)

text {*
It is useful to prove a similar correctness theorem for @{term "mulpp"} first.
*}

lemma evalm_app: "evalm e (xs @ ys) = (evalm e xs \<and> evalm e ys)"
  apply (induct xs)
  apply auto
done

lemma evalp_app: "evalp e (xs @ ys) = (xor (evalp e xs) (evalp e ys))"
  apply (induct xs)
  apply (auto simp add: xor_def)
done

theorem mulmp_correct: "evalp e (map (op @ m) p) = (evalm e m \<and> evalp e p)"
  apply (induct p)
  apply (auto simp add: xor_def evalm_app)
done

theorem mulpp_correct: "evalp e (mulpp p q) = (evalp e p \<and> evalp e q)"
  apply (induct p)
  apply (auto simp add: xor_def mulmp_correct evalp_app)
done

theorem poly_correct: "evalf e f = evalp e (poly f)"
  apply (induct f)
  apply (auto simp add: xor_def mulpp_correct evalp_app)
done

(*<*) end (*>*)


theory EjT2A

imports Main
begin

text {* Relación 1 *}

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.1. [Cálculo con números naturales]
  Calcular el valor de las siguientes expresiones con números naturales:
  + 2 + (2::nat)
  + 2 + (2::int)
  + (2::nat) * (3 + 1)
  + (3::nat) * 4 - 2 * (7 + 1)
  + (3::int) * 4 - 2 * (7 + 1)"
  ------------------------------------------------------------------- *}

value "2 + (2::nat)"
  (* da "Suc (Suc (Suc (Suc 0)))" :: nat *)

value "2 + (2::int)"
  (* da "4" :: int *)

value "(2::nat) * (3 + 1)"
  (* da "Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))))" *)

value "(3::nat) * 4 - 2 * (7 + 1)"
  (* da "0" :: nat *)

value "(3::int) * 4 - 2 * (7 + 1)"
  (* da "- 4" :: int *)

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.2.1 [Propiedades de los números naturales]
  Usando la siguiente definición de suma de números naturales
     fun suma :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
       "suma 0 n = n"
     | "suma (Suc m) n = Suc (suma m n)"
  demostrar que la suma de los naturales es conmutativa.
  ------------------------------------------------------------------- *}

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

lemma suma_asociativa:
  "suma (suma x y) z = suma x (suma y z)"
apply (induction x)
apply auto
done

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.2.2. Demostrar que la suma de los naturales es conmutativa.
  ------------------------------------------------------------------- *}

text {* 1\<ordfeminine> intento *}
lemma suma_conmutativa_1:
  "suma x y = suma y x"
apply (induction x)
apply simp
oops

text {* Queda sin demostrar
     y = suma y 0
  por lo que se introduce el siguiente lema.
*}

lemma suma_0:
  "suma x 0 = x"
apply (induction x)
apply auto
done

text {* 2\<ordfeminine> intento *}
lemma suma_conmutativa_2:
  "suma x y = suma y x"
apply (induction x)
apply (simp add: suma_0)
oops

text {* Queda pendiente el objetivo
     \<And>x. suma x y = suma y x \<Longrightarrow> suma (Suc x) y = suma y (Suc x)
  por lo que se introduce el siguiente lema.
*}

lemma suma_1:
  "suma x (Suc y) = Suc (suma x y)"
apply (induction x)
apply auto
done

text {* 3\<ordfeminine> intento *}
lemma suma_conmutativa_3:
  "suma x y = suma y x"
apply (induction x)
apply (simp add: suma_0)
apply (simp add: suma_1)
done

text {* La demostración anterior se puede simplificar como sigue. *}
lemma suma_conmutativa:
  "suma x y = suma y x"
by (induction x) (simp_all add: suma_0 suma_1)

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.2.3. Definir, por inducción,
     fun doble :: "nat \<Rightarrow> nat"
  tal que (doble n) es el doble de n. Por ejemplo,
     doble 3 = 6
  ------------------------------------------------------------------- *}

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

value "int (doble 3)"
  (* da "6" :: int *)
lemma "doble 3 = 6" by normalization

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.2.4. Demostrar que
     doble x = suma x x
  ------------------------------------------------------------------- *}

text {* 1\<ordfeminine> demostración *}
lemma doble_suma_1:
  "doble x = suma x x"
apply (induction x)
apply simp
apply (simp add: suma_0 suma_1)
done

text {* 2\<ordfeminine> demostración *}
lemma doble_suma:
  "doble x = suma x x"
by (induction x) (simp_all add: suma_0 suma_1)

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.3.1. [Ocurrencias de un elemento en una lista]
  Definir la función
     cuenta :: "'a list \<Rightarrow> 'a \<Rightarrow> nat"
  tal que (cuenta xs y) es el número de ocurrencia de y en xs. Por
  ejemplo,
     cuenta [3, 2] 4 = 0
     cuenta [3, 2] 3 = Suc 0
     cuenta [3, 3] 3 = Suc (Suc 0)
     cuenta []     3 = 0
*}

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

value "cuenta [3, 2] (4::nat)"
  (* da "0" *)
value "cuenta [3, 2] (3::nat)"
  (* da "Suc 0" *)
value "cuenta [3, 3] (3::nat)"
  (* da "Suc (Suc 0)" *)
value "cuenta [] (3::nat)"
  (* da "0" *)

text{*
  ----------------------------------------------------------------------
  Ejercicio 2.3.2. Demostrar que el número de ocurrencia de cualquier
  elemento en una lista es menor o igual que la longitud de la lista.
  ------------------------------------------------------------------- *}

theorem "cuenta xs x \<le> length xs"
apply (induct xs)
apply auto
done

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.1. [Añadiendo los elementos al final de la lista e inversa]
  Definir, por recursión, la función
     snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list"
  tal que (snoc xs y) es la lista obtenida añadiendo y al final de xs.
  Por ejemplo,
     snoc [3,5,2] 7 = [3,5,2,7]
  ----------------------------------------------------------------------
*}

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

value "snoc [3,5,2] (7::int)"
  (* da "[3, 5, 2, 7]" *)
lemma "snoc [3,5,2] (7::int) = [3,5,2,7]"
by simp

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.2. Definir, sin recursión, la función
     snoc2 :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list"
  tal que (snoc2 xs y) es la lista obtenida añadiendo y al final de xs.
  Por ejemplo,
     snoc2 [3,5,2] 7 = [3,5,2,7]
  ----------------------------------------------------------------------
*}

definition snoc2 :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
  "snoc2 xs x \<equiv> xs @ [x]"

value "snoc2 [3,5,2] (7::int)"
  (* da "[3, 5, 2, 7]" *)
lemma "snoc2 [3,5,2] (7::int) = [3, 5, 2, 7]" by normalization

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.3. Demostrar que las funciones snoc y snoc2 son
  equivalentes.
  ------------------------------------------------------------------- *}

lemma snoc_snoc2:
  "snoc xs x = snoc2 xs x"
apply (induction xs)
apply (simp_all add: snoc2_def)
done

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.4. Definir, por recursión, la función
     inversa :: "'a list \<Rightarrow> 'a list"
  tal que (inversa xs) es la lista obtenida invirtiendo el orden de los
  elementos de xs. Por ejemplo,
     inversa [a, b, c] = [c, b, a]
  ------------------------------------------------------------------- *}

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

value "inversa [a, b, c]"
  (* da "[c, b, a]" *)
lemma "inversa [a, b, c] = [c, b, a]"
by simp

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.5. Demostrar que
     inversa (inversa xs) = xs"
  Nota: Se necesita un lema relacionando las funciones inversa y snoc.
  ------------------------------------------------------------------- *}

text {* 1\<ordmasculine> intento *}
theorem inversa_inversa_1:
  "inversa (inversa xs) = xs"
apply (induction xs)
apply simp
apply simp
oops

text {* Se quda sin demostrar
     inversa (inversa xs) = xs \<Longrightarrow>
     inversa (snoc (inversa xs) a) = a # xs
  por lo que se introduce el siguiente lema.
*}
lemma inversa_snoc:
  "inversa (snoc xs y) = y # inversa xs"
by (induct xs) auto

text {* Demostración *}
theorem inversa_inversa
  "inversa (inversa xs) = xs"
by (induct xs) (auto simp add: inversa_snoc)

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.6. Definir la función
     inversa_it :: "'a list \<Rightarrow> 'a list"
  tal que (inversa_it xs) es la inversa de xs calculada con un
  acumulador. Por ejemplo,
     inversa_it [a,b,c] = [c,b,a]
  ------------------------------------------------------------------- *}

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

fun inversa_it :: "'a list \<Rightarrow> 'a list" where
"inversa_it xs = inversa_it_aux [] xs"

value "inversa_it [a,b,c]"
  (* da "[c, b, a]" *)
lemma "inversa_it [a,b,c] = [c, b, a]" by simp

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.7. Demostrar que
     inversa_it (inversa_it xs) = xs"
  ------------------------------------------------------------------- *}

lemma inversa_it_aux_lemma:
  "\<forall>ys. inversa_it_aux [] (inversa_it_aux ys xs) = inversa_it_aux xs ys"
by (induct xs) auto

lemma "inversa_it (inversa_it xs) = xs"
by (simp add: inversa_it_aux_lemma)

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.8. Demostrar que las funciones inversa y rev son
  equivalentes.
  ------------------------------------------------------------------- *}

lemma inversa_rev:
  "inversa xs = rev xs"
apply (induction xs)
apply simp
apply (simp add: snoc_snoc2 snoc2_def)
done

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.9. Buscar los teoremas de la forma
     rev (rev _) = _
  ------------------------------------------------------------------- *}

find_theorems "rev (rev _) = _"
  (* Encuentra el teorema
        List.rev_rev_ident: rev (rev ?xs) = ?xs
  *)

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.4.10. Demostrar, usando el teorema encontrado en el apartado
  anterior, que
     inversa (inversa xs) = xs"
  ------------------------------------------------------------------- *}

lemma "inversa (inversa xs) = xs"
using [[simp_trace_new mode=full]]
apply (simp add: inversa_rev)
done

(* Se puede observar la traza del simplificador:
  Simplifier invoked
  inversa (inversa xs) = xs
    Apply rewrite rule?
      Instance of R01Sol.inversa_rev: inversa xs \<equiv> rev xs
      Trying to rewrite: inversa xs
        Successfully rewrote
          inversa xs \<equiv> rev xs
    Apply rewrite rule?
      Instance of R01Sol.inversa_rev: inversa (rev xs) \<equiv> rev (rev xs)
      Trying to rewrite: inversa (rev xs)
        Successfully rewrote
          inversa (rev xs) \<equiv> rev (rev xs)
    Apply rewrite rule?
      Instance of List.rev_rev_ident: rev (rev xs) \<equiv> xs
      Trying to rewrite: rev (rev xs)
        Successfully rewrote
          rev (rev xs) \<equiv> xs
    Apply rewrite rule?
      Instance of HOL.simp_thms_6: xs = xs \<equiv> True
      Trying to rewrite: xs = xs
        Successfully rewrote
          xs = xs \<equiv> True
*)

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.5.1. [Suma de los primeros números naturales]
  Definir la función
     suma_hasta :: "nat \<Rightarrow> nat" where
  tal que (suma_hasta n) es la suma de los números naturales hasta n.
  Por ejemplo,
     suma_hasta 3 = 6
  ------------------------------------------------------------------- *}

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

lemma "suma_hasta 3 = 6" by normalization

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.5.2. Demostrar que
     suma_hasta n = n * (n + 1) div 2
  ------------------------------------------------------------------- *}

lemma "suma_hasta n = n * (n + 1) div 2"
apply (induction n)
apply simp_all
done

end


theory Concrete
imports Main
begin
datatype bool = True | False

fun conj :: "bool \<Rightarrow> bool \<Rightarrow> bool" where
"conj True True = True" |
"conj _ _ = False"

datatype nat = Z | Succ nat

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

lemma add_02: "add m Z = m"
  apply (induction m)
   apply simp
  apply simp
  done

datatype 'a list = Nil | Cons 'a "'a list"

fun app :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  "app Nil ys = ys" |
  "app (Cons x xs) ys = Cons x (app xs ys)"

fun rev :: "'a list \<Rightarrow> 'a list" where
  "rev Nil = Nil" |
  "rev (Cons x xs) = app (rev xs) (Cons x Nil)"

theorem app_Nil2 [simp] : "app xs Nil = xs"
  apply (induction xs)
   apply auto
  done

theorem  app_assoc [simp] : "app (app xs ys) zs = app xs (app ys zs)"
  apply (induction xs)
   apply auto
  done

theorem rev_app [simp] : "rev (app xs ys) = app (rev ys) (rev xs)"
  apply (induction xs)
   apply auto
  done

theorem rev_rev [simp] : "rev (rev xs) = xs"
  apply (induction xs)
   apply auto
  done

fun map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list" where
  "map f Nil = Nil" |
  "map f (Cons x xs) = Cons (f x) (map f xs)"


chapter {* R3: Razonamiento sobre programas *}

theory R3_Razonamiento_sobre_programas
imports Main
begin

text {* ---------------------------------------------------------------
  Ejercicio 1.1. Definir la función
     sumaImpares :: nat \<Rightarrow> nat
  tal que (sumaImpares n) es la suma de los n primeros números
  impares. Por ejemplo,
     sumaImpares 5  =  25
  ------------------------------------------------------------------ *}

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

text {* ---------------------------------------------------------------
  Ejercicio 1.2. Escribir la demostración detallada de
     sumaImpares n = n*n
  ------------------------------------------------------------------- *}

-- "La demostración detallada es"

lemma "sumaImpares n = n*n"
proof (induct n)
  show "sumaImpares 0 = 0*0" by simp
next
  fix n
  assume HI: "sumaImpares n=n*n"
  have "sumaImpares (Suc n) =sumaImpares n + (2*n+1)" by simp
  also have "... = n*n + (2*n+1)" using HI by simp
  finally show "sumaImpares (Suc n) =(Suc n) *(Suc n)" by simp
qed

text {* ---------------------------------------------------------------
  Ejercicio 2.1. Definir la función
     sumaPotenciasDeDosMasUno :: nat \<Rightarrow> nat
  tal que
     (sumaPotenciasDeDosMasUno n) = 1 + 2^0 + 2^1 + 2^2 + ... + 2^n.
  Por ejemplo,
     sumaPotenciasDeDosMasUno 3  =  16
  ------------------------------------------------------------------ *}

fun sumaPotenciasDeDosMasUno :: "nat \<Rightarrow> nat" where
  "sumaPotenciasDeDosMasUno 0 = 2"
| "sumaPotenciasDeDosMasUno (Suc n) =
      sumaPotenciasDeDosMasUno n + 2^(n+1)"

text {* ---------------------------------------------------------------
  Ejercicio 2.2. Escribir la demostración detallada de
     sumaPotenciasDeDosMasUno n = 2^(n+1)
  ------------------------------------------------------------------- *}

lemma "sumaPotenciasDeDosMasUno n = 2^(n+1)"
proof (induct n)
  show "sumaPotenciasDeDosMasUno 0 = 2^(0+1)" by simp
next
  fix n
  assume HI: "sumaPotenciasDeDosMasUno n = 2^(n+1)"
  have "sumaPotenciasDeDosMasUno (Suc n) = sumaPotenciasDeDosMasUno n + 2^(n+1)" by simp
  also have "... = 2^(n+1) + 2^(n+1)" using HI by simp
  also have "... = 2^((Suc n) + 1)" by simp
  finally show "sumaPotenciasDeDosMasUno (Suc n) = 2 ^ (Suc n + 1)" by simp
qed

text {* ---------------------------------------------------------------
  Ejercicio 3.1. Definir la función
     copia :: nat \<Rightarrow> 'a \<Rightarrow> 'a list
  tal que (copia n x) es la lista formado por n copias del elemento
  x. Por ejemplo,
     copia 3 x = [x,x,x]
  ------------------------------------------------------------------ *}

fun copia :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where
  "copia 0 x       = []"
| "copia (Suc n) x = x # copia n x"

text {* ---------------------------------------------------------------
  Ejercicio 3.2. Definir la función
     todos :: ('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool
  tal que (todos p xs) se verifica si todos los elementos de xs cumplen
  la propiedad p. Por ejemplo,
     todos (\<lambda>x. x>(1::nat)) [2,6,4] = True
     todos (\<lambda>x. x>(2::nat)) [2,6,4] = False
  ------------------------------------------------------------------ *}

fun todos :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where
  "todos p []     = True"
| "todos p (x#xs) = (p x \<and> todos p xs)"

text {* ---------------------------------------------------------------
  Ejercicio 3.2. Demostrar detalladamente que todos los elementos de
  (copia n x) son iguales a x.
  ------------------------------------------------------------------- *}

lemma "todos (\<lambda>y. y=x) (copia n x)"
proof (induct n)
  show "todos (\<lambda>y. y=x) (copia 0 x)" by simp
next
  fix n
  assume HI: "todos (\<lambda>y. y=x) (copia n x)"
  have "todos (\<lambda>y. y=x) (copia (Suc n) x) = todos (\<lambda>y. y=x) (x#(copia n x))" by simp
  also have "... = todos (\<lambda>y. y=x) (copia n x)" by simp
  finally show "todos (\<lambda>y. y=x) (copia (Suc n) x)" using HI by simp
qed

text {* ---------------------------------------------------------------
  Ejercicio 4.1. Definir la función
    factR :: nat \<Rightarrow> nat
  tal que (factR n) es el factorial de n. Por ejemplo,
    factR 4 = 24
  ------------------------------------------------------------------ *}

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

text {* ---------------------------------------------------------------
  Ejercicio 4.2. Se considera la siguiente definición iterativa de la
  función factorial
     factI :: "nat \<Rightarrow> nat" where
     factI n = factI' n 1

     factI' :: nat \<Rightarrow> nat \<Rightarrow> nat" where
     factI' 0       x = x
     factI' (Suc n) x = factI' n (Suc n)*x
  Demostrar que, para todo n y todo x, se tiene
     factI' n x = x * factR n
  Indicación: La propiedad mult_Suc es
     (Suc m) * n = n + m * n
  Puede que se necesite desactivarla en un paso con
     (simp del: mult_Suc)
  ------------------------------------------------------------------- *}

fun factI' :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "factI' 0       x = x"
| "factI' (Suc n) x = factI' n (x * Suc n)"

fun factI :: "nat \<Rightarrow> nat" where
  "factI n = factI' n 1"

lemma fact: "factI' n x = x * factR n"
proof (induct n arbitrary: x)
  show "\<And>x. factI' 0 x = x * factR 0" by simp
next
  fix n
  assume HI: "\<And>x. factI' n x = x * factR n"
  show "\<And>x. factI' (Suc n) x = x * factR (Suc n)"
  proof -
    fix x
    have "factI' (Suc n) x = factI' n (x * Suc n)"   by simp
    also have "... = (x * Suc n) * factR n" using HI by simp
    also have "... = x * (Suc n * factR n)" by (simp del: mult_Suc)
    also have "... = x * factR (Suc n)" by simp
    finally show "factI' (Suc n) x = x * factR (Suc n)" by simp
  qed
qed

text {* ---------------------------------------------------------------
  Ejercicio 4.3. Escribir la demostración detallada de
     factI n = factR n
  ------------------------------------------------------------------- *}

corollary "factI n = factR n"
proof -
  fix n
  have "factI n = factI' n 1" by simp
  also have "... = 1 * factR n" by (simp add:fact)
  finally show "factI n = factR n" by simp
qed

text {* ---------------------------------------------------------------
  Ejercicio 5.1. Definir, recursivamente y sin usar (@), la función
     amplia :: 'a list \<Rightarrow> 'a \<Rightarrow> 'a list
  tal que (amplia xs y) es la lista obtenida añadiendo el elemento y al
  final de la lista xs. Por ejemplo,
     amplia [d,a] t = [d,a,t]
  ------------------------------------------------------------------ *}

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

text {* ---------------------------------------------------------------
  Ejercicio 5.2. Escribir la demostración detallada de
     amplia xs y = xs @ [y]
  ------------------------------------------------------------------- *}

lemma "amplia xs y = xs @ [y]"
proof (induct xs)
  show "amplia [] y = [] @ [y]" by simp
next
  fix a xs
  assume HI: "amplia xs y = xs @ [y]"
  have "amplia (a#xs) y =a # amplia xs y" by simp
  also have "... = a # (xs @[y]) " using HI by simp
  also have "... =(a # xs) @[y] " using HI by simp
  finally show "amplia (a#xs) y= (a # xs) @[y]" by simp
qed

end


section "Topological Ordering of Graphs"
theory Graph_Topological_Ordering
imports
  Refine_Imperative_HOL.Sepref_Misc
  "List-Index.List_Index"
begin

subsection \<open>List-Before Relation\<close>
text \<open>
  Two elements of a list are in relation if the first element comes (strictly) before
  the second element.
\<close>
definition "list_before_rel l \<equiv> { (a,b). \<exists>l1 l2 l3. l=l1@a#l2@b#l3 }"

text \<open>list-before only relates elements of the list\<close>
lemma list_before_rel_on_elems: "list_before_rel l \<subseteq> set l \<times> set l"
  unfolding list_before_rel_def by auto

text \<open>Irreflexivity of list-before is equivalent to the elements of the list being disjoint.\<close>
lemma list_before_irrefl_eq_distinct: "irrefl (list_before_rel l) \<longleftrightarrow> distinct l"
  using not_distinct_decomp[of l]
  by (auto simp: irrefl_def list_before_rel_def)

text \<open>Alternative characterization via indexes\<close>
lemma list_before_rel_alt: "list_before_rel l = { (l!i, l!j) | i j. i<j \<and> j<length l }"
  unfolding list_before_rel_def
  apply (rule; clarsimp)
  subgoal for a b l1 l2 l3
    apply (rule exI[of _ "length l1"]; simp)
    apply (rule exI[of _ "length l1 + Suc (length l2)"]; auto simp: nth_append)
    done
  subgoal for i j
    apply (rule exI[of _ "take i l"])
    apply (rule exI[of _ "drop (Suc i) (take j l)"])
    apply (rule exI[of _ "drop (Suc j) l"])
    by (simp add: Cons_nth_drop_Suc drop_take_drop_unsplit)
  done

text \<open>list-before is a strict ordering, i.e., it is transitive and asymmetric.\<close>
lemma list_before_trans[trans]: "distinct l \<Longrightarrow> trans (list_before_rel l)"
  by (clarsimp simp: trans_def list_before_rel_alt) (metis index_nth_id less_trans)

lemma list_before_asym: "distinct l \<Longrightarrow> asym (list_before_rel l)"
  by (meson asym.intros irrefl_def list_before_irrefl_eq_distinct list_before_trans transE)

text \<open>Structural properties on the list\<close>
lemma list_before_rel_empty[simp]: "list_before_rel [] = {}"
  unfolding list_before_rel_def by auto

lemma list_before_rel_cons: "list_before_rel (x#l) = ({x}\<times>set l) \<union> list_before_rel l"
  apply (intro equalityI subsetI; simp add: split_paired_all)
  subgoal for a b proof -
    assume "(a,b) \<in> list_before_rel (x # l)"
    then obtain i j where IDX_BOUND: "i<j" "j<Suc (length l)" and [simp]: "a=(x#l)!i" "b=(x#l)!j"
      unfolding list_before_rel_alt by auto

    {
      assume "i=0"
      hence "x=a" "b\<in>set l" using IDX_BOUND
        by (auto simp: nth_Cons split: nat.splits)
    } moreover {
      assume "i\<noteq>0"
      with IDX_BOUND have "a=l!(i-1)" "b=l!(j-1)" "i-1 < j-1" "j-1 < length l"
        by auto
      hence "(a, b) \<in> list_before_rel l" unfolding list_before_rel_alt by blast
    } ultimately show ?thesis by blast
  qed
  subgoal premises prems for a b
  proof -
    {
      assume [simp]: "a=x" and "b\<in>set l"
      then obtain j where "b = l!j" "j<length l" by (auto simp: in_set_conv_nth)
      hence "a=(x#l)!0" "b = (x#l)!Suc j" "0 < Suc j" "Suc j < length (x#l)" by auto
      hence ?thesis unfolding list_before_rel_alt by blast
    } moreover {
      assume "(a, b) \<in> list_before_rel l"
      hence ?thesis unfolding list_before_rel_alt
        by clarsimp (metis Suc_mono nth_Cons_Suc)
    } ultimately show ?thesis using prems by blast
  qed
  done

subsection \<open>Topological Ordering\<close>

text \<open>
  A topological ordering of a graph (binary relation) is an enumeration of its
  nodes, such that for any two nodes \<open>x\<close>,\<open>y\<close> with \<open>x\<close> being enumerated earlier than \<open>y\<close>,
  there is no path from \<open>y\<close> to \<open>x\<close> in the graph.

  We define the predicate \<open>is_top_sorted\<close> to capture the sortedness criterion, but
  not the completeness criterion, i.e., the list needs not contain all
  nodes of the graph.
\<close>

definition "is_top_sorted R l \<equiv> list_before_rel l \<inter> (R\<^sup>*)\<inverse> = {}"
lemma is_top_sorted_alt: "is_top_sorted R l \<longleftrightarrow> (\<forall>x y. (x,y)\<in>list_before_rel l \<longrightarrow> (y,x)\<notin>R\<^sup>*)"
  unfolding is_top_sorted_def by auto

lemma is_top_sorted_empty_rel[simp]: "is_top_sorted {} l \<longleftrightarrow> distinct l"
  by (auto simp: is_top_sorted_def list_before_irrefl_eq_distinct[symmetric] irrefl_def)

lemma is_top_sorted_empty_list[simp]: "is_top_sorted R []"
  by (auto simp: is_top_sorted_def)

text \<open>A topological sorted list must be distinct\<close>
lemma is_top_sorted_distinct:
  assumes "is_top_sorted R l"
  shows "distinct l"
proof (rule ccontr)
  assume "\<not>distinct l"
  with list_before_irrefl_eq_distinct[of l] obtain x where "(x,x)\<in>(list_before_rel l)"
    by (auto simp: irrefl_def)
  with assms show False unfolding is_top_sorted_def by auto
qed

lemma is_top_sorted_cons: "is_top_sorted R (x#l) \<longleftrightarrow> ({x}\<times>set l \<inter> (R\<^sup>*)\<inverse> = {}) \<and> is_top_sorted R l"
  unfolding is_top_sorted_def
  by (auto simp: list_before_rel_cons)

lemma is_top_sorted_append: "is_top_sorted R (l1@l2)
  \<longleftrightarrow> (set l1\<times>set l2 \<inter> (R\<^sup>*)\<inverse> = {}) \<and> is_top_sorted R l1 \<and> is_top_sorted R l2"
  by (induction l1) (auto simp: is_top_sorted_cons)

lemma is_top_sorted_remove_elem: "is_top_sorted R (l1@x#l2) \<Longrightarrow> is_top_sorted R (l1@l2)"
  by (auto simp: is_top_sorted_cons is_top_sorted_append)

text \<open>Removing edges from the graph preserves topological sorting\<close>
lemma is_top_sorted_antimono:
  assumes "R\<subseteq>R'"
  assumes "is_top_sorted R' l"
  shows "is_top_sorted R l"
  using assms
  unfolding is_top_sorted_alt
  by (auto dest: rtrancl_mono_mp)

text \<open>
  Adding a node to the graph, which has no incoming edges preserves topological ordering.
\<close>
lemma is_top_sorted_isolated_constraint:
  assumes "R' \<subseteq> R \<union> {x}\<times>X" "R'\<inter>UNIV\<times>{x} = {}"
  assumes "x\<notin>set l"
  assumes "is_top_sorted R l"
  shows "is_top_sorted R' l"
proof -
  {
    fix a b
    assume "(a,b)\<in>R'\<^sup>*" "a\<noteq>x" "b\<noteq>x"
    hence "(a,b)\<in>R\<^sup>*"
    proof (induction rule: converse_rtrancl_induct)
      case base
      then show ?case by simp
    next
      case (step y z)
      with assms(1,2) have "z\<noteq>x" "(y,z)\<in>R" by auto
      with step show ?case by auto
    qed
  } note AUX=this

  show ?thesis
    using assms(3,4) AUX list_before_rel_on_elems
    unfolding is_top_sorted_def by fastforce
qed

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>http://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 ex2_5 imports Main begin (*>*)

text {*
Let the following data type for propositional formulae be given:
*}

datatype form = T | Var nat | And form form | Xor form form

text {*
Here @{term "T"} denotes a formula that is always true, @{term "Var n"} denotes
a propositional variable, its name given by a natural number, @{term "And f1
f2"} denotes the AND combination, and @{term "Xor f1 f2"} the XOR (exclusive or)
combination of two formulae.  A constructor @{term "F"} for a formula that is
always false is not necessary, since @{term "F"} can be expressed by @{term "Xor
T T"}.

{\bf Exercise 1:} Define a function
*}
definition
xor :: "bool \<Rightarrow> bool \<Rightarrow> bool" where
"xor x y \<equiv> (x \<and> \<not> y) \<or> (\<not> x \<and> y)"
primrec  evalf :: "(nat \<Rightarrow> bool) \<Rightarrow> form \<Rightarrow> bool" where
"evalf f T=True"
|"evalf f (Var n) = f n"
|"evalf f (And e1 e2) = ((evalf f e1)\<and>(evalf f e2))"
|"evalf f (Xor e1 e2) = (xor (evalf f e1)  (evalf f e2))"

text {*
that evaluates a formula under a given variable assignment.
*}

text {*
Propositional formulae can be represented by so-called {\it polynomials}.  A
polynomial is a list of lists of propositional variables, i.e.\ an element of
type @{typ "nat list list"}.  The inner lists (the so-called {\it monomials})
are interpreted as conjunctive combination of variables, whereas the outer list
is interpreted as exclusive-or combination of the inner lists.

{\bf Exercise 2:} Define two functions
*}

(*<*)(*>*)
primrec  evalm :: "(nat \<Rightarrow> bool) \<Rightarrow> nat list \<Rightarrow> bool" where
"evalm f [] = True"
|"evalm f (x#xs) = ((f x)\<and>evalm f xs)"

primrec  evalp :: "(nat \<Rightarrow> bool) \<Rightarrow> nat list list \<Rightarrow> bool" where
"evalp f [] = False"
|"evalp f (x#xs) = (xor (evalm f x)  (evalp f xs))"

text {*
for evaluation of monomials and polynomials under a given variable assignment.
In particular think about how empty lists have to be evaluated.
*}

text {*
{\bf Exercise 3:} Define a function
*}
(*<*)primrec(*>*)  mulpp :: "nat list list \<Rightarrow> nat list list \<Rightarrow> nat list list" where
"mulpp [] y = []"
|"mulpp (x#xs) y = map (\<lambda>z. x@z) y @ (mulpp xs y)"
(*<*)primrec(*>*)  poly :: "form \<Rightarrow> nat list list" where
"poly T = [[]]"
|"poly (Var n) = [[n]]"
|"poly (And a b) = mulpp (poly a) (poly b)"
|"poly (Xor a b) = (poly a )@(poly b)"

text {*
that turns a formula into a polynomial.  You will need an auxiliary function
*}

text {*
to ``multiply'' two polynomials, i.e.\ to compute
\[
((v^1_1 \mathbin{\odot} \cdots \mathbin{\odot} v^1_{m_1}) \mathbin{\oplus} \cdots \mathbin{\oplus} (v^k_1 \mathbin{\odot} \cdots \mathbin{\odot} v^k_{m_k})) \mathbin{\odot}
((w^1_1 \mathbin{\odot} \cdots \mathbin{\odot} w^1_{n_1}) \mathbin{\oplus} \cdots \mathbin{\oplus} (w^l_1 \mathbin{\odot} \cdots \mathbin{\odot} w^l_{n_l}))
\]
where $\mathbin{\oplus}$ denotes ``exclusive or'', and $\mathbin{\odot}$ denotes
``and''.  This is done using the usual calculation rules for addition and
multiplication.
*}

text {*
{\bf Exercise 4:} Now show correctness of your function @{term "poly"}:
*}

lemma evalm_app: "evalm e (xs @ ys) = (evalm e xs \<and> evalm e ys)"
apply (induct xs)
apply auto
  done

lemma evalp_app: "evalp e (xs @ ys) = ( xor (evalp e xs) (evalp e ys))"
apply (induct xs)
   apply (auto simp add:xor_def)
  done

theorem mulmp_correct: "evalp e (map (\<lambda>z. m@z) p) = (evalm e m \<and> evalp e p)"
apply (induct p)
apply (auto simp add:  evalm_app xor_def)
  done

theorem mulpp_correct: "evalp e (mulpp p q) = (evalp e p \<and> evalp e q)"
  apply (induct p )
apply (auto simp add:xor_def  mulmp_correct evalp_app )
  done

theorem poly_correct: "evalf e f = evalp e (poly f)"
  apply (induct f)
     apply (auto simp add:xor_def mulpp_correct evalp_app)
  done

text {*
It is useful to prove a similar correctness theorem for @{term "mulpp"} first.
*}

(*<*) end (*>*)