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

datatype ('a, 'b) pair = pair2 "'a" "'b"

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

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

(*fun did not finish the proof*)
function twoThirds :: "int => int" where
  "twoThirds y =
   (if (y = 2) then 1 else
      (if (y = 1) then 1 else
         (if (y = 0) then 0 else 2 + (twoThirds (y - 3)))))"
  by pat_completeness auto

(*fun did not finish the proof*)
function third :: "int => int" where
  "third y =
   (if (y = 2) then 0 else
      (if (y = 1) then 0 else
         (if (y = 0) then 0 else 1 + (third (y - 3)))))"
  by pat_completeness auto

fun take :: "int => 'a list => 'a list" where
  "take y z =
   (if y <= 0 then nil2 else
      (case z of
         nil2 => nil2
         | cons2 z2 xs => cons2 z2 (take (y - 1) xs)))"

fun sort2 :: "int => int => int list" where
  "sort2 y z =
   (if y <= z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun length :: "'a list => int" where
  "length (nil2) = 0"
| "length (cons2 z l) = 1 + (length l)"

fun elem :: "'a => 'a list => bool" where
  "elem y (nil2) = False"
| "elem y (cons2 z2 xs) = ((z2 = y) | (elem y xs))"

fun drop :: "int => 'a list => 'a list" where
  "drop y z =
   (if y <= 0 then z else
      (case z of
         nil2 => nil2
         | cons2 z2 xs1 => drop (y - 1) xs1))"

fun splitAt :: "int => 'a list =>
                (('a list), ('a list)) pair" where
  "splitAt y z = pair2 (take y z) (drop y z)"

function nstooge2sort2 :: "int list => int list"
  and nstoogesort2 :: "int list => int list"
  and nstooge2sort1 :: "int list => int list" where
  "nstooge2sort2 y =
   (case splitAt (twoThirds (length y)) y of
      pair2 ys2 zs1 => x (nstoogesort2 ys2) zs1)"
| "nstoogesort2 (nil2) = nil2"
| "nstoogesort2 (cons2 z (nil2)) = cons2 z (nil2)"
| "nstoogesort2 (cons2 z (cons2 y2 (nil2))) = sort2 z y2"
| "nstoogesort2 (cons2 z (cons2 y2 (cons2 x3 x4))) =
     nstooge2sort2
       (nstooge2sort1 (nstooge2sort2 (cons2 z (cons2 y2 (cons2 x3 x4)))))"
| "nstooge2sort1 y =
     (case splitAt (third (length y)) y of
        pair2 ys2 zs1 => x ys2 (nstoogesort2 zs1))"
  by pat_completeness auto

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
  "deleteBy y z (nil2) = nil2"
| "deleteBy y z (cons2 y2 ys) =
     (if (y z) y2 then ys else cons2 y2 (deleteBy y z ys))"

fun isPermutation :: "'a list => 'a list => bool" where
  "isPermutation (nil2) (nil2) = True"
| "isPermutation (nil2) (cons2 z2 x2) = False"
| "isPermutation (cons2 x3 xs) z =
     ((elem x3 z) &
        (isPermutation
           xs (deleteBy (% (x4 :: 'a) => % (x5 :: 'a) => (x4 = x5)) x3 z)))"

theorem property0 :
  "isPermutation (nstoogesort2 xs) xs"
  oops

end


(*  Title:      IL_AF_Stream.thy
    Date:       Jan 2007
    Author:     David Trachtenherz
*)

section \<open>\textsc{AutoFocus} message streams and temporal logic on intervals\<close>

theory IL_AF_Stream
imports Main "Nat-Interval-Logic.IL_TemporalOperators" AF_Stream
begin

subsection \<open>Stream views -- joining streams and intervals\<close>

subsubsection \<open>Basic definitions\<close>

primrec f_join_aux :: "'a list \<Rightarrow> nat \<Rightarrow> iT \<Rightarrow> 'a list"
where
  "f_join_aux [] n I = []"
| "f_join_aux (x # xs) n I =
    (if n \<in> I then [x] else []) @ f_join_aux xs (Suc n) I"

text \<open>
  The functions \<open>f_join\<close> and \<open>i_join\<close>
  deliver views of finite and infinite streams through intervals
  (more exactly: arbitrary natural sets).
  A stream view contains only the elements of the original stream
  at positions, which are contained in the interval.
  For instance, \<open>f_join [0,10,20,30,40] {1,4} = [10,40]\<close>\<close>

definition f_join :: "'a list \<Rightarrow> iT \<Rightarrow> 'a list"      (infixl "\<Join>\<^sub>f" 100)
  where "xs \<Join>\<^sub>f I \<equiv> f_join_aux xs 0 I"

definition i_join :: "'a ilist \<Rightarrow> iT \<Rightarrow> 'a ilist"    (infixl "\<Join>\<^sub>i" 100)
  where "f \<Join>\<^sub>i I \<equiv> \<lambda>n. (f (I \<rightarrow> n))"

notation
  f_join  (infixl "\<Join>\<^sub>" 100) and
  i_join  (infixl "\<Join>\<^sub>" 100)

text \<open>
  The function \<open>i_f_join\<close> can be used for the case,
  when an infinite stream is joined with a finite interval.
  The function \<open>i_join\<close> would then deliver
  an infinite stream, whose elements after position \<open>card I\<close>
  are equal to initial stream's element at position \<open>Max I\<close>.
  The function \<open>i_f_join\<close> in contrast
  cuts the resulting stream at this position
  and returns a finite stream.\<close>

definition i_f_join :: "'a ilist \<Rightarrow> iT \<Rightarrow> 'a list"    (infixl "\<Join>\<^bsub>i-f\<^esub>" 100)
  where "f \<Join>\<^bsub>i-f\<^esub> I \<equiv> f \<Down> Suc (Max I) \<Join>\<^sub>f I"
notation
  i_f_join  (infixl "\<Join>\<^sub>" 100)

text \<open>
  The function \<open>i_f_join\<close> should be used
  only for finite sets in order to deliver well-defined results.
  The function \<open>i_join\<close> should be used for infinite sets,
  because joining an infinite stream \<open>s\<close> and a finite set \<open>I\<close>
  using \<open>i_join\<close> would deliver an infinite stream,
  ending with an infinite sequence of elements equal to
  \<open>s (Max I)\<close>.\<close>

subsubsection \<open>Basic results\<close>

lemma f_join_aux_length: "
  \<And>n. length (f_join_aux xs n I) = card (I \<inter> {n..<n + length xs})"
apply (induct xs, simp)
apply (simp add: atLeastLessThan_def)
apply (rule_tac t="{n..}" and s="insert n {Suc n..}" in subst, fastforce)
apply simp
done

lemma f_join_aux_nth[rule_format]: "
  \<forall>n i. i < card (I \<inter> {n..<n + length xs}) \<longrightarrow>
  (f_join_aux xs n I) ! i = xs ! (((I \<inter> {n..<n + length xs}) \<rightarrow> i) - n)"
apply (induct xs, simp)
apply (clarsimp split del: if_split)
apply (subgoal_tac "{n..<Suc (n + length xs)} = insert n {Suc n..<Suc (n + length xs)}")
 prefer 2
 apply fastforce
apply (frule card_gr0_imp_not_empty[OF gr_implies_gr0])
apply (case_tac "n \<in> I")
 prefer 2
 apply (simp add: nth_Cons')
 apply (subgoal_tac "Suc n \<le> (I \<inter> {Suc n..<Suc (n + length xs)}) \<rightarrow> i", simp)
 apply (rule order_trans[OF _ iMin_le[OF inext_nth_closed]])
  apply (rule order_trans[OF _ iMin_Int_ge2])
   apply (subgoal_tac "n < n + length xs")
    prefer 2
    apply (rule ccontr, simp)
   apply (simp add: iMin_atLeastLessThan)
  apply assumption+
apply simp
apply (case_tac "I \<inter> {Suc n..<Suc (n + length xs)} = {}", simp)
apply (case_tac i)
 apply (simp add: iMin_insert)
apply (subgoal_tac "Suc n \<le> iMin {Suc n..<Suc (n + length xs)}")
 prefer 2
 apply (subgoal_tac "n < n + length xs")
  prefer 2
  apply (rule ccontr, simp)
 apply (simp add: iMin_atLeastLessThan)
apply (rename_tac i1)
apply (simp del: inext_nth.simps)
apply (subst inext_nth_insert_Suc)
   apply simp
  apply (rule Suc_le_lessD)
  apply (rule order_trans[OF _ iMin_Int_ge2])
  apply assumption+
apply (simp add: nth_Cons')
apply (subgoal_tac "Suc n \<le> (I \<inter> {Suc n..<Suc (n + length xs)}) \<rightarrow> i1", simp)
apply (rule order_trans[OF _ iMin_le[OF inext_nth_closed]])
 apply (rule order_trans[OF _ iMin_Int_ge2])
 apply assumption+
done

text \<open>Joining finite streams and intervals\<close>

(*<*)
(*
lemma "[(0::nat),10,20,30,40] \<Join>\<^sub>f {1,4} = [10,40]"
by (simp add: f_join_def)
*)
(*>*)

lemma f_join_length: "length (xs \<Join>\<^sub>f I) = card (I \<down>< length xs)"
by (simp add: f_join_def f_join_aux_length atLeast0LessThan cut_less_Int_conv)

lemma f_join_nth: "n < length (xs \<Join>\<^sub>f I) \<Longrightarrow> (xs \<Join>\<^sub>f I) ! n = xs ! (I \<rightarrow> n)"
apply (simp add: f_join_length)
apply (unfold f_join_def)
apply (drule back_subst[OF _ cut_less_Int_conv])
apply (simp add: f_join_aux_nth atLeast0LessThan cut_less_Int_conv[symmetric] inext_nth_cut_less_eq)
done

lemma f_join_nth2: "n < card (I \<down>< length xs) \<Longrightarrow> (xs \<Join>\<^sub>f I) ! n = xs ! (I \<rightarrow> n)"
by (simp add: f_join_nth f_join_length)

lemma f_join_empty: "xs \<Join>\<^sub>f {} = []"
by (simp add: length_0_conv[symmetric] f_join_length cut_less_empty del: length_0_conv)

lemma f_join_Nil: "[] \<Join>\<^sub>f I = []"
by (simp add: length_0_conv[symmetric] f_join_length cut_less_0_empty del: length_0_conv)

lemma f_join_Nil_conv: "(xs \<Join>\<^sub>f I = []) = (I \<down>< length xs = {})"
by (simp add: length_0_conv[symmetric] f_join_length card_0_eq[OF nat_cut_less_finite] del: length_0_conv)

lemma f_join_Nil_conv': "(xs \<Join>\<^sub>f I = []) = (\<forall>i<length xs. i \<notin> I)"
by (fastforce simp: f_join_Nil_conv)

lemma f_join_all_conv: "(xs \<Join>\<^sub>f I = xs) = ({..<length xs} \<subseteq> I)"
apply (case_tac "length xs = 0", simp add: f_join_Nil)
apply (rule iffI)
 apply (rule subsetI, rename_tac t)
 apply (clarsimp simp: list_eq_iff[of _ xs] f_join_length)
 apply (rule ccontr)
 apply (subgoal_tac "I \<down>< length xs \<subset> {..<length xs}")
  prefer 2
  apply blast
 apply (drule psubset_card_mono[OF finite_lessThan])
 apply simp
apply (subgoal_tac "length (xs \<Join>\<^sub>f I) = length xs")
 prefer 2
 apply (simp add: f_join_length cut_less_Int_conv Int_absorb1)
apply (clarsimp simp: list_eq_iff[of _ xs] f_join_nth)
apply (rule arg_cong[where f="(!) xs"])
apply (subgoal_tac "I \<down>< length xs = {..<length xs}")
 prefer 2
 apply fastforce
apply (subst inext_nth_cut_less_eq[where t="length xs", symmetric], simp)
apply (simp add: inext_nth_lessThan)
done

lemma f_join_all: "{..<length xs} \<subseteq> I \<Longrightarrow> xs \<Join>\<^sub>f I = xs"
by (rule f_join_all_conv[THEN iffD2])

corollary f_join_UNIV: "xs \<Join>\<^sub>f UNIV = xs"
by (simp add: f_join_all)

lemma f_join_union: "
  \<lbrakk> finite A; Max A < iMin B \<rbrakk> \<Longrightarrow> xs \<Join>\<^sub>f (A \<union> B) = xs \<Join>\<^sub>f A @ (xs \<Join>\<^sub>f B)"
apply (case_tac "A = {}", simp add: f_join_empty)
apply (case_tac "B = {}", simp add: f_join_empty)
apply (frule Max_less_iMin_imp_disjoint, assumption)
apply (simp add: list_eq_iff f_join_length cut_less_Un del: Max_less_iff)
apply (subgoal_tac "A \<down>< length xs \<inter> B \<down>< length xs = {}")
 prefer 2
 apply (simp add: cut_less_Int[symmetric] cut_less_empty)
apply (frule card_Un_disjoint[OF nat_cut_less_finite nat_cut_less_finite])
apply (clarsimp simp del: Max_less_iff)
apply (subst f_join_nth)
 apply (simp add: f_join_length cut_less_Un)
apply (simp add: nth_append f_join_length del: Max_less_iff, intro conjI impI)
 apply (simp add: f_join_nth f_join_length del: Max_less_iff)
   apply (rule ssubst[OF inext_nth_card_append_eq1], assumption)
  apply (rule order_less_le_trans[OF _ cut_less_card], assumption+)
 apply simp
apply (subst f_join_nth)
 apply (simp add: f_join_length)
apply (subgoal_tac "iMin B < length xs")
 prefer 2
 apply (rule ccontr)
 apply (simp add: linorder_not_less cut_less_Min_empty)
apply (frule order_less_trans, assumption)
apply (rule arg_cong[where f="\<lambda>x. xs ! x"])
apply (simp add: cut_less_Max_all inext_nth_card_append_eq2)
done

lemma f_join_insert: "
  n < length xs \<Longrightarrow>
  xs \<Join>\<^sub>f insert n I = xs \<Join>\<^sub>f (I \<down>< n) @ (xs ! n) # (xs \<Join>\<^sub>f (I \<down>> n))"
apply (rule_tac t="insert n I" and s="(I \<down>< n) \<union> {n} \<union> (I \<down>> n)" in subst, fastforce)
apply (insert nat_cut_less_finite[of I n])
apply (case_tac "I \<down>> n = {}")
 apply (simp add: f_join_empty del: Un_insert_right)
 apply (case_tac "I \<down>< n = {}")
  apply (simp add: f_join_empty f_join_singleton_if)
 apply (subgoal_tac "Max (I \<down>< n) < iMin {n}")
  prefer 2
  apply (simp add: cut_less_mem_iff)
 apply (simp add: f_join_union f_join_singleton_if del: Un_insert_right)
apply (subgoal_tac "Max {n} < iMin (I \<down>> n)")
 prefer 2
 apply (simp add: iMin_gr_iff cut_greater_mem_iff)
apply (case_tac "I \<down>< n = {}")
 apply (simp add: f_join_empty f_join_union f_join_singleton_if del: Un_insert_left)
apply (subgoal_tac "Max (I \<down>< n) < iMin {n}")
 prefer 2
 apply (simp add: cut_less_mem_iff)
apply (subgoal_tac "Max (I \<down>< n \<union> {n}) < iMin (I \<down>> n)")
 prefer 2
 apply (simp add: iMin_gr_iff i_cut_mem_iff)
apply (simp add: f_join_union f_join_singleton_if del: Un_insert_right)
done

lemma f_join_snoc: "
  (xs @ [x]) \<Join>\<^sub>f I =
  xs \<Join>\<^sub>f I @ (if length xs \<in> I then [x] else [])"
apply (simp add: list_eq_iff f_join_length)
apply (subgoal_tac "
  card (I \<down>< Suc (length xs)) =
  card (I \<down>< length xs) + (if length xs \<in> I then Suc 0 else 0)")
 prefer 2
 apply (simp add: nat_cut_le_less_conv[symmetric] cut_le_less_conv_if)
 apply (simp add: card_insert_if[OF nat_cut_less_finite] cut_less_mem_iff)
apply simp
apply (case_tac "length xs \<in> I")
 apply (clarsimp simp: f_join_length)
 apply (simp add: nth_append f_join_length, intro conjI impI)
  apply (subst f_join_nth[of _ "xs @ [x]"])
   apply (simp add: f_join_length)
  apply (simp add: nth_append less_card_cut_less_imp_inext_nth_less)
  apply (simp add: f_join_nth f_join_length)
 apply (simp add: linorder_not_less less_Suc_eq_le)
 apply (subst f_join_nth)
  apply (simp add: f_join_length)
 apply (subgoal_tac "I \<rightarrow> i = length xs")
  prefer 2
  apply (rule_tac t="length xs" and s="Max (I \<down>< Suc (length xs))" in subst)
   apply (rule Max_equality[OF _ nat_cut_less_finite])
   apply (simp add: cut_less_mem_iff)+
  apply (subst inext_nth_cut_less_eq[of _ _ "Suc (length xs)", symmetric], simp)
  apply (rule inext_nth_card_Max[OF nat_cut_less_finite])
   apply (simp add: card_gr0_imp_not_empty)
  apply simp+
apply (simp add: f_join_nth f_join_length)
apply (simp add: nth_append less_card_cut_less_imp_inext_nth_less)
done

(*<*)
(*
lemma "
  let xs = [0::nat,10,20,30]; ys =[100,110,120,130]; I = {0,2,4,6} in
  (xs @ ys) \<Join>\<^sub>f I = xs \<Join>\<^sub>f I @ (ys \<Join>\<^sub>f (I \<oplus>- (length xs)))"
by (simp add: Let_def f_join_def iT_Plus_neg_def)
*)
(*>*)

lemma f_join_append: "
  (xs @ ys) \<Join>\<^sub>f I = xs \<Join>\<^sub>f I @ ys \<Join>\<^sub>f (I \<oplus>- (length xs))"
apply (induct ys rule: rev_induct)
 apply (simp add: f_join_Nil)
apply (simp add: append_assoc[symmetric] f_join_snoc del: append_assoc)
apply (simp add: iT_Plus_neg_mem_iff add.commute[of "length xs"])
done

lemma take_f_join_eq1: "
  n < card (I \<down>< length xs) \<Longrightarrow>
  (xs \<Join>\<^sub>f I) \<down> n = xs \<Join>\<^sub>f (I \<down>< (I \<rightarrow> n))"
apply (frule less_card_cut_less_imp_inext_nth_less)
apply (simp add: list_eq_iff f_join_length cut_cut_less min_eqR)
apply (subgoal_tac "n < card I \<or> infinite I")
 prefer 2
 apply (case_tac "finite I")
 apply (drule order_less_le_trans[OF _ cut_less_card], simp+)
apply (simp add: min_eqL cut_less_inext_nth_card_eq1)
apply clarify
apply (subst f_join_nth)
 apply (simp add: f_join_length)
apply (subst f_join_nth)
 apply (simp add: f_join_length cut_cut_less min_eqL)
 apply (simp add: cut_less_inext_nth_card_eq1)
apply (simp add: cut_less_inext_nth_card_eq1 inext_nth_cut_less_eq)
done

lemma take_f_join_eq2: "
  card (I \<down>< length xs) \<le> n \<Longrightarrow> (xs \<Join>\<^sub>f I) \<down> n = xs \<Join>\<^sub>f I"
by (simp add: f_join_length)
lemma take_f_join_if: "
  (xs \<Join>\<^sub>f I) \<down> n =
  (if n < card (I \<down>< length xs) then xs \<Join>\<^sub>f (I \<down>< (I \<rightarrow> n)) else xs \<Join>\<^sub>f I)"
by (simp add: take_f_join_eq1 take_f_join_eq2)

lemma drop_f_join_eq1: "
  n < card (I \<down>< length xs) \<Longrightarrow>
  (xs \<Join>\<^sub>f I) \<up> n = xs \<Join>\<^sub>f (I \<down>\<ge> (I \<rightarrow> n))"
apply (case_tac "I = {}")
 apply (simp add: cut_less_empty)
apply (case_tac "I \<down>< length xs = {}")
 apply (simp add: cut_less_empty)
apply (rule same_append_eq[THEN iffD1, of "xs \<Join>\<^sub>f I \<down> n"])
txt \<open>First, a simplification step without \<open>take_f_join_eq1\<close> required for correct transformation, in order to eliminate \<open>(xs \<Join>\<^sub>f I) \<down> n\<close> in the equation.\<close>
apply simp
txt \<open>Now, \<open>take_f_join_eq1\<close> can be applied\<close>
apply (simp add: take_f_join_eq1)
apply (case_tac "I \<down>< (I \<rightarrow> n) = {}")
 apply (simp add: f_join_empty)
 apply (rule_tac t= "I \<rightarrow> n" and s="iMin I" in subst)
  apply (rule ccontr)
  apply (drule neq_le_trans[of "iMin I"])
   apply (simp add: iMin_le[OF inext_nth_closed])
  apply (simp add: cut_less_Min_not_empty)
 apply (simp add: cut_ge_Min_all)
apply (subst f_join_union[OF nat_cut_less_finite, symmetric])
 apply (subgoal_tac "I \<down>\<ge> (I \<rightarrow> n) \<noteq> {}")
  prefer 2
  apply (simp add: cut_ge_not_empty_iff)
  apply (blast intro: inext_nth_closed)
 apply (simp add: nat_cut_less_finite i_cut_mem_iff iMin_gr_iff)
apply (simp add: cut_less_cut_ge_ident)
done

lemma drop_f_join_eq2: "
  card (I \<down>< length xs) \<le> n \<Longrightarrow> (xs \<Join>\<^sub>f I) \<up> n = []"
by (simp add: f_join_length)

lemma drop_f_join_if: "
  (xs \<Join>\<^sub>f I) \<up> n =
  (if n < card (I \<down>< length xs) then xs \<Join>\<^sub>f (I \<down>\<ge> (I \<rightarrow> n)) else [])"
by (simp add: drop_f_join_eq1 drop_f_join_eq2)

lemma f_join_take: "xs \<down> n \<Join>\<^sub>f I = xs \<Join>\<^sub>f (I \<down>< n)"
apply (clarsimp simp: list_eq_iff f_join_length cut_cut_less min.commute)
apply (simp add: f_join_nth f_join_length cut_cut_less min.commute)
apply (case_tac "n < length xs")
 apply (simp add: min_eqL inext_nth_cut_less_eq)
 apply (simp add: less_card_cut_less_imp_inext_nth_less)
apply (simp add: min_eqR linorder_not_less)
apply (subst inext_nth_cut_less_eq)
apply (rule order_less_le_trans, assumption)
apply (rule card_mono[OF nat_cut_less_finite cut_less_mono], assumption)
apply simp
done

lemma f_join_drop: "xs \<up> n \<Join>\<^sub>f I = xs \<Join>\<^sub>f (I \<oplus> n)"
apply (case_tac "length xs \<le> n")
 apply (simp add: f_join_Nil)
 apply (rule sym)
 apply (simp add: f_join_Nil_conv' iT_Plus_mem_iff)
apply (rule subst[OF append_take_drop_id, of "\<lambda>x. xs \<up> n \<Join>\<^sub>f I = x \<Join>\<^sub>f (I \<oplus> n)" n])
apply (simp only: f_join_append)
apply (simp add: f_join_take min_eqR)
apply (simp add: iT_Plus_Plus_neg_inverse)
apply (rule_tac t="(I \<oplus> n) \<down>< n" and s="{}" in subst)
 apply (rule sym)
 apply (simp add: cut_less_empty_iff iT_Plus_mem_iff)
apply (simp add: f_join_empty)
done

lemma cut_less_eq_imp_f_join_eq: "
  A \<down>< length xs = B \<down>< length xs \<Longrightarrow> xs \<Join>\<^sub>f A = xs \<Join>\<^sub>f B"
apply (clarsimp simp: list_eq_iff f_join_length f_join_nth)
apply (rule subst[OF inext_nth_cut_less_eq, of _ A "length xs"], simp)
apply (rule subst[OF inext_nth_cut_less_eq, of _ B "length xs"], simp)
apply simp
done

corollary f_join_cut_less_eq: "
  length xs \<le> t \<Longrightarrow> xs \<Join>\<^sub>f (I \<down>< t) = xs \<Join>\<^sub>f I"
apply (rule cut_less_eq_imp_f_join_eq)
apply (simp add: cut_cut_less min_eqR)
done

lemma take_Suc_Max_eq_imp_f_join_eq: "
  \<lbrakk> finite I; xs \<down> Suc (Max I) = ys \<down> Suc (Max I) \<rbrakk> \<Longrightarrow>
  xs \<Join>\<^sub>f I = ys \<Join>\<^sub>f I"
apply (case_tac "I = {}")
 apply (simp add: f_join_empty)
apply (simp add: list_eq_iff f_join_length)
apply (case_tac "length xs < Suc (Max I)")
 apply (case_tac "length ys < Suc (Max I)")
  apply (clarsimp simp: min_eqL, rename_tac i)
  apply (simp add: f_join_nth2)
  apply (drule_tac x="I \<rightarrow> i" in spec)
  apply (subgoal_tac "I \<rightarrow> i < length ys")
   prefer 2
   apply (rule less_card_cut_less_imp_inext_nth_less, simp)
  apply simp
 apply (simp add: min_eq)
apply (case_tac "length ys < Suc (Max I)")
 apply (simp add: min_eq)
apply (simp add: linorder_not_less min_eqR Suc_le_eq del: Max_less_iff)
apply (subgoal_tac "I \<down>< length xs = I \<down>< length ys")
 prefer 2
 apply (simp add: cut_less_Max_all)
apply (clarsimp simp: f_join_nth2 simp del: Max_less_iff, rename_tac i)
apply (drule_tac x="I \<rightarrow> i" in spec)
apply (subgoal_tac "I \<rightarrow> i < Suc (Max I)")
 prefer 2
 apply (simp add: less_Suc_eq_le inext_nth_closed)
apply (simp del: Max_less_iff)
done

corollary f_join_take_Suc_Max_eq: "
  finite I \<Longrightarrow> xs \<down> Suc (Max I) \<Join>\<^sub>f I = xs \<Join>\<^sub>f I"
by (rule take_Suc_Max_eq_imp_f_join_eq, simp+)

text \<open>Joining infinite streams and infinite intervals\<close>

lemma i_join_nth: "(f \<Join>\<^sub>i I) n = f (I \<rightarrow> n)"
by (simp add: i_join_def)

lemma i_join_UNIV: "f \<Join>\<^sub>i UNIV = f"
by (simp add: ilist_eq_iff i_join_nth inext_nth_UNIV)

lemma i_join_union: "
  \<lbrakk> finite A; Max A < iMin B; B \<noteq> {} \<rbrakk> \<Longrightarrow>
  f \<Join>\<^sub>i (A \<union> B) = (f \<Down> Suc (Max A) \<Join>\<^sub>f A) \<frown> (f \<Join>\<^sub>i B)"
apply (case_tac "A = {}")
 apply (simp add: f_join_empty)
apply (simp (no_asm) add: ilist_eq_iff, clarify)
apply (simp add: i_join_nth i_append_nth f_join_length del: Max_less_iff)
apply (subgoal_tac "A \<down>< Suc (Max A) = A")
 prefer 2
 apply (simp add: nat_cut_le_less_conv[symmetric] cut_le_Max_all)
apply (simp del: Max_less_iff, intro conjI impI)
 apply (simp add: inext_nth_card_append_eq1)
 apply (simp add: f_join_nth f_join_length)
 apply (simp add: less_card_cut_less_imp_inext_nth_less)
apply (simp add: inext_nth_card_append_eq2)
done

lemma i_join_singleton: "f \<Join>\<^sub>i {a} = (\<lambda>n. f a)"
by (simp add: ilist_eq_iff i_join_nth inext_nth_singleton)

lemma i_join_insert: "
  f \<Join>\<^sub>i (insert n I) =
  (f \<Down> n) \<Join>\<^sub>f (I \<down>< n) \<frown> [f n] \<frown> (
    if I \<down>> n = {} then (\<lambda>x. f n) else f \<Join>\<^sub>i (I \<down>> n))"
apply (rule ssubst[OF insert_eq_cut_less_cut_greater])
apply (case_tac "I \<down>< n = {}")
 apply (simp add: f_join_empty, intro conjI impI)
  apply (simp add: i_join_singleton ilist_eq_iff i_append_nth)
 apply (subgoal_tac "Max {n} < iMin (I \<down>> n)")
  prefer 2
  apply (simp add: cut_greater_Min_greater)
 apply simp
 apply (subst insert_is_Un)
 apply (subst i_join_union[OF singleton_finite])
 apply (simp add: f_join_singleton_if)+
apply (intro conjI impI)
 apply (subgoal_tac "Max (I \<down>< n) < iMin {n}")
  prefer 2
  apply (simp add: nat_cut_less_Max_less)
 apply (rule_tac t="insert n (I \<down>< n)" and s="(I \<down>< n) \<union> {n}" in subst, simp)
 apply (subst i_join_union[OF nat_cut_less_finite _ singleton_not_empty], simp)
 apply (simp add: i_join_singleton)
 apply (rule_tac s="\<lambda>x. f n" and t="[f n] \<frown> (\<lambda>x. f n)" in subst)
  apply (simp add: ilist_eq_iff i_append_nth)
 apply (subst i_append_assoc[symmetric])
 apply (rule_tac t="[f n] \<frown> (\<lambda>x. f n)" and s="(\<lambda>x. f n)" in subst)
  apply (simp add: ilist_eq_iff i_append_nth)
 apply (rule arg_cong)
 apply (simp add: take_Suc_Max_eq_imp_f_join_eq[OF nat_cut_less_finite] min_eqR)
apply (subgoal_tac "Max (I \<down>< n) < iMin {n} \<and> Max {n} < iMin (I \<down>> n)", elim conjE)
 prefer 2
 apply (simp add: cut_greater_Min_greater nat_cut_less_Max_less)
apply (rule_tac t="insert n (I \<down>< n \<union> I \<down>> n)" and s="(I \<down>< n \<union> ({n} \<union> I \<down>> n))" in subst, simp)
apply (subgoal_tac "({n} \<union> I \<down>> n) \<noteq> {} \<and> Max (I \<down>< n) < iMin ({n} \<union> I \<down>> n)", elim conjE)
 prefer 2
 apply (simp add: iMin_insert)
apply (simp add: i_join_union nat_cut_less_finite singleton_finite del: Un_insert_left Un_insert_right Max_less_iff)
apply (simp add: f_join_singleton_if)
apply (rule arg_cong)
apply (simp add: take_Suc_Max_eq_imp_f_join_eq[OF nat_cut_less_finite] min_eqR)
done

lemma i_join_i_append: "
  infinite I \<Longrightarrow> (xs \<frown> f) \<Join>\<^sub>i I = (xs \<Join>\<^sub>f I) \<frown> (f \<Join>\<^sub>i (I \<oplus>- length xs))"
apply (clarsimp simp: ilist_eq_iff)
apply (simp add: i_join_nth i_append_nth f_join_length)
apply (subgoal_tac "I \<down>\<ge> length xs \<noteq> {}")
 prefer 2
 apply (fastforce simp: cut_ge_not_empty_iff infinite_nat_iff_unbounded_le)
apply (simp add: inext_nth_less_less_card_conv)
apply (intro conjI impI)
 apply (simp add: f_join_nth f_join_length)
apply (subgoal_tac "I \<oplus>- length xs \<noteq> {}")
 prefer 2
 apply (simp add: iT_Plus_neg_empty_iff infinite_imp_nonempty)
apply (simp add: iT_Plus_neg_inext_nth)
apply (case_tac "I \<down>< length xs = {}")
 apply (frule cut_less_empty_iff[THEN iffD1, THEN cut_ge_all_iff[THEN iffD2]])
 apply simp
apply (rule subst[OF inext_nth_card_append_eq2, OF nat_cut_less_finite], simp+)
  apply (simp add: less_imp_Max_less_iMin[OF nat_cut_less_finite] i_cut_mem_iff)
 apply simp
apply (simp add: cut_less_cut_ge_ident)
done

lemma i_take_i_join: "infinite I \<Longrightarrow> f \<Join>\<^sub>i I \<Down> n = f \<Down> (I \<rightarrow> n) \<Join>\<^sub>f I"
apply (clarsimp simp: list_eq_iff f_join_length cut_less_inext_nth_card_eq1, rename_tac i)
apply (simp add: i_join_nth)
apply (frule inext_nth_mono2_infin[THEN iffD2], assumption)
apply (rule_tac t="f (I \<rightarrow> i)" and s="f \<Down> (I \<rightarrow> n) ! (I \<rightarrow> i)" in subst, simp)
apply (rule sym, rule f_join_nth)
apply (simp add: f_join_length)
apply (simp add: inext_nth_less_less_card_conv[OF nat_cut_ge_infinite_not_empty])
done

lemma i_drop_i_join: "I \<noteq> {} \<Longrightarrow> f \<Join>\<^sub>i I \<Up> n = f \<Join>\<^sub>i (I \<down>\<ge> (I \<rightarrow> n))"
apply (simp (no_asm) add: ilist_eq_iff)
apply (simp add: i_join_nth inext_nth_cut_ge_inext_nth)
done

lemma i_join_i_take: "f \<Down> n \<Join>\<^sub>f I = f \<Join>\<^sub>i I \<Down> card (I \<down>< n)"
apply (clarsimp simp: list_eq_iff f_join_length)
apply (frule less_card_cut_less_imp_inext_nth_less)
apply (simp add: i_join_nth f_join_length f_join_nth)
done

lemma i_join_i_drop: "I \<noteq> {} \<Longrightarrow> f \<Up> n \<Join>\<^sub>i I = f \<Join>\<^sub>i (I \<oplus> n)"
apply (simp (no_asm) add: ilist_eq_iff)
apply (simp add: i_join_nth iT_Plus_inext_nth add.commute[of _ n])
done

lemma i_join_finite_nth_ge_card_eq_nth_Max: "
  \<lbrakk> finite I; I \<noteq> {}; card I \<le> Suc n \<rbrakk> \<Longrightarrow> (f \<Join>\<^sub>i I) n = f (Max I)"
by (simp add: i_join_nth inext_nth_card_Max)

lemma i_join_finite_i_drop_card_eq_const_nth_Max: "
  \<lbrakk> finite I; I \<noteq> {} \<rbrakk> \<Longrightarrow> (f \<Join>\<^sub>i I) \<Up> (card I) = (\<lambda>n. f (Max I))"
by (simp add: ilist_eq_iff i_join_finite_nth_ge_card_eq_nth_Max)

lemma i_join_finite_i_append_nth_Max_conv: "
  \<lbrakk> finite I; I \<noteq> {} \<rbrakk> \<Longrightarrow> (f \<Join>\<^sub>i I) = f \<Down> Suc (Max I) \<Join>\<^sub>f I \<frown> (\<lambda>n. f (Max I))"
apply (simp (no_asm) add: ilist_eq_iff, clarify)
apply (subgoal_tac "I \<down>< (Suc (Max I)) = I")
 prefer 2
 apply (simp add: nat_cut_le_less_conv[symmetric] cut_le_Max_all)
apply (simp add: i_append_nth i_join_nth f_join_length)
apply (intro conjI impI)
 apply (simp add: f_join_nth f_join_length)
 apply (rule sym, rule i_take_nth)
 apply (simp add: less_card_cut_less_imp_inext_nth_less)
apply (simp add: inext_nth_card_Max)
done

text \<open>Joining infinite streams and finite intervals\<close>

lemma i_f_join_length: "finite I \<Longrightarrow> length (f \<Join>\<^bsub>i-f\<^esub> I) = card I"
apply (simp add: i_f_join_def f_join_length)
apply (simp add: nat_cut_le_less_conv[symmetric] cut_le_Max_all)
done

lemma i_f_join_nth: "n < card I \<Longrightarrow> f \<Join>\<^bsub>i-f\<^esub> I ! n = f (I \<rightarrow> n)"
apply (frule card_gr0_imp_finite[OF gr_implies_gr0])
apply (frule card_gr0_imp_not_empty[OF gr_implies_gr0])
apply (simp add: i_f_join_def)
apply (subst i_take_nth[ of "I \<rightarrow> n" "Suc (Max I)" f, symmetric])
 apply (rule le_imp_less_Suc)
 apply (simp add: Max_ge[OF _ inext_nth_closed])
apply (simp add: f_join_nth2 nat_cut_le_less_conv[symmetric] cut_le_Max_all)
done

lemma i_f_join_empty: "f \<Join>\<^bsub>i-f\<^esub> {} = []"
by (simp add: i_f_join_def f_join_empty)

lemma i_f_join_eq_i_join_i_take: "
  finite I \<Longrightarrow> f \<Join>\<^bsub>i-f\<^esub> I = f \<Join>\<^sub>i I \<Down> (card I)"
apply (simp add: i_f_join_def)
apply (simp add: i_join_i_take nat_cut_le_less_conv[symmetric] cut_le_Max_all)
done

lemma i_f_join_union: "
  \<lbrakk> finite A; finite B; Max A < iMin B \<rbrakk> \<Longrightarrow>
  f \<Join>\<^bsub>i-f\<^esub> (A \<union> B) = f \<Join>\<^bsub>i-f\<^esub> A @ f \<Join>\<^bsub>i-f\<^esub> B"
apply (case_tac "A = {}", simp add: i_f_join_empty)
apply (case_tac "B = {}", simp add: i_f_join_empty)
apply (simp add: i_f_join_def f_join_union del: Max_less_iff)
apply (subgoal_tac "Max A < Max B")
 prefer 2
 apply (rule order_less_le_trans[OF _ iMin_le_Max], assumption+)
apply (simp add: Max_Un max_eqR[OF less_imp_le])
apply (rule take_Suc_Max_eq_imp_f_join_eq, assumption)
apply (simp add: min_eqR[OF less_imp_le])
done

lemma i_f_join_singleton: "f \<Join>\<^bsub>i-f\<^esub> {n} = [f n]"
by (simp add: i_f_join_def f_join_singleton_if)

lemma i_f_join_insert: "
  finite I \<Longrightarrow>
  f \<Join>\<^bsub>i-f\<^esub> insert n I = f \<Join>\<^bsub>i-f\<^esub> (I \<down>< n) @ f n # f \<Join>\<^bsub>i-f\<^esub> (I \<down>> n)"
apply (case_tac "I = {}")
 apply (simp add: i_f_join_singleton i_cut_empty i_f_join_empty)
(*
apply (subgoal_tac "n < Suc (Max (insert n I))")
 prefer 2
 apply simp
apply (frule less_Suc_eq_le[THEN iffD1])*)
apply (simp add: i_f_join_def)
apply (simp add: f_join_insert)
apply (frule cut_greater_finite[of _ n])
apply (case_tac "I \<down>> n = {}")
 apply (simp add: f_join_empty)
 apply (case_tac "I \<down>< n = {}")
  apply (simp add: f_join_empty)
 apply (rule take_Suc_Max_eq_imp_f_join_eq[OF nat_cut_less_finite])
 apply simp
 apply (rule arg_cong[where f="\<lambda>x. f \<Down> x"])
 apply simp
 apply (rule min_eqR, rule max.coboundedI1, rule less_imp_le)
 apply (simp add: nat_cut_less_Max_less)
apply (simp add: cut_greater_Max_eq)
apply (subgoal_tac "n < Max I")
 prefer 2
 apply (rule ccontr)
 apply (simp add: linorder_not_less cut_greater_Max_empty)
apply (simp add: max_eqR[OF less_imp_le])
apply (case_tac "I \<down>< n = {}")
 apply (simp add: f_join_empty)
apply (rule take_Suc_Max_eq_imp_f_join_eq[OF nat_cut_less_finite])
apply simp
apply (rule arg_cong[where f="\<lambda>x. f \<Down> x"])
apply simp
apply (rule min_eqR)
apply (blast intro: Max_subset)
done

lemma take_i_f_join_eq1: "
  n < card I \<Longrightarrow> f \<Join>\<^bsub>i-f\<^esub> I \<down> n = f \<Join>\<^bsub>i-f\<^esub> (I \<down>< (I \<rightarrow> n))"
apply (frule card_ge_0_finite[OF gr_implies_gr0])
apply (case_tac "I = {}")
 apply (simp add: cut_less_empty i_f_join_empty)
apply (subgoal_tac "n < card (I \<down>< Suc (Max I))")
 prefer 2
 apply (simp add: cut_less_Max_all)
apply (simp add: i_f_join_def take_f_join_eq1)
apply (case_tac "I \<down>< (I \<rightarrow> n) = {}")
 apply (simp add: f_join_empty)
apply (rule take_Suc_Max_eq_imp_f_join_eq[OF nat_cut_less_finite])
apply simp
apply (rule arg_cong[where f="\<lambda>x. f \<Down> x"])
apply simp
apply (rule min_eqR)
apply (rule order_trans[OF less_imp_le[OF cut_less_Max_less]])
apply (simp add: nat_cut_less_finite inext_nth_closed)+
done

lemma take_i_f_join_eq2: "
  \<lbrakk> finite I; card I \<le> n \<rbrakk> \<Longrightarrow> f \<Join>\<^bsub>i-f\<^esub> I \<down> n = f \<Join>\<^bsub>i-f\<^esub> I"
apply (case_tac "I = {}")
 apply (simp add: cut_less_empty i_f_join_empty)
apply (simp add: i_f_join_def take_f_join_eq2 cut_less_Max_all)
done

lemma take_i_f_join_if: "
  finite I \<Longrightarrow>
  f \<Join>\<^bsub>i-f\<^esub> I \<down> n = (if n < card I then f \<Join>\<^bsub>i-f\<^esub> (I \<down>< (I \<rightarrow> n)) else f \<Join>\<^bsub>i-f\<^esub> I)"
by (simp add: take_i_f_join_eq1 take_i_f_join_eq2)

lemma drop_i_f_join_eq1: "
  n < card I \<Longrightarrow> f \<Join>\<^bsub>i-f\<^esub> I \<up> n = f \<Join>\<^bsub>i-f\<^esub> (I \<down>\<ge> (I \<rightarrow> n))"
apply (frule card_ge_0_finite[OF gr_implies_gr0])
apply (case_tac "I = {}")
 apply (simp add: cut_ge_empty i_f_join_empty)
apply (subgoal_tac "n < card (I \<down>< Suc (Max I))")
 prefer 2
 apply (simp add: cut_less_Max_all)
apply (simp add: i_f_join_def drop_f_join_eq1)
apply (subgoal_tac "I \<down>\<ge> (I \<rightarrow> n) \<noteq> {}")
 prefer 2
 apply (rule in_imp_not_empty[of "I \<rightarrow> n"])
 apply (simp add: cut_ge_mem_iff inext_nth_closed)
apply (rule take_Suc_Max_eq_imp_f_join_eq)
 apply (rule cut_ge_finite, assumption)
apply simp
apply (rule arg_cong[where f="\<lambda>x. f \<Down> x"])
apply (simp add: min_eqR cut_ge_Max_eq)
done

lemma drop_i_f_join_eq2: "
  \<lbrakk> finite I; card I \<le> n \<rbrakk> \<Longrightarrow> f \<Join>\<^bsub>i-f\<^esub> I \<up> n = []"
by (simp add: i_f_join_length)

lemma drop_i_f_join_if: "
  finite I \<Longrightarrow>
  f \<Join>\<^bsub>i-f\<^esub> I \<up> n = (if n < card I then f \<Join>\<^bsub>i-f\<^esub> (I \<down>\<ge> (I \<rightarrow> n)) else [])"
by (simp add: drop_i_f_join_eq1 drop_i_f_join_eq2)

lemma i_f_join_i_drop: "
  finite I \<Longrightarrow> f \<Up> n \<Join>\<^bsub>i-f\<^esub> I = f \<Join>\<^bsub>i-f\<^esub> (I \<oplus> n)"
apply (case_tac "I = {}")
 apply (simp add: iT_Plus_empty i_f_join_empty)
apply (simp add: i_f_join_def iT_Plus_Max)
apply (simp add: i_take_i_drop f_join_drop)
done

lemma i_take_Suc_Max_eq_imp_i_f_join_eq: "
  f \<Down> Suc (Max I) = g \<Down> Suc (Max I) \<Longrightarrow> f \<Join>\<^bsub>i-f\<^esub> I = g \<Join>\<^bsub>i-f\<^esub> I"
by (simp add: i_f_join_def)

lemma i_take_i_join_eq_i_f_join: "
  infinite I \<Longrightarrow> f \<Join>\<^sub>i I \<Down> n = f \<Join>\<^bsub>i-f\<^esub> (I \<down>< (I \<rightarrow> n))"
apply (frule infinite_imp_nonempty)
apply (case_tac "n = 0")
 apply (simp add: cut_less_Min_empty i_f_join_empty)
apply (frule inext_nth_gr_Min_conv_infinite[THEN iffD2], simp)
apply (simp add: i_take_i_join i_f_join_def)
apply (subgoal_tac "Suc (Max (I \<down>< (I \<rightarrow> n))) \<le> I \<rightarrow> n")
 prefer 2
 apply (rule Suc_leI)
 apply (rule nat_cut_less_Max_less)
 apply (simp add: cut_less_Min_not_empty)
apply (simp add: f_join_cut_less_eq)
apply (simp add: i_join_i_take)
apply (rule arg_cong[where f="\<lambda>x. f \<Join>\<^sub>i I \<Down> card x"])
apply (clarsimp simp: gr0_conv_Suc)
apply (simp add: cut_le_less_inext_conv[OF inext_nth_closed, symmetric])
apply (simp add: nat_cut_le_less_conv[symmetric])
apply (rule arg_cong[where f="\<lambda>x. I \<down>\<le> x"])
apply (rule sym, rule Max_equality[OF _ nat_cut_le_finite])
apply (simp add: cut_le_mem_iff inext_nth_closed)+
done

subsubsection \<open>Results for intervals from \<open>IL_Interval\<close>\<close>

lemma f_join_iFROM: "xs \<Join>\<^sub>f [n\<dots>] = xs \<up> n"
apply (clarsimp simp: list_eq_iff f_join_length iFROM_cut_less iIN_card Suc_diff_Suc)
apply (subst f_join_nth2)
 apply (simp add: iFROM_cut_less iIN_card)
apply (simp add: iFROM_inext_nth)
done

lemma i_join_iFROM: "f \<Join>\<^sub>i [n\<dots>] = f \<Up> n"
by (simp add: ilist_eq_iff i_join_nth iFROM_inext_nth)

lemma f_join_iIN: "xs \<Join>\<^sub>f [n\<dots>,d] = xs \<up> n \<down> Suc d"
apply (simp add: list_eq_iff f_join_length iIN_cut_less iIN_card Suc_diff_Suc min_eq)
apply (simp add: f_join_nth2 iIN_cut_less iIN_card iIN_inext_nth)
done

lemma i_f_join_iIN: "f \<Join>\<^bsub>i-f\<^esub> [n\<dots>,d] = f \<Up> n \<Down> Suc d"
by (simp add: i_f_join_def f_join_iIN iIN_Max i_take_drop)

lemma f_join_iTILL: "xs \<Join>\<^sub>f [\<dots>n] = xs \<down> (Suc n)"
by (simp add: iIN_0_iTILL_conv[symmetric] f_join_iIN)

lemma i_f_join_iTILL: "f \<Join>\<^bsub>i-f\<^esub> [\<dots>n] = f \<Down> Suc n"
by (simp add: iIN_0_iTILL_conv[symmetric] i_f_join_iIN)

lemma f_join_f_expand_iT_Mult: "
  0 < k \<Longrightarrow> xs \<odot>\<^sub>f k \<Join>\<^sub>f (I \<otimes> k) = xs \<Join>\<^sub>f I"
apply (case_tac "I = {}")
 apply (simp add: iT_Mult_empty f_join_empty)
apply (simp add: list_eq_iff f_join_length)
apply (clarsimp simp: iT_Mult_cut_less2 iT_Mult_card)
apply (simp add: f_join_nth2 iT_Mult_cut_less2 iT_Mult_card)
apply (drule less_card_cut_less_imp_inext_nth_less)
apply (simp add: iT_Mult_inext_nth f_expand_nth_mult)
done

lemma i_join_i_expand_iT_Mult: "
  \<lbrakk> 0 < k; I \<noteq> {} \<rbrakk> \<Longrightarrow> f \<odot>\<^sub>i k \<Join>\<^sub>i (I \<otimes> k) = f \<Join>\<^sub>i I"
apply (simp (no_asm) add: ilist_eq_iff, clarify)
apply (simp add: i_join_nth iT_Mult_inext_nth i_expand_nth_mult)
done

lemma i_f_join_i_expand_iT_Mult: "
  \<lbrakk> 0 < k; finite I \<rbrakk> \<Longrightarrow> f \<odot>\<^sub>i k \<Join>\<^bsub>i-f\<^esub> (I \<otimes> k) = f \<Join>\<^bsub>i-f\<^esub> I"
apply (case_tac "I = {}")
 apply (simp add: iT_Mult_empty i_f_join_empty)
apply (clarsimp simp: list_eq_iff i_f_join_length iT_Mult_finite_iff iT_Mult_not_empty iT_Mult_card)
apply (simp add: i_f_join_nth iT_Mult_card iT_Mult_inext_nth i_expand_nth_mult)
done

lemma f_join_f_shrink_iT_Plus_iT_Div_mod: "
  \<lbrakk> 0 < k; \<forall>x\<in>I. x mod k = 0 \<rbrakk> \<Longrightarrow>
  (xs \<longmapsto>\<^sub>f k) \<Join>\<^sub>f (I \<oplus> (k - 1)) = xs \<div>\<^sub>f k \<Join>\<^sub>f (I \<oslash> k)"
apply (case_tac "I = {}")
 apply (simp add: iT_Plus_empty iT_Div_empty f_join_empty)
apply (simp add: list_eq_iff f_join_length f_shrink_length)
apply (subgoal_tac "Suc (length xs) - k \<le> length xs - length xs mod k")
 prefer 2
 apply (case_tac "length xs < k", simp)
 apply (simp add: Suc_diff_le linorder_not_less)
 apply (rule Suc_leI)
 apply (rule diff_less_mono2, simp)
 apply (rule order_less_le_trans[OF mod_less_divisor], assumption+)
apply (rule context_conjI)
 apply (simp add: iT_Plus_cut_less iT_Div_cut_less2 iT_Plus_card)
 apply (subst iT_Div_card_inj_on)
  apply (rule mod_eq_imp_div_right_inj_on)
  apply clarsimp+
 apply (rule arg_cong[where f=card])
 apply (simp (no_asm_simp) add: set_eq_iff cut_less_mem_iff, clarify)
 apply (rule conj_cong, simp)
 apply (rule iffI)
  apply simp
   apply (frule_tac x=x and m=k in less_mod_eq_imp_add_divisor_le)
  apply (simp add: mod_diff_right_eq [symmetric])
 apply simp
apply (clarsimp simp: f_join_nth f_join_length f_shrink_length)
apply (simp add: iT_Plus_inext_nth iT_Plus_not_empty)
apply (simp add: iT_Div_mod_inext_nth)
apply (subst f_shrink_nth_eq_f_last_message_hold_nth)
 apply (drule sym, simp, thin_tac "card x = card y" for x y)
 apply (simp add: iT_Plus_cut_less iT_Plus_card)
 apply (rule less_mult_imp_div_less)
 apply (rule less_le_trans[OF less_card_cut_less_imp_inext_nth_less], assumption)
 apply (simp add: div_mult_cancel)
apply (simp add: div_mult_cancel inext_nth_closed)
done

lemma i_join_i_shrink_iT_Plus_iT_Div_mod: "
  \<lbrakk> 0 < k; I \<noteq> {}; \<forall>x\<in>I. x mod k = 0 \<rbrakk> \<Longrightarrow>
  (f \<longmapsto>\<^sub>i k) \<Join>\<^sub>i (I \<oplus> (k - 1))= f \<div>\<^sub>i k \<Join>\<^sub>i (I \<oslash> k)"
apply (simp (no_asm) add: ilist_eq_iff, clarify)
apply (simp add: i_join_nth)
apply (simp add: i_shrink_nth_eq_i_last_message_hold_nth)
apply (simp add: iT_Plus_inext_nth iT_Div_mod_inext_nth)
apply (drule_tac x="I \<rightarrow> x" in bspec)
 apply (simp add: inext_nth_closed)
apply (simp add: mod_0_div_mult_cancel)
done

lemma i_f_join_i_shrink_iT_Plus_iT_Div_mod: "
  \<lbrakk> 0 < k; finite I; \<forall>x\<in>I. x mod k = 0 \<rbrakk> \<Longrightarrow>
  (f \<longmapsto>\<^sub>i k) \<Join>\<^bsub>i-f\<^esub> (I \<oplus> (k - 1))= f \<div>\<^sub>i k \<Join>\<^bsub>i-f\<^esub> (I \<oslash> k)"
apply (case_tac "I = {}")
 apply (simp add: iT_Plus_empty iT_Div_empty i_f_join_empty)
apply (simp add: i_f_join_def iT_Plus_Max iT_Div_Max)
apply (simp add: i_last_message_hold_i_take[symmetric] i_shrink_i_take_mult[symmetric])
apply (simp add: add.commute[of k])
apply (simp add: mod_0_div_mult_cancel[THEN iffD1])
apply (simp add: f_join_f_shrink_iT_Plus_iT_Div_mod[unfolded One_nat_def])
done

corollary f_join_f_shrink_iT_Plus_iT_Div_mod_subst: "
  \<lbrakk> 0 < k; \<forall>x\<in>I. x mod k = 0;
    A = I \<oplus> (k - 1); B = I \<oslash> k \<rbrakk> \<Longrightarrow>
  (xs \<longmapsto>\<^sub>f k) \<Join>\<^sub>f A = xs \<div>\<^sub>f k \<Join>\<^sub>f B"
by (simp add: f_join_f_shrink_iT_Plus_iT_Div_mod[unfolded One_nat_def])
corollary i_join_i_shrink_iT_Plus_iT_Div_mod_subst: "
  \<lbrakk> 0 < k; I \<noteq> {}; \<forall>x\<in>I. x mod k = 0;
    A = I \<oplus> (k - 1); B = I \<oslash> k \<rbrakk> \<Longrightarrow>
  (f \<longmapsto>\<^sub>i k) \<Join>\<^sub>i A = f \<div>\<^sub>i k \<Join>\<^sub>i B"
by (simp add: i_join_i_shrink_iT_Plus_iT_Div_mod[unfolded One_nat_def])
corollary i_f_join_i_shrink_iT_Plus_iT_Div_mod_subst: "
  \<lbrakk> 0 < k; finite I; \<forall>x\<in>I. x mod k = 0;
    A = I \<oplus> (k - 1); B = I \<oslash> k \<rbrakk> \<Longrightarrow>
  (f \<longmapsto>\<^sub>i k) \<Join>\<^bsub>i-f\<^esub> A= f \<div>\<^sub>i k \<Join>\<^bsub>i-f\<^esub> B"
by (simp add: i_f_join_i_shrink_iT_Plus_iT_Div_mod[unfolded One_nat_def])

lemma f_join_f_shrink_iT_Div_mod: "
  \<lbrakk> 0 < k; \<forall>x\<in>I. x mod k = k - 1 \<rbrakk> \<Longrightarrow>
  (xs \<longmapsto>\<^sub>f k) \<Join>\<^sub>f I = xs \<div>\<^sub>f k \<Join>\<^sub>f (I \<oslash> k)"
apply (case_tac "I = {}")
 apply (simp add: iT_Div_empty f_join_empty)
apply (frule Suc_leI, drule order_le_imp_less_or_eq, erule disjE)
 prefer 2
 apply (drule sym, simp add: iT_Div_1)
apply (rule_tac t=I and s="I \<oplus>- (k - 1) \<oplus> (k - 1)" in subst)
 apply (rule iT_Plus_neg_Plus_le_inverse)
 apply (rule ccontr)
 apply (drule_tac x="iMin I" in bspec, simp add: iMinI_ex2)
 apply (simp add: iMinI_ex2)+
apply (subgoal_tac "\<And>x. x + k - Suc 0 \<in> I \<Longrightarrow> x mod k = 0")
 prefer 2
 apply (rule mod_add_eq_imp_mod_0[THEN iffD1, of "k - Suc 0"])
 apply (simp add: add.commute[of k])
apply (subst iT_Plus_Div_distrib_mod_less)
 apply (clarsimp simp: iT_Plus_neg_mem_iff)
apply (simp add: iT_Plus_0)
apply (rule f_join_f_shrink_iT_Plus_iT_Div_mod[unfolded One_nat_def], simp)
apply (simp add: iT_Plus_neg_mem_iff)
done

lemma i_join_i_shrink_iT_Div_mod: "
  \<lbrakk> 0 < k; I \<noteq> {}; \<forall>x\<in>I. x mod k = k - 1 \<rbrakk> \<Longrightarrow>
  (f \<longmapsto>\<^sub>i k) \<Join>\<^sub>i I= f \<div>\<^sub>i k \<Join>\<^sub>i (I \<oslash> k)"
apply (simp (no_asm) add: ilist_eq_iff, clarify)
apply (simp add: i_join_nth)
apply (simp add: i_shrink_nth_eq_i_last_message_hold_nth)
apply (simp add: iT_Div_mod_inext_nth)
apply (drule_tac x="I \<rightarrow> x" in bspec)
 apply (rule inext_nth_closed, assumption)
apply (simp add: div_mult_cancel)
apply (subgoal_tac "k - Suc 0 \<le> I \<rightarrow> x ")
 prefer 2
 apply (rule order_trans[OF _ mod_le_dividend[where n=k]])
 apply simp
apply simp
done

lemma i_f_join_i_shrink_iT_Div_mod: "
  \<lbrakk> 0 < k; finite I; \<forall>x\<in>I. x mod k = k - 1 \<rbrakk> \<Longrightarrow>
  (f \<longmapsto>\<^sub>i k) \<Join>\<^bsub>i-f\<^esub> I = f \<div>\<^sub>i k \<Join>\<^bsub>i-f\<^esub> (I \<oslash> k)"
apply (case_tac "I = {}")
 apply (simp add: iT_Plus_empty iT_Div_empty i_f_join_empty)
apply (simp add: i_f_join_def)
apply (simp add: iT_Div_Max)
apply (simp add: i_last_message_hold_i_take[symmetric] i_shrink_i_take_mult[symmetric] add.commute[of k])
apply (simp add: div_mult_cancel)
apply (subgoal_tac "k - Suc 0 \<le> Max I")
 prefer 2
 apply (rule order_trans[OF _ mod_le_dividend[where n=k]])
 apply simp
apply (simp add: f_join_f_shrink_iT_Div_mod)
done

lemma f_join_f_expand_iMOD: "
  0 < k \<Longrightarrow> xs \<odot>\<^sub>f k \<Join>\<^sub>f [n * k, mod k] = xs \<Join>\<^sub>f [n\<dots>]"
by (subst iFROM_mult[symmetric], rule f_join_f_expand_iT_Mult)
corollary f_join_f_expand_iMOD_0: "
  0 < k \<Longrightarrow> xs \<odot>\<^sub>f k \<Join>\<^sub>f [0, mod k] = xs"
apply (drule f_join_f_expand_iMOD[of k xs 0])
apply (simp add: iFROM_0 f_join_UNIV)
done

lemma f_join_f_expand_iMODb: "
  0 < k \<Longrightarrow> xs \<odot>\<^sub>f k \<Join>\<^sub>f [n * k, mod k, d] = xs \<Join>\<^sub>f [n\<dots>,d]"
by (subst iIN_mult[symmetric], rule f_join_f_expand_iT_Mult)

corollary f_join_f_expand_iMODb_0: "
  0 < k \<Longrightarrow> xs \<odot>\<^sub>f k \<Join>\<^sub>f [0, mod k, n] = xs \<Join>\<^sub>f [\<dots>n]"
apply (drule f_join_f_expand_iMODb[of k xs 0 n])
apply (simp add: iIN_0_iTILL_conv)
done

lemma i_join_i_expand_iMOD: "
  0 < k \<Longrightarrow> f \<odot>\<^sub>i k \<Join>\<^sub>i [n * k, mod k] = f \<Join>\<^sub>i [n\<dots>]"
by (subst iFROM_mult[symmetric], rule i_join_i_expand_iT_Mult[OF _ iFROM_not_empty])

corollary i_join_i_expand_iMOD_0: "
  0 < k \<Longrightarrow> f \<odot>\<^sub>i k \<Join>\<^sub>i [0, mod k] = f"
apply (drule i_join_i_expand_iMOD[of k f 0])
apply (simp add: iFROM_0 i_join_UNIV)
done

lemma i_join_i_expand_iMODb: "
  0 < k \<Longrightarrow> f \<odot>\<^sub>i k \<Join>\<^sub>i [n * k, mod k, d] = f \<Join>\<^sub>i [n\<dots>,d]"
by (subst iIN_mult[symmetric], rule i_join_i_expand_iT_Mult[OF _ iIN_not_empty])

corollary i_join_i_expand_iMODb_0: "
  0 < k \<Longrightarrow> f \<odot>\<^sub>i k \<Join>\<^sub>i [0, mod k, n] = f \<Join>\<^sub>i [\<dots>n]"
apply (drule i_join_i_expand_iMODb[of k f 0 n])
apply (simp add: iIN_0_iTILL_conv)
done

lemma i_f_join_i_expand_iMODb: "
  0 < k \<Longrightarrow> f \<odot>\<^sub>i k \<Join>\<^bsub>i-f\<^esub> [n * k, mod k, d] = f \<Join>\<^bsub>i-f\<^esub> [n\<dots>,d]"
by (subst iIN_mult[symmetric], rule i_f_join_i_expand_iT_Mult[OF _ iIN_finite])
corollary i_f_join_i_expand_iMODb_0: "
  0 < k \<Longrightarrow> f \<odot>\<^sub>i k \<Join>\<^bsub>i-f\<^esub> [0, mod k, n] = f \<Join>\<^bsub>i-f\<^esub> [\<dots>n]"
apply (drule i_f_join_i_expand_iMODb[of k f 0 n])
apply (simp add: iIN_0_iTILL_conv)
done

lemma f_join_f_shrink_iMOD: "
  0 < k \<Longrightarrow> (xs \<longmapsto>\<^sub>f k) \<Join>\<^sub>f [n * k + (k - 1), mod k] = xs \<div>\<^sub>f k \<Join>\<^sub>f [n\<dots>]"
apply (rule f_join_f_shrink_iT_Plus_iT_Div_mod_subst[where I="[n * k, mod k]"])
apply (simp add: iMOD_iff iMOD_add iMOD_div_ge)+
done

corollary f_join_f_shrink_iMOD_0: "
  0 < k \<Longrightarrow> (xs \<longmapsto>\<^sub>f k) \<Join>\<^sub>f [k - 1, mod k] = xs \<div>\<^sub>f k"
apply (frule f_join_f_shrink_iMOD[of k xs 0])
apply (simp add: iFROM_0 f_join_UNIV)
done

lemma f_join_f_shrink_iMODb: "
  0 < k \<Longrightarrow> (xs \<longmapsto>\<^sub>f k) \<Join>\<^sub>f [n * k + (k - 1), mod k, d] = xs \<div>\<^sub>f k \<Join>\<^sub>f [n\<dots>,d]"
apply (rule f_join_f_shrink_iT_Plus_iT_Div_mod_subst[where I="[n * k, mod k, d]"])
apply (simp add: iMODb_iff iMODb_add iMODb_div_ge)+
done

corollary f_join_f_shrink_iMODb_0: "
  0 < k \<Longrightarrow> (xs \<longmapsto>\<^sub>f k) \<Join>\<^sub>f [k - 1, mod k, n] = xs \<div>\<^sub>f k \<Join>\<^sub>f [\<dots>n]"
apply (frule f_join_f_shrink_iMODb[of k xs 0 n])
apply (simp add: iIN_0_iTILL_conv)
done

lemma i_join_i_shrink_iMOD: "
  0 < k \<Longrightarrow> (f \<longmapsto>\<^sub>i k) \<Join>\<^sub>i [n * k + (k - 1), mod k] = f \<div>\<^sub>i k \<Join>\<^sub>i [n\<dots>]"
apply (rule i_join_i_shrink_iT_Plus_iT_Div_mod_subst[where I="[n * k, mod k]"])
apply (simp add: iMOD_not_empty iMOD_iff iMOD_add iMOD_div_ge)+
done

corollary i_join_i_shrink_iMOD_0: "
  0 < k \<Longrightarrow> (f \<longmapsto>\<^sub>i k) \<Join>\<^sub>i [k - 1, mod k] = f \<div>\<^sub>i k"
apply (frule i_join_i_shrink_iMOD[of k f 0])
apply (simp add: iFROM_0 i_join_UNIV)
done

lemma i_f_join_i_shrink_iMODb: "
  0 < k \<Longrightarrow> (f \<longmapsto>\<^sub>i k) \<Join>\<^bsub>i-f\<^esub> [n * k + (k - 1), mod k, d] = f \<div>\<^sub>i k \<Join>\<^bsub>i-f\<^esub> [n\<dots>,d]"
apply (rule i_f_join_i_shrink_iT_Plus_iT_Div_mod_subst[where I="[n * k, mod k, d]"])
apply (simp add: iMODb_finite iMODb_iff iMODb_add iMODb_div_ge)+
done

corollary i_f_join_i_shrink_iMODb_0: "
  0 < k \<Longrightarrow> (f \<longmapsto>\<^sub>i k) \<Join>\<^bsub>i-f\<^esub> [k - 1, mod k, n] = f \<div>\<^sub>i k \<Join>\<^bsub>i-f\<^esub> [\<dots>n]"
apply (frule i_f_join_i_shrink_iMODb[of k f 0 n])
apply (simp add: iIN_0_iTILL_conv i_join_UNIV)
done

subsection \<open>Streams and temporal operators\<close>

lemma i_shrink_eq_NoMsg_iAll_conv: "
  0 < k \<Longrightarrow> ((s \<div>\<^sub>i k) t = \<NoMsg>) = (\<box> t1 [t * k\<dots>,k - Suc 0]. s t1 = \<NoMsg>)"
apply (simp add: i_shrink_nth last_message_NoMsg_conv iAll_def Ball_def iIN_iff)
apply (rule iffI)
 apply (clarify, rename_tac i)
 apply (drule_tac x="i - t * k" in spec)
 apply simp
apply (clarify, rename_tac i)
apply (drule_tac x="t * k + i" in spec)
apply simp
done

lemma i_shrink_eq_NoMsg_iAll_conv2: "
  0 < k \<Longrightarrow> ((s \<div>\<^sub>i k) t = \<NoMsg>) = (\<box> t1 [\<dots>k - 1] \<oplus> (t * k). s t1 = \<NoMsg>)"
by (simp add: iT_add i_shrink_eq_NoMsg_iAll_conv)

lemma i_shrink_eq_Msg_iEx_iAll_conv: "
  \<lbrakk> 0 < k; m \<noteq> \<NoMsg> \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = m) =
  (\<diamond> t1 [t * k\<dots>,k - Suc 0]. s t1 = m \<and>
    (\<box> t2 [Suc t1\<dots>]. t2 \<le> t * k + k - Suc 0 \<longrightarrow> s t2 = \<NoMsg>))"
apply (simp add: i_shrink_nth last_message_conv)
apply (simp add: iAll_def iEx_def Ball_def Bex_def iIN_iff iFROM_iff)
apply (rule iffI)
 apply (clarsimp, rename_tac i)
 apply (rule_tac x="t * k + i" in exI)
 apply (simp add: diff_add_assoc less_imp_le_pred del: add_diff_assoc)
 apply (clarsimp, rename_tac j)
 apply (drule_tac x="j - t * k" in spec)
 apply simp
apply (clarsimp, rename_tac i)
apply (rule_tac x="i - t * k" in exI)
apply simp
done

lemma i_shrink_eq_Msg_iEx_iAll_conv2: "
  \<lbrakk> 0 < k; m \<noteq> \<NoMsg> \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = m) =
  (\<diamond> t1 [\<dots>k - 1] \<oplus> (t * k). s t1 = m \<and>
    (\<box> t2 [1\<dots>] \<oplus> t1 . t2 \<le> t * k + k - 1 \<longrightarrow> s t2 = \<NoMsg>))"
by (simp add: iT_add i_shrink_eq_Msg_iEx_iAll_conv)

lemma i_shrink_eq_Msg_iEx_iAll_cut_greater_conv: "
  \<lbrakk> 0 < k; m \<noteq> \<NoMsg> \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = m) =
  (\<diamond> t1 [t * k\<dots>,k - Suc 0]. s t1 = m \<and>
    (\<box> t2 [t * k\<dots>,k - Suc 0] \<down>> t1. s t2 = \<NoMsg>))"
apply (simp add: i_shrink_eq_Msg_iEx_iAll_conv)
apply (simp add: iIN_cut_greater iEx_def)
apply (rule bex_cong2[OF subset_refl])
apply (force simp: iAll_def Ball_def iT_iff)
done

lemma i_shrink_eq_Msg_iEx_iAll_cut_greater_conv2: "
  \<lbrakk> 0 < k; m \<noteq> \<NoMsg> \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = m) =
  (\<diamond> t1 [\<dots>k - 1] \<oplus> (t * k). s t1 = m \<and>
    (\<box> t2 ([\<dots>k - 1] \<oplus> (t * k)) \<down>> t1. s t2 = \<NoMsg>))"
by (simp add: iT_add i_shrink_eq_Msg_iEx_iAll_cut_greater_conv)

lemma i_shrink_eq_Msg_iSince_conv: "
  \<lbrakk> 0 < k; m \<noteq> \<NoMsg> \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = m) =
  (s t2 = \<NoMsg>. t2 \<S> t1 [t * k\<dots>,k - Suc 0]. s t1 = m)"
