theory VI_Code
  imports
    Code_Setup
    "../Value_Iteration"
    "HOL-Library.Code_Target_Numeral"
begin

context MDP_Code begin

partial_function (tailrec) VI_code_aux where
"VI_code_aux v eps = (
  let v' = \<L>_code v in
    if check_dist v v' eps
    then v'
    else VI_code_aux v' eps)"

lemmas VI_code_aux.simps[code]

definition "VI_code v eps = (if l = 0 \<or> eps \<le> 0 then \<L>_code v else VI_code_aux v eps)"

lemma VI_code_aux_correct_aux:
  assumes "eps > 0" "v_invar v" "v_len v = states" "l \<noteq> 0"
  shows "V_Map.map_to_fun (VI_code_aux v eps) = MDP.value_iteration eps (V_Map.map_to_bfun v)
  \<and> v_len (VI_code_aux v eps) = states
  \<and> v_invar (VI_code_aux v eps)"
  using assms
proof (induction eps "V_Map.map_to_bfun v" arbitrary: v rule: MDP.value_iteration.induct)
  case (1 eps)
  have *: "(check_dist v (\<L>_code v) eps) \<longleftrightarrow> 2 * l * dist (V_Map.map_to_bfun v) (MDP.\<L>\<^sub>b (V_Map.map_to_bfun v)) < eps * (1 - l)"
  proof (subst check_dist_correct)
    have " 0 < l" using 1 MDP.zero_le_disc by linarith
    thus "(dist (V_Map.map_to_bfun v) (V_Map.map_to_bfun (\<L>_code v)) < eps * (1 - l) / (2 * l)) =
    (2 * l * dist (V_Map.map_to_bfun v) (MDP.\<L>\<^sub>b (V_Map.map_to_bfun v)) < eps * (1 - l))"
      by (subst pos_less_divide_eq) (fastforce simp: \<L>_code_correct' 1 algebra_simps)+
  qed (auto simp: 1 intro: invar_\<L>_code)
  hence **: "V_Map.map_to_fun (VI_code_aux v eps) = (MDP.value_iteration eps (V_Map.map_to_bfun (\<L>_code v)))" if "\<not> (check_dist v (\<L>_code v) eps)"
    using invar_\<L>_code 1 that by (auto simp: VI_code_aux.simps \<L>_code_correct')
  have "V_Map.map_to_fun (VI_code_aux v eps) = (MDP.value_iteration eps (V_Map.map_to_bfun v))"
  proof (cases "(check_dist v (\<L>_code v) eps)")
    case True
    thus ?thesis
    using 1 invar_\<L>_code
    by (auto simp: MDP.value_iteration.simps VI_code_aux.simps[of v] * map_to_bfun_eq_fun[symmetric] \<L>_code_correct')
next
  case False
  thus ?thesis
    using 1 \<L>_code_correct' ** * MDP.value_iteration.simps by auto
qed
  thus ?case
    using 1 VI_code_aux.simps \<L>_code_correct' * invar_\<L>_code by auto
qed

lemma VI_code_aux_correct:
  assumes "eps > 0" "v_invar v" "v_len v = states" "l \<noteq> 0"
  shows "V_Map.map_to_fun (VI_code_aux v eps) = MDP.value_iteration eps (V_Map.map_to_bfun v)"
  using assms VI_code_aux_correct_aux by auto

lemma VI_code_aux_keys:
  assumes "eps > 0" "v_invar v" "v_len v = states" "l \<noteq> 0"
  shows "v_len (VI_code_aux v eps) = states"
  using assms VI_code_aux_correct_aux by auto

lemma VI_code_aux_invar:
  assumes "eps > 0" "v_invar v" "v_len v = states" "l \<noteq> 0"
  shows "v_invar (VI_code_aux v eps)"
  using assms VI_code_aux_correct_aux by auto

lemma VI_code_correct:
  assumes "eps > 0" "v_invar v" "v_len v = states"
  shows "V_Map.map_to_fun (VI_code v eps) = MDP.value_iteration eps (V_Map.map_to_bfun v)"
proof (cases "l = 0")
  case True
  then show ?thesis
    using assms invar_\<L>_code \<L>_code_correct'
    unfolding VI_code_def MDP.value_iteration.simps[of _ "V_Map.map_to_bfun v"]
    by (fastforce simp: map_to_bfun_eq_fun)
next
  case False
  then show ?thesis
    using assms
    by (auto simp add: VI_code_def VI_code_aux_correct)
qed

definition "VI_policy_code v eps = vi_find_policy_code (VI_code v eps)"

lemma VI_policy_code_correct:
  assumes "eps > 0" "v_invar v" "v_len v = states"
  shows "D_Map.map_to_fun (VI_policy_code v eps) = MDP.vi_policy' eps (V_Map.map_to_bfun v)"
proof -
  have "V_Map.map_to_bfun (VI_code v eps) = (MDP.value_iteration eps (V_Map.map_to_bfun v))"
    using  assms VI_code_correct
    by (auto simp:  VI_code_aux_invar map_to_bfun_eq_fun)
  moreover have "D_Map.map_to_fun (VI_policy_code v eps) = MDP.find_policy' (V_Map.map_to_bfun (VI_code v eps))"
    unfolding VI_code_def VI_policy_code_def
    using assms invar_\<L>_code keys_\<L>_code vi_find_policy_correct vi_find_policy_correct VI_code_aux_correct_aux assms by (cases "l = 0") auto
  ultimately show ?thesis
    unfolding MDP.vi_policy'_def
    by presburger
qed

end

context MDP_nat_disc
begin

lemma dist_opt_bound_\<L>\<^sub>b: "dist v \<nu>\<^sub>b_opt \<le> dist v (\<L>\<^sub>b v) / (1 - l)"
  using contraction_\<L>_dist
  by (simp add: mult.commute mult_imp_le_div_pos)

lemma cert_\<L>\<^sub>b:
  assumes "\<epsilon> \<ge> 0" "dist v (\<L>\<^sub>b v) / (1 - l) \<le> \<epsilon>"
  shows "dist v \<nu>\<^sub>b_opt \<le> \<epsilon>"
  using assms dist_opt_bound_\<L>\<^sub>b order_trans by auto

definition "check_value_\<L>\<^sub>b eps v \<longleftrightarrow> dist v (\<L>\<^sub>b v) / (1 - l) \<le> eps"

definition "vi_policy_bound_error v = (
  let v' = (\<L>\<^sub>b v); err = (2 * l) * dist v v' / (1 - l) in
  (err, find_policy' v'))"

lemma
  assumes "vi_policy_bound_error v = (err, d)"
  shows "dist (\<nu>\<^sub>b (mk_stationary_det d)) \<nu>\<^sub>b_opt \<le> err"
proof (cases "l = 0")
  case True
  hence "vi_policy_bound_error v = (0, find_policy' (\<L>\<^sub>b v))"
    unfolding vi_policy_bound_error_def by auto
  have "\<L>\<^sub>b v = \<L>\<^sub>b \<nu>\<^sub>b_opt"
    by (auto simp: \<L>\<^sub>b.rep_eq L_def simp del: \<L>\<^sub>b_opt intro!: bfun_eqI simp: \<L>_def) (simp add: True)
  hence "\<L>\<^sub>b v = \<nu>\<^sub>b_opt"
    by auto
  hence "\<nu>\<^sub>b (mk_stationary_det (find_policy' (\<L>\<^sub>b v))) = \<nu>\<^sub>b_opt"
    using L_\<nu>_fix \<nu>_improving_opt_acts conserving_imp_opt
    unfolding find_policy'_def \<nu>_conserving_def
    by auto
  then show ?thesis
    using assms unfolding vi_policy_bound_error_def
    by (auto simp: True)
next
  case False
  then show ?thesis
  proof (cases "\<L>\<^sub>b v = v")
    case True
  hence "\<nu>\<^sub>b (mk_stationary_det (find_policy' (\<L>\<^sub>b v))) = \<nu>\<^sub>b_opt"
    using L_\<nu>_fix \<nu>_improving_opt_acts conserving_imp_opt
    unfolding find_policy'_def \<nu>_conserving_def
    by auto
  then show ?thesis
    using assms unfolding vi_policy_bound_error_def
    by (auto simp: True)
  next
    case False
    hence 1: "dist v (\<L>\<^sub>b v) > 0"
      by fastforce
    hence "2 * l * dist v (\<L>\<^sub>b v) > 0"
      using \<open>l \<noteq> 0\<close> zero_le_disc by (simp add: less_le)
    hence "err > 0"
      using assms unfolding vi_policy_bound_error_def by auto
    hence "dist (\<nu>\<^sub>b (mk_stationary_det (find_policy' (\<L>\<^sub>b v)))) \<nu>\<^sub>b_opt < err'" if "err < err'" for err'
      using that assms
      unfolding vi_policy_bound_error_def
      by (auto simp:  pos_divide_less_eq[symmetric] intro: find_policy'_error_bound)
    then show ?thesis
      using assms unfolding vi_policy_bound_error_def Let_def
      by force
  qed
qed

end

context MDP_Code
begin
definition "vi_policy_bound_error_code v = (
  let v' = (\<L>_code v);
    d = if states = 0 then 0 else (MAX s \<in> {..< states}. dist (v_lookup v s) (v_lookup v' s));
   err = (2 * l) * d / (1 - l) in
  (err, vi_find_policy_code v'))"

lemma
  assumes "v_len v = states" "v_invar v"
  shows "D_Map.map_to_fun (snd (vi_policy_bound_error_code v)) = snd (MDP.vi_policy_bound_error (V_Map.map_to_bfun v))"
  using assms \<L>_code_correct' invar_\<L>_code vi_find_policy_correct
  by (auto simp: vi_policy_bound_error_code_def MDP.vi_policy_bound_error_def)

lemma MAX_cong:
  assumes "\<And>x. x \<in> X \<Longrightarrow> f x = g x"
  shows "(MAX x \<in> X. f x) = (MAX x \<in> X. g x)"
  using assms by auto

lemma
  assumes "v_len v = states" "v_invar v"
  shows "(fst (vi_policy_bound_error_code v)) = fst (MDP.vi_policy_bound_error (V_Map.map_to_bfun v))"
proof-
  have dist_zero_ge: "dist (apply_bfun (V_Map.map_to_bfun v) x) (apply_bfun (V_Map.map_to_bfun (\<L>_code v)) x) = 0" if "x \<ge> states" for x
    using assms that
    by (auto simp: V_Map.map_to_bfun.rep_eq)
  have univ: "UNIV = {0..<states} \<union> {states..}" by auto
  let ?d = "\<lambda>x. dist (apply_bfun (V_Map.map_to_bfun v) x) (apply_bfun (V_Map.map_to_bfun (\<L>_code v)) x)"

 have fin: "finite (range (\<lambda>x. ?d x))"
   by (auto simp: dist_zero_ge univ Set.image_Un Set.image_constant[of states])

  have r: "range (\<lambda>x. ?d x) = ?d ` {..<states} \<union> ?d ` {states..}"
    by force
  hence "Sup (range ?d) = Max (range ?d)"
    using fin cSup_eq_Max by blast
  also have "\<dots> = (if states = 0 then (Max (?d ` {states..})) else max (Max (?d ` {..<states})) (Max (?d ` {states..})))"
    using r fin by (auto intro: Max_Un)
  also have "\<dots> = (if states = 0 then 0 else max (Max (?d ` {..<states})) 0)"
    using dist_zero_ge
    by (auto simp: Set.image_constant[of states] cSup_eq_Max[symmetric, of "(\<lambda>_. 0) ` {states..}"])
  also have "\<dots> = (if states = 0 then 0 else (Max (?d ` {..<states})))"
    by (auto intro!: max_absorb1 max_geI)
  finally have 1: "Sup (range ?d) = (if states = 0 then 0 else (Max (?d ` {..<states})))".
  thus ?thesis
    unfolding  MDP.vi_policy_bound_error_def vi_policy_bound_error_code_def dist_bfun_def
    using assms v_lookup_map_to_bfun \<L>_code_correct' \<L>_code_correct
    by fastforce
qed

end

global_interpretation VI_Code:
  MDP_Code
  (* state map (transition system) *)
  "IArray.sub" "\<lambda>n x arr. IArray ((IArray.list_of arr)[n:= x])" "IArray.length" "IArray" "IArray.list_of" "\<lambda>_. True"

  (* action map *)
  RBT_Set.empty RBT_Map.update RBT_Map.delete Lookup2.lookup Tree2.inorder rbt

  "MDP.transitions (Rep_Valid_MDP mdp)" "MDP.states (Rep_Valid_MDP mdp)"

  (* value map *)
  starray_get "\<lambda>i x arr. starray_set arr i x" starray_length starray_of_list "\<lambda>arr. starray_foldr (\<lambda>x xs. x # xs) arr []" "\<lambda>_. True"

  (* decision rule map *)
  RBT_Set.empty RBT_Map.update RBT_Map.delete Lookup2.lookup Tree2.inorder rbt

  "MDP.disc (Rep_Valid_MDP mdp)"

  for mdp
  defines VI_code = VI_Code.VI_code
    and vi_policy_bound_error_code = VI_Code.vi_policy_bound_error_code
    and VI_code_aux = VI_Code.VI_code_aux
    and L\<^sub>a_code = VI_Code.L\<^sub>a_code
    and a_lookup' = VI_Code.a_lookup'
    and d_lookup' = VI_Code.d_lookup'
    and find_policy_state_code_aux' = VI_Code.find_policy_state_code_aux'
    and find_policy_state_code_aux = VI_Code.find_policy_state_code_aux
    and check_dist = VI_Code.check_dist
    and \<L>_code = VI_Code.\<L>_code
    and VI_policy_code = VI_Code.VI_policy_code
    and \<L>_GS_code = VI_Code.\<L>_GS_code
    and v0 = VI_Code.v0
    and entries = M.entries
    and from_list' = M.from_list'
    and from_list = M.from_list
    and vi_find_policy_code = VI_Code.vi_find_policy_code
    and v_map_from_list = VI_Code.v_map_from_list
    and arr_tabulate = starray_Array.arr_tabulate
  using Rep_Valid_MDP
  by unfold_locales
   (fastforce simp: Ball_set_list_all[symmetric] case_prod_beta pmf_of_list_wf_def is_MDP_def RBT_Set.empty_def M.invar_def empty_def M.entries_def M.is_empty_def length_0_conv[symmetric])+

lemmas arr_tabulate_def[unfolded starray_Array.arr_tabulate_def, code]
lemmas entries_def[unfolded M.entries_def, code]
lemmas from_list'_def[unfolded M.from_list'_def, code]
lemmas from_list_def[unfolded M.from_list_def, code]

function tabulate where
"tabulate f acc upper n = (
  if n < upper then tabulate f (update n (f n) acc) upper (Suc n) else acc)"
  by auto
termination
  by (relation "Wellfounded.measure (\<lambda>(_, _, i,N). i - N)") auto

lemma tabulate_Suc: "j \<le> n' \<Longrightarrow> update n' (f n') (tabulate f m n' j) = tabulate f m (Suc n') j"
proof (induction "n' - j" arbitrary: m n' j)
  case 0
  then show ?case by auto
next
  case (Suc j)
  then show ?case
    by auto
qed

lemma from_list'_upt [code_unfold]: "from_list' f [0..<n] = tabulate f empty n 0"
proof -
  have "j \<le> n \<Longrightarrow> foldl (\<lambda>acc s. update s (f s) acc) m [j..<n] = tabulate f m n j" for m j
  proof (induction "n - j" arbitrary: m n j)
    case 0
    then show ?case by auto
  next
    case (Suc x)
    then obtain n' where n': "n = Suc n'"
      using diff_le_self Suc_le_D by metis
    then show ?case
      using Suc
      by (auto simp del: tabulate.simps simp: n' tabulate_Suc)
  qed
  thus ?thesis
  unfolding from_list'_def M.from_list'_def
  by auto
qed

end


(*
    File:        KennedyProblem2.thy
    Version:     0.0.2
    Time-stamp:  <2020-06-22T11:04:37Z>
    Author:      JRF
    Logic Image: HOL (of Isabelle2020)

    License:

    Public Domain (because these programs are as small as
    mathematical formulae).

    You can freely modify and re-publish them.
*)

theory KennedyProblem2
  imports Main
begin

typedecl env

consts Paradise :: "bool"

datatype angel = Churchill | Hitler | Stalin

definition churchill :: "bool => bool" where
"churchill x == x"

definition hitler :: "bool => bool" where
"hitler x == ~x"

consts stalin :: "env => bool"

fun apply_angel :: "angel => env => bool => bool" where
"apply_angel Churchill e x = churchill x" |
"apply_angel Hitler e x = hitler x" |
"apply_angel Stalin e x = stalin e"

definition kennedy_problem ::
  "((bool => bool) => angel => angel => angel => bool) =>
   (bool => nat) =>
   ((bool => bool) => angel => angel => angel => bool) =>
   bool"
  where
"kennedy_problem Q1 C Q2 ==
ALL a::angel. ALL b::angel. ALL c::angel.
  a ~= b & b ~= c & c ~= a
-->
(ALL p1::bool. ALL y::angel.
  ALL e1::env. ALL e2::env. ALL e3::env. ALL e4::env.
  apply_angel a e1 (Q1 (apply_angel a e2) a b c) = p1
  & y = nth [a, b, c] (C p1)
  -->
  apply_angel y e3 (Q2 (apply_angel y e4) a b c) = Paradise)"

lemma kennedy_answer:
  shows "kennedy_problem (%f a b c. f (b = Stalin))
           (%p. if p then 2 else 1) (% f a b c. f Paradise)"
  apply (unfold kennedy_problem_def)
  apply (intro allI)
  apply (case_tac [!] a)
  apply (case_tac [!] b)
  apply (case_tac [!] c)
  apply (simp_all add: churchill_def hitler_def)
  done

end


section \<open>FIN is a proper subset of CP\label{s:fin_cp}\<close>

theory CP_FIN_NUM
  imports Inductive_Inference_Basics
begin

text \<open>Let $S$ be a FIN strategy for a non-empty class $U$. Let $T$ be a
strategy that hypothesizes an arbitrary function from $U$ while $S$ outputs
``don't know'' and the hypothesis of $S$ otherwise. Then $T$ is a CP strategy
for $U$.\<close>

lemma nonempty_FIN_wrt_impl_CP:
  assumes "U \<noteq> {}" and "U \<in> FIN_wrt \<psi>"
  shows "U \<in> CP_wrt \<psi>"
proof -
  obtain s where "learn_fin \<psi> U s"
    using assms(2) FIN_wrt_def  by auto
  then have env: "environment \<psi> U s" and
    fin: "\<And>f. f \<in> U \<Longrightarrow>
      \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i)"
    using learn_finE by auto
  from assms(1) obtain f\<^sub>0 where "f\<^sub>0 \<in> U"
    by auto
  with fin obtain i\<^sub>0 where "\<psi> i\<^sub>0 = f\<^sub>0"
    by blast
  define t where "t x \<equiv>
    (if s x \<up> then None else if s x \<down>= 0 then Some i\<^sub>0 else Some (the (s x) - 1))"
    for x
  have "t \<in> \<P>"
  proof -
    from env obtain rs where rs: "recfn 1 rs" "\<And>x. eval rs [x] = s x"
      by auto
    define rt where "rt = Cn 1 r_ifz [rs, r_const i\<^sub>0, Cn 1 r_dec [rs]]"
    then have "recfn 1 rt"
      using rs(1) by simp
    then have "eval rt [x] \<down>= (if s x \<down>= 0 then i\<^sub>0 else (the (s x)) - 1)" if "s x \<down>" for x
      using rs rt_def that by auto
    moreover have "eval rt [x] \<up>" if "eval rs [x] \<up>" for x
      using rs rt_def that by simp
    ultimately have "eval rt [x] = t x" for x
      using rs(2) t_def by simp
    with \<open>recfn 1 rt\<close> show ?thesis by auto
  qed
  have "learn_cp \<psi> U t"
  proof (rule learn_cpI)
    show "environment \<psi> U t"
      using env t_def \<open>t \<in> \<P>\<close> by simp
    show "\<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. t (f \<triangleright> n) \<down>= i)" if "f \<in> U" for f
    proof -
      from that fin obtain i n\<^sub>0 where
        i: "\<psi> i = f" "\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0" "\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i"
        by blast
      moreover have "\<forall>n\<ge>n\<^sub>0. t (f \<triangleright> n) \<down>= i"
        using that t_def i(3) by simp
      ultimately show ?thesis by auto
    qed
    show "\<psi> (the (t (f \<triangleright> n))) \<in> U" if "f \<in> U" for f n
      using \<open>\<psi> i\<^sub>0 = f\<^sub>0\<close> \<open>f\<^sub>0 \<in> U\<close> t_def fin env that
      by (metis (no_types, lifting) diff_Suc_1 not_less option.sel)
  qed
  then show ?thesis using CP_wrt_def env by auto
qed

lemma FIN_wrt_impl_CP:
  assumes "U \<in> FIN_wrt \<psi>"
  shows "U \<in> CP_wrt \<psi>"
proof (cases "U = {}")
  case True
  then have "\<psi> \<in> \<P>\<^sup>2 \<Longrightarrow> U \<in> CP_wrt \<psi>"
    using CP_wrt_def learn_cpI[of \<psi> "{}" "\<lambda>x. Some 0"] const_in_Prim1 by auto
  moreover have "\<psi> \<in> \<P>\<^sup>2"
    using assms FIN_wrt_def learn_finE by auto
  ultimately show "U \<in> CP_wrt \<psi>" by simp
next
  case False
  with nonempty_FIN_wrt_impl_CP assms show ?thesis
    by simp
qed

corollary FIN_subseteq_CP: "FIN \<subseteq> CP"
proof
  fix U
  assume "U \<in> FIN"
  then have "\<exists>\<psi>. U \<in> FIN_wrt \<psi>"
    using FIN_def FIN_wrt_def by auto
  then have "\<exists>\<psi>. U \<in> CP_wrt \<psi>"
    using FIN_wrt_impl_CP by auto
  then show "U \<in> CP"
    by (simp add: CP_def CP_wrt_def)
qed

text \<open>In order to show the \emph{proper} inclusion, we show @{term
"U\<^sub>0 \<in> CP - FIN"}. A CP strategy for @{term "U\<^sub>0"} simply
hypothesizes the function in @{term U0} with the longest prefix of $f^n$ not
ending in zero. For that we define a function computing the index of the
rightmost non-zero value in a list, returning the length of the list if there
is no such value.\<close>

definition findr :: partial1 where
  "findr e \<equiv>
    if \<exists>i<e_length e. e_nth e i \<noteq> 0
    then Some (GREATEST i. i < e_length e \<and> e_nth e i \<noteq> 0)
    else Some (e_length e)"

lemma findr_total: "findr e \<down>"
  unfolding findr_def by simp

lemma findr_ex:
  assumes "\<exists>i<e_length e. e_nth e i \<noteq> 0"
  shows "the (findr e) < e_length e"
    and "e_nth e (the (findr e)) \<noteq> 0"
    and "\<forall>i. the (findr e) < i \<and> i < e_length e \<longrightarrow> e_nth e i = 0"
proof -
  let ?P = "\<lambda>i. i < e_length e \<and> e_nth e i \<noteq> 0"
  from assms have "\<exists>i. ?P i" by simp
  then have "?P (Greatest ?P)"
    using GreatestI_ex_nat[of ?P "e_length e"] by fastforce
  moreover have *: "findr e = Some (Greatest ?P)"
    using assms findr_def by simp
  ultimately show "the (findr e) < e_length e" and "e_nth e (the (findr e)) \<noteq> 0"
    by fastforce+
  show "\<forall>i. the (findr e) < i \<and> i < e_length e \<longrightarrow> e_nth e i = 0"
    using * Greatest_le_nat[of ?P _ "e_length e"] by fastforce
qed

definition "r_findr \<equiv>
  let g =
    Cn 3 r_ifz
     [Cn 3 r_nth [Id 3 2, Id 3 0],
      Cn 3 r_ifeq [Id 3 0, Id 3 1, Cn 3 S [Id 3 0], Id 3 1],
      Id 3 0]
  in Cn 1 (Pr 1 Z g) [Cn 1 r_length [Id 1 0], Id 1 0]"

lemma r_findr_prim [simp]: "prim_recfn 1 r_findr"
  unfolding r_findr_def by simp

lemma r_findr [simp]: "eval r_findr [e] = findr e"
proof -
  define g where "g =
    Cn 3 r_ifz
     [Cn 3 r_nth [Id 3 2, Id 3 0],
      Cn 3 r_ifeq [Id 3 0, Id 3 1, Cn 3 S [Id 3 0], Id 3 1],
      Id 3 0]"
  then have "recfn 3 g"
    by simp
  with g_def have g: "eval g [j, r, e] \<down>=
      (if e_nth e j \<noteq> 0 then j else if j = r then Suc j else r)" for j r e
    by simp
  let ?h = "Pr 1 Z g"
  have "recfn 2 ?h"
    by (simp add: \<open>recfn 3 g\<close>)
  let ?P = "\<lambda>e j i. i < j \<and> e_nth e i \<noteq> 0"
  let ?G = "\<lambda>e j. Greatest (?P e j)"
  have h: "eval ?h [j, e] =
    (if \<forall>i<j. e_nth e i = 0 then Some j else Some (?G e j))" for j e
  proof (induction j)
    case 0
    then show ?case using \<open>recfn 2 ?h\<close> by auto
  next
    case (Suc j)
    then have "eval ?h [Suc j, e] = eval g [j, the (eval ?h [j, e]), e]"
      using \<open>recfn 2 ?h\<close> by auto
    then have "eval ?h [Suc j, e] =
        eval g [j, if \<forall>i<j. e_nth e i = 0 then j else ?G e j, e]"
      using Suc by auto
    then have *: "eval ?h [Suc j, e] \<down>=
      (if e_nth e j \<noteq> 0 then j
       else if j = (if \<forall>i<j. e_nth e i = 0 then j else ?G e j)
            then Suc j
            else (if \<forall>i<j. e_nth e i = 0 then j else ?G e j))"
      using g by simp
    show ?case
    proof (cases "\<forall>i<Suc j. e_nth e i = 0")
      case True
      then show ?thesis using * by simp
    next
      case False
      then have ex: "\<exists>i<Suc j. e_nth e i \<noteq> 0"
        by auto
      show ?thesis
      proof (cases "e_nth e j = 0")
        case True
        then have ex': "\<exists>i<j. e_nth e i \<noteq> 0"
          using ex less_Suc_eq by fastforce
        then have "(if \<forall>i<j. e_nth e i = 0 then j else ?G e j) = ?G e j"
          by metis
        moreover have "?G e j < j"
          using ex' GreatestI_nat[of "?P e j"] less_imp_le_nat by blast
        ultimately have "eval ?h [Suc j, e] \<down>= ?G e j"
          using * True by simp
        moreover have "?G e j = ?G e (Suc j)"
          using True by (metis less_SucI less_Suc_eq)
        ultimately show ?thesis using ex by metis
      next
        case False
        then have "eval ?h [Suc j, e] \<down>= j"
          using * by simp
        moreover have "?G e (Suc j) = j"
          using ex False Greatest_equality[of "?P e (Suc j)"] by simp
        ultimately show ?thesis using ex by simp
      qed
    qed
  qed
  let ?hh = "Cn 1 ?h [Cn 1 r_length [Id 1 0], Id 1 0]"
  have "recfn 1 ?hh"
    using \<open>recfn 2 ?h\<close> by simp
  with h have hh: "eval ?hh [e] \<down>=
      (if \<forall>i<e_length e. e_nth e i = 0 then e_length e else ?G e (e_length e))" for e
    by auto
  then have "eval ?hh [e] = findr e" for e
    unfolding findr_def by auto
  moreover have "total ?hh"
    using hh totalI1 \<open>recfn 1 ?hh\<close> by simp
  ultimately show ?thesis
    using \<open>recfn 1 ?hh\<close> g_def r_findr_def findr_def by metis
qed

lemma U0_in_CP: "U\<^sub>0 \<in> CP"
proof -
  define s where
    "s \<equiv> \<lambda>x. if findr x \<down>= e_length x then Some 0 else Some (e_take (Suc (the (findr x))) x)"
  have "s \<in> \<P>"
  proof -
    define r where
      "r \<equiv> Cn 1 r_ifeq [r_findr, r_length, Z, Cn 1 r_take [Cn 1 S [r_findr], Id 1 0]]"
    then have "\<And>x. eval r [x] = s x"
      using s_def findr_total by fastforce
    moreover have "recfn 1 r"
      using r_def by simp
    ultimately show ?thesis by auto
  qed
  moreover have "learn_cp prenum U\<^sub>0 s"
  proof (rule learn_cpI)
    show "environment prenum U\<^sub>0 s"
      using \<open>s \<in> \<P>\<close> s_def prenum_in_R2 U0_in_NUM by auto
    show "\<exists>i. prenum i = f \<and> (\<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i)" if "f \<in> U\<^sub>0" for f
    proof (cases "f = (\<lambda>_. Some 0)")
      case True
      then have "s (f \<triangleright> n) \<down>= 0" for n
        using findr_def s_def by simp
      then have "\<forall>n\<ge>0. s (f \<triangleright> n) \<down>= 0" by simp
      moreover have "prenum 0 = f"
        using True by auto
      ultimately show ?thesis by auto
    next
      case False
      then obtain ws where ws: "length ws > 0" "last ws \<noteq> 0" "f = ws \<odot> 0\<^sup>\<infinity>"
        using U0_def \<open>f \<in> U\<^sub>0\<close> almost0_canonical by blast
      let ?m = "length ws - 1"
      let ?i = "list_encode ws"
      have "prenum ?i = f"
        using ws by auto
      moreover have "s (f \<triangleright> n) \<down>= ?i" if "n \<ge> ?m" for n
      proof -
        have "e_nth (f \<triangleright> n) ?m \<noteq> 0"
          using ws that by (simp add: last_conv_nth)
        then have "\<exists>k<Suc n. e_nth (f \<triangleright> n) k \<noteq> 0"
          using le_imp_less_Suc that by blast
        moreover have
          "(GREATEST k. k < e_length (f \<triangleright> n) \<and> e_nth (f \<triangleright> n) k \<noteq> 0) = ?m"
        proof (rule Greatest_equality)
          show "?m < e_length (f \<triangleright> n) \<and> e_nth (f \<triangleright> n) ?m \<noteq> 0"
            using \<open>e_nth (f \<triangleright> n) ?m \<noteq> 0\<close> that by auto
          show "\<And>y. y < e_length (f \<triangleright> n) \<and> e_nth (f \<triangleright> n) y \<noteq> 0 \<Longrightarrow> y \<le> ?m"
            using ws less_Suc_eq_le by fastforce
        qed
        ultimately have "findr (f \<triangleright> n) \<down>= ?m"
          using that findr_def by simp
        moreover have "?m < e_length (f \<triangleright> n)"
          using that by simp
        ultimately have "s (f \<triangleright> n) \<down>= e_take (Suc ?m) (f \<triangleright> n)"
          using s_def by simp
        moreover have "e_take (Suc ?m) (f \<triangleright> n) = list_encode ws"
        proof -
          have "take (Suc ?m) (prefix f n) = prefix f ?m"
            using take_prefix[of f ?m n] ws that by (simp add: almost0_in_R1)
          then have "take (Suc ?m) (prefix f n) = ws"
            using ws prefixI by auto
          then show ?thesis by simp
        qed
        ultimately show ?thesis by simp
      qed
      ultimately show ?thesis by auto
    qed
    show "\<And>f n. f \<in> U\<^sub>0 \<Longrightarrow> prenum (the (s (f \<triangleright> n))) \<in> U\<^sub>0"
      using U0_def by fastforce
  qed
  ultimately show ?thesis using CP_def by blast
qed

text \<open>As a bit of an interlude, we can now show that CP is not
closed under the subset relation. This works by removing functions from
@{term "U\<^sub>0"} in a ``noncomputable'' way such that a strategy cannot ensure
that every intermediate hypothesis is in that new class.\<close>

lemma CP_not_closed_subseteq: "\<exists>V U. V \<subseteq> U \<and> U \<in> CP \<and> V \<notin> CP"
proof -
  \<comment> \<open>The numbering $g\in\mathcal{R}^2$ enumerates all
  functions $i0^\infty \in U_0$.\<close>
  define g where "g \<equiv> \<lambda>i. [i] \<odot>  0\<^sup>\<infinity>"
  have g_inj: "i = j" if "g i = g j" for i j
  proof -
    have "g i 0 \<down>= i" and "g j 0 \<down>= j"
      by (simp_all add: g_def)
    with that show "i = j"
      by (metis option.inject)
  qed

  \<comment> \<open>Define a class $V$. If the strategy $\varphi_i$ learns
  $g_i$, it outputs a hypothesis for $g_i$ on some shortest prefix $g_i^m$.
  Then the function $g_i^m10^\infty$ is included in the class $V$; otherwise
  $g_i$ is included.\<close>
  define V where "V \<equiv>
    {if learn_lim \<phi> {g i} (\<phi> i)
     then (prefix (g i) (LEAST n. \<phi> (the (\<phi> i ((g i) \<triangleright> n))) = g i)) @ [1] \<odot> 0\<^sup>\<infinity>
     else g i |
     i. i \<in> UNIV}"
  have "V \<notin> CP_wrt \<phi>"
  proof
    \<comment> \<open>Assuming $V \in CP_\varphi$, there is a CP strategy
    $\varphi_i$ for $V$.\<close>
    assume "V \<in> CP_wrt \<phi>"
    then obtain s where s: "s \<in> \<P>" "learn_cp \<phi> V s"
      using CP_wrt_def learn_cpE(1) by auto
    then obtain i where i: "\<phi> i = s"
      using phi_universal by auto

    show False
    proof (cases "learn_lim \<phi> {g i} (\<phi> i)")
      case learn: True
      \<comment> \<open>If $\varphi_i$ learns $g_i$, it hypothesizes $g_i$ on
      some shortest prefix $g_i^m$. Thus it hypothesizes $g_i$ on some prefix
      of $g_i^m10^\infty \in V$, too. But $g_i$ is not a class-preserving
      hypothesis because $g_i \notin V$.\<close>
      let ?P = "\<lambda>n. \<phi> (the (\<phi> i ((g i) \<triangleright>  n))) = g i"
      let ?m = "Least ?P"
      have "\<exists>n. ?P n"
        using i s by (meson learn infinite_hyp_wrong_not_Lim insertI1 lessI)
      then have "?P ?m"
        using LeastI_ex[of ?P] by simp
      define h where "h = (prefix (g i) ?m) @ [1] \<odot> 0\<^sup>\<infinity>"
      then have "h \<in> V"
        using V_def learn by auto
      have "(g i) \<triangleright>  ?m = h \<triangleright>  ?m"
      proof -
        have "prefix (g i) ?m = prefix h ?m"
          unfolding h_def by (simp add: prefix_prepend_less)
        then show ?thesis by auto
      qed
      then have "\<phi> (the (\<phi> i (h \<triangleright>  ?m))) = g i"
        using \<open>?P ?m\<close> by simp
      moreover have "g i \<notin> V"
      proof
        assume "g i \<in> V"
        then obtain j where j: "g i =
          (if learn_lim \<phi> {g j} (\<phi> j)
           then (prefix (g j) (LEAST n. \<phi> (the (\<phi> j ((g j) \<triangleright>  n))) = g j)) @ [1] \<odot> 0\<^sup>\<infinity>
           else g j)"
          using V_def by auto
        show False
        proof (cases "learn_lim \<phi> {g j} (\<phi> j)")
          case True
          then have "g i =
              (prefix (g j) (LEAST n. \<phi> (the (\<phi> j ((g j) \<triangleright>  n))) = g j)) @ [1] \<odot> 0\<^sup>\<infinity>"
              (is "g i = ?vs @ [1] \<odot> 0\<^sup>\<infinity>")
            using j by simp
          moreover have len: "length ?vs > 0" by simp
          ultimately have "g i (length ?vs) \<down>= 1"
            by (simp add: prepend_associative)
          moreover have "g i (length ?vs) \<down>= 0"
            using g_def len by simp
          ultimately show ?thesis by simp
        next
          case False
          then show ?thesis
            using j g_inj learn by auto
        qed
      qed
      ultimately have "\<phi> (the (\<phi> i (h \<triangleright>  ?m))) \<notin> V" by simp
      then have "\<not> learn_cp \<phi> V (\<phi> i)"
        using \<open>h \<in> V\<close> learn_cpE(3) by auto
      then show ?thesis by (simp add: i s(2))
    next
      \<comment> \<open>If $\varphi_i$ does not learn $g_i$, then $g_i\in V$.
      Hence $\varphi_i$ does not learn $V$.\<close>
      case False
      then have "g i \<in> V"
        using V_def by auto
      with False have "\<not> learn_lim \<phi> V (\<phi> i)"
        using learn_lim_closed_subseteq by auto
      then show ?thesis
        using s(2) i by (simp add: learn_cp_def)
    qed
  qed
  then have "V \<notin> CP"
    using CP_wrt_phi by simp
  moreover have "V \<subseteq> U\<^sub>0"
    using V_def g_def U0_def by auto
  ultimately show ?thesis using U0_in_CP by auto
qed

text \<open>Continuing with the main result of this section, we show that
@{term "U\<^sub>0"} cannot be learned finitely. Any FIN strategy would have
to output a hypothesis for the constant zero function on some prefix. But
@{term "U\<^sub>0"} contains infinitely many other functions starting with
the same prefix, which the strategy then would not learn finitely.\<close>

lemma U0_not_in_FIN: "U\<^sub>0 \<notin> FIN"
proof
  assume "U\<^sub>0 \<in> FIN"
  then obtain \<psi> s where "learn_fin \<psi> U\<^sub>0 s"
    using FIN_def by blast
  with learn_finE have cp: "\<And>f. f \<in> U\<^sub>0 \<Longrightarrow>
      \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i)"
    by simp_all

  define z where "z = [] \<odot> 0\<^sup>\<infinity>"
  then have "z \<in> U\<^sub>0"
    using U0_def by auto
  with cp obtain i n\<^sub>0 where i: "\<psi> i = z" and n0: "\<forall>n\<ge>n\<^sub>0. s (z \<triangleright> n) \<down>= Suc i"
    by blast

  define w where "w = replicate (Suc n\<^sub>0) 0 @ [1] \<odot> 0\<^sup>\<infinity>"
  then have "prefix w n\<^sub>0 = replicate (Suc n\<^sub>0) 0"
    by (simp add: prefix_prepend_less)
  moreover have "prefix z n\<^sub>0 = replicate (Suc n\<^sub>0) 0"
    using prefixI[of "replicate (Suc n\<^sub>0) 0" z] less_Suc_eq_0_disj unfolding z_def
    by fastforce
  ultimately have "z \<triangleright>  n\<^sub>0 = w \<triangleright> n\<^sub>0"
    by (simp add: init_prefixE)
  with n0 have *: "s (w \<triangleright> n\<^sub>0) \<down>= Suc i" by auto

  have "w \<in> U\<^sub>0" using w_def U0_def by auto
  with cp obtain i' n\<^sub>0' where i': "\<psi> i' = w"
    and n0': "\<forall>n<n\<^sub>0'. s (w \<triangleright> n) \<down>= 0" "\<forall>n\<ge>n\<^sub>0'. s (w \<triangleright> n) \<down>= Suc i'"
    by blast

  have "i \<noteq> i'"
  proof
    assume "i = i'"
    then have "w = z"
      using i i' by simp
    have "w (Suc n\<^sub>0) \<down>= 1"
      using w_def prepend[of "replicate (Suc n\<^sub>0) 0 @ [1]" "0\<^sup>\<infinity>" "Suc n\<^sub>0"]
      by (metis length_append_singleton length_replicate lessI nth_append_length)
    moreover have "z (Suc n\<^sub>0) \<down>= 0"
      using z_def by simp
    ultimately show False
      using \<open>w = z\<close> by simp
  qed
  then have "s (w \<triangleright> n\<^sub>0) \<down>\<noteq> Suc i"
    using n0' by (cases "n\<^sub>0 < n\<^sub>0'") simp_all
  with * show False by simp
qed

theorem FIN_subset_CP: "FIN \<subset> CP"
  using U0_in_CP U0_not_in_FIN FIN_subseteq_CP by auto

section \<open>NUM and FIN are incomparable\label{s:num_fin}\<close>

text \<open>The class $V_0$ of all total recursive functions $f$ where $f(0)$
is a Gödel number of $f$ can be learned finitely by always hypothesizing
$f(0)$. The class is not in NUM and therefore serves to separate NUM and
FIN.\<close>

definition V0 :: "partial1 set" ("V\<^sub>0") where
  "V\<^sub>0 = {f. f \<in> \<R> \<and> \<phi> (the (f 0)) = f}"

lemma V0_altdef: "V\<^sub>0 = {[i] \<odot> f| i f. f \<in> \<R> \<and> \<phi> i = [i] \<odot> f}"
  (is "V\<^sub>0 = ?W")
proof
  show "V\<^sub>0 \<subseteq> ?W"
  proof
    fix f
    assume "f \<in> V\<^sub>0"
    then have "f \<in> \<R>"
      unfolding V0_def by simp
    then obtain i where i: "f 0 \<down>= i" by fastforce
    define g where "g = (\<lambda>x. f (x + 1))"
    then have "g \<in> \<R>"
      using skip_R1[OF \<open>f \<in> \<R>\<close>] by blast
    moreover have "[i] \<odot> g = f"
      using g_def i by auto
    moreover have "\<phi> i = f"
      using \<open>f \<in> V\<^sub>0\<close> V0_def i by force
    ultimately show "f \<in> ?W" by auto
  qed
  show "?W \<subseteq> V\<^sub>0"
  proof
    fix g
    assume "g \<in> ?W"
    then have "\<phi> (the (g 0)) = g" by auto
    moreover have "g \<in> \<R>"
      using prepend_in_R1 \<open>g \<in> ?W\<close> by auto
    ultimately show "g \<in> V\<^sub>0"
      by (simp add: V0_def)
  qed
qed

lemma V0_in_FIN: "V\<^sub>0 \<in> FIN"
proof -
  define s where "s = (\<lambda>x. Some (Suc (e_hd x)))"
  have "s \<in> \<P>"
  proof -
    define r where "r = Cn 1 S [r_hd]"
    then have "recfn 1 r" by simp
    moreover have "eval r [x] \<down>= Suc (e_hd x)" for x
      unfolding r_def by simp
    ultimately show ?thesis
      using s_def by blast
  qed
  have s: "s (f \<triangleright> n) \<down>= Suc (the (f 0))" for f n
    unfolding s_def by simp
  have "learn_fin \<phi> V\<^sub>0 s"
  proof (rule learn_finI)
    show "environment \<phi> V\<^sub>0 s"
      using s_def \<open>s \<in> \<P>\<close> phi_in_P2 V0_def by auto
    show "\<exists>i n\<^sub>0. \<phi> i = f \<and> (\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i)"
        if "f \<in> V\<^sub>0" for f
      using that V0_def s by auto
  qed
  then show ?thesis using FIN_def by auto
qed

text \<open>To every @{term "f \<in> \<R>"} a number can be prepended that is
a Gödel number of the resulting function. Such a function is then in $V_0$.

If $V_0$ was in NUM, it would be embedded in a total numbering. Shifting this
numbering to the left, essentially discarding the values at point $0$, would
yield a total numbering for @{term "\<R>"}, which contradicts @{thm[source]
R1_not_in_NUM}. This proves @{prop "V\<^sub>0 \<notin> NUM"}.\<close>

lemma prepend_goedel:
  assumes "f \<in> \<R>"
  shows "\<exists>i. \<phi> i = [i] \<odot> f"
proof -
  obtain r where r: "recfn 1 r" "total r" "\<And>x. eval r [x] = f x"
    using assms by auto
  define r_psi where "r_psi = Cn 2 r_ifz [Id 2 1, Id 2 0, Cn 2 r [Cn 2 r_dec [Id 2 1]]]"
  then have "recfn 2 r_psi"
    using r(1) by simp
  have "eval r_psi [i, x] = (if x = 0 then Some i else f (x - 1))" for i x
  proof -
    have "eval (Cn 2 r [Cn 2 r_dec [Id 2 1]]) [i, x] = f (x - 1)"
      using r by simp
    then have "eval r_psi [i, x] = eval r_ifz [x, i, the (f (x - 1))]"
      unfolding r_psi_def using \<open>recfn 2 r_psi\<close> r R1_imp_total1[OF assms] by auto
    then show ?thesis
      using assms by simp
  qed
  with \<open>recfn 2 r_psi\<close> have "(\<lambda>i x. if x = 0 then Some i else f (x - 1)) \<in> \<P>\<^sup>2"
    by auto
  with kleene_fixed_point obtain i where
    "\<phi> i = (\<lambda>x. if x = 0 then Some i else f (x - 1))"
    by blast
  then have "\<phi> i = [i] \<odot> f" by auto
  then show ?thesis by auto
qed

lemma V0_in_FIN_minus_NUM: "V\<^sub>0 \<in> FIN - NUM"
proof -
  have "V\<^sub>0 \<notin> NUM"
  proof
    assume "V\<^sub>0 \<in> NUM"
    then obtain \<psi> where \<psi>: "\<psi> \<in> \<R>\<^sup>2" "\<And>f. f \<in> V\<^sub>0 \<Longrightarrow> \<exists>i. \<psi> i = f"
      by auto
    define \<psi>' where "\<psi>' i x = \<psi> i (Suc x)" for i x
    have "\<psi>' \<in> \<R>\<^sup>2"
    proof
      from \<psi>(1) obtain r_psi where
        r_psi: "recfn 2 r_psi" "total r_psi" "\<And>i x. eval r_psi [i, x] = \<psi> i x"
        by blast
      define r_psi' where "r_psi' = Cn 2 r_psi [Id 2 0, Cn 2 S [Id 2 1]]"
      then have "recfn 2 r_psi'" and "\<And>i x. eval r_psi' [i, x] = \<psi>' i x"
        unfolding r_psi'_def \<psi>'_def using r_psi by simp_all
      then show "\<psi>' \<in> \<P>\<^sup>2" by blast
      show "total2 \<psi>'"
        using \<psi>'_def \<psi>(1) by (simp add: total2I)
    qed
    have "\<exists>i. \<psi>' i = f" if "f \<in> \<R>" for f
    proof -
      from that obtain j where j: "\<phi> j = [j] \<odot> f"
        using prepend_goedel by auto
      then have "\<phi> j \<in> V\<^sub>0"
        using that V0_altdef by auto
      with \<psi> obtain i where "\<psi> i = \<phi> j" by auto
      then have "\<psi>' i = f"
        using \<psi>'_def j by (auto simp add: prepend_at_ge)
      then show ?thesis by auto
    qed
    with \<open>\<psi>' \<in> \<R>\<^sup>2\<close> have "\<R> \<in> NUM" by auto
    with R1_not_in_NUM show False by simp
  qed
  then show ?thesis
    using V0_in_FIN by auto
qed

corollary FIN_not_subseteq_NUM: "\<not> FIN \<subseteq> NUM"
  using V0_in_FIN_minus_NUM by auto

section \<open>NUM and CP are incomparable\label{s:num_cp}\<close>

text \<open>There are FIN classes outside of NUM, and CP encompasses FIN.
Hence there are CP classes outside of NUM, too.\<close>

theorem CP_not_subseteq_NUM: "\<not> CP \<subseteq> NUM"
  using FIN_subseteq_CP FIN_not_subseteq_NUM by blast

text \<open>Conversely there is a subclass of @{term "U\<^sub>0"} that
is in NUM but cannot be learned in a class-preserving way. The following
proof is due to Jantke and Beick~\<^cite>\<open>"jb-cpnii-81"\<close>. The idea is to
diagonalize against all strategies, that is, all partial recursive
functions.\<close>

theorem NUM_not_subseteq_CP: "\<not> NUM \<subseteq> CP"
proof-
  \<comment> \<open>Define a family of functions $f_k$.\<close>
  define f where "f \<equiv> \<lambda>k. [k] \<odot> 0\<^sup>\<infinity>"
  then have "f k \<in> \<R>" for k
    using almost0_in_R1 by auto

  \<comment> \<open>If the strategy $\varphi_k$ learns $f_k$ it hypothesizes
  $f_k$ for some shortest prefix $f_k^{a_k}$. Define functions $f'_k =
  k0^{a_k}10^\infty$.\<close>
  define a where
    "a \<equiv> \<lambda>k. LEAST x. (\<phi> (the ((\<phi> k) ((f k) \<triangleright> x)))) = f k"
  define f' where "f' \<equiv> \<lambda>k. (k # (replicate (a k) 0) @ [1]) \<odot> 0\<^sup>\<infinity>"
  then have "f' k \<in> \<R>" for k
    using almost0_in_R1 by auto

  \<comment> \<open>Although $f_k$ and $f'_k$ differ, they share the prefix of length $a_k + 1$.\<close>
  have init_eq: "(f' k) \<triangleright> (a k) = (f k) \<triangleright> (a k)" for k
  proof (rule init_eqI)
    fix x assume "x \<le> a k"
    then show "f' k x = f k x"
      by (cases "x = 0") (simp_all add: nth_append f'_def f_def)
  qed
  have "f k \<noteq> f' k" for k
  proof -
    have "f k (Suc (a k)) \<down>= 0" using f_def by auto
    moreover have "f' k (Suc (a k)) \<down>= 1"
      using f'_def prepend[of "(k # (replicate (a k) 0) @ [1])" "0\<^sup>\<infinity>" "Suc (a k)"]
      by (metis length_Cons length_append_singleton length_replicate lessI nth_Cons_Suc
        nth_append_length)
    ultimately show ?thesis by auto
  qed

  \<comment> \<open>The separating class $U$ contains $f'_k$ if $\varphi_k$
  learns $f_k$; otherwise it contains $f_k$.\<close>
  define U where
    "U \<equiv> {if learn_lim \<phi> {f k} (\<phi> k) then f' k else f k |k. k \<in> UNIV}"
  have "U \<notin> CP"
  proof
    assume "U \<in> CP"
    have "\<exists>k. learn_cp \<phi> U (\<phi> k)"
    proof -
      have "\<exists>\<psi> s. learn_cp \<psi> U s"
        using CP_def \<open>U \<in> CP\<close> by auto
      then obtain s where s: "learn_cp \<phi> U s"
        using learn_cp_wrt_goedel[OF goedel_numbering_phi] by blast
      then obtain k where "\<phi> k = s"
        using phi_universal learn_cp_def learn_lim_def by auto
      then show ?thesis using s by auto
    qed
    then obtain k where k: "learn_cp \<phi> U (\<phi> k)" by auto
    then have learn: "learn_lim \<phi> U (\<phi> k)"
      using learn_cp_def by simp
    \<comment> \<open>If $f_k$ was in $U$, $\varphi_k$ would learn it. But then,
    by definition of $U$, $f_k$ would not be in $U$. Hence $f_k \notin U$.\<close>
    have "f k \<notin> U"
    proof
      assume "f k \<in> U"
      then obtain m where m: "f k = (if learn_lim \<phi> {f m} (\<phi> m) then f' m else f m)"
        using U_def by auto
      have "f k 0 \<down>= m"
        using f_def f'_def m by simp
      moreover have "f k 0 \<down>= k" by (simp add: f_def)
      ultimately have "m = k" by simp
      with m have "f k = (if learn_lim \<phi> {f k} (\<phi> k) then f' k else f k)"
        by auto
      moreover have "learn_lim \<phi> {f k} (\<phi> k)"
        using \<open>f k \<in> U\<close> learn_lim_closed_subseteq[OF learn] by simp
      ultimately have "f k = f' k"
        by simp
      then show False
        using \<open>f k \<noteq> f' k\<close> by simp
    qed
    then have "f' k \<in> U" using U_def by fastforce
    then have in_U: "\<forall>n. \<phi> (the ((\<phi> k) ((f' k) \<triangleright> n))) \<in> U"
      using learn_cpE(3)[OF k] by simp

    \<comment> \<open>Since $f'_k \in U$, the strategy $\varphi_k$ learns $f_k$.
    Then $a_k$ is well-defined, $f'^{a_k} = f^{a_k}$, and $\varphi_k$
    hypothesizes $f_k$ on $f'^{a_k}$, which is not a class-preserving
    hypothesis.\<close>
    have "learn_lim \<phi> {f k} (\<phi> k)" using U_def \<open>f k \<notin> U\<close> by fastforce
    then have "\<exists>i n\<^sub>0. \<phi> i = f k \<and> (\<forall>n\<ge>n\<^sub>0. \<phi> k ((f k) \<triangleright> n) \<down>= i)"
      using learn_limE(2) by simp
    then obtain i n\<^sub>0 where "\<phi> i = f k \<and> (\<forall>n\<ge>n\<^sub>0. \<phi> k ((f k) \<triangleright> n) \<down>= i)"
      by auto
    then have "\<phi> (the (\<phi> k ((f k) \<triangleright> (a k)))) = f k"
      using a_def LeastI[of "\<lambda>x. (\<phi> (the ((\<phi> k) ((f k) \<triangleright> x)))) = f k" n\<^sub>0]
      by simp
    then have "\<phi> (the ((\<phi> k) ((f' k) \<triangleright> (a k)))) = f k"
      using init_eq by simp
    then show False
      using \<open>f k \<notin> U\<close> in_U by metis
  qed
  moreover have "U \<in> NUM"
    using NUM_closed_subseteq[OF U0_in_NUM, of U] f_def f'_def U0_def U_def
    by fastforce
  ultimately show ?thesis by auto
qed

section \<open>NUM is a proper subset of TOTAL\label{s:num_total}\<close>

text \<open>A NUM class $U$ is embedded in a total numbering @{term \<psi>}.
The strategy $S$ with $S(f^n) = \min \{i \mid \forall k \le n: \psi_i(k) =
f(k)\}$ for $f \in U$ converges to the least index of $f$ in @{term \<psi>},
and thus learns $f$ in the limit. Moreover it will be a TOTAL strategy
because @{term \<psi>} contains only total functions. This shows @{prop "NUM
\<subseteq> TOTAL"}.\<close>

text \<open>First we define, for every hypothesis space $\psi$, a
function that tries to determine for a given list $e$ and index $i$ whether
$e$ is a prefix of $\psi_i$. In other words it tries to decide whether $i$ is
a consistent hypothesis for $e$. ``Tries'' refers to the fact that the
function will diverge if $\psi_i(x)\uparrow$ for any $x \le |e|$. We start
with a version that checks the list only up to a given length.\<close>

definition r_consist_upto :: "recf \<Rightarrow> recf" where
  "r_consist_upto r_psi \<equiv>
    let g = Cn 4 r_ifeq
      [Cn 4 r_psi [Id 4 2, Id 4 0], Cn 4 r_nth [Id 4 3, Id 4 0], Id 4 1, r_constn 3 1]
    in Pr 2 (r_constn 1 0) g"

lemma r_consist_upto_recfn: "recfn 2 r_psi \<Longrightarrow> recfn 3 (r_consist_upto r_psi)"
  using r_consist_upto_def by simp

lemma r_consist_upto:
  assumes "recfn 2 r_psi"
  shows "\<forall>k<j. eval r_psi [i, k] \<down> \<Longrightarrow>
      eval (r_consist_upto r_psi) [j, i, e] =
        (if \<forall>k<j. eval r_psi [i, k] \<down>= e_nth e k then Some 0 else Some 1)"
    and "\<not> (\<forall>k<j. eval r_psi [i, k] \<down>) \<Longrightarrow> eval (r_consist_upto r_psi) [j, i, e] \<up>"
proof -
  define g where "g =
    Cn 4 r_ifeq
     [Cn 4 r_psi [Id 4 2, Id 4 0], Cn 4 r_nth [Id 4 3, Id 4 0], Id 4 1, r_constn 3 1]"
  then have "recfn 4 g"
    using assms by simp
  moreover have "eval (Cn 4 r_nth [Id 4 3, Id 4 0]) [j, r, i, e] \<down>= e_nth e j" for j r i e
    by simp
  moreover have "eval (r_constn 3 1) [j, r, i, e] \<down>= 1" for j r i e
    by simp
  moreover have "eval (Cn 4 r_psi [Id 4 2, Id 4 0]) [j, r, i, e] = eval r_psi [i, j]" for j r i e
    using assms(1) by simp
  ultimately have g: "eval g [j, r, i, e] =
    (if eval r_psi [i, j] \<up> then None
     else if eval r_psi [i, j] \<down>= e_nth e j then Some r else Some 1)"
    for j r i e
    using \<open>recfn 4 g\<close> g_def assms by auto
  have goal1: "\<forall>k<j. eval r_psi [i, k] \<down> \<Longrightarrow>
    eval (r_consist_upto r_psi) [j, i, e] =
      (if \<forall>k<j. eval r_psi [i, k] \<down>= e_nth e k then Some 0 else Some 1)"
    for j i e
  proof (induction j)
    case 0
    then show ?case
      using r_consist_upto_def r_consist_upto_recfn assms eval_Pr_0 by simp
  next
    case (Suc j)
    then have "eval (r_consist_upto r_psi) [Suc j, i, e] =
        eval g [j, the (eval (r_consist_upto r_psi) [j, i, e]), i, e]"
      using assms eval_Pr_converg_Suc g_def r_consist_upto_def r_consist_upto_recfn
      by simp
    also have "... = eval g [j, if \<forall>k<j. eval r_psi [i, k] \<down>= e_nth e k then 0 else 1, i, e]"
      using Suc by auto
    also have "... \<down>= (if eval r_psi [i, j] \<down>= e_nth e j
        then if \<forall>k<j. eval r_psi [i, k] \<down>= e_nth e k then 0 else 1 else 1)"
      using g by (simp add: Suc.prems)
    also have "... \<down>= (if \<forall>k<Suc j. eval r_psi [i, k] \<down>= e_nth e k then 0 else 1)"
      by (simp add: less_Suc_eq)
    finally show ?case by simp
  qed
  then show "\<forall>k<j. eval r_psi [i, k] \<down> \<Longrightarrow>
    eval (r_consist_upto r_psi) [j, i, e] =
    (if \<forall>k<j. eval r_psi [i, k] \<down>= e_nth e k then Some 0 else Some 1)"
    by simp
  show "\<not> (\<forall>k<j. eval r_psi [i, k] \<down>) \<Longrightarrow> eval (r_consist_upto r_psi) [j, i, e] \<up>"
  proof -
    assume "\<not> (\<forall>k<j. eval r_psi [i, k] \<down>)"
    then have "\<exists>k<j. eval r_psi [i, k] \<up>" by simp
    let ?P = "\<lambda>k. k < j \<and> eval r_psi [i, k] \<up>"
    define kmin where "kmin = Least ?P"
    then have "?P kmin"
      using LeastI_ex[of ?P] \<open>\<exists>k<j. eval r_psi [i, k] \<up>\<close> by auto
    from kmin_def have "\<And>k. k < kmin \<Longrightarrow> \<not> ?P k"
      using kmin_def not_less_Least[of _ ?P] by blast
    then have "\<forall>k < kmin. eval r_psi [i, k] \<down>"
      using \<open>?P kmin\<close> by simp
    then have "eval (r_consist_upto r_psi) [kmin, i, e] =
        (if \<forall>k<kmin. eval r_psi [i, k] \<down>= e_nth e k then Some 0 else Some 1)"
      using goal1 by simp
    moreover have "eval r_psi [i, kmin] \<up>"
      using \<open>?P kmin\<close> by simp
    ultimately have "eval (r_consist_upto r_psi) [Suc kmin, i, e] \<up>"
      using r_consist_upto_def g assms by simp
    moreover have "j \<ge> kmin"
      using \<open>?P kmin\<close> by simp
    ultimately show "eval (r_consist_upto r_psi) [j, i, e] \<up>"
      using r_consist_upto_def r_consist_upto_recfn \<open>?P kmin\<close> eval_Pr_converg_le assms
      by (metis (full_types) Suc_leI length_Cons list.size(3) numeral_2_eq_2 numeral_3_eq_3)
  qed
qed

text \<open>The next function provides the consistency decision functions we
need.\<close>

definition consistent :: "partial2 \<Rightarrow> partial2" where
  "consistent \<psi> i e \<equiv>
    if \<forall>k<e_length e. \<psi> i k \<down>
    then if \<forall>k<e_length e. \<psi> i k \<down>= e_nth e k
         then Some 0 else Some 1
    else None"

text \<open>Given $i$ and $e$, @{term "consistent \<psi>"} decides whether $e$
is a prefix of $\psi_i$, provided $\psi_i$ is defined for the length of
$e$.\<close>

definition r_consistent :: "recf \<Rightarrow> recf" where
  "r_consistent r_psi \<equiv>
     Cn 2 (r_consist_upto r_psi) [Cn 2 r_length [Id 2 1], Id 2 0, Id 2 1]"

lemma r_consistent_recfn [simp]: "recfn 2 r_psi \<Longrightarrow> recfn 2 (r_consistent r_psi)"
  using r_consistent_def r_consist_upto_recfn by simp

lemma r_consistent_converg:
  assumes "recfn 2 r_psi" and "\<forall>k<e_length e. eval r_psi [i, k] \<down>"
  shows "eval (r_consistent r_psi) [i, e] \<down>=
    (if \<forall>k<e_length e. eval r_psi [i, k] \<down>= e_nth e k then 0 else 1)"
proof -
  have "eval (r_consistent r_psi) [i, e] = eval (r_consist_upto r_psi) [e_length e, i, e]"
    using r_consistent_def r_consist_upto_recfn assms(1) by simp
  then show ?thesis using assms r_consist_upto(1) by simp
qed

lemma r_consistent_diverg:
  assumes "recfn 2 r_psi" and "\<exists>k<e_length e. eval r_psi [i, k] \<up>"
  shows "eval (r_consistent r_psi) [i, e] \<up>"
  unfolding r_consistent_def
  using r_consist_upto_recfn[OF assms(1)] r_consist_upto[OF assms(1)] assms(2)
  by simp

lemma r_consistent:
  assumes "recfn 2 r_psi" and "\<forall>x y. eval r_psi [x, y] = \<psi> x y"
  shows "eval (r_consistent r_psi) [i, e] = consistent \<psi> i e"
proof (cases "\<forall>k<e_length e. \<psi> i k \<down>")
  case True
  then have "\<forall>k<e_length e. eval r_psi [i, k] \<down>"
    using assms by simp
  then show ?thesis
    unfolding consistent_def using True by (simp add: assms r_consistent_converg)
next
  case False
  then have "consistent \<psi> i e \<up>"
    unfolding consistent_def by auto
  moreover have "eval (r_consistent r_psi) [i, e] \<up>"
    using r_consistent_diverg[OF assms(1)] assms False by simp
  ultimately show ?thesis by simp
qed

lemma consistent_in_P2:
  assumes "\<psi> \<in> \<P>\<^sup>2"
  shows "consistent \<psi> \<in> \<P>\<^sup>2"
  using assms r_consistent P2E[OF assms(1)] P2I r_consistent_recfn by metis

lemma consistent_for_R2:
  assumes "\<psi> \<in> \<R>\<^sup>2"
  shows "consistent \<psi> i e =
    (if \<forall>j<e_length e. \<psi> i j \<down>= e_nth e j then Some 0 else Some 1)"
  using assms by (simp add: consistent_def)

lemma consistent_init:
  assumes "\<psi> \<in> \<R>\<^sup>2" and "f \<in> \<R>"
  shows "consistent \<psi> i (f \<triangleright> n) = (if \<psi> i \<triangleright> n = f \<triangleright> n then Some 0 else Some 1)"
  using consistent_def[of _ _ "init f n"] assms  init_eq_iff_eq_upto by simp

lemma consistent_in_R2:
  assumes "\<psi> \<in> \<R>\<^sup>2"
  shows "consistent \<psi> \<in> \<R>\<^sup>2"
  using total2I consistent_in_P2 consistent_for_R2[OF assms] P2_total_imp_R2 R2_imp_P2 assms
  by (metis option.simps(3))

text \<open>For total hypothesis spaces the next function computes the
minimum hypothesis consistent with a given prefix. It diverges if no such
hypothesis exists.\<close>

definition min_cons_hyp :: "partial2 \<Rightarrow> partial1" where
  "min_cons_hyp \<psi> e \<equiv>
    if \<exists>i. consistent \<psi> i e \<down>= 0 then Some (LEAST i. consistent \<psi> i e \<down>= 0) else None"

lemma min_cons_hyp_in_P1:
  assumes "\<psi> \<in> \<R>\<^sup>2"
  shows "min_cons_hyp \<psi> \<in> \<P>"
proof -
  from assms consistent_in_R2 obtain rc where
    rc: "recfn 2 rc" "total rc" "\<And>i e. eval rc [i, e] = consistent \<psi> i e"
    using R2E[of "consistent \<psi>"] by metis
  define r where "r = Mn 1 rc"
  then have "recfn 1 r"
    using rc(1) by simp
  moreover from this have "eval r [e] = min_cons_hyp \<psi> e" for e
    using r_def eval_Mn'[of 1 rc "[e]"] rc min_cons_hyp_def assms
    by (auto simp add: consistent_in_R2)
  ultimately show ?thesis by auto
qed

text \<open>The function @{term "min_cons_hyp \<psi>"} is a strategy for
learning all NUM classes embedded in @{term \<psi>}. It is an example of an
``identification-by-enumeration'' strategy.\<close>

lemma NUM_imp_learn_total:
  assumes "\<psi> \<in> \<R>\<^sup>2" and "U \<in> NUM_wrt \<psi>"
  shows "learn_total \<psi> U (min_cons_hyp \<psi>)"
proof (rule learn_totalI)
  have ex_psi_i_f: "\<exists>i. \<psi> i = f" if "f \<in> U" for f
    using assms that NUM_wrt_def by simp
  moreover have consistent_eq_0: "consistent \<psi> i ((\<psi> i) \<triangleright> n) \<down>= 0" for i n
    using assms by (simp add: consistent_init)
  ultimately have "\<And>f n. f \<in> U \<Longrightarrow> min_cons_hyp \<psi> (f \<triangleright> n) \<down>"
    using min_cons_hyp_def assms(1) by fastforce
  then show env: "environment \<psi> U (min_cons_hyp \<psi>)"
    using assms NUM_wrt_def min_cons_hyp_in_P1 NUM_E(1) NUM_I by auto

  show "\<And>f n. f \<in> U \<Longrightarrow> \<psi> (the (min_cons_hyp \<psi> (f \<triangleright> n))) \<in> \<R>"
    using assms by (simp)

  show "\<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. min_cons_hyp \<psi> (f \<triangleright> n) \<down>= i)" if "f \<in> U" for f
  proof -
    from that env have "f \<in> \<R>" by auto

    let ?P = "\<lambda>i. \<psi> i = f"
    define imin where "imin \<equiv> Least ?P"
    with ex_psi_i_f that have imin: "?P imin" "\<And>j. ?P j \<Longrightarrow> j \<ge> imin"
      using LeastI_ex[of ?P] Least_le[of ?P] by simp_all
    then have f_neq: "\<psi> i \<noteq> f" if "i < imin" for i
      using leD that by auto

    let ?Q = "\<lambda>i n. \<psi> i \<triangleright> n \<noteq> f \<triangleright> n"
    define nu :: "nat \<Rightarrow> nat" where "nu = (\<lambda>i. SOME n. ?Q i n)"
    have nu_neq: "\<psi> i \<triangleright> (nu i) \<noteq> f \<triangleright> (nu i)" if "i < imin" for i
    proof -
      from assms have "\<psi> i \<in> \<R>" by simp
      moreover from assms imin(1) have "f \<in> \<R>" by auto
      moreover have "f \<noteq> \<psi> i"
        using that f_neq by auto
      ultimately have "\<exists>n. f \<triangleright> n \<noteq> (\<psi> i) \<triangleright> n"
        using neq_fun_neq_init by simp
      then show "?Q i (nu i)"
        unfolding nu_def using someI_ex[of "\<lambda>n. ?Q i n"] by metis
    qed

    have "\<exists>n\<^sub>0. \<forall>n\<ge>n\<^sub>0. min_cons_hyp \<psi> (f \<triangleright> n) \<down>= imin"
    proof (cases "imin = 0")
      case True
      then have "\<forall>n. min_cons_hyp \<psi> (f \<triangleright> n) \<down>= imin"
        using consistent_eq_0 assms(1) imin(1) min_cons_hyp_def by auto
      then show ?thesis by simp
    next
      case False
      define n\<^sub>0 where "n\<^sub>0 = Max (set (map nu [0..<imin]))" (is "_ = Max ?N")
      have "nu i \<le> n\<^sub>0" if "i < imin" for i
      proof -
        have "finite ?N"
          using n\<^sub>0_def by simp
        moreover have "?N \<noteq> {}"
          using False n\<^sub>0_def by simp
        moreover have "nu i \<in> ?N"
          using that by simp
        ultimately show ?thesis
          using that Max_ge n\<^sub>0_def by blast
      qed
      then have "\<psi> i \<triangleright> n\<^sub>0 \<noteq> f \<triangleright> n\<^sub>0" if "i < imin" for i
        using nu_neq neq_init_forall_ge that by blast
      then have *: "\<psi> i \<triangleright> n \<noteq> f \<triangleright> n" if "i < imin" and "n \<ge> n\<^sub>0" for i n
        using nu_neq neq_init_forall_ge that by blast

      have "\<psi> imin \<triangleright> n = f \<triangleright> n" for n
        using imin(1) by simp
      moreover have "(consistent \<psi> i (f \<triangleright> n) \<down>= 0) = (\<psi> i \<triangleright> n = f \<triangleright> n)" for i n
        by (simp add: \<open>f \<in> \<R>\<close> assms(1) consistent_init)
      ultimately have "min_cons_hyp \<psi> (f \<triangleright> n) \<down>= (LEAST i. \<psi> i \<triangleright> n = f \<triangleright> n)" for n
        using min_cons_hyp_def[of \<psi> "f \<triangleright> n"] by auto
      moreover have "(LEAST i. \<psi> i \<triangleright> n = f \<triangleright> n) = imin" if "n \<ge> n\<^sub>0" for n
      proof (rule Least_equality)
        show "\<psi> imin \<triangleright> n = f \<triangleright> n"
          using imin(1) by simp
        show "\<And>y. \<psi> y \<triangleright> n = f \<triangleright> n \<Longrightarrow> imin \<le> y"
          using imin * leI that by blast
      qed
      ultimately have "min_cons_hyp \<psi> (f \<triangleright> n) \<down>= imin" if "n \<ge> n\<^sub>0" for n
        using that by blast
      then show ?thesis by auto
    qed
    with imin(1) show ?thesis by auto
  qed
qed

corollary NUM_subseteq_TOTAL: "NUM \<subseteq> TOTAL"
proof
  fix U
  assume "U \<in> NUM"
  then have "\<exists>\<psi>\<in>\<R>\<^sup>2. \<forall>f\<in>U. \<exists>i. \<psi> i = f" by auto
  then have "\<exists>\<psi>\<in>\<R>\<^sup>2. U \<in> NUM_wrt \<psi>"
    using NUM_wrt_def by simp
  then have "\<exists>\<psi> s. learn_total \<psi> U s"
    using NUM_imp_learn_total by auto
  then show "U \<in> TOTAL"
    using TOTAL_def by auto
qed

text \<open>The class @{term V0} is in @{term "TOTAL - NUM"}. \<close>

theorem NUM_subset_TOTAL: "NUM \<subset> TOTAL"
  using CP_subseteq_TOTAL FIN_not_subseteq_NUM FIN_subseteq_CP NUM_subseteq_TOTAL
  by auto

end


theory sort_QSortIsSort
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype 'a list = Nil2 | Cons2 "'a" "'a list"

fun insert2 :: "int => int list => int list" where
"insert2 x (Nil2) = Cons2 x (Nil2)"
| "insert2 x (Cons2 z xs) =
     (if x <= z then Cons2 x (Cons2 z xs) else Cons2 z (insert2 x xs))"

fun isort :: "int list => int list" where
"isort (Nil2) = Nil2"
| "isort (Cons2 y xs) = insert2 y (isort xs)"

fun filter :: "('t => bool) => 't list => 't list" where
"filter p (Nil2) = Nil2"
| "filter p (Cons2 y z) =
     (if p y then Cons2 y (filter p z) else filter p z)"

fun append :: "'a list => 'a list => 'a list" where
"append (Nil2) y = y"
| "append (Cons2 z xs) y = Cons2 z (append xs y)"

fun qsort :: "int list => int list" where
"qsort (Nil2) = Nil2"
| "qsort (Cons2 y xs) =
     append
       (append
          (qsort (filter (% (z :: int) => z <= y) xs)) (Cons2 y (Nil2)))
       (qsort (filter (% (x2 :: int) => x2 > y) xs))"

(*hipster insert2 isort filter append qsort *)

theorem x0 :
  "!! (x :: int list) . (qsort x) = (isort x)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


chapter "Functional big-step semantics"

section "Termination proof"

theory Evaluate_Termination
  imports Semantic_Extras
begin

case_of_simps fix_clock_alt_def: fix_clock.simps

primrec size_exp' :: "exp \<Rightarrow> nat" where
"size_exp' (Raise e) = Suc (size_exp' e)" |
[simp del]: "size_exp' (Handle e pes) = Suc (size_exp' e + size_list (\<lambda>(p, es). Suc (size p + es)) (map (map_prod id size_exp') pes))" |
"size_exp' (Con _ es) = Suc (size_list id (map size_exp' es))" |
"size_exp' (Fun _ e) = Suc (size_exp' e)" |
"size_exp' (App _ es) = Suc (size_list id (map size_exp' es))" |
"size_exp' (Log _ e f) = Suc (size_exp' e + size_exp' f)" |
"size_exp' (If e f g) = Suc (size_exp' e + size_exp' f + size_exp' g)" |
[simp del]: "size_exp' (Mat e pes) = Suc (size_exp' e + size_list (\<lambda>(p, es). Suc (size p + es)) (map (map_prod id size_exp') pes))" |
"size_exp' (Let _ e f) = Suc (size_exp' e + size_exp' f)" |
[simp del]: "size_exp' (Letrec defs e) = Suc (size_exp' e + size_list (\<lambda>(_, _, es). Suc (Suc es)) (map (map_prod id (map_prod id size_exp')) defs))" |
"size_exp' (Tannot e _) = Suc (size_exp' e)" |
"size_exp' (Lannot e _) = Suc (size_exp' e)" |
"size_exp' (Lit _) = 0" |
"size_exp' (Var _) = 0"

lemma [simp]:
  "size_exp' (Handle e pes) = Suc (size_exp' e + size_list (size_prod size size_exp') pes)"
apply (simp add: size_exp'.simps size_list_conv_sum_list)
apply (rule arg_cong[where f = sum_list])
apply auto
done

lemma [simp]:
  "size_exp' (Letrec defs e) = Suc (size_exp' e + size_list (size_prod (\<lambda>_. 0) (size_prod (\<lambda>_. 0) size_exp')) defs)"
apply (simp add: size_exp'.simps size_list_conv_sum_list)
apply (rule arg_cong[where f = sum_list])
apply auto
done

context begin

private definition fun_evaluate_relation where
"fun_evaluate_relation = inv_image (less_than <*lex*> less_than) (\<lambda>x.
  case x of
    Inr (s, _, es) \<Rightarrow> (clock s, size_list size_exp' es)
  | Inl (s,_,_,pes,_) \<Rightarrow> (clock s, size_list (size_prod size size_exp') pes))"

termination fun_evaluate
by (relation fun_evaluate_relation;
    auto
      simp: fun_evaluate_relation_def fix_clock_alt_def dec_clock_def do_if_def do_log_alt_def
      simp: datatype_record_update
      split: prod.splits state.splits lop.splits v.splits option.splits if_splits tid_or_exn.splits id0.splits list.splits)

end

end


(* Title: Kleene Algebra with Tests
   Author: Georg Struth
*)

section \<open>Kleene Algebra with Tests\<close>

theory KAT
  imports KA

begin

subsection \<open>Definitions and Basic Properties\<close>

class kat = kleene_algebra +
  fixes atest :: "'a \<Rightarrow> 'a" ("\<alpha>")
  assumes test_one [simp]: "\<alpha> (\<alpha> 1) = 1"
  and test_mult [simp]: "\<alpha> (\<alpha> (\<alpha> (\<alpha> x) \<cdot> \<alpha> (\<alpha> y))) = \<alpha> (\<alpha> y) \<cdot> \<alpha> (\<alpha> x)"
  and test_mult_comp [simp]: "\<alpha> x \<cdot> \<alpha> (\<alpha> x) = 0"
  and test_de_morgan: "\<alpha> (\<alpha> (\<alpha> x) \<cdot> \<alpha> (\<alpha> y)) = \<alpha> x + \<alpha> y"

begin

definition test :: "'a \<Rightarrow> 'a"  ("\<tau>") where
  "\<tau> x = \<alpha> (\<alpha> x)"

lemma a_a [simp]: "\<alpha> \<circ> \<alpha> = \<tau>"
  sorry

lemma t_a [simp]: "\<tau> \<circ> \<alpha> = \<alpha>"
  sorry

lemma t_a_var [simp]: "\<tau> (\<alpha> x) = \<alpha> x"
  sorry

lemma a_t [simp]: "\<alpha> \<circ> \<tau> = \<alpha>"
  sorry

lemma a_t_var [simp]: "\<alpha> (\<tau> x) = \<alpha> x"
  sorry

lemma t_t [simp]: "\<tau> \<circ> \<tau> = \<tau>"
  sorry

lemma t_t_var [simp]: "\<tau> (\<tau> x) = \<tau> x"
  sorry

lemma a_comm: "\<alpha> x \<cdot> \<alpha> y = \<alpha> y \<cdot> \<alpha> x"
  sorry

lemma a_idem [simp]: "\<alpha> x \<cdot> \<alpha> x = \<alpha> x"
  sorry

lemma t_add_closed [simp]: "\<tau> (\<alpha> x + \<alpha> y) = \<alpha> x + \<alpha> y"
  sorry

lemma t_mult_closed [simp]: "\<tau> (\<alpha> x \<cdot> \<alpha> y) = \<alpha> x \<cdot> \<alpha> y"
  sorry

lemma t_at_compl1 [simp]: "\<tau> x + \<alpha> x = 1"
  sorry

lemma t_at_compl2 [simp]: "\<tau> x \<cdot> \<alpha> x = 0"
  sorry

lemma a_absorb1 [simp]: "\<alpha> x \<cdot> (\<alpha> x + \<alpha> y) = \<alpha> x"
  sorry

lemma a_absorb2 [simp]: "\<alpha> x + \<alpha> x \<cdot> \<alpha> y = \<alpha> x"
  sorry

lemma t_distl2: "\<alpha> x + \<alpha> y \<cdot> \<alpha> z = (\<alpha> x + \<alpha> y) \<cdot> (\<alpha> x + \<alpha> z)"
  sorry

lemma a_de_morgan2: "\<alpha> (\<alpha> x + \<alpha> y) = \<tau> x \<cdot> \<tau> y"
  sorry

lemma a_de_morgan3: "\<alpha> (\<alpha> x \<cdot> \<alpha> y) = \<tau> x + \<tau> y"
  sorry

lemma a_lbl: "\<alpha> x \<cdot> \<alpha> y \<le> \<alpha> x"
  sorry

lemma a_lbr: "\<alpha> x \<cdot> \<alpha> y \<le> \<alpha> y"
  sorry

lemma a_upper: "\<alpha> z \<le> \<alpha> x \<Longrightarrow> \<alpha> z \<le> \<alpha> y \<Longrightarrow> \<alpha> z \<le> \<alpha> x \<cdot> \<alpha> y"
  sorry

lemma a_glb: "(\<tau> z \<le> \<tau> x \<cdot> \<tau> y) = (\<tau> z \<le> \<tau> x \<and> \<tau> z \<le> \<tau> y)"
  sorry

lemma t_subid: "\<tau> x \<le> 1"
  sorry

lemma a_subid: "\<alpha> x \<le> 1"
  sorry

lemma a_comp_ord_def: "(\<alpha> x \<le> \<alpha> y) = (\<alpha> x \<cdot> \<alpha> y = \<alpha> x)"
  sorry

lemma t_le_antitone: "(\<tau> x \<le> \<tau> y) = (\<alpha> y \<le> \<alpha> x)"
  sorry

lemma at_shunt: "(\<alpha> x \<cdot> \<alpha> y \<le> \<alpha> z) = (\<alpha> x \<le> \<tau> y + \<alpha> z)"
  sorry

end

subsection \<open>Boolean Subalgebra of Tests\<close>

typedef (overloaded) 'a test_alg = "{x::'a::kat. \<tau> x = x}"
  by (meson CollectI t_a_var)

setup_lifting type_definition_test_alg

instantiation test_alg :: (kat) boolean_algebra
begin

lift_definition minus_test_alg :: "'a test_alg \<Rightarrow> 'a test_alg \<Rightarrow> 'a test_alg" is "\<lambda>x y. x \<cdot> \<alpha> y"
  by (metis t_mult_closed test_def)

lift_definition uminus_test_alg :: "'a test_alg \<Rightarrow> 'a test_alg" is "\<alpha>"
  by simp

lift_definition bot_test_alg :: "'a test_alg" is "0"
  by (metis t_mult_closed test_mult_comp)

lift_definition top_test_alg :: "'a test_alg" is "1"
  by (simp add: test_def)

lift_definition inf_test_alg :: "'a test_alg \<Rightarrow> 'a test_alg \<Rightarrow> 'a test_alg" is "(\<cdot>)"
  by (metis t_mult_closed test_def)

lift_definition sup_test_alg :: "'a test_alg \<Rightarrow> 'a test_alg \<Rightarrow> 'a test_alg" is "(+)"
  by (metis t_add_closed test_def)

lift_definition less_eq_test_alg :: "'a test_alg \<Rightarrow> 'a test_alg \<Rightarrow> bool" is "(\<le>)".

lift_definition less_test_alg :: "'a test_alg \<Rightarrow> 'a test_alg \<Rightarrow> bool" is "(<)".

instance
  sorry

end

text \<open>Unfortunately, this theorem must be given outside of the context of the Kleene algebra with tests class.
We can therefore not use its results within this context. This means in particular that theorems from
Isabelle's boolean algebra component are not within scope of this context.\<close>

text \<open>Are all subidenties tests? The following counterexample, obtained using nitpick, shows that this
is not the case.\<close>

lemma (in kat) "x \<le> 1 \<Longrightarrow> \<tau> x = x"
  nitpick (* 3-element counterexample *)
  oops

subsection \<open>Properties Helpful for Propositional Hoare Logic\<close>

context kat
begin

lemma pcorrect_if1: "\<alpha> p \<cdot> x \<le> x \<cdot> \<alpha> q \<Longrightarrow> \<alpha> p \<cdot> x \<cdot> \<tau> q = 0"
  sorry

lemma pcorrect_if1_op: "x \<cdot> \<alpha> q \<le> \<alpha> p \<cdot> x \<Longrightarrow> \<tau> p \<cdot> x \<cdot> \<alpha> q = 0"
  sorry

lemma pcorrect_if2: "\<alpha> p \<cdot> x \<cdot> \<tau> q = 0 \<Longrightarrow> \<alpha> p \<cdot> x \<cdot> \<alpha> q = \<alpha> p \<cdot> x"
  sorry

lemma pcorrect_if2_op: "\<tau> p \<cdot> x \<cdot> \<alpha> q = 0 \<Longrightarrow> \<alpha> p \<cdot> x \<cdot> \<alpha> q = x \<cdot> \<alpha> q"
  sorry

lemma pcorrect_if3: "\<alpha> p \<cdot> x = \<alpha> p \<cdot> x \<cdot> \<alpha> q \<Longrightarrow> \<alpha> p \<cdot> x \<le> x \<cdot> \<alpha> q"
  sorry
lemma pcorrect_if3_op: "\<alpha> p \<cdot> x \<cdot> \<alpha> q = x \<cdot> \<alpha> q \<Longrightarrow> x \<cdot> \<alpha> q \<le> \<alpha> p \<cdot>  x"
  sorry

lemma pcorrect_iff1: "(\<alpha> p \<cdot> x \<le> x \<cdot> \<alpha> q) = (\<alpha> p \<cdot> x \<cdot> \<tau> q = 0)"
  sorry

lemma pcorrect_iff1_op: "(x \<cdot> \<alpha> q \<le> \<alpha> p \<cdot> x) = (\<tau> p \<cdot> x \<cdot> \<alpha> q = 0)"
  sorry

lemma pcorrect_iff2: "(\<alpha> p \<cdot> x \<cdot> \<tau> q = 0) = (\<alpha> p \<cdot> x \<cdot> \<alpha> q = \<alpha> p \<cdot> x)"
  sorry

lemma pcorrect_iff2_op: "(\<tau> p \<cdot> x \<cdot> \<alpha> q = 0) = (\<alpha> p \<cdot> x \<cdot> \<alpha> q  = x \<cdot> \<alpha> q)"
  sorry

lemma pcorrect_op: "(\<alpha> p \<cdot> x \<le> x \<cdot> \<alpha> q) = (x \<cdot> \<tau> q \<le> \<tau> p \<cdot> x)"
  sorry

lemma pcorrect: "(\<tau> p \<cdot> x \<le> x \<cdot> \<tau> q) = (x \<cdot> \<alpha> q \<le> \<alpha> p \<cdot> x)"
  sorry

subsection  \<open>Conditionals and while-Loops.\<close>

definition cond :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" ("if _ then _ else _ fi" [64,64,64] 63) where
  "if p then x else y fi = \<tau> p \<cdot> x + \<alpha> p \<cdot> y"

definition while :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" ("while _ do _ od" [64,64] 63) where
  "while p do x od = (\<tau> p \<cdot> x)\<^sup>\<star> \<cdot> \<alpha> p"

subsection \<open>Program Equivalences and Transformations\<close>

lemma while_rec: "while p do x od = if p then x \<cdot> (while p do x od) else 1 fi"
  sorry

lemma while_rec_least: "if p then x \<cdot> y else 1 fi = y \<Longrightarrow> while p do x od \<le> y"
  sorry

lemma cond_merge_aux: "(\<tau> p \<cdot> x = x \<cdot> \<tau> p) = (\<alpha> p \<cdot> x = x \<cdot> \<alpha> p)"
  sorry

lemma cond_merge:
  assumes "\<tau> p \<cdot> x = x \<cdot> \<tau> p"
  shows "if p then (x \<cdot> y) else (x \<cdot> z) fi = x \<cdot> (if p then y else z fi)"
  sorry

lemma loop_denest: "while p do (x \<cdot> (while q do y od)) od = if p then (x \<cdot> (while (\<tau> p + \<tau> q) do (if q then y else x fi) od)) else 1 fi"
  sorry

end

subsection \<open>A Locale for KAT\<close>

locale katloc =
  fixes test :: "'a::boolean_algebra \<Rightarrow> 'b::kleene_algebra" ("\<iota>")
  and not :: "'b::kleene_algebra \<Rightarrow> 'b::kleene_algebra" ("!")
  assumes test_sup: "\<iota> (sup p q) = \<iota> p + \<iota> q"
  and test_inf: "\<iota> (inf p q) = \<iota> p \<cdot> \<iota> q"
  and test_top: "\<iota> top = 1"
  and test_bot: "\<iota> bot = 0"
  and test_not: "\<iota> (- p) = ! (\<iota> p)"
  and test_ord_emb: "\<iota> p \<le> \<iota> q \<Longrightarrow> p \<le> q"

begin

lemma test_iso: "p \<le> q \<Longrightarrow> \<iota> p \<le> \<iota> q"
  by (metis order_def sup_absorb2 test_sup)

lemma test_iso_eq: "p \<le> q \<longleftrightarrow> \<iota> p \<le> \<iota> q"
  using test_iso test_ord_emb by blast

lemma test_eq: "p = q \<longleftrightarrow> \<iota> p = \<iota> q"
  by (metis eq_iff test_iso_eq)

lemma test_meet_comm: "\<iota> p \<cdot> \<iota> q = \<iota> q \<cdot> \<iota> p"
  by (metis inf.commute test_inf)

lemma [simp]: "\<iota> p + \<iota> (-p) = 1"
  by (metis sup_compl_top test_sup test_top)

lemma [simp]: "\<iota> (-p) \<cdot> \<iota> p = 0"
  by (metis compl_inf_bot test_bot test_inf)

lemma [simp]: "\<iota> p \<cdot> ! (\<iota> p) = 0"
  by (metis inf_compl_bot test_bot test_inf test_not)

end

subsection \<open>Relational and State Transformer Model\<close>

definition rel_atest :: "'a rel \<Rightarrow> 'a rel" ("\<alpha>\<^sub>r") where
  "\<alpha>\<^sub>r R = Id \<inter> -R"

interpretation rel_kat: kat "(\<union>)" "{}" Id "(;)" "(\<subseteq>)" "(\<subset>)" rtrancl "\<alpha>\<^sub>r"
  by unfold_locales (auto simp: rel_atest_def)

definition sta_atest :: "'a sta \<Rightarrow> 'a sta" ("\<alpha>\<^sub>s") where
  "\<alpha>\<^sub>s f x = \<eta> x - f x"

lemma katest_iff: "y \<in> \<alpha>\<^sub>s f x \<longleftrightarrow> y \<in> \<eta> x \<and> \<not> y \<in> f x"
  unfolding sta_atest_def by simp

interpretation sta_kat: kat "(+\<^sub>K)" "\<nu>" "\<eta>" "(\<circ>\<^sub>K)" "(\<sqsubseteq>)" "(\<sqsubset>)" kstar "\<alpha>\<^sub>s"
  apply unfold_locales
  unfolding sta_iff katest_iff eta_def kcomp_iff kadd_iff nsta_def by auto

lemma r2s_atest: "\<S> (\<alpha>\<^sub>r R) = \<alpha>\<^sub>s (\<S> R)"
  unfolding sta_iff r2s_iff katest_iff rel_atest_def eta_def by force

lemma s2r_atest: "\<R> (\<alpha>\<^sub>s f) = \<alpha>\<^sub>r (\<R> f)"
  by (metis r2s2r_galois r2s_atest)

lemma p2r_atest [simp]: "\<alpha>\<^sub>r \<lceil>P\<rceil>\<^sub>r = \<lceil>\<lambda>x. \<not> P x\<rceil>\<^sub>r"
  unfolding p2r_def rel_atest_def by force

lemma p2r_test [simp]: "rel_kat.test \<lceil>P\<rceil>\<^sub>r = \<lceil>P\<rceil>\<^sub>r"
  unfolding rel_kat.test_def by force

lemma p2s_atest [simp]: "\<alpha>\<^sub>s \<lceil>P\<rceil>\<^sub>s = \<lceil>\<lambda>x. \<not> P x\<rceil>\<^sub>s"
  unfolding  p2s_def s2p_def sta_atest_def fun_eq_iff eta_def by simp

lemma p2s_test [simp]: "sta_kat.test \<lceil>P\<rceil>\<^sub>s = \<lceil>P\<rceil>\<^sub>s"
  unfolding sta_kat.test_def by force

end


(*  Title:      RSAPSS/SHA1.thy
    Author:     Christina Lindenberg, Kai Wirt, Technische Universität Darmstadt
    Copyright:  2005 - Technische Universität Darmstadt
*)

header  "Formal definition of the secure hash algorithm"

theory SHA1
imports SHA1Padding
begin

text {* We define the secure hash algorithm SHA-1 and give a proof for the
  length of the message digest *}

definition fif where
  fif: "fif x y z = bvor (bvand x y) (bvand (bv_not x) z)"

definition fxor where
  fxor: "fxor x y z = bvxor (bvxor x y) z"

definition fmaj where
  fmaj: "fmaj x y z = bvor (bvor (bvand x y) (bvand x z)) (bvand y z)"

definition fselect :: "nat \<Rightarrow> bit list \<Rightarrow> bit list \<Rightarrow> bit list \<Rightarrow> bit list" where
  fselect: "fselect r x y z = (if (r < 20) then (fif x y z) else
                        (if (r < 40) then (fxor x y z) else
                          (if (r < 60) then (fmaj x y z) else
                             (fxor x y z))))"

definition K1 where
  K1: "K1 = hexvtobv [x5,xA,x8,x2,x7,x9,x9,x9]"

definition K2 where
  K2: "K2 = hexvtobv [x6,xE,xD,x9,xE,xB,xA,x1]"

definition K3 where
  K3: "K3 = hexvtobv [x8,xF,x1,xB,xB,xC,xD,xC]"

definition K4 where
  K4: "K4 = hexvtobv [xC,xA,x6,x2,xC,x1,xD,x6]"

definition kselect :: "nat \<Rightarrow> bit list" where
  kselect: "kselect r = (if (r < 20) then K1 else
                    (if (r < 40) then K2 else
                        (if (r < 60) then K3 else
                            K4)))"

definition getblock where
  getblock: "getblock x = select x 0 511"

fun delblockhelp where
  "delblockhelp [] n = []"
  | "delblockhelp (x#r) n = (if n <= 0 then x#r else delblockhelp r (n-(1::nat)))"

definition delblock where
  delblock: "delblock x = delblockhelp x 512"

primrec sha1compress where
  "sha1compress 0 b A B C D E = (let j = (79::nat) in
                                       (let W = select b (32*j) ((32*j)+31) in
                                        (let AA = addmod32 (addmod32 (addmod32 W (bvrol A 5)) (fselect j B C D)) (addmod32 E (kselect j));
                                             BB = A;
                                             CC = bvrol B 30;
                                             DD = C;
                                             EE = D in
                                AA@BB@CC@DD@EE)))"
 | "sha1compress (Suc n) b A B C D E = (let j = (79 - (Suc n)) in
                                       (let W = select b (32*j) ((32*j)+31) in
                                        (let AA = addmod32 (addmod32 (addmod32 W (bvrol A 5)) (fselect j B C D)) (addmod32 E (kselect j));
                                             BB = A;
                                             CC = bvrol B 30;
                                             DD = C;
                                             EE = D in
                               sha1compress n b AA BB CC DD EE)))"

definition sha1expandhelp where
  "sha1expandhelp x i = (let j = (79+16-i) in (bvrol (bvxor(bvxor(
    select x (32*(j-(3::nat))) (31+(32*(j-(3::nat))))) (select x (32*(j-(8::nat))) (31+(32*(j-(8::nat)))))) (bvxor(select x (32*(j-(14::nat))) (31+(32*(j-(14::nat))))) (select x (32*(j-(16::nat))) (31+(32*(j-(16::nat))))))) 1))"

fun sha1expand where
  "sha1expand x i = (if (i < 16) then x else
     let y = sha1expandhelp x i in
   sha1expand (x @ y) (i - 1))"

