theory EjT3A
imports "../Temas/Ejemplos/ExpA"
begin

section "Ejercicio 3.1: La función simp_constA simplifica"

text {*
  ----------------------------------------------------------------------
  Ejercicio 3.1.1. Una expresión aritmética está simplificada si no
  contiene niguna subexpresión que sea una suma de dos números.

  Definir la función
     simplificada :: "expA \<Rightarrow> bool" where
  tal que (simplificada a) se verifica si la expresión aritmética a está
  simplificada. Por ejemplo,
     simplificada (Suma (V ''x'') (N 5))              = True
     simplificada (Suma (V ''x'') (Suma (N 2) (N 5))) = False
     simplificada (Suma (N 2) (Suma (V ''x'') (N 5))) = True
  ------------------------------------------------------------------- *}

fun simplificada :: "expA \<Rightarrow> bool" where
"simplificada (N _) = True" |
"simplificada (V _) = True" |
"simplificada (Suma (N _) (N _)) = False" |
"simplificada (Suma a1 a2) = (simplificada a1 \<and> simplificada a2)"

value "simplificada (Suma (V ''x'') (N 5))"
  (* da True *)
value "simplificada (Suma (V ''x'') (Suma (N 2) (N 5)))"
  (* da False *)
value "simplificada (Suma (N 2) (Suma (V ''x'') (N 5)))"
  (* da True *)

text {*
  ----------------------------------------------------------------------
  Ejercicio 3.1.2. Demostrar que para cualquier expresión aritmética a,

  ------------------------------------------------------------------- *}

lemma "simplificada (simp_constA a)"
apply (induction a rule: simplificada.induct)
apply (auto split: expA.split)
done

text{*
This proof needs the same @{text "split:"} directive as the correctness proof of
@{const simp_constA}. This increases the chance of nontermination
of the simplifier. Therefore @{const simplificada} should be defined purely by
pattern matching on the left-hand side,
without @{text case} expressions on the right-hand side.
\endexercise

\exercise
In this exercise we verify constant folding for @{typ expA}
where we sum up all constants, even if they are not next to each other.
For example, @{term "Plus (N 1) (Plus (V x) (N 2))"} becomes
@{term "Plus (V x) (N 3)"}. This goes beyond @{const asimp}.
Below we follow a particular solution strategy but there are many others.

First, define a function @{text sumN} that returns the sum of all
constants in an expression and a function @{text zeroN} that replaces all
constants in an expression by zeroes (they will be optimized away later):
*}

fun sumN :: "expA \<Rightarrow> int" where
(* your definition/proof here *)

fun zeroN :: "expA \<Rightarrow> expA" where
(* your definition/proof here *)

text {*
Next, define a function @{text sepN} that produces an arithmetic expression
that adds the results of @{const sumN} and @{const zeroN}. Prove that
@{text sepN} preserves the value of an expression.
*}

definition sepN :: "expA \<Rightarrow> expA" where
(* your definition/proof here *)

lemma aval_sepN: "aval (sepN t) s = aval t s"
(* your definition/proof here *)

text {*
Finally, define a function @{text full_asimp} that uses @{const asimp}
to eliminate the zeroes left over by @{const sepN}.
Prove that it preserves the value of an arithmetic expression.
*}

definition full_asimp :: "expA \<Rightarrow> expA" where
(* your definition/proof here *)

lemma aval_full_asimp: "aval (full_asimp t) s = aval t s"
(* your definition/proof here *)

text{*
\endexercise

\exercise\label{exe:subst}
Substitution is the process of replacing a variable
by an expression in an expression. Define a substitution function
*}

fun subst :: "vname \<Rightarrow> expA \<Rightarrow> expA \<Rightarrow> expA" where
(* your definition/proof here *)

text{*
such that @{term "subst x a e"} is the result of replacing
every occurrence of variable @{text x} by @{text a} in @{text e}.
For example:
@{lemma[display] "subst ''x'' (N 3) (Plus (V ''x'') (V ''y'')) = Plus (N 3) (V ''y'')" by simp}

Prove the so-called \concept{substitution lemma} that says that we can either
substitute first and evaluate afterwards or evaluate with an updated state:
*}

lemma subst_lemma: "aval (subst x a e) s = aval e (s(x := aval a s))"
(* your definition/proof here *)

text {*
As a consequence prove that we can substitute equal expressions by equal expressions
and obtain the same result under evaluation:
*}
lemma "aval a1 s = aval a2 s
  \<Longrightarrow> aval (subst x a1 e) s = aval (subst x a2 e) s"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Take a copy of theory @{theory AExp} and modify it as follows.
Extend type @{typ expA} with a binary constructor @{text Times} that
represents multiplication. Modify the definition of the functions @{const aval}
and @{const asimp} accordingly. You can remove @{const simp_constA}.
Function @{const asimp} should eliminate 0 and 1 from multiplications
as well as evaluate constant subterms. Update all proofs concerned.
*}

text{*
\endexercise

\exercise
Define a datatype @{text expA2} of extended arithmetic expressions that has,
in addition to the constructors of @{typ expA}, a constructor for
modelling a C-like post-increment operation $x{++}$, where $x$ must be a
variable. Define an evaluation function @{text "aval2 :: expA2 \<Rightarrow> state \<Rightarrow> val \<times> state"}
that returns both the value of the expression and the new state.
The latter is required because post-increment changes the state.

Extend @{text expA2} and @{text aval2} with a division operation. Model partiality of
division by changing the return type of @{text aval2} to
@{typ "(val \<times> state) option"}. In case of division by 0 let @{text aval2}
return @{const None}. Division on @{typ int} is the infix @{text div}.
*}

text{*
\endexercise

\exercise
The following type adds a @{text LET} construct to arithmetic expressions:
*}

datatype lexp = Nl int | Vl vname | Plusl lexp lexp | LET vname lexp lexp

text{* The @{const LET} constructor introduces a local variable:
the value of @{term "LET x e\<^sub>1 e\<^sub>2"} is the value of @{text e\<^sub>2}
in the state where @{text x} is bound to the value of @{text e\<^sub>1} in the original state.
Define a function @{const lval} @{text"::"} @{typ "lexp \<Rightarrow> state \<Rightarrow> int"}
that evaluates @{typ lexp} expressions. Remember @{term"s(x := i)"}.

Define a conversion @{const inline} @{text"::"} @{typ "lexp \<Rightarrow> expA"}.
The expression \mbox{@{term "LET x e\<^sub>1 e\<^sub>2"}} is inlined by substituting
the converted form of @{text e\<^sub>1} for @{text x} in the converted form of @{text e\<^sub>2}.
See Exercise~\ref{exe:subst} for more on substitution.
Prove that @{const inline} is correct w.r.t.\ evaluation.
\endexercise

\exercise
Show that equality and less-or-equal tests on @{text expA} are definable
*}

definition Le :: "expA \<Rightarrow> expA \<Rightarrow> bexp" where
(* your definition/proof here *)

definition Eq :: "expA \<Rightarrow> expA \<Rightarrow> bexp" where
(* your definition/proof here *)