by (simp add: iSince_def iIN_cut_greater i_shrink_eq_Msg_iEx_iAll_cut_greater_conv)
lemma i_shrink_eq_Msg_iSince_conv2: "
  \<lbrakk> 0 < k; m \<noteq> \<NoMsg> \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = m) =
  (s t2 = \<NoMsg>. t2 \<S> t1 [\<dots>k - 1] \<oplus> (t * k). s t1 = m)"
by (simp add: iT_add i_shrink_eq_Msg_iSince_conv)

lemma iT_Mult_iAll_i_expand_nth_iff:
  "0 < k \<Longrightarrow> (\<box> t (I \<otimes> k). P ((f \<odot>\<^sub>i k) t)) = (\<box> t I. P (f t))"
apply (rule iffI)
 apply clarify
 apply (drule_tac t="t * k" in ispec)
  apply (simp add: iT_Mult_mem_iff2)
 apply (simp add: i_expand_nth_mult)
apply (fastforce simp: iT_Mult_mem_iff mult.commute[of k] i_expand_nth_mod_eq_0)
done

text \<open>Streams and temporal operators cycle start/finish events\<close>

lemma i_shrink_eq_NoMsg_iAll_start_event_conv: "
  \<lbrakk> 0 < k; \<And>t. event t = (t mod k = 0); t0 = t * k \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = \<NoMsg>) =
  (s t0 = \<NoMsg> \<and> (\<circle> t' t0 [0\<dots>]. (s t1 = \<NoMsg>. t1 \<U> t2 ([0\<dots>] \<oplus> t'). event t2)))"
