(* Author: Max P.L. Haslbeck, Bohua Zhan
*)
section \<open>Imperative Implementation of the Median-of-Medians Selection Algorithm with Runtime Analysis\<close>
theory IHT_Select
  imports "../Functional/Select" IHT_Dynamic_Array_More IHT_Linked_List
begin

subsection \<open>Choose the nth element by insertion sort\<close>

definition select_small :: "'a::{ord,heap} list \<Rightarrow> nat \<Rightarrow> 'a Heap" where
  "select_small xs n = do {
     p \<leftarrow> os_insert_sort xs;
     return (p ! n)
    }"

definition select_small_time :: "nat \<Rightarrow> nat" where [rewrite]:
  "select_small_time n = os_insert_sort_time n + 1"

lemma select_small_rule [hoare_triple]:
  "length xs \<le> B \<Longrightarrow> n < length xs \<Longrightarrow>
   <$(select_small_time B)>
   select_small xs n
   <\<lambda>r. \<up>(r = sort xs ! n)>\<^sub>t"
@proof
  @have "os_insert_sort_time B \<ge>\<^sub>t os_insert_sort_time (length xs)"
@qed
setup \<open>del_prfstep_thm @{thm select_small_time_def}\<close>

subsection \<open>Extract sublist from l to r\<close>

function extract_sublist :: "'a::heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list Heap" where
  "extract_sublist a l r = (if r \<le> l then return [] else do {
     xs \<leftarrow> extract_sublist a (l+1) r;
     x \<leftarrow> Array_Time.nth a l;
     return (x#xs)
   })"
by auto
termination apply (relation "Wellfounded.measure (\<lambda>(a, l, r). (r - l))")  by auto

definition extract_sublist_time :: "nat \<Rightarrow> nat" where
  "extract_sublist_time n = 2 * n + 1"

lemma extract_sublist_time_monotonic [backward]:
  "n \<le> m \<Longrightarrow> extract_sublist_time n \<le> extract_sublist_time m"
  unfolding extract_sublist_time_def by auto

lemma extract_sublist_time_rec [backward]:
  "r > l \<Longrightarrow> extract_sublist_time (r - l) \<ge> extract_sublist_time (r - (l + 1)) + 2"
  unfolding extract_sublist_time_def by auto

lemma extract_sublist_correct [hoare_triple]:
  "r \<le> length xs \<Longrightarrow>
   <a \<mapsto>\<^sub>a xs * $(extract_sublist_time (r - l))>
   extract_sublist a l r
   <\<lambda>rs. a \<mapsto>\<^sub>a xs * \<up>(rs = sublist l r xs)>\<^sub>t"
@proof @fun_induct "extract_sublist a l r"
  @case "r \<le> l" @with @unfold "extract_sublist_time (r - l)" @end
  @have "extract_sublist_time (r - l) \<ge>\<^sub>t extract_sublist_time (r - (l + 1)) + 2"
@qed

subsection \<open>nth term of chop\<close>

setup \<open>register_wellform_data ("chop n xs", ["n > 0"])\<close>
setup \<open>fold add_rewrite_rule @{thms chop.simps(1,3)}\<close>

lemma nth_chop:
  "i < length (chop 5 xs) \<Longrightarrow> chop 5 xs ! i = take 5 (drop (5*i) xs)"
@proof @induct i arbitrary xs @with
  @subgoal "i = 0" @case "xs = []" @endgoal
  @subgoal "i = Suc i"
    @case "xs = []"
    @have "tl (chop 5 xs) = chop 5 (drop 5 xs)"
    @have "chop 5 xs ! (Suc i) = chop 5 (drop 5 xs) ! i"
    @have "chop 5 (drop 5 xs) ! i = take 5 (drop (5 * i) (drop 5 xs))"
  @endgoal @end
@qed

lemma nth_chop_length [resolve]:
  "i < length (chop 5 xs) \<Longrightarrow> chop 5 xs ! i \<noteq> []"
  by (metis chop_elem_not_Nil in_set_conv_nth)

lemma take_drop_to_sublist [rewrite]:
  "i < length (chop 5 xs) \<Longrightarrow> chop 5 xs ! i = sublist (5*i) (5*i+(min 5 (length xs-5*i))) xs"
  by (simp add: add.commute min_def sublist_def take_drop nth_chop)

setup \<open>fold del_prfstep_thm @{thms chop.simps(1,3)}\<close>

subsection \<open>Array-based refinement of medians of chop\<close>

fun chopmed5_aux_fun :: "'a::linorder list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a::linorder list" where
  "chopmed5_aux_fun xs ys 0 = ys"
| "chopmed5_aux_fun xs ys (Suc n) =
    (let l = min 5 (length xs-5*n);
         m = median (sublist (5*n) (5*n+l) xs) in
       list_update (chopmed5_aux_fun xs ys n) n m)"
setup \<open>fold add_rewrite_rule @{thms chopmed5_aux_fun.simps}\<close>

lemma length_chopmed5_aux_fun [rewrite_arg]:
  "length (chopmed5_aux_fun xs ys n) = length ys"
@proof @induct n @qed

lemma chopmed5_aux_fun_ind [rewrite]:
  "n \<le> length ys \<Longrightarrow> length ys = length (chop 5 xs) \<Longrightarrow>
   i < n \<Longrightarrow> chopmed5_aux_fun xs ys n ! i = map median (chop 5 xs) ! i"
@proof @induct n @qed

lemma chopmed5_aux_fun_correct [rewrite]:
  "length ys = length (chop 5 xs) \<Longrightarrow> chopmed5_aux_fun xs ys (length ys) = map median (chop 5 xs)"
@proof
  @have "length (chopmed5_aux_fun xs ys (length ys)) = length (map median (chop 5 xs))"
@qed

subsection \<open>Imperative version of chopmed5\<close>

definition medchop :: "'a::{linorder,heap} array \<Rightarrow> nat \<Rightarrow> 'a Heap" where
  "medchop a n = do {
     l \<leftarrow> Array_Time.len a;
     ls \<leftarrow> extract_sublist a (5*n) (5*n+(min 5 (l-5*n)));
     select_small ls (((min 5 (l-5*n))-1) div 2)
   }"

definition medchop_time :: nat where [rewrite]:
  "medchop_time = extract_sublist_time 5 + select_small_time 5 + 1"