text{*
and prove that they do what they are supposed to:
*}

lemma bval_Le: "bval (Le a1 a2) s = (aval a1 s \<le> aval a2 s)"
(* your definition/proof here *)

lemma bval_Eq: "bval (Eq a1 a2) s = (aval a1 s = aval a2 s)"
(* your definition/proof here *)

end


theory Harmonic_Numbers
imports Complex_Main Summation Integral_Test
begin

text \<open>
  The harmonic numbers
\<close>
definition harm :: "nat \<Rightarrow> 'a :: real_normed_field" where
  "harm n = (\<Sum>k=1..n. inverse (of_nat k))"

lemma harm_altdef: "harm n = (\<Sum>k<n. inverse (of_nat (Suc k)))"
  unfolding harm_def by (induction n) simp_all

lemma harm_Suc: "harm (Suc n) = harm n + inverse (of_nat (Suc n))"
  by (simp add: harm_def)

lemma harm_nonneg: "harm n \<ge> (0 :: 'a :: {real_normed_field,linordered_field})"
  unfolding harm_def by (intro setsum_nonneg) simp_all

lemma of_real_harm: "of_real (harm n) = harm n"
  unfolding harm_def by simp

lemma norm_harm: "norm (harm n) = harm n"
  by (subst of_real_harm [symmetric]) (simp add: harm_nonneg)

lemma harm_expand:
  "harm (Suc 0) = 1"
  "harm (numeral n) = harm (pred_numeral n) + inverse (numeral n)"
proof -
  have "numeral n = Suc (pred_numeral n)" by simp
  also have "harm \<dots> = harm (pred_numeral n) + inverse (numeral n)"
    by (subst harm_Suc, subst numeral_eq_Suc[symmetric]) simp
  finally show "harm (numeral n) = harm (pred_numeral n) + inverse (numeral n)" .
qed (simp add: harm_def)

