(*  Title:       Countable Ordinals

    Author:      Brian Huffman, 2005
    Maintainer:  Brian Huffman <brianh at cse.ogi.edu>
*)

section \<open>Ordinal Induction\<close>

theory OrdinalInduct
imports OrdinalDef
begin

subsection \<open>Zero and successor ordinals\<close>

definition
  oSuc :: "ordinal \<Rightarrow> ordinal" where
    "oSuc x = oStrictLimit (\<lambda>n. x)"

lemma less_oSuc[iff]: "x < oSuc x"
by (unfold oSuc_def, rule oStrictLimit_ub)

lemma oSuc_leI: "x < y \<Longrightarrow> oSuc x \<le> y"
by (unfold oSuc_def, rule oStrictLimit_lub, simp)

instantiation ordinal :: "{zero, one}"
begin

definition
  ordinal_zero_def:       "(0::ordinal) = oZero"

definition
  ordinal_one_def [simp]: "(1::ordinal) = oSuc 0"

instance ..

end

subsubsection \<open>Derived properties of 0 and oSuc\<close>

lemma less_oSuc_eq_le: "(x < oSuc y) = (x \<le> y)"
 apply (rule iffI)
  apply (erule contrapos_pp, simp add: linorder_not_less linorder_not_le)
  apply (erule oSuc_leI)
 apply (erule order_le_less_trans[OF _ less_oSuc])
done

lemma ordinal_0_le [iff]: "0 \<le> (x::ordinal)"
by (unfold ordinal_zero_def, rule oZero_least)

lemma ordinal_not_less_0 [iff]: "\<not> (x::ordinal) < 0"
by (simp add: linorder_not_less)

lemma ordinal_le_0 [iff]: "(x \<le> 0) = (x = (0::ordinal))"
by (simp add: order_le_less)

lemma ordinal_neq_0 [iff]: "(x \<noteq> 0) = (0 < (x::ordinal))"
by (simp add: order_less_le)

lemma ordinal_not_0_less [iff]: "(\<not> 0 < x) = (x = (0::ordinal))"
by (simp add: linorder_not_less)

lemma zero_less_oSuc [iff]: "0 < oSuc x"
by (rule order_le_less_trans, rule ordinal_0_le, rule less_oSuc)

lemma oSuc_not_0 [iff]: "oSuc x \<noteq> 0"
by simp

lemma less_oSuc0 [iff]: "(x < oSuc 0) = (x = 0)"
by (simp add: less_oSuc_eq_le)

lemma oSuc_less_oSuc [iff]: "(oSuc x < oSuc y) = (x < y)"
 apply (rule iffI)
  apply (simp add: less_oSuc_eq_le order_less_le_trans[OF less_oSuc])
 apply (erule order_le_less_trans[OF oSuc_leI less_oSuc])
done

lemma oSuc_eq_oSuc [iff]: "(oSuc x = oSuc y) = (x = y)"
by (safe, erule contrapos_pp, simp add: linorder_neq_iff)

lemma oSuc_le_oSuc [iff]: "(oSuc x \<le> oSuc y) = (x \<le> y)"
by (simp add: order_le_less)

lemma le_oSucE:
"\<lbrakk>x \<le> oSuc y; x \<le> y \<Longrightarrow> R; x = oSuc y \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
by (auto simp add: order_le_less less_oSuc_eq_le)

lemma less_oSucE:
"\<lbrakk>x < oSuc y; x < y \<Longrightarrow> P; x = y \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
by (auto simp add: less_oSuc_eq_le order_le_less)

subsection \<open>Strict monotonicity\<close>

locale strict_mono =
  fixes f
  assumes strict_mono: "A < B \<Longrightarrow> f A < f B"

lemmas strict_monoI = strict_mono.intro
   and strict_monoD = strict_mono.strict_mono

lemma strict_mono_natI:
fixes f :: "nat \<Rightarrow> 'a::order"
shows "(\<And>n. f n < f (Suc n)) \<Longrightarrow> strict_mono f"
 apply (rule strict_monoI)
 apply (drule Suc_leI)
 apply (drule le_add_diff_inverse)
 apply (subgoal_tac "\<forall>k. f A < f (Suc A + k)")
  apply (erule subst, erule spec)
 apply (rule allI, induct_tac k, simp)
 apply (erule order_less_trans, simp)
done

lemma mono_natI:
fixes f :: "nat \<Rightarrow> 'a::order"
shows "(\<And>n. f n \<le> f (Suc n)) \<Longrightarrow> mono f"
 apply (rule monoI)
 apply (drule le_add_diff_inverse)
 apply (subgoal_tac "\<forall>k. f x \<le> f (x + k)")
  apply (erule subst, erule spec)
 apply (rule allI, induct_tac k, simp)
 apply (erule order_trans, simp)
done

lemma strict_mono_mono:
fixes f :: "'a::order \<Rightarrow> 'b::order"
shows "strict_mono f \<Longrightarrow> mono f"
by (auto intro!: monoI simp add: order_le_less strict_monoD)