lemma medchop_time81: "medchop_time = 81"
  unfolding medchop_time_def extract_sublist_time_def
    extract_sublist_time_def select_small_time_def os_insert_sort_time_def by simp

lemma helper2 [backward]: "(n::nat) > 0 \<Longrightarrow> (n-1) div 2 < n" by simp

lemma median_sort [backward]: "xs \<noteq> [] \<Longrightarrow> median xs = sort xs ! ((length xs - 1) div 2)"
  by (simp add: Median_Of_Medians_Selection.select_def median_def)

lemma chop_length_prop [resolve]: "n < length (chop 5 xs) \<Longrightarrow> 5 * n \<le> length xs"
  using nth_chop nth_chop_length by fastforce

lemma medchop_rule' [hoare_triple]:
  "n < length (chop 5 xs) \<Longrightarrow>
   <a \<mapsto>\<^sub>a xs * $medchop_time>
    medchop a n
   <\<lambda>r. a \<mapsto>\<^sub>a xs * \<up>(r = median (chop 5 xs ! n) )>\<^sub>t"
@proof
  @let "l = length xs" "sz = min 5 (l - 5*n)"
  @have "5*n + sz \<le> length xs" @with
    @have "5*n + sz \<le> 5*n + (l - 5*n)"
  @end
  @have "extract_sublist_time 5 \<ge>\<^sub>t extract_sublist_time ((5*n+sz)-5*n)"
@qed

fun chopmed5_aux :: "'a::{linorder,heap} array \<Rightarrow> 'a array \<Rightarrow> nat \<Rightarrow> ('a array) Heap" where
  "chopmed5_aux a b 0 = (return b)"
| "chopmed5_aux a b (Suc n) = do {
     x \<leftarrow> medchop a n;
     b' \<leftarrow> chopmed5_aux a b n;
     Array_Time.upd n x b'
   }"

lemma chopmed5_aux_ind [hoare_triple]:
  "length ys = length (chop 5 xs) \<Longrightarrow> i \<le> length ys \<Longrightarrow>
   <a \<mapsto>\<^sub>a xs * b \<mapsto>\<^sub>a ys * $(i*(medchop_time+1) + 1)>
    chopmed5_aux a b i
   <\<lambda>r. a \<mapsto>\<^sub>a xs * r \<mapsto>\<^sub>a chopmed5_aux_fun xs ys i>\<^sub>t"
@proof @induct i @qed

definition chop5_length :: "nat \<Rightarrow> nat" where
  "chop5_length n = nat \<lceil>n / real 5\<rceil>"

lemma chop_length_rel [rewrite_back]: "chop5_length n = (n + 4) div 5"
  unfolding chop5_length_def by linarith

lemma chop5_length_bound [asym_bound]: "(\<lambda>n. chop5_length n) \<in> \<Theta>(\<lambda>n. n)"
  unfolding chop_length_rel by auto2

lemma chop5_length_mono: "n \<le> m \<Longrightarrow> chop5_length n \<le> chop5_length m"
  unfolding chop5_length_def by linarith

lemma chop_length_rule [rewrite_back]:
  "length (chop 5 xs) = chop5_length (length xs)"
  by (simp add: length_chop chop5_length_def)

definition chopmed5_aux_time :: "nat \<Rightarrow> nat" where [rewrite]:
  "chopmed5_aux_time n = chop5_length n * (medchop_time + 1) + 1"

lemma chopmed5_aux_correct [hoare_triple]:
  "length ys = length (chop 5 xs) \<Longrightarrow>
   <a \<mapsto>\<^sub>a xs * b \<mapsto>\<^sub>a ys * $(chopmed5_aux_time (length xs))>
    chopmed5_aux a b (length ys)
   <\<lambda>r. a \<mapsto>\<^sub>a xs * r \<mapsto>\<^sub>a map median (chop 5 xs)>\<^sub>t" by auto2

lemma chopmed5_aux_time_bound [asym_bound]: "(\<lambda>n. chopmed5_aux_time n) \<in> \<Theta>(\<lambda>n. n)"
  unfolding chopmed5_aux_time_def medchop_time81 apply simp by auto2

setup \<open>del_prfstep_thm @{thm chopmed5_aux_time_def}\<close>

definition chopmed5 :: "'a::{linorder,heap} array \<Rightarrow> 'a array Heap" where
  "chopmed5 a = do {
     len \<leftarrow> Array_Time.len a;
     b \<leftarrow> Array_Time.new ((len + 4) div 5) undefined;
     chopmed5_aux a b ((len + 4) div 5)
   }"

definition chopmed5_time :: "nat \<Rightarrow> nat" where
  "chopmed5_time l = 2 + ((l + 4) div 5) + chopmed5_aux_time l"

lemma chopmed5_runtime_mono: "n \<le> m \<Longrightarrow> chopmed5_time n \<le> chopmed5_time m"
  unfolding chopmed5_aux_time_def chopmed5_time_def medchop_time_def extract_sublist_time_def
      select_small_time_def
  by (simp add: add_le_mono os_insert_sort_time_monotonic chop5_length_mono)

lemma chopmed5_rule [hoare_triple]:
  "<a \<mapsto>\<^sub>a xs * $(chopmed5_time (length xs))>
    chopmed5 a
   <\<lambda>r. a \<mapsto>\<^sub>a xs * r \<mapsto>\<^sub>a (map median (chop 5 xs))>\<^sub>t"
@proof @unfold "chopmed5_time (length xs)" @qed

lemma chopmed5_time_bound [asym_bound]: "(\<lambda>n. chopmed5_time n) \<in> \<Theta>(\<lambda>n. n)"
  unfolding chopmed5_time_def by auto2

definition filter_impl :: "'a::{zero,heap} array \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a array Heap" where
  "filter_impl a P = do {
     d <- dfilter_impl a P;
     destroy d
   }"

definition filter_impl_time :: "nat \<Rightarrow> nat" where [rewrite]:
  "filter_impl_time n = dfilter_impl_time n + 3"

lemma filter_impl_rule [hoare_triple]:
  "<a \<mapsto>\<^sub>a as * $(filter_impl_time (length as))>
   filter_impl a P
   <\<lambda>r. a \<mapsto>\<^sub>a as * r \<mapsto>\<^sub>a filter P as>\<^sub>t" by auto2