lemma not_convergent_harm: "\<not>convergent (harm :: nat \<Rightarrow> 'a :: real_normed_field)"
proof -
  have "convergent (\<lambda>n. norm (harm n :: 'a)) \<longleftrightarrow>
            convergent (harm :: nat \<Rightarrow> real)" by (simp add: norm_harm)
  also have "\<dots> \<longleftrightarrow> convergent (\<lambda>n. \<Sum>k=Suc 0..Suc n. inverse (of_nat k) :: real)"
    unfolding harm_def[abs_def] by (subst convergent_Suc_iff) simp_all
  also have "... \<longleftrightarrow> convergent (\<lambda>n. \<Sum>k\<le>n. inverse (of_nat (Suc k)) :: real)"
    by (subst setsum_shift_bounds_cl_Suc_ivl) (simp add: atLeast0AtMost)
  also have "... \<longleftrightarrow> summable (\<lambda>n. inverse (of_nat n) :: real)"
    by (subst summable_Suc_iff [symmetric]) (simp add: summable_iff_convergent')
  also have "\<not>..." by (rule not_summable_harmonic)
  finally show ?thesis by (blast dest: convergent_norm)
qed

subsection \<open>The Euler–Mascheroni constant\<close>

text \<open>
  The limit of the difference between the partial harmonic sum and the natural logarithm
  (approximately 0.577216). This value occurs e.g. in the definition of the Gamma function.
 \<close>
definition euler_mascheroni :: "'a :: real_normed_algebra_1" where
  "euler_mascheroni = of_real (lim (\<lambda>n. harm n - ln (of_nat n)))"

lemma of_real_euler_mascheroni [simp]: "of_real euler_mascheroni = euler_mascheroni"
  by (simp add: euler_mascheroni_def)

interpretation euler_mascheroni: antimono_fun_sum_integral_diff "\<lambda>x. inverse (x + 1)"
  by unfold_locales (auto intro!: continuous_intros)

lemma euler_mascheroni_sum_integral_diff_series:
  "euler_mascheroni.sum_integral_diff_series n = harm (Suc n) - ln (of_nat (Suc n))"
proof -
  have "harm (Suc n) = (\<Sum>k=0..n. inverse (of_nat k + 1) :: real)" unfolding harm_def
    unfolding One_nat_def by (subst setsum_shift_bounds_cl_Suc_ivl) (simp add: add_ac)
  moreover have "((\<lambda>x. inverse (x + 1) :: real) has_integral ln (of_nat n + 1) - ln (0 + 1))
                   {0..of_nat n}"
    by (intro fundamental_theorem_of_calculus)
       (auto intro!: derivative_eq_intros simp: divide_inverse
           has_field_derivative_iff_has_vector_derivative[symmetric])
  hence "integral {0..of_nat n} (\<lambda>x. inverse (x + 1) :: real) = ln (of_nat (Suc n))"
    by (auto dest!: integral_unique)
  ultimately show ?thesis
    by (simp add: euler_mascheroni.sum_integral_diff_series_def atLeast0AtMost)
qed

lemma euler_mascheroni_sequence_decreasing:
  "m > 0 \<Longrightarrow> m \<le> n \<Longrightarrow> harm n - ln (of_nat n) \<le> harm m - ln (of_nat m :: real)"
  by (cases m, simp, cases n, simp, hypsubst,
      subst (1 2) euler_mascheroni_sum_integral_diff_series [symmetric],
      rule euler_mascheroni.sum_integral_diff_series_antimono, simp)

lemma euler_mascheroni_sequence_nonneg:
  "n > 0 \<Longrightarrow> harm n - ln (of_nat n) \<ge> (0::real)"
  by (cases n, simp, hypsubst, subst euler_mascheroni_sum_integral_diff_series [symmetric],
      rule euler_mascheroni.sum_integral_diff_series_nonneg)

lemma euler_mascheroni_convergent: "convergent (\<lambda>n. harm n - ln (of_nat n) :: real)"
proof -
  have A: "(\<lambda>n. harm (Suc n) - ln (of_nat (Suc n))) =
             euler_mascheroni.sum_integral_diff_series"
    by (subst euler_mascheroni_sum_integral_diff_series [symmetric]) (rule refl)
  have "convergent (\<lambda>n. harm (Suc n) - ln (of_nat (Suc n) :: real))"
    by (subst A) (fact euler_mascheroni.sum_integral_diff_series_convergent)
  thus ?thesis by (subst (asm) convergent_Suc_iff)
qed

lemma euler_mascheroni_LIMSEQ:
  "(\<lambda>n. harm n - ln (of_nat n) :: real) ----> euler_mascheroni"
  unfolding euler_mascheroni_def
  by (simp add: convergent_LIMSEQ_iff [symmetric] euler_mascheroni_convergent)

lemma euler_mascheroni_LIMSEQ_of_real:
  "(\<lambda>n. of_real (harm n - ln (of_nat n))) ---->
      (euler_mascheroni :: 'a :: {real_normed_algebra_1, topological_space})"
proof -
  have "(\<lambda>n. of_real (harm n - ln (of_nat n))) ----> (of_real (euler_mascheroni) :: 'a)"
    by (intro tendsto_of_real euler_mascheroni_LIMSEQ)
  thus ?thesis by simp
qed

lemma euler_mascheroni_sum:
  "(\<lambda>n. inverse (of_nat (n+1)) + ln (of_nat (n+1)) - ln (of_nat (n+2)) :: real)
       sums euler_mascheroni"
 using sums_add[OF telescope_sums[OF LIMSEQ_Suc[OF euler_mascheroni_LIMSEQ]]
                   telescope_sums'[OF LIMSEQ_inverse_real_of_nat]]
  by (simp_all add: harm_def algebra_simps)

lemma alternating_harmonic_series_sums: "(\<lambda>k. (-1)^k / real_of_nat (Suc k)) sums ln 2"
proof -
  let ?f = "\<lambda>n. harm n - ln (real_of_nat n)"
  let ?g = "\<lambda>n. if even n then 0 else (2::real)"
  let ?em = "\<lambda>n. harm n - ln (real_of_nat n)"
  have "eventually (\<lambda>n. ?em (2*n) - ?em n + ln 2 = (\<Sum>k<2*n. (-1)^k / real_of_nat (Suc k))) at_top"
    using eventually_gt_at_top[of "0::nat"]
  proof eventually_elim
    fix n :: nat assume n: "n > 0"
    have "(\<Sum>k<2*n. (-1)^k / real_of_nat (Suc k)) =
              (\<Sum>k<2*n. ((-1)^k + ?g k) / of_nat (Suc k)) - (\<Sum>k<2*n. ?g k / of_nat (Suc k))"
      by (simp add: setsum.distrib algebra_simps divide_inverse)
    also have "(\<Sum>k<2*n. ((-1)^k + ?g k) / real_of_nat (Suc k)) = harm (2*n)"
      unfolding harm_altdef by (intro setsum.cong) (auto simp: field_simps)
    also have "(\<Sum>k<2*n. ?g k / real_of_nat (Suc k)) = (\<Sum>k|k<2*n \<and> odd k. ?g k / of_nat (Suc k))"
      by (intro setsum.mono_neutral_right) auto
    also have "\<dots> = (\<Sum>k|k<2*n \<and> odd k. 2 / (real_of_nat (Suc k)))"
      by (intro setsum.cong) auto
    also have "(\<Sum>k|k<2*n \<and> odd k. 2 / (real_of_nat (Suc k))) = harm n"
      unfolding harm_altdef
      by (intro setsum.reindex_cong[of "\<lambda>n. 2*n+1"]) (auto simp: inj_on_def field_simps elim!: oddE)
    also have "harm (2*n) - harm n = ?em (2*n) - ?em n + ln 2" using n
      by (simp_all add: algebra_simps ln_mult)
    finally show "?em (2*n) - ?em n + ln 2 = (\<Sum>k<2*n. (-1)^k / real_of_nat (Suc k))" ..
  qed
  moreover have "(\<lambda>n. ?em (2*n) - ?em n + ln (2::real))
                     ----> euler_mascheroni - euler_mascheroni + ln 2"
    by (intro tendsto_intros euler_mascheroni_LIMSEQ filterlim_compose[OF euler_mascheroni_LIMSEQ]
              filterlim_subseq) (auto simp: subseq_def)
  hence "(\<lambda>n. ?em (2*n) - ?em n + ln (2::real)) ----> ln 2" by simp
  ultimately have "(\<lambda>n. (\<Sum>k<2*n. (-1)^k / real_of_nat (Suc k))) ----> ln 2"
    by (rule Lim_transform_eventually)

  moreover have "summable (\<lambda>k. (-1)^k * inverse (real_of_nat (Suc k)))"
    using LIMSEQ_inverse_real_of_nat
    by (intro summable_Leibniz(1) decseq_imp_monoseq decseq_SucI) simp_all
  hence A: "(\<lambda>n. \<Sum>k<n. (-1)^k / real_of_nat (Suc k)) ----> (\<Sum>k. (-1)^k / real_of_nat (Suc k))"
    by (simp add: summable_sums_iff divide_inverse sums_def)
  from filterlim_compose[OF this filterlim_subseq[of "op * (2::nat)"]]
    have "(\<lambda>n. \<Sum>k<2*n. (-1)^k / real_of_nat (Suc k)) ----> (\<Sum>k. (-1)^k / real_of_nat (Suc k))"
    by (simp add: subseq_def)
  ultimately have "(\<Sum>k. (- 1) ^ k / real_of_nat (Suc k)) = ln 2" by (intro LIMSEQ_unique)
  with A show ?thesis by (simp add: sums_def)
qed

lemma alternating_harmonic_series_sums':
  "(\<lambda>k. inverse (real_of_nat (2*k+1)) - inverse (real_of_nat (2*k+2))) sums ln 2"
unfolding sums_def
proof (rule Lim_transform_eventually)
  show "(\<lambda>n. \<Sum>k<2*n. (-1)^k / (real_of_nat (Suc k))) ----> ln 2"
    using alternating_harmonic_series_sums unfolding sums_def
    by (rule filterlim_compose) (rule mult_nat_left_at_top, simp)
  show "eventually (\<lambda>n. (\<Sum>k<2*n. (-1)^k / (real_of_nat (Suc k))) =
            (\<Sum>k<n. inverse (real_of_nat (2*k+1)) - inverse (real_of_nat (2*k+2)))) sequentially"
  proof (intro always_eventually allI)
    fix n :: nat
    show "(\<Sum>k<2*n. (-1)^k / (real_of_nat (Suc k))) =
              (\<Sum>k<n. inverse (real_of_nat (2*k+1)) - inverse (real_of_nat (2*k+2)))"
      by (induction n) (simp_all add: inverse_eq_divide)
  qed
qed

end


theory Chapter3
imports "HOL-IMP.BExp"
        "HOL-IMP.ASM"
begin

text{*
\section*{Chapter 3}

\exercise
To show that @{const asimp_const} really folds all subexpressions of the form
@{term "Plus (N i) (N j)"}, define a function
*}

fun optimal :: "aexp \<Rightarrow> bool" where
"optimal (Plus (N i) (N j)) = False" |
"optimal (N n) = True" |
"optimal (V x) = True" |
"optimal (Plus a1 a2) = conj (optimal a1) (optimal a2)"

text{*
that checks that its argument does not contain a subexpression of the form
@{term "Plus (N i) (N j)"}. Then prove that the result of @{const asimp_const}
is optimal:
*}

lemma "optimal (asimp_const a)"
  apply(induction a)
  apply(auto split:aexp.split)
  done

text{*
This proof needs the same @{text "split:"} directive as the correctness proof of
@{const asimp_const}. This increases the chance of nontermination
of the simplifier. Therefore @{const optimal} should be defined purely by
pattern matching on the left-hand side,
without @{text case} expressions on the right-hand side.
\endexercise

\exercise
In this exercise we verify constant folding for @{typ aexp}
where we sum up all constants, even if they are not next to each other.
For example, @{term "Plus (N 1) (Plus (V x) (N 2))"} becomes
@{term "Plus (V x) (N 3)"}. This goes beyond @{const asimp}.
Below we follow a particular solution strategy but there are many others.

First, define a function @{text sumN} that returns the sum of all
constants in an expression and a function @{text zeroN} that replaces all
constants in an expression by zeroes (they will be optimized away later):
*}

fun sumN :: "aexp \<Rightarrow> int" where
"sumN (N n) = n" |
"sumN (V x) = 0" |
"sumN (Plus a b) = sumN a + sumN b"

fun zeroN :: "aexp \<Rightarrow> aexp" where
"zeroN (N n) = N 0" |
"zeroN (V x) = V x" |
"zeroN (Plus a b) = Plus (zeroN a) (zeroN b)"

text {*
Next, define a function @{text sepN} that produces an arithmetic expression
that adds the results of @{const sumN} and @{const zeroN}. Prove that
@{text sepN} preserves the value of an expression.
*}

definition sepN :: "aexp \<Rightarrow> aexp" where
"sepN a = Plus (N (sumN a)) (zeroN a)"

(*
lemma aux_1: "aval t s = sumN t + aval (zeroN t) s"
  apply(induction t arbitrary: s)
  apply(auto)
  done

lemma aux_2: "aval (sepN t) s = sumN t + aval (zeroN t) s"
  apply(induction t arbitrary:s)
  apply(auto simp add:sepN_def)
  done
*)

lemma aval_sepN: "aval (sepN t) s = aval t s"
  apply(induction t)
  apply(auto simp add:sepN_def)
  done

text {*
Finally, define a function @{text full_asimp} that uses @{const asimp}
to eliminate the zeroes left over by @{const sepN}.
Prove that it preserves the value of an arithmetic expression.
*}

definition full_asimp :: "aexp \<Rightarrow> aexp" where
"full_asimp a = asimp (sepN a)"

lemma aval_full_asimp: "aval (full_asimp t) s = aval t s"
  apply(induction t arbitrary:s)
  apply(auto simp add:full_asimp_def sepN_def simp:algebra_simps)
  done

text{*
\endexercise

\exercise\label{exe:subst}
Substitution is the process of replacing a variable
by an expression in an expression. Define a substitution function
*}

fun subst :: "vname \<Rightarrow> aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
"subst var a (N n) = N n" |
"subst var a (V x) = (if var=x then a else (V x))" |
"subst var a (Plus b c) = Plus (subst var a b) (subst var a c)"

text{*
such that @{term "subst x a e"} is the result of replacing
every occurrence of variable @{text x} by @{text a} in @{text e}.
For example:
@{lemma[display] "subst ''x'' (N 3) (Plus (V ''x'') (V ''y'')) = Plus (N 3) (V ''y'')" by simp}

Prove the so-called \concept{substitution lemma} that says that we can either
substitute first and evaluate afterwards or evaluate with an updated state:
*}

lemma subst_lemma: "aval (subst x a e) s = aval e (s(x := aval a s))"
  apply(induction e)
  apply(auto)
  done

text {*
As a consequence prove that we can substitute equal expressions by equal expressions
and obtain the same result under evaluation:
*}
lemma "aval a1 s = aval a2 s
  \<Longrightarrow> aval (subst x a1 e) s = aval (subst x a2 e) s"
  apply(induction e)
  apply(auto)
  done

text{*
\endexercise

\exercise
Take a copy of theory @{short_theory "AExp"} and modify it as follows.
Extend type @{typ aexp} with a binary constructor @{text Times} that
represents multiplication. Modify the definition of the functions @{const aval}
and @{const asimp} accordingly. You can remove @{const asimp_const}.
Function @{const asimp} should eliminate 0 and 1 from multiplications
as well as evaluate constant subterms. Update all proofs concerned.
*}

text{*
\endexercise

\exercise
Define a datatype @{text aexp2} of extended arithmetic expressions that has,
in addition to the constructors of @{typ aexp}, a constructor for
modelling a C-like post-increment operation $x{++}$, where $x$ must be a
variable. Define an evaluation function @{text "aval2 :: aexp2 \<Rightarrow> state \<Rightarrow> val \<times> state"}
that returns both the value of the expression and the new state.
The latter is required because post-increment changes the state.

Extend @{text aexp2} and @{text aval2} with a division operation. Model partiality of
division by changing the return type of @{text aval2} to
@{typ "(val \<times> state) option"}. In case of division by 0 let @{text aval2}
return @{const None}. Division on @{typ int} is the infix @{text div}.
*}

datatype aexp2 = N2 int | V2 vname | Plus2 aexp2 aexp2 | Times2 aexp2 aexp2 | Inc vname | Div aexp2 aexp2

fun aval2 :: "aexp2 \<Rightarrow> state \<Rightarrow> (val \<times> state)" where
"aval2 (N2 n) s = (n, s)" |
"aval2 (V2 x) s = (s x, s)" |
"aval2 (Plus2 a b) s = (fst (aval2 a s) + fst (aval2 b s), (\<lambda> x. (snd (aval2 a s) x) + (snd (aval2 b s) x) - (s x)))" |
"aval2 (Times2 a b) s = (fst (aval2 a s) * fst (aval2 b s), (\<lambda> x. (snd (aval2 a s) x) + (snd (aval2 b s) x) - (s x)))" |
"aval2 (Inc x) s = (s x, s(x:= 1 + s x))" |
"aval2 (Div a b) s = (fst (aval2 a s) div fst (aval2 b s), (\<lambda> x. (snd (aval2 a s) x) + (snd (aval2 b s) x) - (s x)))"

text{*
\endexercise

\exercise
The following type adds a @{text LET} construct to arithmetic expressions:
*}

datatype lexp = Nl int | Vl vname | Plusl lexp lexp | LET vname lexp lexp

text{* The @{const LET} constructor introduces a local variable:
the value of @{term "LET x e\<^sub>1 e\<^sub>2"} is the value of @{text e\<^sub>2}
in the state where @{text x} is bound to the value of @{text e\<^sub>1} in the original state.
Define a function @{const lval} @{text"::"} @{typ "lexp \<Rightarrow> state \<Rightarrow> int"}
that evaluates @{typ lexp} expressions. Remember @{term"s(x := i)"}.

Define a conversion @{const inline} @{text"::"} @{typ "lexp \<Rightarrow> aexp"}.
The expression \mbox{@{term "LET x e\<^sub>1 e\<^sub>2"}} is inlined by substituting
the converted form of @{text e\<^sub>1} for @{text x} in the converted form of @{text e\<^sub>2}.
See Exercise~\ref{exe:subst} for more on substitution.
Prove that @{const inline} is correct w.r.t.\ evaluation.
\endexercise*}

fun lval :: "lexp \<Rightarrow> state \<Rightarrow> int" where
"lval (Nl a) s = a" |
"lval (Vl x) s = s x" |
"lval (Plusl a b) s = lval a s + lval b s" |
"lval (LET v a b) s = lval b (s(v:= lval a s))"

fun inline :: "lexp \<Rightarrow> aexp" where
"inline (Nl a) = N a" |
"inline (Vl x) = V x" |
"inline (Plusl a b) = Plus (inline a) (inline b)" |
"inline (LET v a b) = subst v (inline a) (inline b)"

lemma "aval (inline e) s = lval e s"
  apply (induction e arbitrary: s rule: inline.induct)
  apply (auto simp: subst_lemma)
  done

text{*
\exercise
Show that equality and less-or-equal tests on @{text aexp} are definable
*}

definition Le :: "aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
"Le a b = Not (Less b a)"

definition Eq :: "aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
"Eq a b = And (Not (Less a b)) (Not (Less b a)) "

text{*
and prove that they do what they are supposed to:
*}

lemma bval_Le: "bval (Le a1 a2) s = (aval a1 s \<le> aval a2 s)"
  apply(auto simp add: Le_def)
  done

lemma bval_Eq: "bval (Eq a1 a2) s = (aval a1 s = aval a2 s)"
  apply(auto simp add: Eq_def)
  done

text{*
\endexercise

\exercise
Consider an alternative type of boolean expressions featuring a conditional: *}

datatype ifexp = Bc2 bool | If ifexp ifexp ifexp | Less2 aexp aexp

text {*  First define an evaluation function analogously to @{const bval}: *}

fun ifval :: "ifexp \<Rightarrow> state \<Rightarrow> bool" where
"ifval (Bc2 b) s = b" |
"ifval (If a b c) s = (if (ifval a s) then (ifval b s) else (ifval c s))" |
"ifval (Less2 a b) s = (aval a s < aval b s)"

text{* Then define two translation functions *}

fun b2ifexp :: "bexp \<Rightarrow> ifexp" where
"b2ifexp (Bc b) = Bc2 b " |
"b2ifexp (Not a) = If (b2ifexp a) (Bc2 False) (Bc2 True)" |
"b2ifexp (And a b) = If (b2ifexp a) (b2ifexp b) (Bc2 False)" |
"b2ifexp (Less a b) = Less2 a b"

fun if2bexp :: "ifexp \<Rightarrow> bexp" where
"if2bexp (Bc2 b) = Bc b" |
"if2bexp (If a b c) = (And (Not (And (if2bexp a) (Not (if2bexp b))))
                           (Not (And (Not (if2bexp a)) (Not (if2bexp c)))))" |
"if2bexp (Less2 a b) = Less a b"

text{* and prove their correctness: *}

lemma "bval (if2bexp exp) s = ifval exp s"
  apply(induction exp)
  apply(auto)
  done

lemma "ifval (b2ifexp exp) s = bval exp s"
  apply(induction exp)
  apply(auto)
  done

text{*
\endexercise

\exercise
We define a new type of purely boolean expressions without any arithmetic
*}

datatype pbexp =
  VAR vname | NOT pbexp | AND pbexp pbexp | OR pbexp pbexp

text{*
where variables range over values of type @{typ bool},
as can be seen from the evaluation function:
*}

fun pbval :: "pbexp \<Rightarrow> (vname \<Rightarrow> bool) \<Rightarrow> bool" where
"pbval (VAR x) s = s x"  |
"pbval (NOT b) s = (\<not> pbval b s)" |
"pbval (AND b1 b2) s = (pbval b1 s \<and> pbval b2 s)" |
"pbval (OR b1 b2) s = (pbval b1 s \<or> pbval b2 s)"

text {* Define a function that checks whether a boolean exression is in NNF
(negation normal form), i.e., if @{const NOT} is only applied directly
to @{const VAR}s: *}

fun is_nnf :: "pbexp \<Rightarrow> bool" where
"is_nnf (VAR x) = True" |
"is_nnf (NOT (VAR x)) = True" |
"is_nnf (NOT p) = False" |
"is_nnf (AND p1 p2) = (is_nnf p1 \<and> is_nnf p2)" |
"is_nnf (OR p1 p2) = (is_nnf p1 \<and> is_nnf p2)"

text{*
Now define a function that converts a @{text bexp} into NNF by pushing
@{const NOT} inwards as much as possible:
*}

fun nnf :: "pbexp \<Rightarrow> pbexp" where
"nnf (VAR x) = VAR x" |
"nnf (AND p1 p2) = AND (nnf p1) (nnf p2)" |
"nnf (OR p1 p2) = OR (nnf p1) (nnf p2)" |
"nnf (NOT (VAR x)) = NOT (VAR x)" |
"nnf (NOT (NOT x)) = nnf x" |
"nnf (NOT (AND p1 p2)) = OR (nnf (NOT p1)) (nnf (NOT p2))" |
"nnf (NOT (OR p1 p2)) = AND (nnf (NOT p1)) (nnf (NOT p2))"

value "nnf (NOT (OR (NOT (AND (VAR ''x'') (VAR ''y''))) (VAR ''z'')))"

text{*
Prove that @{const nnf} does what it is supposed to do:
*}

lemma neg_aux [simp]: "pbval (nnf (NOT b)) s = (\<not> (pbval (nnf b) s))"
  apply(induction b)
  apply(auto)
  done

lemma pbval_nnf: "pbval (nnf b) s = pbval b s"
  apply(induction b)
  apply(auto)
  done

lemma is_nnf_nnf: "is_nnf (nnf b)"
  apply(induction b rule: nnf.induct)
  apply(auto)
  done

text{*
An expression is in DNF (disjunctive normal form) if it is in NNF
and if no @{const OR} occurs below an @{const AND}. Define a corresponding
test:
*}

fun no_ors :: "pbexp \<Rightarrow> bool" where
"no_ors (OR e1 e2) = False" |
"no_ors (AND e1 e2) = (no_ors e1 \<and> no_ors e2)" |
"no_ors e = True"

fun is_dnf :: "pbexp \<Rightarrow> bool" where
"is_dnf (VAR _) = True" |
"is_dnf (NOT b) = is_nnf (NOT b)" |
"is_dnf (AND b1 b2) =  (no_ors b1 \<and> no_ors b2 \<and> is_dnf b1 \<and> is_dnf b2)" |
"is_dnf (OR b1 b2) = (is_dnf b1 \<and> is_dnf b2)"

value "is_dnf (OR (AND (NOT (VAR ''x'')) (VAR ''y'')) (VAR ''z''))"
value "is_dnf (AND (OR (NOT (VAR ''x'')) (VAR ''y'')) (VAR ''z''))"

text {*
An NNF can be converted into a DNF in a bottom-up manner.
The critical case is the conversion of @{term (sub) "AND b1 b2"}.
Having converted @{text b\<^sub>1} and @{text b\<^sub>2}, apply distributivity of @{const AND}
over @{const OR}. If we write @{const OR} as a multi-argument function,
we can express the distributivity step as follows:
@{text "dist_AND (OR a\<^sub>1 ... a\<^sub>n) (OR b\<^sub>1 ... b\<^sub>m)"}
= @{text "OR (AND a\<^sub>1 b\<^sub>1) (AND a\<^sub>1 b\<^sub>2) ... (AND a\<^sub>n b\<^sub>m)"}. Define
*}

fun dist_AND :: "pbexp \<Rightarrow> pbexp \<Rightarrow> pbexp" where
"dist_AND (OR a b) c = OR (dist_AND a c) (dist_AND b c)" |
"dist_AND a (OR b c) = OR (dist_AND a b) (dist_AND a c)" |
"dist_AND a b = AND a b"

text {* and prove that it behaves as follows: *}

lemma pbval_dist [simp]: "pbval (dist_AND b1 b2) s = pbval (AND b1 b2) s"
  apply(induction b1 b2 rule: dist_AND.induct)
  apply(auto)
  done

lemma is_dnf_dist: "is_dnf b1 \<Longrightarrow> is_dnf b2 \<Longrightarrow> is_dnf (dist_AND b1 b2)"
  apply(induction b1 b2 rule: dist_AND.induct)
  apply(auto)
  done

text {* Use @{const dist_AND} to write a function that converts an NNF
  to a DNF in the above bottom-up manner.
*}

fun dnf_of_nnf :: "pbexp \<Rightarrow> pbexp" where
"dnf_of_nnf (VAR x) = VAR x" |
"dnf_of_nnf (NOT a) = NOT a" |
"dnf_of_nnf (AND a b) = dist_AND (dnf_of_nnf a) (dnf_of_nnf b)" |
"dnf_of_nnf (OR a b) = OR (dnf_of_nnf a) (dnf_of_nnf b)"

value "dnf_of_nnf (AND
                       (AND
                          (VAR ''b'')
                          (OR
                            (NOT (VAR ''c''))
                            (VAR ''d'')
                          )
                       )
                       (NOT (VAR ''a''))
                  )"