lemma strict_mono_monoD:
fixes f :: "'a::order \<Rightarrow> 'b::order"
shows "\<lbrakk>strict_mono f; A \<le> B\<rbrakk> \<Longrightarrow> f A \<le> f B"
by (rule monoD[OF strict_mono_mono])

lemma strict_mono_cancel_eq:
fixes f :: "'a::linorder \<Rightarrow> 'b::linorder"
shows "strict_mono f \<Longrightarrow> (f x = f y) = (x = y)"
 apply safe
 apply (rule_tac x=x and y=y in linorder_cases)
   apply (drule strict_monoD, assumption, simp)
  apply assumption
 apply (drule strict_monoD, assumption, simp)
done

lemma strict_mono_cancel_less:
fixes f :: "'a::linorder \<Rightarrow> 'b::linorder"
shows "strict_mono f \<Longrightarrow> (f x < f y) = (x < y)"
 apply safe
  apply (rule_tac x=x and y=y in linorder_cases)
    apply assumption
   apply simp
  apply (drule strict_monoD, assumption, simp)
 apply (simp add: strict_monoD)
done

lemma strict_mono_cancel_le:
fixes f :: "'a::linorder \<Rightarrow> 'b::linorder"
shows "strict_mono f \<Longrightarrow> (f x \<le> f y) = (x \<le> y)"
 apply (auto simp add: order_le_less)
   apply (simp add: strict_mono_cancel_less)
  apply (simp add: strict_mono_cancel_eq)
 apply (simp add: strict_monoD)
done

subsection \<open>Limit ordinals\<close>

definition
  oLimit :: "(nat \<Rightarrow> ordinal) \<Rightarrow> ordinal" where
  "oLimit f = (LEAST k. \<forall>n. f n \<le> k)"

lemma oLimit_leI: "\<forall>n. f n \<le> x \<Longrightarrow> oLimit f \<le> x"
 apply (unfold oLimit_def)
 apply (erule Least_le)
done

lemma le_oLimit [iff]: "f n \<le> oLimit f"
 apply (unfold oLimit_def)
 apply (rule_tac x=n in spec)
 apply (rule_tac k="oStrictLimit f" in LeastI)
 apply (clarify, rule order_less_imp_le)
 apply (rule oStrictLimit_ub)
done

lemma le_oLimitI: "x \<le> f n \<Longrightarrow> x \<le> oLimit f"
by (erule order_trans, rule le_oLimit)

lemma less_oLimitI: "x < f n \<Longrightarrow> x < oLimit f"
by (erule order_less_le_trans, rule le_oLimit)

lemma less_oLimitD: "x < oLimit f \<Longrightarrow> \<exists>n. x < f n"
 apply (unfold oLimit_def)
 apply (drule not_less_Least)
 apply (simp add: linorder_not_le)
done

lemma less_oLimitE:
"\<lbrakk>x < oLimit f; \<And>n. x < f n \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
by (auto dest: less_oLimitD)

lemma le_oLimitE:
"\<lbrakk>x \<le> oLimit f; \<And>n. x \<le> f n \<Longrightarrow> R; x = oLimit f \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
by (auto simp add: order_le_less dest: less_oLimitD)

lemma oLimit_const [simp]: "oLimit (\<lambda>n. x) = x"
 apply (rule order_antisym[OF _ le_oLimit])
 apply (rule oLimit_leI, simp)
done

lemma strict_mono_less_oLimit:
"strict_mono f \<Longrightarrow> f n < oLimit f"
 apply (rule order_less_le_trans)
  apply (erule strict_monoD, rule lessI)
 apply (rule le_oLimit)
done

lemma oLimit_eqI:
"\<lbrakk>\<And>n. \<exists>m. f n \<le> g m; \<And>n. \<exists>m. g n \<le> f m\<rbrakk> \<Longrightarrow> oLimit f = oLimit g"
 apply atomize
 apply (rule order_antisym)
  apply (rule oLimit_leI, clarify)
  apply (drule spec, erule exE, erule le_oLimitI)
 apply (rule oLimit_leI, clarify)
 apply (drule spec, erule exE, erule le_oLimitI)
done

lemma oLimit_Suc:
"f 0 < oLimit f \<Longrightarrow> oLimit (\<lambda>n. f (Suc n)) = oLimit f"
 apply (rule oLimit_eqI)
  apply (rule exI, rule order_refl)
 apply (case_tac n)
  apply (drule less_oLimitD, clarify, rename_tac m)
  apply (case_tac m, simp)
  apply (rule_tac x=nat in exI)
  apply (simp add: order_less_imp_le)
 apply (rule_tac x=nat in exI, simp)
done

lemma oLimit_shift:
"\<forall>n. f n < oLimit f \<Longrightarrow> oLimit (\<lambda>n. f (n + k)) = oLimit f"
 apply (induct_tac k, simp, rename_tac k)
 apply (simp only: add_Suc_right add_Suc[symmetric])
 apply (rule trans[OF oLimit_Suc], simp_all)
done