apply (case_tac "k = Suc 0")
 apply (simp add: iT_add iT_not_empty iNext_True)
apply (drule neq_le_trans[OF not_sym], simp)
apply (simp add: i_shrink_eq_NoMsg_iAll_conv iTL_defs Ball_def Bex_def iT_add iT_iff iFROM_cut_less iFROM_inext)
apply (rule iffI)
 apply simp
 apply (rule_tac x="t * k + k" in exI)
 apply fastforce
apply (clarify elim!: dvdE, rename_tac x1 x2)
apply (case_tac "x2 = Suc (t * k)")
 apply (simp add: mod_Suc)
apply (clarsimp elim!: dvdE, rename_tac q)
apply (drule_tac y=x1 in order_le_imp_less_or_eq, erule disjE)
 prefer 2
 apply simp
apply (drule_tac x=x1 in spec)
apply (simp add: mult.commute[of k])
apply (drule Suc_le_lessD)
apply (drule_tac y="q * k" and m=k in less_mod_eq_imp_add_divisor_le, simp)
apply simp
done

lemma i_shrink_eq_Msg_iUntil_start_event_conv: "
  \<lbrakk> 0 < k; m \<noteq> \<NoMsg>; \<And>t. event t = (t mod k = 0); t0 = t * k \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = m) = (
  (s t0 = m \<and> (\<circle> t' t0 [0\<dots>]. (s t1 = \<NoMsg>. t1 \<U> t2 ([0\<dots>] \<oplus> t'). event t2))) \<or>
  (\<circle> t' t0 [0\<dots>]. (\<not> event t1. t1 \<U> t2 ([0\<dots>] \<oplus> t'). (
    s t2 = m \<and> \<not> event t2 \<and> (\<circle> t'' t2 [0\<dots>].
      (s t3 = \<NoMsg>. t3 \<U> t4 ([0\<dots>] \<oplus> t''). event t4))))))"