definition sha1compressstart where
  sha1compressstart: "sha1compressstart r b A B C D E = sha1compress r (sha1expand b 79) A B C D E"

function (sequential) sha1block where
  "sha1block b [] A B C D E = (let H = sha1compressstart 79 b A B C D E;
                                   AA = addmod32 A (select H 0 31);
                                   BB = addmod32 B (select H 32 63);
                                   CC = addmod32 C (select H 64 95);
                                   DD = addmod32 D (select H 96 127);
                                   EE = addmod32 E (select H 128 159)
                               in AA@BB@CC@DD@EE)"
  | "sha1block b x A B C D E =  (let H = sha1compressstart 79 b A B C D E;
                                     AA = addmod32 A (select H 0 31);
                                     BB = addmod32 B (select H 32 63);
                                     CC = addmod32 C (select H 64 95);
                                     DD = addmod32 D (select H 96 127);
                                     EE = addmod32 E (select H 128 159)
                               in sha1block (getblock x) (delblock x) AA BB CC DD E)"
by pat_completeness auto

termination proof -
  have aux: "\<And>n xs :: bit list. length (delblockhelp xs n) <= length xs"
  proof -
    fix n and xs :: "bit list"
    show "length (delblockhelp xs n) \<le> length xs"
      by (induct n rule: delblockhelp.induct) auto
  qed
  have "\<And>x xs :: bit list. length (delblock (x#xs)) < Suc (length xs)"
  proof -
    fix x and xs :: "bit list"
    from aux have "length (delblockhelp xs 511) < Suc (length xs)"
    using le_less_trans [of "length (delblockhelp xs 511)" "length xs"] by auto
    then show "length (delblock (x#xs)) < Suc (length xs)" by (simp add: delblock)
  qed
  then show ?thesis
    by (relation "measure (\<lambda>(b, x, A, B, C, D, E). length x)") auto