text {* Prove the correctness of your function: *}

lemma "pbval (dnf_of_nnf b) s = pbval b s"
  apply(induction b)
  apply(auto)
  done

lemma "is_nnf b \<Longrightarrow> is_dnf (dnf_of_nnf b)"
  apply(induction b )
  apply(auto)
  done

text{*
\endexercise

\exercise\label{exe:stack-underflow}
A \concept{stack underflow} occurs when executing an @{text ADD}
instruction on a stack of size less than 2. In our semantics
a term @{term "exec1 ADD s stk"} where @{prop "length stk < 2"}
is simply some unspecified value, not an error or exception --- HOL does not have those concepts.
Modify theory @{short_theory "ASM"}
such that stack underflow is modelled by @{const None}
and normal execution by @{text Some}, i.e., the execution functions
have return type @{typ "stack option"}. Modify all theorems and proofs
accordingly.
Hint: you may find @{text"split: option.split"} useful in your proofs.
*}

text{*
\endexercise

\exercise\label{exe:register-machine}
This exercise is about a register machine
and compiler for @{typ aexp}. The machine instructions are
*}
type_synonym reg = nat
datatype instr = LDI val reg | LD vname reg | ADD reg reg

text {*
where type @{text reg} is a synonym for @{typ nat}.
Instruction @{term "LDI i r"} loads @{text i} into register @{text r},
@{term "LD x r"} loads the value of @{text x} into register @{text r},
and @{term[names_short] "ADD r\<^sub>1 r\<^sub>2"} adds register @{text r\<^sub>2} to register @{text r\<^sub>1}.

Define the execution of an instruction given a state and a register state;
the result is the new register state: *}