lemma oLimit_shift_mono:
"mono f \<Longrightarrow> oLimit (\<lambda>n. f (n + k)) = oLimit f"
 apply (rule oLimit_eqI)
  apply (rule exI, rule order_refl)
 apply (rule_tac x=n in exI)
 apply (erule monoD, simp)
done

text "limit ordinal predicate"

definition
  limit_ordinal :: "ordinal \<Rightarrow> bool" where
  "limit_ordinal x \<longleftrightarrow> (x \<noteq> 0) \<and> (\<forall>y. x \<noteq> oSuc y)"

lemma limit_ordinal_not_0 [simp]: "\<not> limit_ordinal 0"
by (simp add: limit_ordinal_def)

lemma zero_less_limit_ordinal [simp]: "limit_ordinal x \<Longrightarrow> 0 < x"
by (simp add: limit_ordinal_def)

lemma limit_ordinal_not_oSuc [simp]: "\<not> limit_ordinal (oSuc p)"
by (simp add: limit_ordinal_def)

lemma oSuc_less_limit_ordinal:
"limit_ordinal x \<Longrightarrow> (oSuc w < x) = (w < x)"
 apply (rule iffI)
  apply (erule order_less_trans[OF less_oSuc])
 apply (simp add: linorder_not_le[symmetric])
 apply (erule contrapos_nn)
 apply (auto simp add: order_le_less less_oSuc_eq_le)
done

lemma limit_ordinal_oLimitI:
"\<forall>n. f n < oLimit f \<Longrightarrow> limit_ordinal (oLimit f)"
 apply (unfold limit_ordinal_def, simp)
 apply (rule conjI)
  apply (rule order_le_less_trans[OF ordinal_0_le])
  apply (erule spec)
 apply (clarsimp simp add: less_oSuc_eq_le)
 apply (drule oLimit_leI)
 apply (simp add: linorder_not_less[symmetric])
done

lemma strict_mono_limit_ordinal:
"strict_mono f \<Longrightarrow> limit_ordinal (oLimit f)"
 apply (rule limit_ordinal_oLimitI)
 apply (simp add: strict_mono_less_oLimit)
done

lemma limit_ordinalI:
"\<lbrakk>0 < z; \<forall>x<z. oSuc x < z\<rbrakk> \<Longrightarrow> limit_ordinal z"
 apply (erule contrapos_pp)
 apply (unfold limit_ordinal_def, clarsimp)
 apply (drule_tac x=y in spec, clarsimp)
done

subsubsection \<open>Making strict monotonic sequences\<close>

primrec make_mono :: "(nat \<Rightarrow> ordinal) \<Rightarrow> nat \<Rightarrow> nat"
where
  "make_mono f 0       = 0"
| "make_mono f (Suc n) = (LEAST x. f (make_mono f n) < f x)"

lemma strict_mono_f_make_mono:
"\<forall>n. f n < oLimit f \<Longrightarrow> strict_mono (\<lambda>n. f (make_mono f n))"
by (rule strict_mono_natI, erule f_make_mono_less)

lemma le_f_make_mono:
"\<lbrakk>\<forall>n. f n < oLimit f; m \<le> make_mono f n\<rbrakk> \<Longrightarrow> f m \<le> f (make_mono f n)"
 apply (auto simp add: order_le_less)
 apply (case_tac n, simp_all)
 apply (drule not_less_Least)
 apply (simp add: linorder_not_less)
 apply (erule order_le_less_trans)
 apply (rule LeastI)
 apply (erule f_make_mono_less)
done

lemma make_mono_less:
"\<forall>n. f n < oLimit f \<Longrightarrow> make_mono f n < make_mono f (Suc n)"
 apply (frule_tac n=n in f_make_mono_less)
 apply (rule ccontr, simp only: linorder_not_less)
 apply (drule le_f_make_mono, assumption)
 apply (simp add: linorder_not_less[symmetric])
done

declare make_mono.simps [simp del]

lemma oLimit_make_mono_eq:
"\<forall>n. f n < oLimit f \<Longrightarrow> oLimit (\<lambda>n. f (make_mono f n)) = oLimit f"
 apply (rule oLimit_eqI, force)
 apply (rule_tac x=n in exI)
 apply (rule le_f_make_mono, assumption)
 apply (induct_tac n, simp)
 apply (rule Suc_leI)
 apply (erule order_le_less_trans)
 apply (erule make_mono_less)
done

subsection \<open>Induction principle for ordinals\<close>

lemma oLimit_le_oStrictLimit: "oLimit f \<le> oStrictLimit f"
 apply (rule oLimit_leI, clarify)
 apply (rule order_less_imp_le)
 apply (rule oStrictLimit_ub)
done

lemma oLimit_induct:
assumes zero: "P 0"
    and suc:  "\<And>x. P x \<Longrightarrow> P (oSuc x)"
    and lim:  "\<And>f. \<lbrakk>strict_mono f; \<forall>n. P (f n)\<rbrakk> \<Longrightarrow> P (oLimit f)"