lemma filter_impl_time_bound [asym_bound]: "(\<lambda>n. filter_impl_time n) \<in> \<Theta>(\<lambda>n. n)"
  unfolding filter_impl_time_def by auto2

setup \<open>del_prfstep_thm @{thm filter_impl_time_def}\<close>

definition threeway_partition_impl :: "'a \<Rightarrow> ('a::{zero,heap,linorder}) array \<Rightarrow> ('a array * 'a array * 'a array) Heap" where
 "threeway_partition_impl med a = do {
      ls \<leftarrow> filter_impl a (\<lambda>x. x < med);
      es \<leftarrow> filter_impl a (\<lambda>x. x = med);
      gs \<leftarrow> filter_impl a (\<lambda>x. x > med);
      return (ls, es, gs)
    }"

definition [rewrite]: "threeway_partition_impl_time l = 1 + 3 * filter_impl_time l"

lemma threeway_partition_impl_time_mono:
  "n \<le> m \<Longrightarrow> threeway_partition_impl_time n \<le> threeway_partition_impl_time m"
  unfolding filter_impl_time_def dfilter_impl_time_def threeway_partition_impl_time_def by auto

lemmas [rewrite] = threeway_partition_def

lemma threeway_partition_impl_rule [hoare_triple]:
  "<a \<mapsto>\<^sub>a as * $ (threeway_partition_impl_time (length as))>
    threeway_partition_impl med a
   <\<lambda>r. a \<mapsto>\<^sub>a as * fst r \<mapsto>\<^sub>a fst (threeway_partition med as)
                 * fst (snd r) \<mapsto>\<^sub>a fst (snd (threeway_partition med as))
                 * snd (snd r) \<mapsto>\<^sub>a snd (snd (threeway_partition med as))>\<^sub>t" by auto2

lemma threeway_partition_impl_time_bound [asym_bound]:
  "(\<lambda>n. threeway_partition_impl_time n) \<in> \<Theta>(\<lambda>n. n)"
  unfolding threeway_partition_impl_time_def by auto2

setup \<open>del_prfstep_thm @{thm threeway_partition_impl_time_def}\<close>

subsection \<open>The deterministic linear-time selection algorithm\<close>

function select_time :: "nat \<Rightarrow> nat" where
  "n \<le> 23 \<Longrightarrow> select_time n = n + 1 + 1 + select_small_time n"
| "n > 23 \<Longrightarrow> select_time n = chopmed5_time n + threeway_partition_impl_time n + 5 +
                (select_time ((n + 4) div 5) +
                 select_time (((7*n) + 9) div 10 + 6))" (* recursive call *)
  by force simp_all
  termination by (relation "Wellfounded.measure (\<lambda>n. n)") auto

definition select_time' :: "nat \<Rightarrow> real" where
  "select_time' n = real (select_time n)"

lemma c: "((7*n) + 9) div 10 = nat \<lceil>0.7 * n\<rceil>"
         "(n + 4) div 5 = nat \<lceil>n / 5\<rceil>" by linarith+

lemma select_time_Theta: "select_time' \<in> \<Theta>(\<lambda>n. real n)"
  apply (master_theorem2 3 recursion: select_time.simps(2) rew: select_time'_def c)
  prefer 4 apply auto2
  by (simp_all add: select_time'_def filter_impl_time_def)

lemma select_time_mono[backward]: "n \<le> m \<Longrightarrow> select_time n \<le> select_time m"
proof(induct m arbitrary: n rule: less_induct)
  case (less m)
  show ?case
  proof(cases "m\<le>23")
    case True
    with less(2) show ?thesis
      by (auto simp add: select_small_time_def os_insert_sort_time_monotonic add_le_mono)
  next
    case False
    note m23 = this
    show ?thesis
    proof(cases "n\<le>23")
      case True
      have a: "((7*m) +9) div 10 + 6 < m"
          "23 \<le> ((7*m) +9) div 10 + 6" apply(simp add: c) using m23 by linarith+
      have "select_time n \<le> select_time 23" apply(rule less(1))
        using m23 True by auto
      also from less(1)[OF a] have "\<dots> \<le> select_time (((7*m) +9) div 10 + 6)" .
      also from m23 have "\<dots> \<le> select_time m" by simp
      finally show ?thesis .
    next
      case False
      from m23 False less(2) have "(m + 4) div 5 < m"
              "(n + 4) div 5 \<le> (m + 4) div 5" by linarith+
      note 1 = less(1)[OF this]
      from m23 False less(2) have "((7*m) +9) div 10 + 6 < m"
              "((7*n) +9) div 10 + 6 \<le> ((7*m) +9) div 10 + 6" by linarith+
      note 2 = less(1)[OF this]
      note 3 = chopmed5_runtime_mono[OF less(2)]
      note 4 = threeway_partition_impl_time_mono[OF less(2)]
      from m23 False show ?thesis apply simp
        using 1 2 3 4 by auto
    qed
  qed
qed

partial_function (heap_time) select :: "nat \<Rightarrow> ('a::{zero,heap,linorder}) array \<Rightarrow> 'a Heap" where
  "select k a = do {
     len \<leftarrow> Array_Time.len a;
     if len \<le> 23 then do {
       alist \<leftarrow> Array_Time.freeze a;
       select_small alist k
     }
     else do {
       medlist \<leftarrow> chopmed5 a;
       med \<leftarrow> select (((len + 4) div 5 - 1) div 2) medlist;
       (ls, es, gs) \<leftarrow> threeway_partition_impl med a;
       ls_len \<leftarrow> Array_Time.len ls;
       es_len \<leftarrow> Array_Time.len es;
       gs_len \<leftarrow> Array_Time.len gs;
       if k < ls_len then
         select k ls
       else if k < ls_len + es_len then
         return med
       else
         select (k - ls_len - es_len) gs
     }
   }"

lemma estim' [backward]:
  "xs \<noteq> [] \<Longrightarrow>
   length [y\<leftarrow>xs. y < fast_select l (((length xs + 4) div 5 - 1) div 2) (map median (chop 5 xs))] \<le> (7 * (length xs) + 9) div 10 + 6"
  apply(rule size_less_greater_median_of_medians_5[where med=median, unfolded c[symmetric]])
  subgoal by blast
  subgoal apply(subst fast_select_correct) apply (simp add: length_chop) apply linarith
    using median_def[where xs="map median (chop 5 xs)", simplified length_map length_chop, simplified, symmetric]
    by (auto simp: c)
  done

lemma estim'' [backward]:
  "xs \<noteq> [] \<Longrightarrow>
   length [y\<leftarrow>xs . y > fast_select l (((length xs + 4) div 5 - 1) div 2)  (map median (chop 5 xs))] \<le> (7 * (length xs) + 9) div 10 + 6"
  apply(rule size_less_greater_median_of_medians_5[where med=median, unfolded c[symmetric]])
  subgoal by blast
  subgoal apply(subst fast_select_correct) apply (simp add: length_chop) apply linarith
    using median_def[where xs="map median (chop 5 xs)", simplified length_map length_chop, simplified, symmetric]
    by (auto simp: c)
  done

lemma length_filter_split:
  fixes xs :: "'a::linorder list"
  shows "length xs = length (filter (\<lambda>y. y < x) xs) + length (filter (\<lambda>y. y = x) xs) + length (filter (\<lambda>y. y > x) xs)"
proof -
  have i: "\<And>xa. (\<not> xa < x \<and> xa = x) = (xa = x)"
          "\<And>xa. (\<not> xa < x \<and> xa \<noteq> x) = (xa > x)" by auto
  have "mset xs = mset (filter (\<lambda>y. y < x) xs)
         + (mset (filter (\<lambda>y. y = x) (filter (\<lambda>y. ~ y < x) xs)) + mset (filter (\<lambda>y. ~ y = x) (filter (\<lambda>y. ~ y < x) xs)))"
    by (auto simp del: filter_filter)
  also have "\<dots> = mset (filter (\<lambda>y. y < x) xs) + mset (filter (\<lambda>y. y = x) xs)
         + mset (filter (\<lambda>y. y > x) xs)"
    apply(subst filter_filter)+ apply auto by (auto simp add: i)
  finally have a: "mset xs = mset (filter (\<lambda>y. y < x) xs) + mset (filter (\<lambda>y. y = x) xs)
         + mset (filter (\<lambda>y. y > x) xs)" by auto
  have "length xs = size (mset xs)" by auto
  also have "\<dots> = size (mset (filter (\<lambda>y. y < x) xs) + mset (filter (\<lambda>y. y = x) xs)
         + mset (filter (\<lambda>y. y > x) xs))" using a by auto
  finally show ?thesis by (metis size_mset size_union)