apply (case_tac "k = Suc 0")
 apply (simp add: iT_add iT_not_empty iNext_iff)
apply (drule neq_le_trans[OF not_sym], simp)
apply (simp add: i_shrink_eq_Msg_iSince_conv iTL_defs iT_add iT_cut_greater iT_cut_less Ball_def Bex_def iT_iff iFROM_inext)
apply (rule_tac t="Suc (t * k + k - 2)" and s="t * k + k - Suc 0" in subst, simp)
apply (rule iffI)
 apply (elim exE conjE, rename_tac i)
 apply (case_tac "i = t * k")
  apply (rule disjI1)
  apply simp
  apply (rule_tac x="t * k + k" in exI)
  apply force
 apply (rule disjI2)
 apply (rule_tac x=i in exI)
 apply (case_tac "i = Suc (t * k)")
  apply simp
  apply (case_tac "Suc (t * k) < t * k + k - Suc 0")
   apply (clarsimp simp: mod_Suc)
   apply (case_tac "k = Suc (Suc 0)", simp)
   apply simp
   apply (rule_tac x="t * k + k" in exI)
   apply force
  apply clarsimp
  apply (subgoal_tac "k = Suc (Suc 0)")
   prefer 2
   apply simp
  apply (simp add: mod_Suc)
  apply (simp add: mult_2_right[symmetric] numeral_2_eq_2 del: mult_Suc_right)
  apply (rule_tac x="t * k + k" in exI)
  apply simp
 apply simp
 apply (subgoal_tac "Suc (t * k) \<le> i")
  prefer 2
  apply (rule ccontr, simp)
 apply simp
 apply (case_tac "i < t * k + k - Suc 0")
  apply clarsimp
  apply (subgoal_tac "0 < i mod k")
   prefer 2
   apply (simp add: mult.commute[of t])
   apply (rule between_imp_mod_gr0[OF Suc_le_lessD], simp+)
  apply (rule conjI)
   apply (rule_tac x="t * k + k" in exI)
   apply force
  apply clarify
  apply (simp add: mult.commute[of t])
  apply (rule between_imp_mod_gr0[OF Suc_le_lessD], assumption)
  apply simp
 apply clarsimp
 apply (subgoal_tac "Suc (Suc 0) < k")
  prefer 2
  apply simp
 apply (simp add: mod_0_imp_mod_pred)
 apply (rule conjI, blast)
 apply clarify
 apply (simp add: mult.commute[of t])
 apply (rule between_imp_mod_gr0[OF Suc_le_lessD], assumption)
 apply simp