shows "P a"
 apply (rule oStrictLimit_induct)
  apply (rule zero[unfolded ordinal_zero_def])
 apply (cut_tac f=f in oLimit_le_oStrictLimit)
 apply (simp add: order_le_less, erule disjE)
  apply (drule less_oStrictLimitD, clarify)
  apply (subgoal_tac "oStrictLimit f = oSuc (f n)", simp add: suc)
  apply (rule order_antisym)
   apply (rule oStrictLimit_lub, clarify)
   apply (simp add: less_oSuc_eq_le)
   apply (erule order_trans[OF le_oLimit])
  apply (rule oSuc_leI, rule oStrictLimit_ub)
 apply (subgoal_tac "\<forall>n. f n < oLimit f")
  apply (subgoal_tac "P (oLimit (\<lambda>n. f (make_mono f n)))")
   apply (simp add: oLimit_make_mono_eq)
  apply (rule lim)
   apply (erule strict_mono_f_make_mono)
  apply simp
 apply (simp add: oStrictLimit_ub)
done

lemma ordinal_cases:
assumes zero: "a = 0 \<Longrightarrow> P"
    and suc:  "\<And>x. a = oSuc x \<Longrightarrow> P"
    and lim:  "\<And>f. \<lbrakk>strict_mono f; a = oLimit f\<rbrakk> \<Longrightarrow> P"
shows "P"
 apply (subgoal_tac "\<forall>x. a = x \<longrightarrow> P", force)
 apply (rule allI)
 apply (rule_tac a=x in oLimit_induct)
   apply (rule impI, erule zero)
  apply (rule impI, erule suc)
 apply (rule impI, erule lim, assumption)
done

end


theory Homework7
imports
  "../IMP/Small_Step"
  "~~/src/HOL/Library/Code_Target_Nat"   (* Makes value-command compute with ML-integers rather than unary Suc (Suc ...) objects. *)
begin

  (*
    ISSUED: Wednesday, Nov 1
    DUE: Wednesday, Nov 8, 11:59pm
    POINTS: 10   (5 per part)
  *)

  (********** PART 1 ***************)

  (*
    In this homework, we will develop a faster way to interpret programs.

    First, we want to define a functional version of a small step,
    that is, a function
      small_stepf :: com * state \<Rightarrow> (com * state) option
    that returns the next configuration, after performing one small step.
    If the configuration was final, it shall return None.
    The equations of this function correspond to the rules of SmallStep.

    Complete the function!
  *)

  (* Hint: Ignore *warnings* about ambiguous inputs ... the \<Rightarrow> in case and big-step causes them.
    If you get type *errors*, though, DO NOT IGNORE THEM!
  *)

  fun small_stepf :: "com * state \<Rightarrow> (com * state) option" where
    "small_stepf (x ::= a, s) = Some (SKIP, s(x := aval a s))"
  | "small_stepf (SKIP;;c\<^sub>2,s) = Some (c\<^sub>2,s)"
  | "small_stepf (c\<^sub>1;;c\<^sub>2,s) = undefined"
  | "small_stepf (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) = undefined"
        (* Note: Although there are two If-rules in SmallStep, you only need a single equation here!  *)
  | "small_stepf (WHILE b DO c,s) = undefined"
  | "small_stepf _ = None" (* Catch-all case*)

  (* Show that small_stepf indeed computes a single small step! *)
  lemma small_stepf_eq: "cs\<rightarrow>cs'\<longleftrightarrow> small_stepf cs = Some cs'" sorry

  (* Show that None is returned only for final configurations.
    Hint: Already implied by thm small_stepf_eq, no separate induction required!
  *)
  lemma final_eq: "final cs \<longleftrightarrow> small_stepf cs = None"
    sorry

  (*
    Write a function iterate that iterates small_stepf, until a final
    configuration is reached, but for at most n iterations.

    If no final configuration is reached after n iterations, the function
    shall return None.

    Hint: For n=0, it is OK to always return None, even if the configuration should be final.
      This will simplify the equation for 0.

    n is also called fuel: Each iteration uses one unit of fuel,
      and when running out of fuel the computation stops.

    Do not use \<rightarrow> or final in your function, but
    use small_stepsf instead (cf. thms small_stepf_eq and final_eq)!

  *)
  fun iterate :: "nat \<Rightarrow> com * state \<Rightarrow> (com * state) option" where
    "iterate 0 cs = undefined"
  | "iterate (Suc n) cs = undefined"

  (* Show that iterate behaves as expected!
    There is a terminating execution if, and only if, there is an
    initial fuel value such that iterate returns Some.

    Hint: Prove both directions separately.
  *)
  lemma iterate_eq: "(cs \<rightarrow>* cs' \<and> final cs') \<longleftrightarrow> (\<exists>n. iterate n cs = Some cs')"
    sorry

  (*
    The iterate function gives you another way to execute programs, which
    is considerably faster than constructing derivation trees.

    Notes:
      * the extracts the value cs from Some cs, and the None is undefined.
      * snd extracts the second component of a pair
      * If you do not specify enough initial fuel, the command will just return
        \<open>snd (the None) ''a''\<close>, otherwise it returns teh correct result, e.g., 225.
        Specifying too much fuel, on the other hand, is no problem, as the iteration
        stops once it reaches a final result, not necessarily using up all its fuel.

  *)

  value "(snd (the (iterate 100000000000 (DerTreeExample.square,<''x'':=15>)))) ''a''"

  (********** PART 2 ***************)

  (*
    In this part, you are supposed to write some programs,
    satisfying a given specification. Test your programs!

    Try to find short and simple programs that only use the
    available operations of IMP!
  *)

  (* Write a program power2 that returns 2^c (2 to the power of c) in variable a.
    You may assume c being non-negative.

    Specification: { c=i\<^sub>c \<and> i\<^sub>c\<ge>0 } power2 { a=2^i\<^sub>c }, i\<^sub>c does not occur in power2!
  *)

  definition power2 where "power2 \<equiv> undefined"

  (* Template for testing \<dots> *)
  value "(snd (the (iterate 100000000000 (power2,<''c'':=10>)))) ''a''"

  (* If you did not succeed with the iterate function, use the standard big-step
    derivation to test your programs ... will be much slower, though!
  *)
  schematic_goal "(power2,<''c'':=10>) \<Rightarrow> ?s"
    unfolding power2_def
    by BigSteps

  (* Write a program that replaces variable a by a*b, and does not change b!
    You may assume that a and b are positive!

    Specification: { a=i\<^sub>a \<and> b=i\<^sub>b \<and> i\<^sub>a>0 \<and> i\<^sub>b>0 } mult { a=i\<^sub>a*i\<^sub>b \<and> b=i\<^sub>b }, i\<^sub>a,i\<^sub>b do not occur in mult!
  *)

  definition mult where "mult \<equiv> undefined
  "

  value "(snd (the (iterate 100000000000 (mult,<''a'':=10, ''b'':=7>)))) ''a''"

  (* Write a program that returns b^c in variable a.
    You may assume that b is positive and c is non-negative

    Specification: { b=i\<^sub>b \<and> c=i\<^sub>c \<and> i\<^sub>b>0 \<and> i\<^sub>c\<ge>0 } power { a=i\<^sub>b^i\<^sub>c }, i\<^sub>b,i\<^sub>c do not occur in power

    Hint: Combine the ideas from the two above programs, you'll need two nested while loops.
      If your multiplication program uses auxiliary variables, keep care that they do not
      conflict with the variables used in your main program!

  *)

  definition power where "power \<equiv> undefined"

  value "(snd (the (iterate 100000000000 (power,<''b'':=5, ''c'':=4>)))) ''a''"

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_sort_TSortIsSort
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Tree = TNode "Tree" "int" "Tree" | TNil