type_synonym rstate = "reg \<Rightarrow> val"

fun exec1 :: "instr \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
"exec1 (LDI i r) s rs = rs(r:= i)" |
"exec1 (LD x r) s rs = rs(r:= s(x))" |
"exec1 (ADD r1 r2) s rs = rs(r1:= (rs r1) + (rs r2))"

text{*
Define the execution @{const[source] exec} of a list of instructions as for the stack machine.

The compiler takes an arithmetic expression @{text a} and a register @{text r}
and produces a list of instructions whose execution places the value of @{text a}
into @{text r}. The registers @{text "> r"} should be used in a stack-like fashion
for intermediate results, the ones @{text "< r"} should be left alone.
Define the compiler and prove it correct:
*}

fun exec :: "instr list \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
"exec [] _ rs = rs" |
"exec (i # is) s rs = exec is s (exec1 i s rs)"

fun comp :: "aexp \<Rightarrow> reg \<Rightarrow> instr list" where
"comp (N n) r =  [LDI n r]" |
"comp (V x) r = [LD x r]" |
"comp (Plus a1 a2) r = (comp a1 r) @ (comp a2 (r+1)) @ [ADD r (r+1)]"

lemma [simp]: "exec (xs @ ys) s rs = exec ys s (exec xs s rs)"
  apply(induction xs arbitrary: rs)
  apply(auto)
  done