apply (simp add: mod_Suc)
apply (erule disjE)
 apply (clarsimp simp: mult.commute[of k] elim!: dvdE, rename_tac i)
 apply (subgoal_tac "t < i")
  prefer 2
  apply (rule ccontr)
  apply (simp add: linorder_not_less)
  apply (drule_tac i=i and k=k in mult_le_mono1)
  apply simp
 apply (rule_tac x="t * k" in exI)
 apply simp
 apply (subgoal_tac "t * k < t * k + k - Suc 0")
  prefer 2
  apply simp
 apply (clarsimp, rename_tac j)
 apply (drule_tac x=j in spec)
 apply (simp add: numeral_2_eq_2 Suc_diff_Suc)
 apply (drule mp)
  apply (rule order_trans, assumption)
  apply (drule_tac m=t and n=i in Suc_leI)
  apply (drule mult_le_mono1[of "Suc t"_ k])
  apply simp
 apply simp
apply (clarsimp, rename_tac i)
apply (case_tac "i = Suc (t * k)")
 apply (clarsimp, rename_tac i1)
 apply (rule_tac x="Suc (t * k)" in exI)
 apply simp
 apply (case_tac "k = Suc (Suc 0)", simp)
 apply (clarsimp simp: mult.commute[of k] elim!: dvdE, rename_tac q)
 apply (subgoal_tac "Suc (t * k) < t * k + k - Suc 0")
  prefer 2
  apply simp
 apply (clarsimp elim!: dvdE, rename_tac j)
 apply (drule_tac x=j in spec)
 apply (simp add: numeral_3_eq_3 Suc_diff_Suc)
 apply (subgoal_tac "t * k + k \<le> q * k")
  prefer 2
  apply (rule less_mod_eq_imp_add_divisor_le)
   apply (rule Suc_le_lessD, simp)
  apply simp
 apply simp
apply (clarsimp, rename_tac i1)
apply (rule_tac x=i in exI)
apply (simp add: numeral_2_eq_2 Suc_diff_Suc)
apply (case_tac "i1 = Suc i")
 apply simp
 apply (case_tac "Suc (i mod k) = k")
  apply simp
  apply (subgoal_tac "i \<le> t * k + k - Suc 0")
   prefer 2
   apply (rule ccontr)
   apply (drule_tac x="t * k + k" in spec)
   apply (simp add: linorder_not_le)
   apply (drule pred_less_imp_le)+
   apply clarsimp
  apply simp
  apply (drule_tac x=i in le_imp_less_or_eq, erule disjE)
   apply simp
   apply (cut_tac b="k - Suc (Suc 0)" and m=k and k=t and a="Suc 0" and n=i in between_imp_mod_between)
   apply (simp add: mult.commute[of k])+
   apply (clarsimp elim!: dvdE)+
apply (rename_tac q)
apply (simp add: mult.commute[of k])
apply (subgoal_tac "Suc t \<le> q")
 prefer 2
 apply (rule Suc_leI)
 apply (rule mult_less_cancel2[where k=k, THEN iffD1, THEN conjunct2])
 apply (rule Suc_le_lessD)
 apply simp
