src/HOL/IMP/Abs_Int3.thy
changeset 51791 c4db685eaed0
parent 51786 61ed47755088
child 51792 4b3d9b2412b4
equal deleted inserted replaced
51790:22517d04d20b 51791:c4db685eaed0
   276 ..
   276 ..
   277 
   277 
   278 
   278 
   279 subsubsection "Tests"
   279 subsubsection "Tests"
   280 
   280 
   281 definition "step_up_ivl n =
   281 definition "step_up_ivl n = ((\<lambda>C. C \<nabla> step_ivl \<top> C)^^n)"
   282   ((\<lambda>C. C \<nabla> step_ivl \<top> C)^^n)"
   282 definition "step_down_ivl n = ((\<lambda>C. C \<triangle> step_ivl \<top> C)^^n)"
   283 definition "step_down_ivl n =
       
   284   ((\<lambda>C. C \<triangle> step_ivl \<top> C)^^n)"
       
   285 
   283 
   286 text{* For @{const test3_ivl}, @{const AI_ivl} needed as many iterations as
   284 text{* For @{const test3_ivl}, @{const AI_ivl} needed as many iterations as
   287 the loop took to execute. In contrast, @{const AI_ivl'} converges in a
   285 the loop took to execute. In contrast, @{const AI_ivl'} converges in a
   288 constant number of steps: *}
   286 constant number of steps: *}
   289 
   287 
   352 proof-
   350 proof-
   353   from assms have "\<forall>x. m(S1 x) \<ge> m(S2 x)" by (metis m_anti_mono)
   351   from assms have "\<forall>x. m(S1 x) \<ge> m(S2 x)" by (metis m_anti_mono)
   354   thus "(\<Sum>x\<in>X. m (S2 x)) \<le> (\<Sum>x\<in>X. m (S1 x))" by (metis setsum_mono)
   352   thus "(\<Sum>x\<in>X. m (S2 x)) \<le> (\<Sum>x\<in>X. m (S1 x))" by (metis setsum_mono)
   355 qed
   353 qed
   356 
   354 
   357 lemma m_s_anti_mono: "S1 \<le> S2 \<Longrightarrow> m_s X S1 \<ge> m_s X S2"
   355 lemma m_s_anti_mono: "S1 \<le> S2 \<Longrightarrow> m_s S1 X \<ge> m_s S2 X"
   358 unfolding m_s_def
   356 unfolding m_s_def
   359 apply (transfer fixing: m)
   357 apply (transfer fixing: m)
   360 apply(simp add: less_eq_st_rep_iff eq_st_def m_s_anti_mono_rep)
   358 apply(simp add: less_eq_st_rep_iff eq_st_def m_s_anti_mono_rep)
   361 done
   359 done
   362 
   360 
   372   from setsum_strict_mono_ex1[OF `finite X` 1 2]
   370   from setsum_strict_mono_ex1[OF `finite X` 1 2]
   373   show ?thesis .
   371   show ?thesis .
   374 qed
   372 qed
   375 
   373 
   376 lemma m_s_widen: "finite X \<Longrightarrow> fun S1 = fun S2 on -X ==>
   374 lemma m_s_widen: "finite X \<Longrightarrow> fun S1 = fun S2 on -X ==>
   377   ~ S2 \<le> S1 \<Longrightarrow> m_s X (S1 \<nabla> S2) < m_s X S1"
   375   ~ S2 \<le> S1 \<Longrightarrow> m_s (S1 \<nabla> S2) X < m_s S1 X"
   378 apply(auto simp add: less_st_def m_s_def)
   376 apply(auto simp add: less_st_def m_s_def)
   379 apply (transfer fixing: m)
   377 apply (transfer fixing: m)
   380 apply(auto simp add: less_eq_st_rep_iff m_s_widen_rep)
   378 apply(auto simp add: less_eq_st_rep_iff m_s_widen_rep)
   381 done
   379 done
   382 
   380 
   383 lemma m_o_anti_mono: "finite X \<Longrightarrow> top_on_opt o1 (-X) \<Longrightarrow> top_on_opt o2 (-X) \<Longrightarrow>
   381 lemma m_o_anti_mono: "finite X \<Longrightarrow> top_on_opt o1 (-X) \<Longrightarrow> top_on_opt o2 (-X) \<Longrightarrow>
   384   o1 \<le> o2 \<Longrightarrow> m_o X o1 \<ge> m_o X o2"
   382   o1 \<le> o2 \<Longrightarrow> m_o o1 X \<ge> m_o o2 X"
   385 proof(induction o1 o2 rule: less_eq_option.induct)
   383 proof(induction o1 o2 rule: less_eq_option.induct)
   386   case 1 thus ?case by (simp add: m_o_def)(metis m_s_anti_mono)
   384   case 1 thus ?case by (simp add: m_o_def)(metis m_s_anti_mono)
   387 next
   385 next
   388   case 2 thus ?case
   386   case 2 thus ?case
   389     by(simp add: m_o_def le_SucI m_s_h split: option.splits)
   387     by(simp add: m_o_def le_SucI m_s_h split: option.splits)
   390 next
   388 next
   391   case 3 thus ?case by simp
   389   case 3 thus ?case by simp
   392 qed
   390 qed
   393 
   391 
   394 lemma m_o_widen: "\<lbrakk> finite X; top_on_opt S1 (-X); top_on_opt S2 (-X); \<not> S2 \<le> S1 \<rbrakk> \<Longrightarrow>
   392 lemma m_o_widen: "\<lbrakk> finite X; top_on_opt S1 (-X); top_on_opt S2 (-X); \<not> S2 \<le> S1 \<rbrakk> \<Longrightarrow>
   395   m_o X (S1 \<nabla> S2) < m_o X S1"
   393   m_o (S1 \<nabla> S2) X < m_o S1 X"
   396 by(auto simp: m_o_def m_s_h less_Suc_eq_le m_s_widen split: option.split)
   394 by(auto simp: m_o_def m_s_h less_Suc_eq_le m_s_widen split: option.split)
   397 
   395 
   398 lemma m_c_widen:
   396 lemma m_c_widen:
   399   "strip C1 = strip C2  \<Longrightarrow> top_on_acom C1 (-vars C1) \<Longrightarrow> top_on_acom C2 (-vars C2)
   397   "strip C1 = strip C2  \<Longrightarrow> top_on_acom C1 (-vars C1) \<Longrightarrow> top_on_acom C2 (-vars C2)
   400    \<Longrightarrow> \<not> C2 \<le> C1 \<Longrightarrow> m_c (C1 \<nabla> C2) < m_c C1"
   398    \<Longrightarrow> \<not> C2 \<le> C1 \<Longrightarrow> m_c (C1 \<nabla> C2) < m_c C1"
   407 apply(rule_tac x=i in bexI)
   405 apply(rule_tac x=i in bexI)
   408  apply (auto simp: vars_acom_def m_o_widen top_on_acom_def)
   406  apply (auto simp: vars_acom_def m_o_widen top_on_acom_def)
   409 done
   407 done
   410 
   408 
   411 
   409 
   412 definition n_s :: "vname set \<Rightarrow> 'av st \<Rightarrow> nat" ("n\<^isub>s") where
   410 definition n_s :: "'av st \<Rightarrow> vname set \<Rightarrow> nat" ("n\<^isub>s") where
   413 "n\<^isub>s X S = (\<Sum>x\<in>X. n(fun S x))"
   411 "n\<^isub>s S X = (\<Sum>x\<in>X. n(fun S x))"
   414 
   412 
   415 lemma n_s_narrow_rep:
   413 lemma n_s_narrow_rep:
   416 assumes "finite X"  "S1 = S2 on -X"  "\<forall>x. S2 x \<le> S1 x"  "\<forall>x. S1 x \<triangle> S2 x \<le> S1 x"
   414 assumes "finite X"  "S1 = S2 on -X"  "\<forall>x. S2 x \<le> S1 x"  "\<forall>x. S1 x \<triangle> S2 x \<le> S1 x"
   417   "S1 x \<noteq> S1 x \<triangle> S2 x"
   415   "S1 x \<noteq> S1 x \<triangle> S2 x"
   418 shows "(\<Sum>x\<in>X. n (S1 x \<triangle> S2 x)) < (\<Sum>x\<in>X. n (S1 x))"
   416 shows "(\<Sum>x\<in>X. n (S1 x \<triangle> S2 x)) < (\<Sum>x\<in>X. n (S1 x))"
   425   show ?thesis
   423   show ?thesis
   426     apply(rule setsum_strict_mono_ex1[OF `finite X`]) using 1 2 by blast+
   424     apply(rule setsum_strict_mono_ex1[OF `finite X`]) using 1 2 by blast+
   427 qed
   425 qed
   428 
   426 
   429 lemma n_s_narrow: "finite X \<Longrightarrow> fun S1 = fun S2 on -X \<Longrightarrow> S2 \<le> S1 \<Longrightarrow> S1 \<triangle> S2 < S1
   427 lemma n_s_narrow: "finite X \<Longrightarrow> fun S1 = fun S2 on -X \<Longrightarrow> S2 \<le> S1 \<Longrightarrow> S1 \<triangle> S2 < S1
   430   \<Longrightarrow> n\<^isub>s X (S1 \<triangle> S2) < n\<^isub>s X S1"
   428   \<Longrightarrow> n\<^isub>s (S1 \<triangle> S2) X < n\<^isub>s S1 X"
   431 apply(auto simp add: less_st_def n_s_def)
   429 apply(auto simp add: less_st_def n_s_def)
   432 apply (transfer fixing: n)
   430 apply (transfer fixing: n)
   433 apply(auto simp add: less_eq_st_rep_iff eq_st_def fun_eq_iff n_s_narrow_rep)
   431 apply(auto simp add: less_eq_st_rep_iff eq_st_def fun_eq_iff n_s_narrow_rep)
   434 done
   432 done
   435 
   433 
   436 definition n_o :: "vname set \<Rightarrow> 'av st option \<Rightarrow> nat" ("n\<^isub>o") where
   434 definition n_o :: "'av st option \<Rightarrow> vname set \<Rightarrow> nat" ("n\<^isub>o") where
   437 "n\<^isub>o X opt = (case opt of None \<Rightarrow> 0 | Some S \<Rightarrow> n\<^isub>s X S + 1)"
   435 "n\<^isub>o opt X = (case opt of None \<Rightarrow> 0 | Some S \<Rightarrow> n\<^isub>s S X + 1)"
   438 
   436 
   439 lemma n_o_narrow:
   437 lemma n_o_narrow:
   440   "top_on_opt S1 (-X) \<Longrightarrow> top_on_opt S2 (-X) \<Longrightarrow> finite X
   438   "top_on_opt S1 (-X) \<Longrightarrow> top_on_opt S2 (-X) \<Longrightarrow> finite X
   441   \<Longrightarrow> S2 \<le> S1 \<Longrightarrow> S1 \<triangle> S2 < S1 \<Longrightarrow> n\<^isub>o X (S1 \<triangle> S2) < n\<^isub>o X S1"
   439   \<Longrightarrow> S2 \<le> S1 \<Longrightarrow> S1 \<triangle> S2 < S1 \<Longrightarrow> n\<^isub>o (S1 \<triangle> S2) X < n\<^isub>o S1 X"
   442 apply(induction S1 S2 rule: narrow_option.induct)
   440 apply(induction S1 S2 rule: narrow_option.induct)
   443 apply(auto simp: n_o_def n_s_narrow)
   441 apply(auto simp: n_o_def n_s_narrow)
   444 done
   442 done
   445 
   443 
   446 
   444 
   447 definition n_c :: "'av st option acom \<Rightarrow> nat" ("n\<^isub>c") where
   445 definition n_c :: "'av st option acom \<Rightarrow> nat" ("n\<^isub>c") where
   448 "n\<^isub>c C = (let as = annos C in \<Sum>i<size as. n\<^isub>o (vars C) (as!i))"
   446 "n\<^isub>c C = (let as = annos C in \<Sum>i<size as. n\<^isub>o (as!i) (vars C))"
   449 
   447 
   450 lemma less_annos_iff: "(C1 < C2) = (C1 \<le> C2 \<and>
   448 lemma less_annos_iff: "(C1 < C2) = (C1 \<le> C2 \<and>
   451   (\<exists>i<length (annos C1). annos C1 ! i < annos C2 ! i))"
   449   (\<exists>i<length (annos C1). annos C1 ! i < annos C2 ! i))"
   452 by(metis (hide_lams, no_types) less_le_not_le le_iff_le_annos size_annos_same2)
   450 by(metis (hide_lams, no_types) less_le_not_le le_iff_le_annos size_annos_same2)
   453 
   451