lemma [simp]: "r < q \<Longrightarrow> exec (comp a q) s rs r = rs r"
  apply(induction a arbitrary: rs r q)
  apply(auto)
  done

theorem "exec (comp a r) s rs r = aval a s"
  apply(induction a arbitrary: rs r)
  apply(auto)
  done

text{*
\endexercise

\exercise\label{exe:accumulator}
This exercise is a variation of the previous one
with a different instruction set:
*}

datatype instr0 = LDI0 val | LD0 vname | MV0 reg | ADD0 reg

text{*
All instructions refer implicitly to register 0 as a source or target:
@{const LDI0} and @{const LD0} load a value into register 0, @{term "MV0 r"}
copies the value in register 0 into register @{text r}, and @{term "ADD0 r"}
adds the value in register @{text r} to the value in register 0;
@{term "MV0 0"} and @{term "ADD0 0"} are legal. Define the execution functions
*}

fun exec01 :: "instr0 \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
"exec01 (LDI0 x) s rs = rs(0:= x)" |
"exec01 (LD0 v) s rs = rs(0:= (s v))" |
"exec01 (MV0 r) s rs = rs(r:= (rs 0))" |
"exec01 (ADD0 r) s rs = rs(0:=(rs 0) + (rs r))"

text{*
and @{const exec0} for instruction lists.

The compiler takes an arithmetic expression @{text a} and a register @{text r}
and produces a list of instructions whose execution places the value of @{text a}
into register 0. The registers @{text "> r"} should be used in a stack-like fashion
for intermediate results, the ones @{text "\<le> r"} should be left alone
(with the exception of 0). Define the compiler and prove it correct:
*}

fun exec0 :: "instr0 list \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
"exec0 [] _ rs = rs" |
"exec0 (x # xs) s rs = exec0 xs s (exec01 x s rs)"

fun comp0 :: "aexp \<Rightarrow> reg \<Rightarrow> instr0 list" where
"comp0 (N n) r = [LDI0 n]" |
"comp0 (V x) r = [LD0 x]" |
"comp0 (Plus a b) r = (comp0 a (r+1)) @ [MV0 (r+1)] @ (comp0 b (r+2)) @ [ADD0 (r+1)]"

lemma [simp]: "exec0 (xs @ ys) s rs = exec0 ys s (exec0 xs s rs)"
  apply(induction xs arbitrary: rs)
  apply(auto)
  done