qed

lemma k_inbounds [backward2]:
  fixes x :: "'a::linorder"
  shows "k \<ge> length (filter (\<lambda>y. y < x) xs) + length (filter (\<lambda>y. y = x) xs) \<Longrightarrow>
         k < length xs \<Longrightarrow>
         k - length (filter (\<lambda>y. y < x) xs) - length (filter (\<lambda>y. y = x) xs) < length (filter (\<lambda>y. y > x) xs)"
  by (simp add: length_filter_split[of xs x])

setup \<open>fold add_rewrite_rule @{thms select_time.simps}\<close>

lemma n_div_5_pos [backward]: "(n::nat) > 0 \<Longrightarrow> (n + 4) div 5 > 0" by linarith

lemma select_rule_aux:
  "k < length as \<Longrightarrow> l = 23 \<Longrightarrow>
   <a \<mapsto>\<^sub>a as * $(select_time (length as))>
    select k a
   <\<lambda>r. a \<mapsto>\<^sub>a as * \<up>(r = fast_select l k as)>\<^sub>t"
@proof @fun_induct "fast_select l k as" arbitrary a
  @unfold "fast_select l k as"
  @let "n = length as"
  @case "n \<le> 23"
  @let "x = fast_select l (((n + 4) div 5 - 1) div 2) (map median (chop 5 as))"
  @let "ls = filter (\<lambda>y. y < x) as"
  @let "es = filter (\<lambda>y. y = x) as"
  @let "gs = filter (\<lambda>y. y > x) as"

  @have "((n + 4) div 5 - 1) div 2 < (n + 4) div 5"
  @case "k < length ls" @with  (* Recursive call on ls *)
    @have "select_time ((7 * n + 9) div 10 + 6) \<ge>\<^sub>t select_time (length ls)"
  @end
  @case "k < length ls + length es"
  @case "k \<ge> length ls + length es" @with  (* Recursive call on gs *)
    @have "select_time ((7 * n + 9) div 10 + 6) \<ge>\<^sub>t select_time (length gs)"
    @have "k - length ls - length es < length gs"
  @end
@qed

lemma select_rule_aux'[hoare_triple]:
  "k < length as \<Longrightarrow>
   <a \<mapsto>\<^sub>a as * $(select_time (length as))>
    select k a
   <\<lambda>r. a \<mapsto>\<^sub>a as * \<up>(r = fast_select 23 k as)>\<^sub>t"
  using select_rule_aux by metis

setup \<open>add_rewrite_rule @{thm fast_select_correct}\<close>
lemma select_rule [hoare_triple]:
  "k < length as \<Longrightarrow>
   <a \<mapsto>\<^sub>a as * $(select_time (length as))>
    select k a
   <\<lambda>r. a \<mapsto>\<^sub>a as * \<up>(r = Median_Of_Medians_Selection.select k as)>\<^sub>t" by auto2
setup \<open>del_prfstep_thm @{thm fast_select_correct}\<close>

corollary select_time_bound [asym_bound]:
  "(\<lambda>n. select_time n) \<in> \<Theta>(\<lambda>n. n)"
  using select_time_Theta unfolding select_time'_def by blast

end


(*  Title:       Examples of hybrid systems verifications
    Author:      Jonathan Julián Huerta y Munive, 2019
    Maintainer:  Jonathan Julián Huerta y Munive <jjhuertaymunive1@sheffield.ac.uk>
*)

section \<open>PID Examples \<close>

text \<open> We prove partial correctness specifications of some hybrid systems with our
verification components.\<close>

theory PID_Examples
  imports "../HS_VC_Spartan"

begin

abbreviation "time_counter_vars \<equiv> {''t'', ''time'', ''counter''}"

typedef time_counter = time_counter_vars
  morphisms to_str to_var
  by blast

notation to_var ("\<downharpoonright>\<^sub>V")