fun insert :: "int => int list => int list" where
"insert x (nil2) = cons2 x (nil2)"
| "insert x (cons2 z xs) =
     (if x <= z then cons2 x (cons2 z xs) else cons2 z (insert x xs))"

fun isort :: "int list => int list" where
"isort (nil2) = nil2"
| "isort (cons2 y xs) = insert y (isort xs)"

fun flatten :: "Tree => int list => int list" where
"flatten (TNode p z q) y = flatten p (cons2 z (flatten q y))"
| "flatten (TNil) y = y"

fun add :: "int => Tree => Tree" where
"add x (TNode p z q) =
   (if x <= z then TNode (add x p) z q else TNode p z (add x q))"
| "add x (TNil) = TNode TNil x TNil"

fun toTree :: "int list => Tree" where
"toTree (nil2) = TNil"
| "toTree (cons2 y xs) = add y (toTree xs)"

fun tsort :: "int list => int list" where
"tsort x = flatten (toTree x) (nil2)"

theorem property0 :
  "((tsort xs) = (isort xs))"
  oops

end


theory EjT2B
imports Main
begin

section "Ejercicio 2.6: Suma de elementos de un árbol"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.6.1. En este ejercicio se usa el tipo de los árboles
  definido por
     datatype 'a arbol = Hoja | Nodo "'a arbol" 'a "'a arbol"
  Por ejemplo, el árbol
      9
     / \
   .    4
        /\
       .   .
  se define por
     abbreviation ejArbol1 :: "int arbol" where
       "ejArbol1 \<equiv> Nodo Hoja (9::int) (Nodo Hoja 4 Hoja)"
  Definir la función
     elementos :: "'a arbol \<Rightarrow> 'a list"
  tal que (elementos t) es la lista de los elementos del árbol t. Por
  ejemplo,
     elementos ejArbol1                   = [9,4]
     elementos (Nodo ejArbol1 7 ejArbol1) = [9,4,7,9,4]
  ------------------------------------------------------------------- *}

datatype 'a arbol = Hoja | Nodo "'a arbol" 'a "'a arbol"

abbreviation ejArbol1 :: "int arbol" where
  "ejArbol1 \<equiv> Nodo Hoja (9::int) (Nodo Hoja 4 Hoja)"

fun elementos :: "'a arbol \<Rightarrow> 'a list" where
  "elementos Hoja = []"
| "elementos (Nodo i x d) = elementos i @ [x] @ elementos d"