qed

definition IV1 where
  IV1: "IV1 = hexvtobv [x6,x7,x4,x5,x2,x3,x0,x1]"

definition IV2 where
  IV2: "IV2 = hexvtobv [xE,xF,xC,xD,xA,xB,x8,x9]"

definition IV3 where
  IV3: "IV3 = hexvtobv [x9,x8,xB,xA,xD,xC,xF,xE]"

definition IV4 where
  IV4: "IV4 = hexvtobv [x1,x0,x3,x2,x5,x4,x7,x6]"

definition IV5 where
  IV5: "IV5 = hexvtobv [xC,x3,xD,x2,xE,x1,xF,x0]"

definition sha1 where
  sha1: "sha1 x = (let y = sha1padd x in
  sha1block (getblock y) (delblock y) IV1 IV2 IV3 IV4 IV5)"

lemma sha1blocklen: "length (sha1block b x A B C D E) = 160"
proof (induct b x A B C D E rule: sha1block.induct)
  case 1 show ?case by (simp add: Let_def addmod32len)
next
  case 2 then show ?case by (simp add: Let_def)
qed

lemma sha1len: "length (sha1 m) = 160"
  unfolding sha1 Let_def sha1blocklen ..

end


(* Property from Productive Use of Failure in Inductive Proof,
   Andrew Ireland and Alan Bundy, JAR 1996.
   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_prop_06
  imports "../../Test_Base"
begin

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

datatype Nat = Z | S "Nat"
print_theorems
fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun rev :: "'a list => 'a list" where
  "rev (nil2) = nil2"
| "rev (cons2 z xs) = x (rev xs) (cons2 z (nil2))"

fun length :: "'a list => Nat" where
  "length (nil2) = Z"
| "length (cons2 z xs) = S (length xs)"

fun t2 :: "Nat => Nat => Nat" where
  "t2 (Z) z = z"
| "t2 (S z2) z = S (t2 z2 z)"

theorem property0 :
  "((length (rev (x y z))) = (t2 (length y) (length z)))"
  oops

end


(*  Title:      Inductive definition of termination
    Author:      Tobias Nipkow, 2001/2006
    Maintainer:  Tobias Nipkow
*)
theory PTermi imports PLang begin

subsection\<open>Termination\<close>

inductive
  termi :: "com \<Rightarrow> state \<Rightarrow> bool" (infixl "\<down>" 50)
where
  Do[iff]: "f s \<noteq> {} \<Longrightarrow> Do f \<down> s"
| Semi[intro!]:   "\<lbrakk> c1 \<down> s0; \<And>s1. s0 -c1\<rightarrow> s1 \<Longrightarrow> c2 \<down> s1 \<rbrakk>
            \<Longrightarrow> (c1;c2) \<down> s0"

| IfTrue[intro,simp]: "\<lbrakk> b s; c1 \<down> s \<rbrakk> \<Longrightarrow> IF b THEN c1 ELSE c2 \<down> s"
| IfFalse[intro,simp]: "\<lbrakk> \<not>b s; c2 \<down> s \<rbrakk> \<Longrightarrow> IF b THEN c1 ELSE c2 \<down> s"

| WhileFalse: "\<not>b s \<Longrightarrow> WHILE b DO c \<down> s"

| WhileTrue:  "\<lbrakk> b s; c \<down> s; \<And>t. s -c\<rightarrow> t \<Longrightarrow> WHILE b DO c \<down> t \<rbrakk>
                \<Longrightarrow> WHILE b DO c \<down> s"
| "body \<down> s \<Longrightarrow> CALL \<down> s"

| Local: "c \<down> f s \<Longrightarrow> LOCAL f;c;g \<down> s"

lemma [iff]: "((c1;c2) \<down> s0) = (c1 \<down> s0 \<and> (\<forall>s1. s0 -c1\<rightarrow> s1 \<longrightarrow> c2 \<down> s1))"
apply(rule iffI)
 prefer 2
 apply(best intro:termi.intros)
apply(erule termi.cases)
apply blast+
done

lemma [iff]: "(IF b THEN c1 ELSE c2 \<down> s) =
              ((if b s then c1 else c2) \<down> s)"
apply simp
apply(rule conjI)
apply(rule impI)
apply(rule iffI)
prefer 2
apply(blast intro:termi.intros)
apply(erule termi.cases)
apply blast+
apply(rule impI)
apply(rule iffI)
prefer 2
apply(blast intro:termi.intros)
apply(erule termi.cases)
apply blast+
done

lemma [iff]: "(CALL \<down> s) = (body \<down> s)"
by(fast elim: termi.cases intro:termi.intros)

lemma [iff]: "(LOCAL f;c;g \<down> s) = (c \<down> f s)"
by(fast elim: termi.cases intro:termi.intros)

lemma termi_while_lemma[rule_format]:
 "w\<down>fk \<Longrightarrow>
 (\<forall>k b c. fk = f k \<and> w = WHILE b DO c \<and> (\<forall>i. f i -c\<rightarrow> f(Suc i))
          \<longrightarrow> (\<exists>i. \<not>b(f i)))"
apply(erule termi.induct)
apply simp_all
apply blast
apply blast
done

lemma termi_while:
 "\<lbrakk> (WHILE b DO c) \<down> f k;  \<forall>i. f i -c\<rightarrow> f(Suc i) \<rbrakk> \<Longrightarrow> \<exists>i. \<not>b(f i)"
by(blast intro:termi_while_lemma)

lemma wf_termi: "wf {(t,s). WHILE b DO c \<down> s \<and> b s \<and> s -c\<rightarrow> t}"
apply(subst wf_iff_no_infinite_down_chain)
apply(rule notI)
apply clarsimp
apply(insert termi_while)
apply blast
done

end