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" |