lemma card_time_counter: "CARD(time_counter) = 3"
  using type_definition.card type_definition_time_counter by fastforce

instance time_counter::finite
  apply(standard, subst bij_betw_finite[of to_str UNIV time_counter_vars])
   apply(rule bij_betwI')
     apply (simp add: to_str_inject)
  using to_str apply blast
   apply (metis to_var_inverse UNIV_I)
  by simp

lemma time_counter_univ: "(UNIV::time_counter set) = {\<downharpoonright>\<^sub>V''t'', \<downharpoonright>\<^sub>V''time'' , \<downharpoonright>\<^sub>V''counter''}"
  by auto (metis to_str to_str_inverse insertE singletonD)

lemma time_counter_exhaust: "x = \<downharpoonright>\<^sub>V''t'' \<or> x = \<downharpoonright>\<^sub>V''time'' \<or> x = \<downharpoonright>\<^sub>V''counter''"
  using time_counter_univ by auto

lemma time_counter_sum:
  fixes f :: "time_counter \<Rightarrow> ('a::banach)"
  shows "(\<Sum>(i::time_counter)\<in>UNIV. f i) = f (\<downharpoonright>\<^sub>V''t'') + f (\<downharpoonright>\<^sub>V''time'') + f (\<downharpoonright>\<^sub>V''counter'')"
  unfolding time_counter_univ by (simp add: to_var_inject)

abbreviation val_time_counter :: "real^time_counter \<Rightarrow> string \<Rightarrow> real" (infixl "\<restriction>\<^sub>V" 90)
  where "s\<restriction>\<^sub>Vstring \<equiv> s $ (to_var string)"

lemma time_counter_induct: "P (\<downharpoonright>\<^sub>V''t'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''time'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''counter'') \<Longrightarrow> \<forall>i. P i"
  using time_counter_exhaust by metis

abbreviation time_counter_vec_field :: "real^time_counter \<Rightarrow> real^time_counter" ("f")
  where "f s \<equiv> (\<chi> i. if i = \<downharpoonright>\<^sub>V''t'' then 1 else 0)"

abbreviation time_counter_flow :: "real \<Rightarrow> real^time_counter \<Rightarrow> real^time_counter" ("\<phi>")
  where "\<phi> t s \<equiv> (\<chi> i. if i = \<downharpoonright>\<^sub>V''t'' then t + s\<restriction>\<^sub>V''t'' else s $ i)"

lemma local_lipschitz_time_counter_vec_field: "local_lipschitz UNIV UNIV (\<lambda>t. f)"
  apply(unfold local_lipschitz_def lipschitz_on_def dist_norm)
  apply(clarsimp, rule_tac x=1 in exI, clarsimp, rule_tac x=1 in exI)
  apply(clarsimp simp: norm_vec_def L2_set_def)
  unfolding time_counter_sum by (simp add: to_var_inject)

lemma local_flow_time_counter: "local_flow f UNIV UNIV \<phi>"
  apply(unfold_locales, simp_all add: vec_eq_iff local_lipschitz_time_counter_vec_field)
   apply(rule time_counter_induct, simp_all add: to_var_inject)
  using time_counter_exhaust by (auto intro!: poly_derivatives)

lemma time_loop_verif: "(\<lambda>s. s\<restriction>\<^sub>V''t''=0) \<le> |
   LOOP
    (IF (\<lambda>s. s\<restriction>\<^sub>V''t'' = 0.01) THEN
      (\<downharpoonright>\<^sub>V''t'' ::= (\<lambda>s. 0))
    ELSE
      (x\<acute>= f & (\<lambda>s. s\<restriction>\<^sub>V''t'' \<le> 0.01)))
   INV (\<lambda>s. s\<restriction>\<^sub>V''t''\<le> 0.01)]
  (\<lambda>s. s\<restriction>\<^sub>V''t'' \<le> 0.01)"
  apply(rule fbox_loopI)
    apply(clarsimp simp: to_var_inject)
   apply(clarsimp simp: to_var_inject)
   apply(clarsimp simp: to_var_inject)
  apply(subst local_flow.fbox_g_ode_subset[OF local_flow_time_counter])
  apply simp_all
  done

lemma counter_loop_verif: "(\<lambda>s. s\<restriction>\<^sub>V''counter''=0 \<and> s\<restriction>\<^sub>V''t''=0 \<and> s\<restriction>\<^sub>V''time''=0) \<le> |
   LOOP
    (IF (\<lambda>s. s\<restriction>\<^sub>V''t'' = 0.01) THEN
      (\<downharpoonright>\<^sub>V''time'' ::= (\<lambda>s. s\<restriction>\<^sub>V''time'' + s\<restriction>\<^sub>V''t''));
      (\<downharpoonright>\<^sub>V''t'' ::= (\<lambda>s. 0));
      (\<downharpoonright>\<^sub>V''counter'' ::= (\<lambda>s. s\<restriction>\<^sub>V''counter'' + 1))
    ELSE
      (x\<acute>= f & (\<lambda>s. s\<restriction>\<^sub>V''t'' \<le> 0.01)))
   INV (\<lambda>s. s\<restriction>\<^sub>V''time'' = 0.01* s\<restriction>\<^sub>V''counter'' \<and> s\<restriction>\<^sub>V''t'' \<le> 0.01)]
  (\<lambda>s. s\<restriction>\<^sub>V''time'' = 0.01* s\<restriction>\<^sub>V''counter'')"
  apply(rule fbox_loopI)
    apply(clarsimp simp: to_var_inject)
   apply(clarsimp simp: to_var_inject)
  apply(simp only: fbox_if_then_else, safe)
   apply(clarsimp simp: to_var_inject)
  apply(subst local_flow.fbox_g_ode_subset[OF local_flow_time_counter])
  apply(auto simp: to_var_inject)
  done

no_notation to_var ("\<downharpoonright>\<^sub>V")
        and val_time_counter (infixl "\<restriction>\<^sub>V" 90)
        and time_counter_vec_field ("f")
        and time_counter_flow ("\<phi>")

subsection \<open> PI controller on kinematics \<close>

abbreviation "kin_PI_strs \<equiv> {''t'', ''r'', ''v'', ''T'', ''roll'', ''error'',
  ''roll_rate'', ''error_sum'', ''veri_test'', ''counter''}"

typedef kin_PI_vars = kin_PI_strs
  morphisms to_str to_var
  by blast