value "elementos ejArbol1"
lemma "elementos ejArbol1 = [9,4]" by simp
value "elementos (Nodo ejArbol1 7 ejArbol1) = [9, 4, 7, 9, 4]"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.6.2. Definir la función
     suma_arbol :: "int arbol \<Rightarrow> int"
  tal que (suma_arbol t) es la suma de los elementos del árbol t. Por
  ejemplo,
     suma_arbol ejArbol1 = 13
     suma_arbol (Nodo ejArbol1 7 ejArbol1) = 33
  ------------------------------------------------------------------- *}

fun suma_arbol :: "int arbol \<Rightarrow> int" where
  "suma_arbol Hoja = 0"
| "suma_arbol (Nodo i x d) = suma_arbol i + x + suma_arbol d"

value "suma_arbol ejArbol1 = 13"
value "suma_arbol (Nodo ejArbol1 7 ejArbol1) = 33"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.6.3. Demostrar que
     suma_arbol t = listsum (elementos t)
  ------------------------------------------------------------------- *}

lemma "suma_arbol t = listsum (elementos t)"
apply (induction t)
apply simp_all
done

section "Ejercicio 2.7: Recorrido de árboles e imagen especular"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.7.1. Definir el tipo arbol2 para representar los árboles
  con valores en las hojas. Por ejemplo, el árbol
       /\
      /\ 1
     3  5
  se define por
     abbreviation ejArbol2 :: "int arbol2" where
       "ejArbol2 \<equiv> N (N (H 3) (H 5)) (H (1::int))"
  ------------------------------------------------------------------- *}

datatype 'a arbol2 = H "'a"
                   | N "'a arbol2" "'a arbol2"

abbreviation ejArbol2 :: "int arbol2" where
  "ejArbol2 \<equiv> N (N (H 3) (H 5)) (H (1::int))"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.7.2. Definir la función
     espejo :: "'a arbol2 \<Rightarrow> 'a arbol2" where
  tal que (espejo t) es la imagen especular de t. Por ejemplo,
     espejo ejArbol2 = N (H 1) (N (H 5) (H 3))
  ------------------------------------------------------------------- *}

fun espejo :: "'a arbol2 \<Rightarrow> 'a arbol2" where
  "espejo (H x)   = H x"
| "espejo (N i d) = N (espejo d) (espejo i)"

value "espejo ejArbol2 = N (H 1) (N (H 5) (H 3))"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.7.3. Definir la función
     pre_orden :: "'a arbol2 \<Rightarrow> 'a list"
  tal que (pre_orden t) es el recorrido pre orden de t. Por ejemplo,
     pre_orden ejArbol2 = [3, 5, 1]
  ------------------------------------------------------------------- *}

fun pre_orden :: "'a arbol2 \<Rightarrow> 'a list" where
  "pre_orden (H x) = [x]"
| "pre_orden (N i d) = pre_orden i @ pre_orden d"

value "pre_orden ejArbol2 = [3, 5, 1]"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.7.4. Definir la función
     post_orden :: "'a arbol2 \<Rightarrow> 'a list"
  tal que (post_orden t) es el recorrido post orden de t. Por ejemplo,
     post_orden ejArbol2 = [1, 5, 3]
  ------------------------------------------------------------------- *}

fun post_orden :: "'a arbol2 \<Rightarrow> 'a list" where
  "post_orden (H x)   = [x]"
| "post_orden (N i d) = post_orden d @ post_orden i"

value "post_orden ejArbol2 = [1, 5, 3]"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.7.5. Demostrar que
     pre_orden (espejo t) = post_orden t
  ------------------------------------------------------------------- *}

lemma "pre_orden (espejo t) = post_orden t"
apply (induction t)
apply simp_all
done

section "Ejercicio 2.8: Intercalado de un elemento"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.8.1. Definir la función
     intercala :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list
  tal que (intercala x ys) es la lista obtenida intercalando x entre los
  elementos consecutivos de ys. Por ejemplo,
     intercala x [a,b,c] = [a,x,b,x,c]
  ------------------------------------------------------------------- *}

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

value "intercala x [a,b,c] = [a,x,b,x,c]"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.8.2. Demostrar que
     map f (intercala a xs) = intercala (f a) (map f xs)
  ------------------------------------------------------------------- *}

lemma "map f (intercala a xs) = intercala (f a) (map f xs)"
apply (induction xs rule: intercala.induct)
apply simp_all
done

section "Ejercicio 2.9: Definición iterativa de suma de naturales"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.9.1. Definir, como recursiva final, la función
     sumaIt :: "nat \<Rightarrow> nat \<Rightarrow> nat
  tal que (sumaIt n m) es la suma de n y m. Por ejemplo,
     sumaIt 3 2 = 5
  Nota: Que sumaIt es recursiva final significa que en la llamada
  recursiva, la aplicación de sumaIt es la última; es decir,
     sumaIt (Suc n) m = sumaIt ...
  ------------------------------------------------------------------- *}

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

value "sumaIt 3 2 = 5"