apply (frule mult_le_mono1[of "Suc t" _ k])
apply (simp add: add.commute[of k])
apply (intro conjI impI allI)
 apply force
apply (simp add: linorder_not_less)
apply (case_tac "i > t * k + k")
 apply (drule_tac x="t * k + k" in spec)
 apply simp
apply (case_tac "i = t * k + k", simp)
apply simp
done

lemma i_shrink_eq_NoMsg_iAll_finish_event_conv: "
  \<lbrakk> 1 < k; \<And>t. event t = (t mod k = k - 1); t0 = t * k \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = \<NoMsg>) =
  (s t0 = \<NoMsg> \<and> (\<circle> t' t0 [0\<dots>]. (s t1 = \<NoMsg>. t1 \<U> t2 ([0\<dots>] \<oplus> t'). (event t2 \<and> s t2 = \<NoMsg>))))"
apply (simp add: i_shrink_eq_NoMsg_iAll_conv iT_add)
apply (unfold iTL_defs Ball_def Bex_def)
apply (simp add: iT_iff div_mult_cancel iFROM_cut_less iFROM_inext)
apply (subgoal_tac "t * k < t * k + k - Suc 0")
 prefer 2
 apply simp
apply (rule iffI)
 apply simp
 apply (rule_tac x="t * k + k - Suc 0" in exI)
 apply (simp add: mod_pred)
 apply (clarify, rename_tac t1)
 apply (drule Suc_leI[of "t * k"])
 apply (drule order_le_less[THEN iffD1], erule disjE)
  prefer 2
  apply simp
 apply (clarsimp simp: iIN_iff)
apply (clarify, rename_tac t1 t2)
apply (case_tac "t2 \<le> Suc (t * k)")
 apply (clarsimp simp: mod_Suc)
 apply (drule_tac s="Suc 0" in sym, drule_tac x="k - Suc 0" and f=Suc in arg_cong)
 apply (drule_tac y=t1 in order_le_imp_less_or_eq, erule disjE)
  apply (drule_tac n=t1 in Suc_leI)
  apply simp
 apply simp
apply clarsimp
apply (drule_tac x=t1 in spec)
apply (simp add: iIN_iff linorder_not_le)
apply (drule_tac y=t1 in order_le_imp_less_or_eq, erule disjE)
 prefer 2
 apply simp
apply (subgoal_tac "t * k + k - Suc 0 \<le> t2")
 prefer 2
 apply (rule le_diff_conv[THEN iffD2])
 apply (rule less_mod_eq_imp_add_divisor_le, simp)
 apply (simp add: mod_Suc)
apply simp
apply (drule_tac x="t * k + k - Suc 0" and y=t2 in order_le_imp_less_or_eq, erule disjE)
 prefer 2
 apply (drule_tac t=t2 in sym, simp)
 apply (drule_tac x=t1 in order_le_imp_less_or_eq, erule disjE)
 apply simp+
done

lemma i_shrink_eq_Msg_iUntil_finish_event_conv: "
  \<lbrakk> 1 < k; m \<noteq> \<NoMsg>; \<And>t. event t = (t mod k = k - 1); t0 = t * k \<rbrakk> \<Longrightarrow>
  ((s \<div>\<^sub>i k) t = m) = (
  (\<not> event t1. t1 \<U> t2 ([0\<dots>] \<oplus> t0). event t2 \<and> s t2 = m) \<or>
  (\<not> event t1. t1 \<U> t2 ([0\<dots>] \<oplus> t0). (\<not> event t2 \<and> s t2 = m \<and> (
    \<circle> t' t2 [0\<dots>]. (s t3 = \<NoMsg>. t3 \<U> t4 ([0\<dots>] \<oplus> t'). event t4 \<and> s t4 = \<NoMsg>)))))"
apply (simp add: i_shrink_eq_Msg_iSince_conv split del: if_split)
apply (simp only: iTL_defs iT_add iT_cut_greater iT_cut_less Ball_def Bex_def iT_iff iFROM_inext)
apply (subgoal_tac "t * k < t * k + k - Suc 0")
 prefer 2
 apply simp
apply (rule iffI)
 apply (subgoal_tac "\<And>x. t * k \<le> x \<Longrightarrow> x < t * k + k - Suc 0 \<Longrightarrow> x mod k \<noteq> k - Suc 0")
  prefer 2
  apply (rule less_imp_neq)
  apply (rule le_pred_imp_less, simp)
  apply (simp only: mult.commute[of t k])
  apply (rule between_imp_mod_le[of "k - Suc 0 - Suc 0" k t])
  apply (simp split del: if_split)+
 apply (elim exE conjE, rename_tac t1)
 apply (drule_tac x=t1 in order_le_imp_less_or_eq, erule disjE)
  prefer 2
  apply (rule disjI1)
  apply (rule_tac x=t1 in exI)
  apply (clarsimp simp add: mod_pred iIN_iff)
 apply (rule disjI2)
 apply (rule_tac x=t1 in exI)
 apply (simp split del: if_split)
 apply (rule conjI)
  apply (rule_tac x="t * k + k - Suc 0" in exI)
  apply (clarsimp simp: mod_pred iIN_iff)
 apply (clarsimp simp: iIN_iff)
apply (erule disjE)
 apply (clarsimp, rename_tac t1)
 apply (drule_tac y=t1 in order_le_imp_less_or_eq, erule disjE)
  prefer 2
  apply (drule_tac t=t1 in sym, simp)
 apply (simp add: iIN_iff)
 apply (subgoal_tac "t1 \<le> t * k + k - Suc 0")
  prefer 2
  apply (rule ccontr)
  apply (drule_tac x="t * k + k - Suc 0" in spec)
  apply (simp add: mod_pred)
 apply (frule_tac a="t * k" and b=t1 and k="k - Suc 0" and m=k
   in le_mod_add_eq_imp_add_mod_le[OF less_imp_le, rule_format])
  apply (simp add: add.commute[of "t * k"] mod_pred)
 apply (rule_tac x=t1 in exI)
 apply simp
apply (clarsimp, rename_tac t1 t2)
apply (rule_tac x=t1 in exI)
apply (drule_tac y=t1 in order_le_imp_less_or_eq, erule disjE)
 prefer 2
 apply (drule_tac t=t1 in sym)
 apply (clarsimp simp: iIN_iff, rename_tac t3)
 apply (split if_split_asm)
  apply (subgoal_tac "t2 = Suc (t * k)")
   prefer 2
   apply simp
  apply (subgoal_tac "k = Suc (Suc 0)")
   prefer 2
   apply (simp add: mod_Suc)
  apply (simp add: mod_Suc)
 apply (simp add: iIN_iff)
 apply (subgoal_tac "t * k + k - Suc 0 \<le> t2")
  prefer 2
  apply (rule ccontr)
  apply (simp add: linorder_not_le)
  apply (drule_tac m=t2 in less_imp_le_pred)
  apply (simp only: mult.commute[of t])
  apply (frule_tac n=t2 in between_imp_mod_le[of "k - Suc (Suc 0)" k t _, OF diff_Suc_less, OF gr_implies_gr0])
   apply simp+
 apply (drule_tac x=t3 in spec)
 apply simp
 apply (drule_tac x=t3 in order_le_imp_less_or_eq)
 apply (drule_tac x="t * k + k - Suc 0" and y=t2 in order_le_imp_less_or_eq)
 apply (fastforce simp: numeral_2_eq_2 Suc_diff_Suc)
apply simp
apply (case_tac "Suc t1 = t2")
 apply (drule_tac t=t2 in sym)
 apply (simp add: iIN_iff numeral_2_eq_2 Suc_diff_Suc)
 apply (subgoal_tac "t1 \<le> t * k + k - Suc 0")
  prefer 2
  apply (rule ccontr)
  apply (drule_tac x="t * k + k - Suc 0" in spec)
  apply (simp add: mod_pred)
 apply (intro conjI impI)
 apply (subgoal_tac "Suc t1 = t * k + k - Suc 0", clarsimp)
 apply (subgoal_tac "t * k + (k - Suc 0) \<le> Suc t1")
  prefer 2
  apply (rule ccontr)
  apply (subgoal_tac "k - Suc 0 - Suc 0 < k")
   prefer 2
   apply simp
  apply (simp only: mult.commute[of t])
  apply (drule_tac n="Suc t1" in between_imp_mod_le[of "k - Suc 0 - Suc 0" k t])
  apply simp_all
apply (simp add: iIN_iff)
apply (subgoal_tac "t1 \<le> t * k + k - Suc 0")
 prefer 2
 apply (rule ccontr)
 apply (drule_tac x="t * k + k - Suc 0" in spec)
 apply (simp add: mod_pred)
apply (clarsimp, rename_tac t3)
apply (thin_tac "All (\<lambda>x. A x \<longrightarrow> B (x mod k))" for A B)
apply (drule_tac x=t3 in spec)
apply (subgoal_tac "t3 \<le> t2 \<Longrightarrow> s t3 = \<NoMsg>")
 prefer 2
 apply (drule_tac x=t3 and y=t2 in order_le_imp_less_or_eq, erule disjE)
  apply simp
 apply simp
apply (drule_tac P="t3 \<le> t2" in meta_mp)
 apply (subgoal_tac "t * k < t2")
  prefer 2
  apply (rule_tac y=t1 in less_trans, assumption+)
 apply (case_tac "t * k + (k - Suc 0) < t2")
  apply simp
 apply simp
apply (subgoal_tac "t * k + (k - Suc 0) \<le> t2")
 prefer 2
 apply (simp only: mult.commute[of t])
 apply (rule mult_divisor_le_mod_ge_imp_ge)
 apply simp_all
done

end


\<^marker>\<open>creator "Johannes Hölzl"\<close>
chapter \<open>Probabilistic Guarded Command Language\<close>
theory PGCL
  imports verERT_Misc
begin

paragraph \<open>Summary\<close>

text \<open>This theory introduces the probabilistic guarded command language pGCL.
    It also introduces the weakest preexpectation transformer, and the expected running time
    transformer.
    Then proves some general properties of @{term ert} \<close>

paragraph \<open>Main Definitions\<close>

text \<open>
  \<^item> pgcl:  the type of deeply embedded pGCL programs
  \<^item> wp: the weakest preexpectation transformer
  \<^item> ert: the expected running time transformer
\<close>

section \<open>Definition of PGCL and transformers\<close>

datatype 'a pgcl = Empty
                 | Skip
                 | Halt
                 | Assign "'a \<Rightarrow> 'a pmf"
                 | Seq (left: "'a pgcl") (right: "'a pgcl") ("_;;/ _"  [60, 61] 60)
                 | Par (left: "'a pgcl") (right: "'a pgcl")
                 | If "'a \<Rightarrow> bool" (left: "'a pgcl") (right: "'a pgcl")
                 | While "'a \<Rightarrow> bool" "'a pgcl" ("(WHILE _/ DO _)"  [0, 61] 61)

inductive halt_free :: "'a pgcl \<Rightarrow> bool"
where
  Empty: "halt_free Empty"
| Skip: "halt_free Skip"
| Assign: "halt_free (Assign u)"
| Seq: "halt_free c\<^sub>1 \<Longrightarrow> halt_free c\<^sub>2 \<Longrightarrow> halt_free (Seq c\<^sub>1 c\<^sub>2)"
| Par: "halt_free c\<^sub>1 \<Longrightarrow> halt_free c\<^sub>2 \<Longrightarrow> halt_free (Par c\<^sub>1 c\<^sub>2)"
| If: "halt_free c\<^sub>1 \<Longrightarrow> halt_free c\<^sub>2 \<Longrightarrow> halt_free (If g c\<^sub>1 c\<^sub>2)"
| While: "halt_free c \<Longrightarrow> halt_free (While g c)"

inductive fully_probabilistic :: "'a pgcl \<Rightarrow> bool"
where
  Empty: "fully_probabilistic Empty"
| Skip: "fully_probabilistic Skip"
| Halt: "fully_probabilistic Halt"
| Assign: "fully_probabilistic (Assign u)"
| Seq: "fully_probabilistic c\<^sub>1 \<Longrightarrow> fully_probabilistic c\<^sub>2 \<Longrightarrow> fully_probabilistic (Seq c\<^sub>1 c\<^sub>2)"
| If: "fully_probabilistic c\<^sub>1 \<Longrightarrow> fully_probabilistic c\<^sub>2 \<Longrightarrow> fully_probabilistic (If g c\<^sub>1 c\<^sub>2)"
| While: "fully_probabilistic c \<Longrightarrow> fully_probabilistic (While g c)"

hide_fact (open) Empty Skip Halt Assign Seq If While

subsection \<open>Weakest Preexpectation Transformer\<close>

primrec wp :: "'a pgcl \<Rightarrow> ('a \<Rightarrow> ennreal) \<Rightarrow> ('a \<Rightarrow> ennreal)"
where
  "wp Empty f = f"
| "wp Skip f = f"
| "wp Halt f = \<bottom>"
| "wp (Assign u) = (\<lambda>f x. \<integral>\<^sup>+y. f y \<partial>u x)"
| "wp (Seq c\<^sub>1 c\<^sub>2) f = wp c\<^sub>1 (wp c\<^sub>2 f)"
| "wp (Par c\<^sub>1 c\<^sub>2) f = wp c\<^sub>1 f \<sqinter> wp c\<^sub>2 f"
| "wp (If g c\<^sub>1 c\<^sub>2) f = (\<lambda>x. if g x then wp c\<^sub>1 f x else wp c\<^sub>2 f x)"
| "wp (While g c) f = lfp (\<lambda>W x. (if g x then wp c W x else f x))"

subsection \<open>Expected Runtime Transformer\<close>

primrec ert :: "'a pgcl \<Rightarrow> ('a \<Rightarrow> ennreal) \<Rightarrow> ('a \<Rightarrow> ennreal)"
where
  "ert Empty f = f"
| "ert Skip f = 1 + f"
| "ert Halt f = 0"
| "ert (Assign u) f = 1 + (\<lambda>x. \<integral>\<^sup>+y. f y \<partial>u x)"
| "ert (Seq c\<^sub>1 c\<^sub>2) f = ert c\<^sub>1 (ert c\<^sub>2 f)"
| "ert (Par c\<^sub>1 c\<^sub>2) f = ert c\<^sub>1 f \<squnion> ert c\<^sub>2 f"
| "ert (If g c\<^sub>1 c\<^sub>2) f = 1 + (\<lambda>x. if g x then ert c\<^sub>1 f x else ert c\<^sub>2 f x)"
| "ert (While g c) f = lfp (\<lambda>W x. 1 + (if g x then ert c W x else f x))"

lemma sup_continuous_ert: "sup_continuous (ert P)"
  by (induction P)
     (auto intro!: order_continuous_intros sup_continuous_lfp''[THEN sup_continuous_applyD]
           dest: sup_continuous_compose sup_continuous_applyD)

lemma mono_ert: "mono (ert P)"
  using sup_continuous_mono[OF sup_continuous_ert] .

lemma ert_const_add:
  assumes P: "halt_free P"
  shows "ert P ((\<lambda>x. k) + f) = (\<lambda>x. k) + ert P f"
using P proof (induction arbitrary: f k)
  case Seq then show ?case by simp
