src/HOL/IMP/Abs_Int3.thy
changeset 49496 2694d1615eef
parent 49399 a9d9f3483b71
child 49547 78be750222cf
equal deleted inserted replaced
49495:675b9df572df 49496:2694d1615eef
   433 
   433 
   434 begin
   434 begin
   435 
   435 
   436 definition "m_st S = (SUM x:dom S. m(fun S x))"
   436 definition "m_st S = (SUM x:dom S. m(fun S x))"
   437 
   437 
   438 lemma h_st: assumes "finite X" and "dom S \<subseteq> X"
   438 lemma m_st_h: "x \<in> L X \<Longrightarrow> finite X \<Longrightarrow> m_st x \<le> h * card X"
   439 shows "m_st S \<le> h * card X"
   439 by(simp add: L_st_def m_st_def)
   440 proof(auto simp: m_st_def)
   440   (metis nat_mult_commute of_nat_id setsum_bounded[OF m_height])
   441   have "(\<Sum>x\<in>dom S. m (fun S x)) \<le> (\<Sum>x\<in>dom S. h)" (is "?L \<le> _")
   441 
   442     by(rule setsum_mono)(simp add: m_height)
       
   443   also have "\<dots> \<le> (\<Sum>x\<in>X. h)"
       
   444     by(rule setsum_mono3[OF assms]) simp
       
   445   also have "\<dots> = h * card X" by simp
       
   446   finally show "?L \<le> \<dots>" .
       
   447 qed
       
   448 
       
   449 
       
   450 (* FIXME identical *)
       
   451 lemma m_st_anti_mono: "S1 \<sqsubseteq> S2 \<Longrightarrow> m_st S1 \<ge> m_st S2"
   442 lemma m_st_anti_mono: "S1 \<sqsubseteq> S2 \<Longrightarrow> m_st S1 \<ge> m_st S2"
   452 proof(auto simp add: le_st_def m_st_def)
   443 proof(auto simp add: le_st_def m_st_def)
   453   assume "\<forall>x\<in>dom S2. fun S1 x \<sqsubseteq> fun S2 x"
   444   assume "\<forall>x\<in>dom S2. fun S1 x \<sqsubseteq> fun S2 x"
   454   hence "\<forall>x\<in>dom S2. m(fun S1 x) \<ge> m(fun S2 x)" by (metis m_anti_mono)
   445   hence "\<forall>x\<in>dom S2. m(fun S1 x) \<ge> m(fun S2 x)" by (metis m_anti_mono)
   455   thus "(\<Sum>x\<in>dom S2. m (fun S2 x)) \<le> (\<Sum>x\<in>dom S2. m (fun S1 x))"
   446   thus "(\<Sum>x\<in>dom S2. m (fun S2 x)) \<le> (\<Sum>x\<in>dom S2. m (fun S1 x))"
   494     apply(rule setsum_strict_mono_ex1[OF `finite(dom S1)`]) using 1 2 by blast+
   485     apply(rule setsum_strict_mono_ex1[OF `finite(dom S1)`]) using 1 2 by blast+
   495   moreover have "dom (S1 \<triangle> S2) = dom S1" by(simp add: narrow_st_def)
   486   moreover have "dom (S1 \<triangle> S2) = dom S1" by(simp add: narrow_st_def)
   496   ultimately show ?thesis by(simp add: n_st_def)
   487   ultimately show ?thesis by(simp add: n_st_def)
   497 qed
   488 qed
   498 
   489 
   499 
   490 definition m_o :: "nat \<Rightarrow> 'av st option \<Rightarrow> nat" where
   500 definition "m_o k opt = (case opt of None \<Rightarrow> k+1 | Some x \<Rightarrow> m_st x)"
   491 "m_o d opt = (case opt of None \<Rightarrow> h*d+1 | Some S \<Rightarrow> m_st S)"
       
   492 
       
   493 lemma m_o_h: "ost \<in> L X \<Longrightarrow> finite X \<Longrightarrow> m_o (card X) ost \<le> (h*card X + 1)"
       
   494 by(auto simp add: m_o_def m_st_h split: option.split dest!:m_st_h)
   501 
   495 
   502 lemma m_o_anti_mono: "S1 \<in> L X \<Longrightarrow> S2 \<in> L X \<Longrightarrow> finite X \<Longrightarrow>
   496 lemma m_o_anti_mono: "S1 \<in> L X \<Longrightarrow> S2 \<in> L X \<Longrightarrow> finite X \<Longrightarrow>
   503   S1 \<sqsubseteq> S2 \<Longrightarrow> m_o (h * card X) S2 \<le> m_o (h * card X) S1"
   497   S1 \<sqsubseteq> S2 \<Longrightarrow> m_o (card X) S2 \<le> m_o (card X) S1"
   504 apply(induction S1 S2 rule: le_option.induct)
   498 apply(induction S1 S2 rule: le_option.induct)
   505 apply(auto simp: m_o_def m_st_anti_mono le_SucI h_st L_st_def
   499 apply(auto simp: m_o_def m_st_anti_mono le_SucI m_st_h L_st_def
   506            split: option.splits)
   500            split: option.splits)
   507 done
   501 done
   508 
   502 
   509 lemma m_o_widen: "\<lbrakk> S1 \<in> L X; S2 \<in> L X; finite X; \<not> S2 \<sqsubseteq> S1 \<rbrakk> \<Longrightarrow>
   503 lemma m_o_widen: "\<lbrakk> S1 \<in> L X; S2 \<in> L X; finite X; \<not> S2 \<sqsubseteq> S1 \<rbrakk> \<Longrightarrow>
   510   m_o (h * card X) (S1 \<nabla> S2) < m_o (h * card X) S1"
   504   m_o (card X) (S1 \<nabla> S2) < m_o (card X) S1"
   511 by(auto simp: m_o_def L_st_def h_st less_Suc_eq_le m_st_widen
   505 by(auto simp: m_o_def L_st_def m_st_h less_Suc_eq_le m_st_widen
   512         split: option.split)
   506         split: option.split)
   513 
   507 
   514 definition "n_o opt = (case opt of None \<Rightarrow> 0 | Some x \<Rightarrow> n_st x + 1)"
   508 definition "n_o opt = (case opt of None \<Rightarrow> 0 | Some x \<Rightarrow> n_st x + 1)"
   515 
   509 
   516 lemma n_o_mono: "S1 \<sqsubseteq> S2 \<Longrightarrow> n_o S1 \<le> n_o S2"
   510 lemma n_o_mono: "S1 \<sqsubseteq> S2 \<Longrightarrow> n_o S1 \<le> n_o S2"
   529 by(induction "narrow::'a\<Rightarrow>'a\<Rightarrow>'a" C1 C2 rule: map2_acom.induct)
   523 by(induction "narrow::'a\<Rightarrow>'a\<Rightarrow>'a" C1 C2 rule: map2_acom.induct)
   530   (simp_all add: narrow_acom_def size_annos_same2)
   524   (simp_all add: narrow_acom_def size_annos_same2)
   531 
   525 
   532 
   526 
   533 definition "m_c C = (let as = annos C in
   527 definition "m_c C = (let as = annos C in
   534   \<Sum>i=0..<size as. m_o (h * card(vars(strip C))) (as!i))"
   528   \<Sum>i<size as. m_o (card(vars(strip C))) (as!i))"
       
   529 
       
   530 lemma m_c_h: assumes "C \<in> L(vars(strip C))"
       
   531 shows "m_c C \<le> size(annos C) * (h * card(vars(strip C)) + 1)"
       
   532 proof-
       
   533   let ?X = "vars(strip C)" let ?n = "card ?X" let ?a = "size(annos C)"
       
   534   { fix i assume "i < ?a"
       
   535     hence "annos C ! i \<in> L ?X" using assms by(simp add: L_acom_def)
       
   536     note m_o_h[OF this finite_cvars]
       
   537   } note 1 = this
       
   538   have "m_c C = (\<Sum>i<?a. m_o ?n (annos C ! i))" by(simp add: m_c_def Let_def)
       
   539   also have "\<dots> \<le> (\<Sum>i<?a. h * ?n + 1)"
       
   540     apply(rule setsum_mono) using 1 by simp
       
   541   also have "\<dots> = ?a * (h * ?n + 1)" by simp
       
   542   finally show ?thesis .
       
   543 qed
   535 
   544 
   536 lemma m_c_widen:
   545 lemma m_c_widen:
   537   "C1 \<in> Lc c \<Longrightarrow> C2 \<in> Lc c \<Longrightarrow> \<not> C2 \<sqsubseteq> C1 \<Longrightarrow> m_c (C1 \<nabla> C2) < m_c C1"
   546   "C1 \<in> Lc c \<Longrightarrow> C2 \<in> Lc c \<Longrightarrow> \<not> C2 \<sqsubseteq> C1 \<Longrightarrow> m_c (C1 \<nabla> C2) < m_c C1"
   538 apply(auto simp: Lc_acom_def m_c_def Let_def widen_acom_def)
   547 apply(auto simp: Lc_acom_def m_c_def Let_def widen_acom_def)
   539 apply(subgoal_tac "length(annos C2) = length(annos C1)")
   548 apply(subgoal_tac "length(annos C2) = length(annos C1)")
   562 apply simp
   571 apply simp
   563 apply (clarsimp)
   572 apply (clarsimp)
   564 apply(rule n_o_mono)
   573 apply(rule n_o_mono)
   565 apply(rule narrow2)
   574 apply(rule narrow2)
   566 apply(fastforce simp: le_iff_le_annos listrel_iff_nth)
   575 apply(fastforce simp: le_iff_le_annos listrel_iff_nth)
   567 apply(auto simp: le_iff_le_annos listrel_iff_nth strip_narrow_acom)
   576 apply(auto simp: le_iff_le_annos listrel_iff_nth)
   568 apply(rule_tac x=i in bexI)
   577 apply(rule_tac x=i in bexI)
   569 prefer 2 apply simp
   578 prefer 2 apply simp
   570 apply(rule n_o_narrow[where X = "vars(strip C1)"])
   579 apply(rule n_o_narrow[where X = "vars(strip C1)"])
   571 apply (simp add: finite_cvars)+
   580 apply (simp add: finite_cvars)+
   572 done
   581 done
   586 next
   595 next
   587   show "P C" by(rule `P C`)
   596   show "P C" by(rule `P C`)
   588 next
   597 next
   589   fix C assume "P C" thus "P (C \<nabla> f C)" by(simp add: P_f P_widen)
   598   fix C assume "P C" thus "P (C \<nabla> f C)" by(simp add: P_f P_widen)
   590 qed
   599 qed
   591 thm mono_step'(*FIXME does not need wt assms*)
   600 
   592 lemma iter_narrow_termination:
   601 lemma iter_narrow_termination:
   593 fixes n :: "'a::WN_Lc \<Rightarrow> nat"
   602 fixes n :: "'a::WN_Lc \<Rightarrow> nat"
   594 assumes P_f: "\<And>C. P C \<Longrightarrow> P(f C)"
   603 assumes P_f: "\<And>C. P C \<Longrightarrow> P(f C)"
   595 and P_narrow: "\<And>C1 C2. P C1 \<Longrightarrow> P C2 \<Longrightarrow> P(C1 \<triangle> C2)"
   604 and P_narrow: "\<And>C1 C2. P C1 \<Longrightarrow> P C2 \<Longrightarrow> P(C1 \<triangle> C2)"
   596 and mono: "\<And>C1 C2. P C1 \<Longrightarrow> P C2 \<Longrightarrow> C1 \<sqsubseteq> C2 \<Longrightarrow> f C1 \<sqsubseteq> f C2"
   605 and mono: "\<And>C1 C2. P C1 \<Longrightarrow> P C2 \<Longrightarrow> C1 \<sqsubseteq> C2 \<Longrightarrow> f C1 \<sqsubseteq> f C2"