notation to_var ("\<downharpoonright>\<^sub>V")

abbreviation "kin_PI_terms \<equiv> {\<downharpoonright>\<^sub>V''t'', \<downharpoonright>\<^sub>V''r'', \<downharpoonright>\<^sub>V''v'', \<downharpoonright>\<^sub>V''T'', \<downharpoonright>\<^sub>V''roll'', \<downharpoonright>\<^sub>V''error'',
  \<downharpoonright>\<^sub>V''roll_rate'', \<downharpoonright>\<^sub>V''error_sum'', \<downharpoonright>\<^sub>V''veri_test'', \<downharpoonright>\<^sub>V''counter''}"

lemma number_of_program_vars: "CARD(kin_PI_vars) = 10"
  using type_definition.card type_definition_kin_PI_vars by fastforce

instance kin_PI_vars::finite
  apply(standard, subst bij_betw_finite[of to_str UNIV kin_PI_strs])
   apply(rule bij_betwI')
     apply (simp add: to_str_inject)
  using to_str apply blast
   apply (metis to_var_inverse UNIV_I)
  by simp

abbreviation val_kin_PI :: "real^kin_PI_vars \<Rightarrow> string \<Rightarrow> real" (infixl "\<restriction>\<^sub>V" 90)
  where "s\<restriction>\<^sub>Vstring \<equiv> s $ (to_var string)"

lemma kin_PI_vars_univ: "(UNIV::kin_PI_vars set) = kin_PI_terms"
  by auto (metis kin_PI_vars.to_str kin_PI_vars.to_str_inverse insertE singletonD)

lemma kin_PI_vars_exhaust: "x = \<downharpoonright>\<^sub>V''t'' \<or> x = \<downharpoonright>\<^sub>V''r'' \<or> x = \<downharpoonright>\<^sub>V''v'' \<or> x = \<downharpoonright>\<^sub>V''T''
  \<or> x = \<downharpoonright>\<^sub>V''roll'' \<or> x = \<downharpoonright>\<^sub>V''roll_rate'' \<or> x = \<downharpoonright>\<^sub>V''error'' \<or> x = \<downharpoonright>\<^sub>V''error_sum''
  \<or> x = \<downharpoonright>\<^sub>V''veri_test'' \<or> x = \<downharpoonright>\<^sub>V''counter''"
  using kin_PI_vars_univ by auto

lemma kin_PI_vars_sum:
  fixes f :: "kin_PI_vars \<Rightarrow> ('a::banach)"
  shows "(\<Sum>i\<in>UNIV. f i) = f (\<downharpoonright>\<^sub>V''t'') + f (\<downharpoonright>\<^sub>V''r'') + f (\<downharpoonright>\<^sub>V''v'') + f (\<downharpoonright>\<^sub>V''T'')
  + f (\<downharpoonright>\<^sub>V''roll'') + f (\<downharpoonright>\<^sub>V''roll_rate'') + f (\<downharpoonright>\<^sub>V''error'') + f (\<downharpoonright>\<^sub>V''error_sum'')
  + f (\<downharpoonright>\<^sub>V''veri_test'') + f (\<downharpoonright>\<^sub>V''counter'')"
  unfolding kin_PI_vars_univ by (simp add: to_var_inject)

lemma kin_PI_vars_induct: "P (\<downharpoonright>\<^sub>V''t'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''r'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''v'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''T'')
  \<Longrightarrow> P (\<downharpoonright>\<^sub>V''roll'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''roll_rate'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''error'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''error_sum'')
  \<Longrightarrow> P (\<downharpoonright>\<^sub>V''veri_test'') \<Longrightarrow> P (\<downharpoonright>\<^sub>V''counter'') \<Longrightarrow> \<forall>i. P i"
  using kin_PI_vars_exhaust by metis

lemma kin_PI_vars_eq:
  "(s1 = s2) \<longleftrightarrow> (s1\<restriction>\<^sub>V''t'' = s2\<restriction>\<^sub>V''t'' \<and> s1\<restriction>\<^sub>V''r'' = s2\<restriction>\<^sub>V''r'' \<and> s1\<restriction>\<^sub>V''v'' = s2\<restriction>\<^sub>V''v'' \<and>
  s1\<restriction>\<^sub>V''T'' = s2\<restriction>\<^sub>V''T'' \<and> s1\<restriction>\<^sub>V''roll'' = s2\<restriction>\<^sub>V''roll'' \<and> s1\<restriction>\<^sub>V''roll_rate'' = s2\<restriction>\<^sub>V''roll_rate'' \<and>
  s1\<restriction>\<^sub>V''error'' = s2\<restriction>\<^sub>V''error'' \<and> s1\<restriction>\<^sub>V''error_sum'' = s2\<restriction>\<^sub>V''error_sum'' \<and>
  s1\<restriction>\<^sub>V''veri_test'' = s2\<restriction>\<^sub>V''veri_test'' \<and> s1\<restriction>\<^sub>V''counter'' = s2\<restriction>\<^sub>V''counter'')"
  apply(clarsimp simp: vec_eq_iff, rule iffI, force)
  by (rule kin_PI_vars_induct, auto)

abbreviation kin_PI_vec_field :: "real^kin_PI_vars \<Rightarrow> real^kin_PI_vars" ("f")
  where "f s \<equiv> (\<chi> i. if i = \<downharpoonright>\<^sub>V''t'' then 1 else
                    (if i = \<downharpoonright>\<^sub>V''r'' then s\<restriction>\<^sub>V''v'' else
                    (if i = \<downharpoonright>\<^sub>V''v'' then s\<restriction>\<^sub>V''T'' else 0)))"

abbreviation kin_PI_flow :: "real \<Rightarrow> real^kin_PI_vars \<Rightarrow> real^kin_PI_vars" ("\<phi>")
  where "\<phi> t s \<equiv>
  (\<chi> i. if i = \<downharpoonright>\<^sub>V''t'' then t + s\<restriction>\<^sub>V''t'' else
       (if i = \<downharpoonright>\<^sub>V''r'' then (s\<restriction>\<^sub>V''T'')*t^2/2 + (s\<restriction>\<^sub>V''v'')*t + (s\<restriction>\<^sub>V''r'') else
       (if i = \<downharpoonright>\<^sub>V''v'' then (s\<restriction>\<^sub>V''T'')*t + (s\<restriction>\<^sub>V''v'') else s$i)))"