lemma [simp]: "(0 < r) \<and> (r \<le> q) \<Longrightarrow> exec0 (comp0 a q) s rs r = rs r"
  apply(induction a arbitrary: r q rs)
  apply(auto)
  done

theorem "exec0 (comp0 a r) s rs 0 = aval a s"
  apply(induction a arbitrary: r rs)
  apply(auto)
  done

text{*
\endexercise
*}

end


(*  Title: HOL/ex/Birthday_Paradox.thy
    Author: Lukas Bulwahn, TU Muenchen, 2007
*)

section \<open>A Formulation of the Birthday Paradox\<close>

theory Birthday_Paradox
imports MainRLT "HOL-Library.FuncSet"
begin

section \<open>Cardinality\<close>

lemma card_product_dependent:
  assumes "finite S"
  assumes "\<forall>x \<in> S. finite (T x)"
  shows "card {(x, y). x \<in> S \<and> y \<in> T x} = (\<Sum>x \<in> S. card (T x))"
  using card_SigmaI[OF assms, symmetric] by (auto intro!: arg_cong[where f=card] simp add: Sigma_def)

lemma card_extensional_funcset_inj_on:
  assumes "finite S" "finite T" "card S \<le> card T"
  shows "card {f \<in> extensional_funcset S T. inj_on f S} = fact (card T) div (fact (card T - card S))"
using assms
proof (induct S arbitrary: T rule: finite_induct)
  case empty
  from this show ?case by (simp add: Collect_conv_if PiE_empty_domain)