text {*
  ----------------------------------------------------------------------
  Ejercicio 2.9.2. Demostrar que la función suma It es equivalente a
  suma definida por
     fun suma :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
       "suma 0 m      = m"
     | "suma (Suc n) m = Suc (suma n m)"
  ------------------------------------------------------------------- *}

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

text {* 1\<ordmasculine> intento *}
lemma "sumaIt n m = suma n m"
apply (induction n)
apply simp_all
oops

text {* Queda pendiente
     sumaIt n m = suma n m \<Longrightarrow> sumaIt n (Suc m) = Suc (suma n m)
  Para probarlo se introduce el siguiente lema. *}

lemma sumaIt1:
  "sumaIt n (Suc m) = Suc (sumaIt n m)"
sorry

text {* 2\<ordmasculine> intento *}
lemma "sumaIt n m = suma n m"
apply (induction n)
apply (simp_all add: sumaIt1)
done

end


theory Concrete_Semantics_3_3
  imports Main
begin

(* from 3.1 and 3.2 *)

type_synonym vname = string
datatype aexp = N int | V vname | Plus aexp aexp
type_synonym val = int
type_synonym state = "vname \<Rightarrow> val"

fun aval :: "aexp \<Rightarrow> state \<Rightarrow> val" where
"aval (N n) s = n" |
"aval (V x) s = s x" |
"aval (Plus a b) s = aval a s + aval b s"

(* ----- *)

datatype instr = LOADI val | LOAD vname | ADD

type_synonym stack = "val list"

(* we argue about the case of stack, so the following warning is dismissed:
Missing patterns in function definition:
\<And>b. exec1 ADD b [] = undefined
\<And>b v. exec1 ADD b [v] = undefined
*)
fun exec1 :: "instr \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> stack" where
"exec1 (LOADI n) _ stk = n # stk" |
"exec1 (LOAD x) s stk = s(x) # stk" |
"exec1 ADD _ (j # i # stk) = (i + j) # stk"

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

lemma exec_division: "exec (is1 @ is2) s stk = exec is2 s (exec is1 s stk)"
  apply(induction is1 arbitrary:stk)
   apply(auto)
  done

fun comp:: "aexp \<Rightarrow> instr list" where
"comp (N n) = [LOADI n]" |
"comp (V x) = [LOAD x]" |
"comp (Plus e1 e2) = comp e1 @ comp e2 @ [ADD]"

lemma "exec (comp a) s stk = aval a s # stk"
  apply(induction a arbitrary:stk)
    apply(auto simp add: exec_division)
  done

fun mexec1 :: "instr \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> stack option" where
"mexec1 (LOADI n) _ stk = Some (n # stk)" |
"mexec1 (LOAD x) s stk = Some(s(x) # stk)" |
"mexec1 ADD _ (j # i # stk) = Some((i + j) # stk)" |
"mexec1 ADD _ _ = None"

(* case stk is None or Some *)
fun mexec :: "instr list \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> stack option" where
"mexec [] _ stk = Some(stk)" |
"mexec (i#is) s stk = (case (mexec1 i s stk) of Some stk' \<Rightarrow> mexec is s stk' |
None \<Rightarrow> None)"

fun mcomp:: "aexp \<Rightarrow> instr list" where
"mcomp (N n) = [LOADI n]" |
"mcomp (V x) = [LOAD x]" |
"mcomp (Plus e1 e2) = mcomp e1 @ mcomp e2 @ [ADD]"

(* add condition to exec_division
 *)
lemma mexec_division:"mexec a1 s stk = Some stk' \<Longrightarrow> mexec (a1 @ a2) s stk = mexec a2 s stk'"
  apply(induction a1 arbitrary:stk)
  apply(auto)
  by (metis option.case_eq_if option.simps(3))

lemma "mexec (mcomp a) s stk = Some(aval a s # stk)"
  apply(induction a arbitrary:stk)
    apply(auto simp add: mexec_division)
  done

(* ex 3.11 *)

type_synonym reg = nat

datatype r_instr = LDI int reg | LD vname reg | ADD reg reg

fun rexec1 :: "r_instr \<Rightarrow> state \<Rightarrow> (reg \<Rightarrow> int) \<Rightarrow> reg \<Rightarrow> int" where
"rexec1 (LDI i r1) _ f  = f(r1 := i)" |
"rexec1 (LD x r1) s f = f(r1 := s(x))" |
"rexec1 (ADD r1 r2) s f = f(r1:= (f r1) + (f r2))"

fun rexec :: "r_instr list \<Rightarrow> state \<Rightarrow> (reg \<Rightarrow> int) \<Rightarrow> reg \<Rightarrow> int" where
"rexec [] _ f = f" |
"rexec (r#rs) s f = rexec rs s (rexec1 r s f)"

(* I don't undestand about register machine enough.
Why (r + 1) is needed? \<rightarrow> the answer might be that each register machines is different?
 *)
fun rcomp:: "aexp \<Rightarrow> reg \<Rightarrow> r_instr list" where
"rcomp (N n) r = [LDI n r]" |
"rcomp (V x) r = [LD x r]" |
"rcomp (Plus e1 e2) r = rcomp e1 r @ rcomp e2 (r + 1) @ [ADD r (r + 1)]"