lemma local_lipschitz_kin_PI_vec_field: "local_lipschitz UNIV UNIV (\<lambda>t. f)"
  apply(unfold local_lipschitz_def lipschitz_on_def dist_norm)
  apply(clarsimp, rule_tac x=1 in exI, clarsimp, rule_tac x=1 in exI)
  apply(clarsimp simp: norm_vec_def L2_set_def)
  unfolding kin_PI_vars_sum by (simp add: to_var_inject)

lemma local_flow_kin_PI: "local_flow f UNIV UNIV \<phi>"
  apply(unfold_locales, simp_all add: vec_eq_iff local_lipschitz_kin_PI_vec_field)
  apply(rule kin_PI_vars_induct, simp_all add: to_var_inject)
  by (auto intro!: poly_derivatives)

lemma the_inv_real_Suc [simp]: "the_inv real (real m + 1) = Suc m"
  by (metis Groups.add_ac(2) Num.of_nat_simps(3) inj_def of_nat_eq_iff the_inv_f_f)

lemma "real \<circ> the_inv real = id"
  oops

lemma "the_inv real m = 0 \<Longrightarrow> m \<in> \<nat>"
proof(subgoal_tac "m = 0", simp)
  assume h0: "the_inv real m = 0"
  have "0 = real 0"
    by simp
  also have "... = real (the_inv real m)"
    using h0 arg_cong[of _ _ real] by simp
  also have "... = m"
    oops

lemma inNatsD:
  assumes "(n::real) \<in> \<nat>"
  shows "n = 0 \<or> n \<ge> 1"
    and "\<exists>k::nat. the_inv of_nat n = k \<and> ((k = 0) \<or> (\<exists>m. k = Suc m))"
proof-
  obtain n'::nat where obs: "n = real n'"
    using assms unfolding Nats_def by blast
  have "n' = 0 \<or> n' \<ge> 1"
    by auto
  thus "n = 0 \<or> n \<ge> 1"
    using obs by (simp add: real_of_nat_ge_one_iff)
  then show "\<exists>k::nat. the_inv of_nat n = k \<and> ((k = 0) \<or> (\<exists>m. k = Suc m))"
    using not0_implies_Suc by fastforce
qed

lemma PI_controller_invariants:
  shows "(\<lambda>s. s\<restriction>\<^sub>V''t''=0 \<and> s\<restriction>\<^sub>V''r''=0 \<and> s\<restriction>\<^sub>V''v''=0 \<and> s\<restriction>\<^sub>V''T''=1 \<and> s\<restriction>\<^sub>V''roll'' = 0 \<and> s\<restriction>\<^sub>V''roll_rate''=0 \<and>
  s\<restriction>\<^sub>V''error'' = 0 \<and> s\<restriction>\<^sub>V''error_sum''=0 \<and> s\<restriction>\<^sub>V''veri_test''=0 \<and> s\<restriction>\<^sub>V''counter''=0) \<le>
  |LOOP
    (IF (\<lambda>s. s\<restriction>\<^sub>V''t'' = dt) THEN
      \<comment> \<open>CONTROL\<close>
        (\<downharpoonright>\<^sub>V''error'' ::= (\<lambda>s. s\<restriction>\<^sub>V''r'' - s\<restriction>\<^sub>V''roll''));
        (\<downharpoonright>\<^sub>V''error_sum'' ::= (\<lambda>s. s\<restriction>\<^sub>V''error_sum'' + s\<restriction>\<^sub>V''error''));
        (\<downharpoonright>\<^sub>V''T'' ::= (\<lambda>s. Prop * s\<restriction>\<^sub>V''error'' + Integr * dt * s\<restriction>\<^sub>V''error_sum''));
        (\<downharpoonright>\<^sub>V''roll'' ::= (\<lambda>s. s\<restriction>\<^sub>V''r''));
        (\<downharpoonright>\<^sub>V''roll_rate'' ::= (\<lambda>s. s\<restriction>\<^sub>V''v''));
        (\<downharpoonright>\<^sub>V''veri_test'' ::= (\<lambda>s. s\<restriction>\<^sub>V''veri_test'' + s\<restriction>\<^sub>V''error_sum''));
        (\<downharpoonright>\<^sub>V''counter'' ::= (\<lambda>s. s\<restriction>\<^sub>V''counter'' + 1));
        (\<downharpoonright>\<^sub>V''t'' ::= (\<lambda>s. 0))
     ELSE
      \<comment> \<open>DYNAMICS\<close>
        (x\<acute>= f & (\<lambda>s. s\<restriction>\<^sub>V''t'' \<le> dt)))
   INV (\<lambda>s. (s\<restriction>\<^sub>V''counter'' \<ge> 1 \<longrightarrow> s\<restriction>\<^sub>V''T'' = Prop * s\<restriction>\<^sub>V''error'' + Integr * dt * s\<restriction>\<^sub>V''error_sum'') \<and>
  s\<restriction>\<^sub>V''counter'' \<in> \<nat> \<and> s\<restriction>\<^sub>V''v'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll_rate'' \<and>
  s\<restriction>\<^sub>V''r'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t''^2/2 + s\<restriction>\<^sub>V''roll_rate'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll'')]
  (\<lambda>s. (s\<restriction>\<^sub>V''counter'' \<ge> 1 \<longrightarrow> s\<restriction>\<^sub>V''T'' = Prop * s\<restriction>\<^sub>V''error'' + Integr * dt * s\<restriction>\<^sub>V''error_sum'') \<and>
    s\<restriction>\<^sub>V''counter'' \<in> \<nat> \<and> s\<restriction>\<^sub>V''v'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll_rate'' \<and>
    s\<restriction>\<^sub>V''r'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t''^2/2 + s\<restriction>\<^sub>V''roll_rate'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll'')"
  apply(rule fbox_loopI)
    apply (clarsimp simp: to_var_inject, clarsimp simp: to_var_inject)
  apply(subst fbox_if_then_else, clarify, rule conjI)
   apply (clarsimp simp: to_var_inject power2_sum)
  apply(subst local_flow.fbox_g_ode_subset[OF local_flow_kin_PI], simp)
  apply(clarsimp simp: le_fun_def to_var_inject power2_sum)
   apply(force simp: field_simps)
  done