next
  case (insert x S)
  { fix x
    from \<open>finite T\<close> have "finite (T - {x})" by auto
    from \<open>finite S\<close> this have "finite (extensional_funcset S (T - {x}))"
      by (rule finite_PiE)
    moreover
    have "{f : extensional_funcset S (T - {x}). inj_on f S} \<subseteq> (extensional_funcset S (T - {x}))" by auto
    ultimately have "finite {f : extensional_funcset S (T - {x}). inj_on f S}"
      by (auto intro: finite_subset)
  } note finite_delete = this
  from insert have hyps: "\<forall>y \<in> T. card ({g. g \<in> extensional_funcset S (T - {y}) \<and> inj_on g S}) = fact (card T - 1) div fact ((card T - 1) - card S)"(is "\<forall> _ \<in> T. _ = ?k") by auto
  from extensional_funcset_extend_domain_inj_on_eq[OF \<open>x \<notin> S\<close>]
  have "card {f. f \<in> extensional_funcset (insert x S) T \<and> inj_on f (insert x S)} =
    card ((\<lambda>(y, g). g(x := y)) ` {(y, g). y \<in> T \<and> g \<in> extensional_funcset S (T - {y}) \<and> inj_on g S})"
    by metis
  also from extensional_funcset_extend_domain_inj_onI[OF \<open>x \<notin> S\<close>, of T] have "\<dots> =  card {(y, g). y \<in> T \<and> g \<in> extensional_funcset S (T - {y}) \<and> inj_on g S}"
    by (simp add: card_image)
  also have "card {(y, g). y \<in> T \<and> g \<in> extensional_funcset S (T - {y}) \<and> inj_on g S} =
    card {(y, g). y \<in> T \<and> g \<in> {f \<in> extensional_funcset S (T - {y}). inj_on f S}}" by auto
  also from \<open>finite T\<close> finite_delete have "... = (\<Sum>y \<in> T. card {g. g \<in> extensional_funcset S (T - {y}) \<and>  inj_on g S})"
    by (subst card_product_dependent) auto
  also from hyps have "... = (card T) * ?k"
    by auto
  also have "... = card T * fact (card T - 1) div fact (card T - card (insert x S))"
    using insert unfolding div_mult1_eq[of "card T" "fact (card T - 1)"]
    by (simp add: fact_mod)
  also have "... = fact (card T) div fact (card T - card (insert x S))"
    using insert by (simp add: fact_reduce[of "card T"])
  finally show ?case .
qed

lemma card_extensional_funcset_not_inj_on:
  assumes "finite S" "finite T" "card S \<le> card T"
  shows "card {f \<in> extensional_funcset S T. \<not> inj_on f S} = (card T) ^ (card S) - (fact (card T)) div (fact (card T - card S))"
proof -
  have subset: "{f : extensional_funcset S T. inj_on f S} <= extensional_funcset S T" by auto
  from finite_subset[OF subset] assms have finite: "finite {f : extensional_funcset S T. inj_on f S}"
    by (auto intro!: finite_PiE)
  have "{f \<in> extensional_funcset S T. \<not> inj_on f S} = extensional_funcset S T - {f \<in> extensional_funcset S T. inj_on f S}" by auto
  from assms this finite subset show ?thesis
    by (simp add: card_Diff_subset card_PiE card_extensional_funcset_inj_on prod_constant)
qed

lemma prod_upto_nat_unfold:
  "prod f {m..(n::nat)} = (if n < m then 1 else (if n = 0 then f 0 else f n * prod f {m..(n - 1)}))"
  by auto (auto simp add: gr0_conv_Suc atLeastAtMostSuc_conv)

section \<open>Birthday paradox\<close>

lemma birthday_paradox:
  assumes "card S = 23" "card T = 365"
  shows "2 * card {f \<in> extensional_funcset S T. \<not> inj_on f S} \<ge> card (extensional_funcset S T)"
proof -
  from \<open>card S = 23\<close> \<open>card T = 365\<close> have "finite S" "finite T" "card S <= card T" by (auto intro: card_ge_0_finite)
  from assms show ?thesis
    using card_PiE[OF \<open>finite S\<close>, of "\<lambda>i. T"] \<open>finite S\<close>
      card_extensional_funcset_not_inj_on[OF \<open>finite S\<close> \<open>finite T\<close> \<open>card S <= card T\<close>]
    by (simp add: fact_div_fact prod_upto_nat_unfold prod_constant)
qed

end


theory ch612
imports Main
begin

subsection{*Inductive definition of the even numbers*}

inductive_set Ev :: "nat set" where
ZeroI: "0 : Ev" |
Add2I: "n : Ev \<Longrightarrow> Suc(Suc n) : Ev"

text{* Using the introduction rules: *}
lemma "Suc(Suc(Suc(Suc 0))) \<in> Ev"
apply(rule Add2I)
apply(rule Add2I)
apply(rule ZeroI)
done

text{*A simple inductive proof: *}
lemma "n:Ev \<Longrightarrow> n+n : Ev"
apply(induct rule: Ev.induct)
 apply(simp)
 apply(rule Ev.ZeroI)
apply(simp)
apply(rule Ev.Add2I)
apply(rule Ev.Add2I)
apply(assumption)
done

text{* You can also use the rules for Ev as conditional simplification
rules. This can shorten proofs considerably.  \emph{Warning}:
conditional rules can lead to nontermination of the simplifier.  The
rules for Ev are OK because the premises are always smaller than the
conclusion. The list of rules for Ev is contained in Ev.intrs.  *}

declare Ev.intros[simp]

text{* A shorter proof: *}

lemma "n:Ev \<Longrightarrow> n+n : Ev"
apply(induct rule: Ev.induct)
apply(auto)
done

text{* Nice example, but overkill: don't need assumption @{prop"n \<in>
Ev"} because @{prop"n+n \<in> Ev"} is true for all @{text n}.

However, here we really need the assumptions: *}

lemma "\<lbrakk> m:Ev; n:Ev \<rbrakk> \<Longrightarrow> m+n : Ev"
apply(induct rule: Ev.induct)
apply(auto)
done

text{* An inductive proof of @{prop"1 \<notin> Ev"}: *}

lemma "n \<in> Ev \<Longrightarrow> n \<noteq> 1"
apply(induct rule: Ev.induct)
apply(auto)
done

text{* The general case: *}
lemma "n \<in> Ev \<Longrightarrow> \<not>(\<exists>k. n = 2*k+1)"
apply(induct rule: Ev.induct)
 apply(simp)
apply arith
done

subsection{*Inductive definition of AVL trees*}

datatype tree = Tip | Br tree tree

inductive_set AVL :: "(tree * nat)set" where
"(Tip,0) : AVL" |
"\<lbrakk> (t,m) : AVL; (u,n) : AVL; m=n | m = n+1 | n = m+1 \<rbrakk> \<Longrightarrow>
 (Br t u, max m n + 1) : AVL"

text{* We prove a lower bound for the number of internal nodes in an
AVL tree of height h. *}

fun fib1 :: "nat => nat" where
"fib1 0 = 0" |
"fib1 (Suc 0) = 1" |
"fib1 (Suc (Suc x)) = fib1 x + fib1 (Suc x) + 1"

lemma fib1_Suc: "fib1(Suc n) \<le> 2*fib1(n) + 1"
apply(induct n rule: fib1.induct)
apply auto
done

lemma "(t,h) : AVL \<Longrightarrow> fib1 h \<le> size t"
apply(induct rule:AVL.induct)
 apply simp
apply(erule disjE)
 apply simp
 apply(cut_tac n=n in fib1_Suc)
 apply arith
apply(erule disjE)
 apply (simp add:max_def)
apply (simp add:max_def)
done

end


theory QuantLists
    imports Main
begin

text \<open> Define a universal and an existential quantifier on lists
using primitive recursion.  Expression @{term "alls P xs"} should
be true iff @{term "P x"} holds for every element @{term x} of
@{term xs}, and @{term "exs P xs"} should be true iff @{term "P x"}
holds for some element @{term x} of @{term xs}.
\<close>

consts
  alls' :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool"
  exs'  :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool"

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

lemma alls_app[simp]:"alls P (xs @ ys) = (alls P xs \<and> alls P ys)"
  apply (induction xs)
  by auto

fun exs :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool"
  where
  "exs _ [] = False" |
  "exs P (x#xs) = (P x \<or> (exs P xs))"

lemma exs_app[simp]:"exs P (xs @ ys) = (exs P xs \<or> exs P ys)"
  apply (induction xs)
  by auto

lemma alls_exs_dual1:"exs P xs = (\<not>alls (\<lambda> x. \<not>P x) xs)"
  apply (induction xs)
  by auto

lemma exs_alls_dual1:"alls P xs = (\<not>exs (\<lambda> x. \<not>P x) xs)"
  apply (induction xs)
  by auto

text \<open>
Prove or disprove (by counterexample) the following theorems.
You may have to prove some lemmas first.

Use the @{text "[simp]"}-attribute only if the equation is truly a
simplification and is necessary for some later proof.
\<close>

lemma "alls (\<lambda>x. P x \<and> Q x) xs = (alls P xs \<and> alls Q xs)"
  apply (induction xs) by auto

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

lemma "exs (\<lambda>x. P x \<and> Q x) xs = (exs P xs \<and> exs Q xs)"
  (*
Auto Quickcheck found a counterexample:
  P = {a\<^sub>1}
  Q = {a\<^sub>2}
  xs = [a\<^sub>1, a\<^sub>2]
Evaluated terms:
  exs (\<lambda>x. P x \<and> Q x) xs = False
  exs P xs \<and> exs Q xs = True
*)
  oops

lemma "exs P (map f xs) = exs (P o f) xs"
  apply (induction xs) by auto

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

text \<open> Find a (non-trivial) term @{text Z} such that the following equation holds: \<close>

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

text \<open> Express the existential via the universal quantifier --
@{text exs} should not occur on the right-hand side: \<close>

lemma "exs P xs = (\<not> alls (\<lambda>x. \<not>P x) xs)"
  by (rule alls_exs_dual1)

text \<open>
Define a primitive-recursive function @{term "is_in x xs"} that
checks if @{term x} occurs in @{term xs}. Now express
@{text is_in} via @{term exs}:
\<close>

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

lemma "is_in a xs = exs (\<lambda>x. x = a) xs"
  apply (induction xs) by auto

text \<open> Define a primitive-recursive function @{term "nodups xs"}
that is true iff @{term xs} does not contain duplicates, and a
function @{term "deldups xs"} that removes all duplicates.  Note
that @{term "deldups[x,y,x]"} (where @{term x} and @{term y} are
distinct) can be either @{term "[x,y]"} or @{term "[y,x]"}.

Prove or disprove (by counterexample) the following theorems.
\<close>

primrec nodups :: "'a list \<Rightarrow> bool"
  where
"nodups [] = True" |
"nodups (x#xs) = ((x \<in> set xs) \<or> nodups xs)"

primrec deldups :: "'a list \<Rightarrow> 'a list"
  where
"deldups [] = []" |
"deldups (x#xs) = (if (x \<in> set xs)
                   then deldups xs
                   else x#(deldups xs))"

lemma "length (deldups xs) <= length xs"
  apply (induction xs) by auto

lemma "nodups (deldups xs)"
  apply (induction xs) by auto

lemma "deldups (rev xs) = rev (deldups xs)"
(* counter example:
  xs = [1, 2, 3, 1]
  deldups (rev xs) = [3, 2, 1]
  rev (deldups xs) = [2, 3, 1]
*)
  oops

(*<*) end (*>*)


theory iter
imports Main
begin

primrec iter::"nat \<Rightarrow>('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)"
  where
"iter 0 f = (\<lambda> x. x)"
|"iter (Suc n) f = (\<lambda> x. f ((iter n f) x))"

(*Prove the following*)
lemma fixedpt_iteration:
  assumes "f x = x"
  shows "iter (n+1) f x = x"
  using assms
proof(induction n)
  case 0
  then show ?case by simp
next
  case (Suc n)
  then show ?case by simp
qed

lemma iterative_fixed_pt:
  assumes "iter (n+1) f x = iter n f x"
  shows "iter (k+(n+1)) f x = iter (k+n) f x"
  using assms
proof(induction k)
  case 0
  then show ?case
    by force
next
  case (Suc m)
  have "iter (m + (n + 1)) f x = iter (Suc m + n) f x" by simp
  then show ?case using Suc.IH Suc.prems by fastforce
qed

end