lemma rexec_division:"rexec (a1 @ a2) s e = rexec a2 s (rexec a1 s e)"
  apply(induction a1 arbitrary: s e)
  apply(auto)
  done

(*
The following lemma is not needed. And in this proof I found the above lemma.
lemma "rexec (rcomp a1 r @ rcomp a2 (Suc r) @ [ADD r (Suc r)]) s e r
= aval a1 s + aval a2 s"
  apply(induction a1 arbitrary:s r e)
  done
*)

(* Do not misunderstand to use which of r and q*)
lemma min_number_of_reg_is_prior:"r < q \<Longrightarrow> rexec (rcomp a q) s f r = f r"
  apply(induction a arbitrary: q f)
    apply(auto simp add:rexec_division)
  done

(* NOTE: "The registers > r should be used in a stack-like fashion for intermediate results,
 the ones < r should be left alone."*)
lemma min_number_of_reg_is_aval: "rexec (rcomp a2 (Suc r)) s (rexec (rcomp a1 r) s e) r = aval a1 s"
  apply(induction a1 arbitrary: s e r)
    apply(auto simp add: rexec_division min_number_of_reg_is_prior)
  done

(* counter examples occurs at
- "(rexec (rcomp a r1) s e) r2 = aval a s"
*)
lemma "(rexec (rcomp a r) s e) r = aval a s"
  apply(induction a arbitrary:s r e)
    apply(auto simp add: rexec_division min_number_of_reg_is_aval)
  done

(* Exercise 3.12 *)

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

fun lexec1 :: "instr0 \<Rightarrow> state \<Rightarrow> (reg \<Rightarrow> int) \<Rightarrow> reg \<Rightarrow> int" where
"lexec1 (LDI0 i) _ f  = f(0 := i)" |
"lexec1 (LD0 x) s f = f(0 := s(x))" |
"lexec1 (MV0 r1) s f = f(r1 := f(0))" |
"lexec1 (ADD0 r1 ) s f = f(0:= (f 0) + (f r1))"

fun lexec :: "instr0 list \<Rightarrow> state \<Rightarrow> (reg \<Rightarrow> int) \<Rightarrow> reg \<Rightarrow> int" where
"lexec [] _ f = f" |
"lexec (r#rs) s f = lexec rs s (lexec1 r s f)"

(* I don't undestand about register machine enough.
Why (r + 1) is needed? \<rightarrow> the answer might be that each register machines is different?
 *)
fun lcomp:: "aexp \<Rightarrow> reg \<Rightarrow> instr0 list" where
"lcomp (N n) r = [LDI0 n]" |
"lcomp (V x) r = [LD0 x]" |
"lcomp (Plus e1 e2) r = (lcomp e1 (r + 1)@ [MV0 (r + 1)]  @ lcomp e2 (r + 2) @ [ADD0 (r + 1)])"

lemma lexec_division:"lexec (a1 @ a2) s e = lexec a2 s (lexec a1 s e)"
  apply(induction a1 arbitrary: s e)
  apply(auto)
  done

lemma min_number_of_reg0_is_prior:"0 < r \<Longrightarrow> r < q \<Longrightarrow> lexec (lcomp a q) s f r = f r"
  apply(induction a arbitrary: q f)
    apply(auto simp add:lexec_division)
  done

lemma "lexec (lcomp a r) s rs 0 = aval a s"
  apply(induction a arbitrary: r s rs)
  apply(auto simp add:lexec_division min_number_of_reg0_is_prior)
  done

end


theory Calculus
  imports Complex_Main
begin

theorem mvt:
  fixes \<phi> :: "real \<Rightarrow> real"
  assumes "a < b"
    and contf: "continuous_on {a..b} \<phi>"
    and derf: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> (\<phi> has_derivative \<phi>' x) (at x)"
  obtains \<xi> where "a < \<xi>" "\<xi> < b" "\<phi> b - \<phi> a = (\<phi>' \<xi>) (b-a)"
proof -
  define f where "f \<equiv> \<lambda>x. \<phi> x - (\<phi> b - \<phi> a) / (b-a) * x"
  have "\<exists>\<xi>. a < \<xi> \<and> \<xi> < b \<and> (\<lambda>y. \<phi>' \<xi> y - (\<phi> b - \<phi> a) / (b-a) * y) = (\<lambda>v. 0)"
  proof (intro Rolle_deriv[OF \<open>a < b\<close>])
    fix x
    assume x: "a < x" "x < b"
    show "(f has_derivative (\<lambda>y. \<phi>' x y - (\<phi> b - \<phi> a) / (b-a) * y)) (at x)"
      unfolding f_def by (intro derivative_intros derf x)
  next
    show "f a = f b"
      using assms by (simp add: f_def field_simps)
  next
    show "continuous_on {a..b} f"
      unfolding f_def by (intro continuous_intros assms)
  qed
  then show ?thesis
    by (smt (verit, ccfv_SIG) pos_le_divide_eq pos_less_divide_eq that)
qed

end