lemma PI_controller_invariants2:
  assumes "Prop = -6" and "Integr = -0.1" and "dt = 0.01"
  shows "(\<lambda>s. s\<restriction>\<^sub>V''t''=0 \<and> s\<restriction>\<^sub>V''v'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll_rate'' \<and> s\<restriction>\<^sub>V''counter'' \<in> \<nat> \<and>
    s\<restriction>\<^sub>V''r'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t''^2/2 + s\<restriction>\<^sub>V''roll_rate'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll'' \<and>
    s\<restriction>\<^sub>V''T''= Prop * s\<restriction>\<^sub>V''error'' + Integr * dt * s\<restriction>\<^sub>V''error_sum'' \<and> s\<restriction>\<^sub>V''error_sum'' - s\<restriction>\<^sub>V''error'' \<le> 2/10 \<and>
    s\<restriction>\<^sub>V''roll_rate'' = Prop * dt * (s\<restriction>\<^sub>V''error_sum'' - s\<restriction>\<^sub>V''error'') + Integr * dt^2 * (s\<restriction>\<^sub>V''veri_test'' - s\<restriction>\<^sub>V''error_sum'')) \<le>
  |LOOP
    (IF (\<lambda>s. s\<restriction>\<^sub>V''t'' = dt) THEN
      \<comment> \<open>CONTROL\<close>
        (\<downharpoonright>\<^sub>V''error'' ::= (\<lambda>s. s\<restriction>\<^sub>V''r'' - s\<restriction>\<^sub>V''roll''));
        (\<downharpoonright>\<^sub>V''error_sum'' ::= (\<lambda>s. s\<restriction>\<^sub>V''error_sum'' + s\<restriction>\<^sub>V''error''));
        (\<downharpoonright>\<^sub>V''T'' ::= (\<lambda>s. Prop * s\<restriction>\<^sub>V''error'' + Integr * dt * s\<restriction>\<^sub>V''error_sum''));
        (\<downharpoonright>\<^sub>V''roll'' ::= (\<lambda>s. s\<restriction>\<^sub>V''r''));
        (\<downharpoonright>\<^sub>V''roll_rate'' ::= (\<lambda>s. s\<restriction>\<^sub>V''v''));
        (\<downharpoonright>\<^sub>V''veri_test'' ::= (\<lambda>s. s\<restriction>\<^sub>V''veri_test'' + s\<restriction>\<^sub>V''error_sum''));
        (\<downharpoonright>\<^sub>V''t'' ::= (\<lambda>s. 0))
     ELSE
      \<comment> \<open>DYNAMICS\<close>
        (x\<acute>= f & (\<lambda>s. 0 \<le> s\<restriction>\<^sub>V''t'' \<and> s\<restriction>\<^sub>V''t'' \<le> dt)))
   INV (\<lambda>s. s\<restriction>\<^sub>V''T'' = Prop * s\<restriction>\<^sub>V''error'' + Integr * dt * s\<restriction>\<^sub>V''error_sum'' \<and>
    s\<restriction>\<^sub>V''roll_rate'' = Prop * dt * (s\<restriction>\<^sub>V''error_sum'' - s\<restriction>\<^sub>V''error'')
      + Integr * dt^2 * (s\<restriction>\<^sub>V''veri_test'' - s\<restriction>\<^sub>V''error_sum'') \<and>
    s\<restriction>\<^sub>V''counter'' \<in> \<nat> \<and> s\<restriction>\<^sub>V''v'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll_rate'' \<and>
    s\<restriction>\<^sub>V''r'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t''^2/2 + s\<restriction>\<^sub>V''roll_rate'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll'')]
  (\<lambda>s. s\<restriction>\<^sub>V''T'' = Prop * s\<restriction>\<^sub>V''error'' + Integr * dt * s\<restriction>\<^sub>V''error_sum'' \<and>
    s\<restriction>\<^sub>V''counter'' \<in> \<nat> \<and> s\<restriction>\<^sub>V''v'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll_rate'' \<and>
    s\<restriction>\<^sub>V''r'' = s\<restriction>\<^sub>V''T'' * s\<restriction>\<^sub>V''t''^2/2 + s\<restriction>\<^sub>V''roll_rate'' * s\<restriction>\<^sub>V''t'' + s\<restriction>\<^sub>V''roll'')"
  apply(rule fbox_loopI)
    apply (clarsimp simp: to_var_inject)
   apply (clarsimp simp: to_var_inject)
  apply(subst fbox_if_then_else, clarify, rule conjI)
   apply (force simp: to_var_inject power2_eq_square field_simps)
  apply(subst local_flow.fbox_g_ode_subset[OF local_flow_kin_PI], simp)
  apply(clarsimp simp: le_fun_def to_var_inject power2_sum)
   apply(force simp: field_simps)
  done

end


theory prop_29
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  fun qrev :: "'a list => 'a list => 'a list" where
  "qrev (Nil2) y = y"
  | "qrev (Cons2 z xs) y = qrev xs (Cons2 z y)"
  fun append :: "'a list => 'a list => 'a list" where
  "append (Nil2) y = y"
  | "append (Cons2 z xs) y = Cons2 z (append xs y)"
  fun rev :: "'a list => 'a list" where
  "rev (Nil2) = Nil2"
  | "rev (Cons2 y xs) = append (rev xs) (Cons2 y (Nil2))"
  (*hipster qrev append rev *)

(*hipster qrev append rev*)
lemma lemma_a [thy_expl]: "append x2 Nil2 = x2"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

lemma lemma_aa [thy_expl]: "append (append x1 y1) z1 = append x1 (append y1 z1)"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

lemma lemma_ab [thy_expl]: "append (qrev x1 y1) z1 = qrev x1 (append y1 z1)"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

lemma lemma_ac [thy_expl]: "qrev (append x1 y1) z1 = qrev y1 (qrev x1 z1)"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

lemma lemma_ad [thy_expl]: "qrev (qrev x1 y1) z1 = qrev y1 (append x1 z1)"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

lemma lemma_ae [thy_expl]: "append (rev x3) y3 = qrev x3 y3"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

  theorem x0 :
    "(rev (qrev x (Nil2))) = x"
    by (hipster_induct_schemes qrev.simps append.simps rev.simps)
end