next
  case (While c g f)
  have "(\<lambda>a. k) \<le> lfp (\<lambda>W x. 1 + (if g x then ert c W x else k + f x))"
  proof (intro lfp_greatest)
    fix u assume *: "(\<lambda>x. 1 + (if g x then ert c u x else k + f x)) \<le> u"
    have "(\<lambda>_. min k n) \<le> u" for n :: nat
    proof (induction n)
      case (Suc n)
      show ?case
      proof (rule le_funI)
        fix x
        show "min k (Suc n) \<le> u x"
        proof cases
          assume "g x"
          have "(\<lambda>_. min k (Suc n)) \<le> 1 + (\<lambda>_. min k n)"
            by (auto intro!: le_funI split: split_min
                     intro!: add_increasing ennreal_zero_less_one[THEN less_imp_le])
          also have "\<dots> \<le> 1 + ert c ((\<lambda>_. min k n) + 0)"
            by (subst While.IH) (intro add_left_mono order_refl zero_le add_increasing2)
          also have "\<dots> \<le> 1 + ert c u"
            by (auto intro: monoD[OF mono_ert] add_left_mono Suc)
          finally show ?thesis
            using \<open>g x\<close> *[THEN le_funD, of x] by (auto dest!: le_funD intro: order_trans)
        next
          assume "\<not> g x"
          have "min k (Suc n) \<le> k + (1 + f x)"
            by (intro min.coboundedI1 add_increasing2 zero_le) auto
          also have "\<dots> \<le> u x"
            using \<open>\<not> g x\<close> *[THEN le_funD, of x] by (auto simp: ac_simps)
          finally show ?thesis .
        qed
      qed
    qed (simp add: min.absorb2 zero_le le_funI)
    then have "(SUP n::nat. (\<lambda>_. min k n)) \<le> u"
      by (intro SUP_least)
    also have "(SUP n::nat. (\<lambda>_. min k n)) = (\<lambda>x. k)"
      by (auto intro!: antisym SUP_least le_funI
               simp: inf_min[symmetric] inf_SUP[symmetric] ennreal_SUP_of_nat_eq_top SUP_image)
    finally show "(\<lambda>x. k) \<le> u" .
  qed

  with While show ?case
    apply simp
    apply (intro lfp_transfer[symmetric, where \<alpha>="\<lambda>f a. k + f a"])
    apply (auto intro!: order_continuous_intros sup_continuous_ert[THEN sup_continuous_applyD]
                        monoI[OF le_funI] add_mono mono_ert[THEN monoD, THEN le_funD]
                simp: fun_eq_iff add_ac bot_ennreal)
    done
qed (auto simp: sup_const_add_ennreal add_ac nn_integral_add)

lemma ert_infty: "halt_free P \<Longrightarrow> ert P \<top> = \<top>"
  using ert_const_add[of P \<top> 0] by (simp add: plus_fun_def top_add top_fun_def[symmetric])

lemma ert_subadditive: "ert P (F + G) \<le> ert P F + ert P G"
proof (induction P arbitrary: F G)
  case Empty then show ?case
    by simp
next
  case Skip then show ?case
    by (auto simp add: ac_simps le_fun_def add_increasing zero_le)
next
  case Halt then show ?case
    by (simp add: le_fun_def)
next
  case (Assign u f g) then show ?case
    by (auto simp: nn_integral_add intro!: le_funI)
next
  case (Seq c\<^sub>1 c\<^sub>2 F G)
  have "ert c\<^sub>1 (ert c\<^sub>2 (F + G)) \<le> ert c\<^sub>1 (ert c\<^sub>2 F + ert c\<^sub>2 G)"
    by (intro mono_ert[THEN monoD] Seq)
  also have "\<dots> \<le> ert c\<^sub>1 (ert c\<^sub>2 F) + ert c\<^sub>1 (ert c\<^sub>2 G)"
    by (intro Seq)
  finally show ?case
    by (simp del: plus_fun_apply)
next
  case (Par c\<^sub>1 c\<^sub>2 F G)
  have "ert c\<^sub>1 (F + G) \<squnion> ert c\<^sub>2 (F + G) \<le> (ert c\<^sub>1 F + ert c\<^sub>1 G) \<squnion> (ert c\<^sub>2 F + ert c\<^sub>2 G)"
    by (intro sup.mono Par)
  also have "\<dots> \<le> (ert c\<^sub>1 F \<squnion> ert c\<^sub>2 F) + (ert c\<^sub>1 G \<squnion> ert c\<^sub>2 G)"
    by (intro sup_least add_mono) auto
  finally show ?case
    by (simp del: plus_fun_apply sup_apply)
next
  case (If g c\<^sub>1 c\<^sub>2 F G) then show ?case
    by (auto simp: le_fun_def ac_simps intro!: add_increasing[of 1 _ _])
next
  case (While g c F G)
  let ?P = "\<lambda>F W x. 1 + (if g x then ert c W x else F x)"
  have *: "\<And>F. mono (?P F)"
    by (auto simp: mono_def le_fun_def intro!: add_mono mono_ert[THEN monoD, THEN le_funD])

  have "?P (\<lambda>x. F x + G x) (lfp (?P F) + lfp (?P G)) \<le> ?P F (lfp (?P F)) + ?P G (lfp (?P G))"
    using add_left_mono[OF While, of 1, THEN le_funD]
    by (auto intro!: add_increasing[of 1 _ _] simp: ac_simps le_fun_def plus_fun_def)
  also have "\<dots> = lfp (?P F) + lfp (?P G)"
    unfolding lfp_unfold[OF *, symmetric] ..
  finally show ?case
    by (clarsimp intro!: lfp_lowerbound simp add: plus_fun_def cong: if_cong)
qed

end


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

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

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

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

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

fun filter :: "('a => bool) => 'a list => 'a list" where
  "filter p (nil2) = nil2"
| "filter p (cons2 z xs) =
     (if p z then cons2 z (filter p xs) else filter p xs)"

(*fun did not finish the proof*)
function qsort :: "int list => int list" where
  "qsort (nil2) = nil2"
| "qsort (cons2 z xs) =
     x (qsort (filter (% (z2 :: int) => z2 <= z) xs))
       (x (cons2 z (nil2)) (qsort (filter (% (x2 :: int) => x2 > z) xs)))"
  by pat_completeness auto

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

end


theory Scratch_01
  imports Main
begin
context comm_monoid_add
begin
sublocale bigvee: comm_monoid_set HOL.disj False
  defines bigvee = bigvee.F and bigvee' = bigvee.G
  by standard auto

abbreviation bigvee'' :: \<open>bool set \<Rightarrow> bool\<close> ("\<Or>")
  where "\<Or> \<equiv> bigvee (\<lambda>x. x)"

sublocale bigwedge: comm_monoid_set HOL.conj True
  defines bigwedge = bigwedge.F and bigwedge' = bigwedge.G
  by standard auto

abbreviation bigwedge'' :: \<open>bool set \<Rightarrow> bool\<close> ("\<And>")
  where "\<And> \<equiv> bigwedge (\<lambda>x. x)"
end

syntax
  "_bigwedge" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b::comm_monoid_add"  ("(2\<And>(_/\<in>_)./ _)" [0, 51, 10] 10)
translations \<comment> \<open>Beware of argument permutation!\<close>
  "\<And>i\<in>A. b" \<rightleftharpoons> "CONST bigwedge (\<lambda>i. b) A"

syntax
  "_bigvee" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b::comm_monoid_add"  ("(2\<Or>(_/\<in>_)./ _)" [0, 51, 10] 10)
translations \<comment> \<open>Beware of argument permutation!\<close>
  "\<Or>i\<in>A. b" \<rightleftharpoons> "CONST bigvee (\<lambda>i. b) A"

instantiation bool :: comm_monoid_add
begin
definition zero_bool where
[simp]: \<open>zero_bool = False\<close>
definition plus_bool where
[simp]: \<open>plus_bool = (\<or>)\<close>
instance
  by standard auto
end
thm bigvee_def

lemma \<open>finite A \<Longrightarrow> (\<Or>i\<in>A. f i) \<longleftrightarrow> (\<exists>i \<in> A. f i)\<close>
  apply (induction rule: finite_induct)
  apply (auto simp: )
  done

lemma \<open>finite A \<Longrightarrow> (\<And>i\<in>A. f i) \<longleftrightarrow> A = {} \<or> (\<forall>i \<in> A. f i)\<close>
  apply (induction rule: finite_induct)
  apply (auto simp: )[2]
  done

lemma \<open>infinite A \<Longrightarrow> (\<And>i\<in>A. f i) \<longleftrightarrow> True\<close>
  by auto

lemma test1:
  \<open>(\<And>j\<in>L. \<And>u\<in>U. \<And>t\<in>T. \<And>l\<in>L. \<And>l\<^sub>1\<in>L\<^sub>1. \<not>P j u t l\<^sub>1) \<or>
   (\<Or>i\<in>I. \<Or>v\<in>V. \<And>k\<in>K. \<Or>h\<in>H. Q i \<or> k h) \<Longrightarrow>
   (\<Or>i\<in>I. \<Or>v\<in>V. \<And>k\<in>K. \<Or>h\<in>H. Q i \<or> k h) \<or> (\<And>j\<in>J. \<And>u\<in>U. \<And>t\<in>T. \<And>l\<^sub>1\<in>L\<^sub>1. \<not>P j u t l\<^sub>1)\<close>
  apply auto


chapter SeCaV_Propositional

(*
  Author: Jørgen Villadsen, DTU Compute, 2020
  Contributors: Asta Halkjær From & Alexander Birch Jensen
*)

section \<open>Sequent Calculus Verifier (SeCaV)\<close>

theory SeCaV_Propositional imports SeCaV begin

abbreviation \<open>P \<equiv> Pre 0 []\<close>

abbreviation \<open>Q \<equiv> Pre 1 []\<close>

abbreviation \<open>R \<equiv> Pre 2 []\<close>

section \<open>Examples\<close>

subsection \<open>Example 1\<close>

proposition \<open>p \<longrightarrow> p\<close> by metis

lemma \<open>\<tturnstile>
  [
    Imp P P
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg P,
      P
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      P,
      Neg P
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

subsection \<open>Example 2\<close>

proposition \<open>\<not> p \<longrightarrow> \<not> \<not> \<not> p\<close> by metis

lemma \<open>\<tturnstile>
  [
    Imp (Neg P) (Neg (Neg (Neg P)))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Neg P),
      Neg (Neg (Neg P))
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

subsection \<open>Example 3\<close>

proposition \<open>\<not> \<not> p \<longrightarrow> p\<close> by metis

lemma \<open>\<tturnstile>
  [
    Imp (Neg (Neg P)) P
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Neg (Neg P)),
      P
    ]
    \<close>
    using that by simp
  with Neg have ?thesis if \<open>\<tturnstile>
    [
      Neg P,
      P
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      P,
      Neg P
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

subsection \<open>Example 4\<close>

proposition \<open>p \<or> (p \<longrightarrow> q)\<close> by metis

lemma \<open>\<tturnstile>
  [
    Dis P (Imp P Q)
  ]
  \<close>
proof -
  from AlphaDis have ?thesis if \<open>\<tturnstile>
    [
      P,
      Imp P Q
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Imp P Q,
      P
    ]
    \<close>
    using that by simp
  with AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg P,
      Q,
      P
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      P,
      Neg P
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

subsection \<open>Example 5\<close>

proposition \<open>p \<and> q \<longrightarrow> r \<longrightarrow> p \<and> r\<close> by metis

lemma \<open>\<tturnstile>
  [
    Imp (Con P Q) (Imp R (Con P R))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Con P Q),
      Imp R (Con P R)
    ]
    \<close>
    using that by simp
  with AlphaCon have ?thesis if \<open>\<tturnstile>
    [
      Neg P,
      Neg Q,
      Imp R (Con P R)
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Imp R (Con P R),
      Neg P
    ]
    \<close>
    using that by simp
  with AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg R,
      Con P R,
      Neg P
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Con P R,
      Neg R,
      Neg P
    ]
    \<close>
    using that by simp
  with BetaCon have ?thesis if \<open>\<tturnstile>
    [
      P,
      Neg R,
      Neg P
    ]
    \<close> and \<open>\<tturnstile>
    [
      R,
      Neg R,
      Neg P
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

end


theory BCI imports Main
begin

section \<open>A toy background theory\<close> (*skip on first read*)

(*Sets are encoded as characteristic functions/predicates (i.e. functions with a 'bool' codomain)*)
type_synonym 'a \<sigma> = \<open>'a \<Rightarrow> bool\<close>

(*The infimum (i.e. big-intersection) of a set of sets*)
definition Infimum:: "('a \<sigma>)\<sigma> \<Rightarrow> 'a \<sigma>" ("\<^bold>\<Inter>")
  where "\<^bold>\<Inter>S \<equiv> \<lambda>z. (\<forall>X. S X \<longrightarrow> X z)"

(*A set S can be closed under a zero-ary, unary, or binary operation (\<chi>/0, \<phi>/1, or \<xi>/2 resp.)*)
abbreviation (input) op0_closed::"'a  \<Rightarrow> 'a \<sigma>  \<Rightarrow> bool" ("_-closed\<^sub>0")
  where "\<chi>-closed\<^sub>0 \<equiv> \<lambda>S. S \<chi>" (*just for illustration, not really useful as a definition *)
definition op1_closed::"('a \<Rightarrow> 'a) \<Rightarrow> 'a \<sigma> \<Rightarrow> bool" ("_-closed\<^sub>1")
  where "\<phi>-closed\<^sub>1 \<equiv> \<lambda>S. \<forall>x. S x \<longrightarrow> S(\<phi> x)"

(*Convenient abbreviation to say that the set S is a (sub)algebra wrt. to the operations \<chi>/0, \<phi>/1*)
abbreviation "subAlg \<chi> \<phi> \<equiv> \<lambda>S. (\<chi>-closed\<^sub>0 S) \<and> (\<phi>-closed\<^sub>1 S)" (*i.e. (\<chi>-closed\<^sub>0 S) \<and> (\<phi>-closed\<^sub>1 S)*)

(*The set of elements denoted by terms of the form \<phi>\<^sup>n\<chi>. Let's call them 'inductive(ly generated) sets'*)
abbreviation "indAlg \<chi> \<phi> \<equiv> \<^bold>\<Inter>(subAlg \<chi> \<phi>)"

(*Convenient shorthand for composing unary with binary functions*)
abbreviation (input) fcomp12::"('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'c)" (infixr "\<circ>\<^sub>1\<^sub>2" 75)
  where "\<phi> \<circ>\<^sub>1\<^sub>2 \<xi> \<equiv> \<lambda>x y. \<phi>(\<xi> x y)"

section \<open>Encoding BCI problem\<close>

(*For each model, the semantic domain \<D>\<^sup>i can be seen as the carrier of an algebra \<A> = <\<D>\<^sup>i,e/0,s/1>*)
typedecl i
consts e :: "i"  (*zero-ary operation*)
       s :: "i\<Rightarrow>i"  (*unary operation*)

(*The first three axioms axiomatize (via equations!) a binary operation 'f' in terms of 'e' and 's'*)
abbreviation (input) "A1 f \<equiv> \<forall>x. f x e = s e"
abbreviation (input) "A2 f \<equiv> \<forall>y. f e (s y) = s (s (f e y))"
abbreviation (input) "A3 f \<equiv> \<forall>x y. f (s x) (s y) = f x (f (s x) y)"

(*The final two axioms constrain a given set 'd' as a subuniverse (subalgebra) of \<A> (= <\<D>\<^sup>i,e/0,s/1>)*)
abbreviation (input) "A4 d \<equiv> d e"
abbreviation (input) "A5 d \<equiv> \<forall>x. d x \<longrightarrow> d (s x)"

(*Boolos problem corresponds to asking whether, for an arbitrary <e,s>-subalgebra 'd', the image under 'f'
 (as axiomatized with A1-A3) of two particular elements (denoted by the terms of the form 's\<^sup>ne') is in 'd'*)
theorem BCI: "A1 f \<and> A2 f \<and> A3 f \<longrightarrow> (\<forall>d. (A4 d \<and> A5 d) \<longrightarrow> d (f (s(s(s(s e)))) (s(s(s(s e))))))"
  (*sledgehammer*) oops (*not solvable automatically*)

section \<open>Solving the BCI problem fully automatically\<close>

(*Let us introduce a convenient shorthand notation for the (inductively generated) set N of all elements
 that are denoted by terms of the form s\<^sup>ne (for some arbitrary n). This is the smallest <e,s>-subalgebra.*)
abbreviation "N \<equiv> indAlg e s"
(*Let us introduce the following (monomorphic!) definition:*)
definition p:: "(i \<Rightarrow> i \<Rightarrow> i) \<Rightarrow> (i \<Rightarrow> i \<Rightarrow> bool)"
  where "p f \<equiv> N \<circ>\<^sub>1\<^sub>2 f"

(*In previous work it has been shown that the above definition 'p' makes Boolos' problem solvable automatically*)
theorem BCI: "A1 f \<and> A2 f \<and> A3 f \<longrightarrow> (\<forall>d. (A4 d \<and> A5 d) \<longrightarrow> d (f (s(s(s(s e)))) (s(s(s(s e))))))"
  (*sledgehammer*) by (smt (z3) Infimum_def op1_closed_def p_def)

end


theory VDMToolkit
imports Main
begin

type_notation bool ("\<bool>")
type_notation nat ("\<nat>")
type_notation int ("\<int>")

(*****************************************************************)
section {* Basic types *}

type_synonym VDMNat  = \<int>
type_synonym VDMNat1 = \<int>
type_synonym VDMInt  = \<int>

definition
  inv_VDMNat :: "\<int> \<Rightarrow> \<bool>"
where
  (*<*) [intro!]: (*>*)
  "inv_VDMNat n \<equiv> n \<ge> 0"

definition
  inv_VDMNat1 :: "\<int> \<Rightarrow> \<bool>"
where
  (*<*)[intro!]: (*>*)
  "inv_VDMNat1 n \<equiv> n > 0"

(*****************************************************************)
section {* Sets *}

type_synonym 'a VDMSet = "'a set"

definition
  inv_SetElems :: "('a \<Rightarrow> \<bool>) \<Rightarrow> 'a VDMSet \<Rightarrow> \<bool>"
where
  "inv_SetElems einv s \<equiv> \<forall> e \<in> s . einv e"

lemma l_inv_SetElems_Cons: "(inv_SetElems f (insert a s)) = (f a \<and> (inv_SetElems f s))"
unfolding inv_SetElems_def
by auto

definition
  inv_VDMSet :: "'a VDMSet \<Rightarrow> \<bool>"
  where
   [intro!]:  "inv_VDMSet v \<equiv> finite v"

definition
  vdm_card :: "'a VDMSet \<Rightarrow> VDMNat"
  where
    "vdm_card s \<equiv> (if finite s then int (card s) else undefined)"

definition
  pre_vdm_card :: "'a VDMSet \<Rightarrow> \<bool>"
  where
  [intro!]:  "pre_vdm_card s \<equiv> inv_VDMSet s"

definition
  post_vdm_card :: "'a VDMSet \<Rightarrow> VDMNat \<Rightarrow> \<bool>"
  where
  [intro!]:  "post_vdm_card s RESULT \<equiv> inv_VDMNat RESULT"

lemma "vdm_card {0,1,(2::int)} = 3"
  unfolding vdm_card_def by simp

lemma l_vdm_card_finite[simp]: "finite s \<Longrightarrow> vdm_card s = int (card s)"
  unfolding vdm_card_def by simp

lemma l_vdm_card_range[simp]: "x \<le> y \<Longrightarrow> vdm_card {x .. y} = y - x + 1"
  unfolding vdm_card_def by simp

lemma l_vdm_card_positive:
  "finite s \<Longrightarrow> vdm_card s \<ge> 0"
  by simp

lemma l_vdm_card_non_negative:
  "finite s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> vdm_card s > 0"
  by (simp add: card_gt_0_iff)

theorem PO_feas_vdm_card:
  "pre_vdm_card s \<Longrightarrow> post_vdm_card s (vdm_card s)"
  by (simp add: inv_VDMNat_def inv_VDMSet_def post_vdm_card_def pre_vdm_card_def)

(*****************************************************************)
section {* Sequences *}

type_synonym 'a VDMSeq = "'a list"

text{* Isabelle's list @{term hd} and @{term tl} functions have the
same name as VDM. Nevertheless, their results is defined for empty lists.
We need to rule them out.
*}

definition
  pre_hd :: "'a VDMSeq \<Rightarrow> \<bool>"
where
  "pre_hd s \<equiv> s \<noteq> []"

definition
  pre_tl :: "'a VDMSeq \<Rightarrow> \<bool>"
where
  "pre_tl s \<equiv> s \<noteq> []"

definition
   len :: "'a VDMSeq \<Rightarrow> VDMNat"
where
   "len l \<equiv> int (length l)"

definition
  inv_VDMSeq1 :: "'a VDMSeq \<Rightarrow> \<bool>"
where
  "inv_VDMSeq1 s \<equiv> len s \<ge> 1"

lemma l_len_append: "len(xs @ [x]) = 1 + len xs"
apply (induct xs)
apply simp_all
unfolding len_def by simp_all

lemma l_len_empty: "len [] = 0" unfolding len_def by simp

lemma l_len_cons[simp]: "len(x # xs) = 1 + len xs"
apply (induct xs)
unfolding len_def by simp_all

definition
  elems :: "'a VDMSeq \<Rightarrow> 'a set"
where
  "elems l \<equiv> set l"

lemma l_elems_append: "elems (xs @ [x]) = insert x (elems xs)"
unfolding elems_def by simp

lemma l_elems_cons: "elems (x # xs) = insert x (elems xs)"
unfolding elems_def by simp

lemma l_elems_empty[simp]: "elems [] = {}" unfolding elems_def by simp

lemma l_inj_seq: "distinct s \<Longrightarrow> nat (len s) = card (elems s)"
by (induct s) (simp_all add: l_elems_cons  elems_def len_def)

text{* Be careful with representation differences
   VDM lists are 1-based, whereas Isabelle list
   are 0-based. This function returns {0,1,2}
   for sequence [A, B, C] instead of {1,2,3} *}

definition
   inds0 :: "'a VDMSeq \<Rightarrow> VDMNat set"
where
  "inds0 l \<equiv> {0 ..< len l}"

value "inds0 [A, B, C]"
(* indexes are 0, 1, 2; VDM would give 1, 2, 3 *)

definition
   inds :: "'a VDMSeq \<Rightarrow> VDMNat1 set"
where
  "inds l \<equiv> {1 .. len l}"

lemma l_inds_append: "inds (xs @ [x]) = insert (len (xs @ [x])) (inds xs)"
unfolding inds_def
by (simp add: atLeastAtMostPlus1_int_conv len_def)

lemma l_len_within_inds[simp]: "s \<noteq> [] \<Longrightarrow> len s \<in> inds s"
unfolding len_def inds_def
apply (induct s)
by simp_all

definition
   inds_as_nat :: "'a VDMSeq \<Rightarrow> \<nat> set"
where
  "inds_as_nat l \<equiv> {1 .. nat (len l)}"

lemma l_inds_as_nat_append: "inds_as_nat (xs @ [x]) = insert (length (xs @ [x])) (inds_as_nat xs)"
unfolding inds_as_nat_def len_def by auto

text{* Sequences may have invariants within their inner type. *}

definition
  inv_SeqElems0 :: "('a \<Rightarrow> \<bool>) \<Rightarrow> 'a VDMSeq \<Rightarrow> \<bool>"
where
  "inv_SeqElems0 einv s \<equiv> \<forall> e \<in> (elems s) . einv e"

definition
  inv_SeqElems :: "('a \<Rightarrow> \<bool>) \<Rightarrow> 'a VDMSeq \<Rightarrow> \<bool>"
where
  "inv_SeqElems einv s \<equiv> list_all einv s"

lemma l_inv_SeqElems_alt: "inv_SeqElems einv s = inv_SeqElems0 einv s"
by (simp add: elems_def inv_SeqElems0_def inv_SeqElems_def list_all_iff)

lemma l_inv_SeqElems_Cons: "(inv_SeqElems f (a#s)) = (f a \<and> (inv_SeqElems f s))"
unfolding inv_SeqElems_def elems_def by auto

lemma l_inv_SeqElems_append: "(inv_SeqElems f (xs @ [x])) = (f x \<and> (inv_SeqElems f xs))"
unfolding inv_SeqElems_def elems_def by auto

definition
  applyList :: "'a list \<Rightarrow> \<nat> \<Rightarrow> 'a option"
where
 "applyList l n \<equiv> (if (n > 0 \<and> int n \<le> len l) then
                      Some(l ! (n - (1::nat)))
                   else
                      None)"

definition
  applyVDMSeq :: "'a VDMSeq \<Rightarrow> \<int> \<Rightarrow> 'a" (infixl "$" 100)
where
 "applyVDMSeq l n \<equiv> (if (n > 0 \<and> n \<le> len l) then
                      (l ! nat (n - 1))
                   else
                      undefined)"

lemma applyVDM_len1: "applyVDMSeq s (len s + 1) = undefined"
unfolding applyVDMSeq_def len_def
apply simp
done

(* this goal is too specific; they are useful in specific situations *)
lemma applyVDM1: "(x # xs) $ 1 = x"
by (simp add: applyVDMSeq_def len_def)

lemma applyVDM2: "(x # xs) $ 2 = xs $ 1"
by (simp add: applyVDMSeq_def len_def)

(* generalise previous failure for a better matching goal: trade $ for ! *)
lemma applyVDM1_gen[simp]: "s \<noteq> [] \<Longrightarrow> s $ 1 = s ! 0"
apply (induct s)
apply (simp_all add: applyVDMSeq_def len_def)
done

(* combine repeated uses *)
lemmas applyVDMSeq_defs =  len_def applyVDMSeq_def

lemma applyVDM_cons_gt1empty: "i > 1 \<Longrightarrow> (x # []) $ i = undefined"
by (simp add: applyVDMSeq_defs)

lemma applyVDM_cons_gt1: "len xs > 0 \<Longrightarrow> i > 1 \<Longrightarrow> (x # xs) $ i = xs $ (i - 1)"
apply (simp add: applyVDMSeq_defs) (* again too complex; try avoiding the trade $ for ! again *)
apply (intro impI)
find_theorems name:induct name:List
apply (induct xs rule: length_induct)
apply simp_all
by (smt nat_1 nat_diff_distrib)

lemma applyVDM_zero[simp]: "applyVDMSeq s 0 = undefined"
unfolding applyVDMSeq_def len_def
apply simp
done

lemmas VDMSeq_def = elems_def inds_def len_def applyVDMSeq_def

lemma l_len_nat1: "s \<noteq> [] \<Longrightarrow> 0 < len s"
unfolding len_def by simp

lemma l_applyVDMSeq_defined: "s \<noteq> [] \<Longrightarrow> inv_SeqElems (\<lambda> x . x \<noteq> undefined) s \<Longrightarrow> applyVDMSeq s (len s) \<noteq> undefined"
unfolding applyVDMSeq_def  len_def
apply (simp add: l_len_nat1)
apply (cases "nat (int (length s) - 1)")
apply simp_all
apply (cases s)
apply simp_all
(*thm ssubst[OF l_inv_SeqElems_alt]
apply (subst ssubst[OF l_inv_SeqElems_alt])*)
apply (simp_all add: l_inv_SeqElems_alt)
unfolding inv_SeqElems0_def elems_def
apply (erule ballE)
apply simp_all
by simp

lemma l_applyVDMSeq_append_last:
  "applyVDMSeq (ms @ [m]) (len (ms @ [m])) = m"
unfolding applyVDMSeq_def len_def
by (simp add: l_len_append)

lemma l_applyVDMSeq_cons_last:
  "applyVDMSeq (m # ms) (len (m # ms)) = (if ms = [] then m else applyVDMSeq ms (len ms))"
apply (simp)
unfolding applyVDMSeq_def len_def
by (simp add: nat_diff_distrib')

(*****************************************************************)
section {* Maps *}

(*type_synonym ('a, 'b) "VDMMap" = "'a \<rightharpoonup> 'b" (infixr "\<rightharpoonup>" 0)*)

definition
  inv_Map :: "('a \<Rightarrow> \<bool>) \<Rightarrow> ('b \<Rightarrow> \<bool>) \<Rightarrow> ('a \<rightharpoonup> 'b) \<Rightarrow>\<bool>"
where
  "inv_Map inv_Dom inv_Rng m \<equiv>
      inv_SetElems inv_Dom (dom m) \<and>
      inv_SetElems inv_Rng (ran m)"

(*****************************************************************)
section {* Some useful examples *}

(* { expr | var . filter }, { var \<in> type . filter }, { var . filter } *)
value "{ x+x | x . x \<in> {(1::nat),2,3} }"
value "{ x+x | x . x \<in> {(1::nat),2,3} }"
(*value "{ x+x | x . x \<in> {(1::nat)..3} }" --"not always work"*)

value "{ [A,B,C,D,E,F] ! i | i . i \<in> {0,2,4} }"
(* { s(i) | i in set inds s & i mod 2 = 0 } *)

  (* List application (i.e. s(x)) is available in Isabelle *)

value "[A, B, C] ! 0"
value "[A, B, C] ! 1"
value "[A, B, C] ! 2"
value "[A, B, C] ! 3"
value "nth [A, B, C] 0"

(* List comprehension *)
value "{ [A,B,C] ! i | i . i \<in> {0,1,2} }"
value "[ x . x \<leftarrow> [0,1,(2::int)] ]" (*avoid if possible... *)
value "[ x . x \<leftarrow> [0 .. 3] ]"

value "len [A, B, C]"
value "elems [A, B, C, A, B]"
value "elems [(0::nat), 1, 2]"
value "inds [A,B,C]"
value "inds_as_nat [A,B,C]"
value "card (elems [10, 20, 30, 1, 2, 3, 4, (5::nat), 10])"
value "len [10, 20, 30, 1, 2, 3, 4, (5::nat), 10]"

value "applyList [A, B] 0" --"out of range"
value "applyList [A, B] 1"
value "applyList [A, B] 2"
value "applyList [A, B] 3" --"out of range"

value "applyVDMSeq [a] (len [a])"
value "applyVDMSeq [A, B] 0" --"out of range"
value "[A,B]$1"
value "applyVDMSeq [A, B] 1"
value "applyVDMSeq [A, B] 2"
value "applyVDMSeq [A, B] 3" --"out of range"

(* MySeq = seq of nat1
   inv s == len s \<le> 9 and card(elem s) = len s and (forall i in set elems s . i \<le> 9)*)
type_synonym MySeq = "VDMNat1 list"
definition
   inv_MySeq :: "MySeq \<Rightarrow> \<bool>"
where
   "inv_MySeq s \<equiv> (inv_SeqElems inv_VDMNat1 s) \<and>
                  len s \<le> 9 \<and> int (card (elems s)) = len s \<and>
                  (\<forall> i \<in> elems s . i > 0 \<and> i \<le> 9)"

value "inv_MySeq [1, 2, 3]"

  text {* VDM maps auxiliary functions *}

(*
type_synonym ('a,'b) "map" = "'a \<Rightarrow> 'b option" (infixr "~=>" 0)
*)

(* dom exists already *)
thm dom_def
find_theorems "dom _"

(* map values are given as *)
value "[ (0::nat) \<mapsto> 7, 1  \<mapsto> 5 ]"

value "[ (0::nat) \<mapsto> (0::nat), 1  \<mapsto> 5 ] 0"

value "the ([ (0::nat) \<mapsto> (0::nat), 1  \<mapsto> 5 ] 4)"

value "the (Some b)"
value "the None"

value "empty(A \<mapsto> 0)"
value "empty(A := Some 0)"
value "[A \<mapsto> 0]"
value "[A \<mapsto> 0, B \<mapsto> 1]"

lemma "dom [ A \<mapsto> 0, B \<mapsto> 1] = LOOK_HERE" apply simp oops
lemma "ran [ A \<mapsto> (0::nat), B \<mapsto> 1] = {0,1}" apply simp oops

end


theory Andb
  imports Main
begin

section {* Andb *}

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

theorem andb_true_elim2: "\<forall> b c :: bool. (andb b c) = True \<longrightarrow> c = True"
  using andb.elims
  apply(auto)
  done

end