614 by (induct set: finite) auto |
614 by (induct set: finite) auto |
615 |
615 |
616 |
616 |
617 subsubsection{*From @{const fold_graph} to @{term fold}*} |
617 subsubsection{*From @{const fold_graph} to @{term fold}*} |
618 |
618 |
619 lemma image_less_Suc: "h ` {i. i < Suc m} = insert (h m) (h ` {i. i < m})" |
|
620 by (auto simp add: less_Suc_eq) |
|
621 |
|
622 lemma insert_image_inj_on_eq: |
|
623 "[|insert (h m) A = h ` {i. i < Suc m}; h m \<notin> A; |
|
624 inj_on h {i. i < Suc m}|] |
|
625 ==> A = h ` {i. i < m}" |
|
626 apply (auto simp add: image_less_Suc inj_on_def) |
|
627 apply (blast intro: less_trans) |
|
628 done |
|
629 |
|
630 lemma insert_inj_onE: |
|
631 assumes aA: "insert a A = h`{i::nat. i<n}" and anot: "a \<notin> A" |
|
632 and inj_on: "inj_on h {i::nat. i<n}" |
|
633 shows "\<exists>hm m. inj_on hm {i::nat. i<m} & A = hm ` {i. i<m} & m < n" |
|
634 proof (cases n) |
|
635 case 0 thus ?thesis using aA by auto |
|
636 next |
|
637 case (Suc m) |
|
638 have nSuc: "n = Suc m" by fact |
|
639 have mlessn: "m<n" by (simp add: nSuc) |
|
640 from aA obtain k where hkeq: "h k = a" and klessn: "k<n" by (blast elim!: equalityE) |
|
641 let ?hm = "Fun.swap k m h" |
|
642 have inj_hm: "inj_on ?hm {i. i < n}" using klessn mlessn |
|
643 by (simp add: inj_on) |
|
644 show ?thesis |
|
645 proof (intro exI conjI) |
|
646 show "inj_on ?hm {i. i < m}" using inj_hm |
|
647 by (auto simp add: nSuc less_Suc_eq intro: subset_inj_on) |
|
648 show "m<n" by (rule mlessn) |
|
649 show "A = ?hm ` {i. i < m}" |
|
650 proof (rule insert_image_inj_on_eq) |
|
651 show "inj_on (Fun.swap k m h) {i. i < Suc m}" using inj_hm nSuc by simp |
|
652 show "?hm m \<notin> A" by (simp add: swap_def hkeq anot) |
|
653 show "insert (?hm m) A = ?hm ` {i. i < Suc m}" |
|
654 using aA hkeq nSuc klessn |
|
655 by (auto simp add: swap_def image_less_Suc fun_upd_image |
|
656 less_Suc_eq inj_on_image_set_diff [OF inj_on]) |
|
657 qed |
|
658 qed |
|
659 qed |
|
660 |
|
661 context fun_left_comm |
619 context fun_left_comm |
662 begin |
620 begin |
663 |
621 |
664 lemma fold_graph_determ_aux: |
622 lemma fold_graph_insertE_aux: |
665 "A = h`{i::nat. i<n} \<Longrightarrow> inj_on h {i. i<n} |
623 "fold_graph f z A y \<Longrightarrow> a \<in> A \<Longrightarrow> \<exists>y'. y = f a y' \<and> fold_graph f z (A - {a}) y'" |
666 \<Longrightarrow> fold_graph f z A x \<Longrightarrow> fold_graph f z A x' |
624 proof (induct set: fold_graph) |
667 \<Longrightarrow> x' = x" |
625 case (insertI x A y) show ?case |
668 proof (induct n arbitrary: A x x' h rule: less_induct) |
626 proof (cases "x = a") |
669 case (less n) |
627 assume "x = a" with insertI show ?case by auto |
670 have IH: "\<And>m h A x x'. m < n \<Longrightarrow> A = h ` {i. i<m} |
|
671 \<Longrightarrow> inj_on h {i. i<m} \<Longrightarrow> fold_graph f z A x |
|
672 \<Longrightarrow> fold_graph f z A x' \<Longrightarrow> x' = x" by fact |
|
673 have Afoldx: "fold_graph f z A x" and Afoldx': "fold_graph f z A x'" |
|
674 and A: "A = h`{i. i<n}" and injh: "inj_on h {i. i<n}" by fact+ |
|
675 show ?case |
|
676 proof (rule fold_graph.cases [OF Afoldx]) |
|
677 assume "A = {}" and "x = z" |
|
678 with Afoldx' show "x' = x" by auto |
|
679 next |
628 next |
680 fix B b u |
629 assume "x \<noteq> a" |
681 assume AbB: "A = insert b B" and x: "x = f b u" |
630 then obtain y' where y: "y = f a y'" and y': "fold_graph f z (A - {a}) y'" |
682 and notinB: "b \<notin> B" and Bu: "fold_graph f z B u" |
631 using insertI by auto |
683 show "x'=x" |
632 have 1: "f x y = f a (f x y')" |
684 proof (rule fold_graph.cases [OF Afoldx']) |
633 unfolding y by (rule fun_left_comm) |
685 assume "A = {}" and "x' = z" |
634 have 2: "fold_graph f z (insert x A - {a}) (f x y')" |
686 with AbB show "x' = x" by blast |
635 using y' and `x \<noteq> a` and `x \<notin> A` |
687 next |
636 by (simp add: insert_Diff_if fold_graph.insertI) |
688 fix C c v |
637 from 1 2 show ?case by fast |
689 assume AcC: "A = insert c C" and x': "x' = f c v" |
|
690 and notinC: "c \<notin> C" and Cv: "fold_graph f z C v" |
|
691 from A AbB have Beq: "insert b B = h`{i. i<n}" by simp |
|
692 from insert_inj_onE [OF Beq notinB injh] |
|
693 obtain hB mB where inj_onB: "inj_on hB {i. i < mB}" |
|
694 and Beq: "B = hB ` {i. i < mB}" and lessB: "mB < n" by auto |
|
695 from A AcC have Ceq: "insert c C = h`{i. i<n}" by simp |
|
696 from insert_inj_onE [OF Ceq notinC injh] |
|
697 obtain hC mC where inj_onC: "inj_on hC {i. i < mC}" |
|
698 and Ceq: "C = hC ` {i. i < mC}" and lessC: "mC < n" by auto |
|
699 show "x'=x" |
|
700 proof cases |
|
701 assume "b=c" |
|
702 then moreover have "B = C" using AbB AcC notinB notinC by auto |
|
703 ultimately show ?thesis using Bu Cv x x' IH [OF lessC Ceq inj_onC] |
|
704 by auto |
|
705 next |
|
706 assume diff: "b \<noteq> c" |
|
707 let ?D = "B - {c}" |
|
708 have B: "B = insert c ?D" and C: "C = insert b ?D" |
|
709 using AbB AcC notinB notinC diff by(blast elim!:equalityE)+ |
|
710 have "finite A" by(rule fold_graph_imp_finite [OF Afoldx]) |
|
711 with AbB have "finite ?D" by simp |
|
712 then obtain d where Dfoldd: "fold_graph f z ?D d" |
|
713 using finite_imp_fold_graph by iprover |
|
714 moreover have cinB: "c \<in> B" using B by auto |
|
715 ultimately have "fold_graph f z B (f c d)" by(rule Diff1_fold_graph) |
|
716 hence "f c d = u" by (rule IH [OF lessB Beq inj_onB Bu]) |
|
717 moreover have "f b d = v" |
|
718 proof (rule IH[OF lessC Ceq inj_onC Cv]) |
|
719 show "fold_graph f z C (f b d)" using C notinB Dfoldd by fastsimp |
|
720 qed |
|
721 ultimately show ?thesis |
|
722 using fun_left_comm [of c b] x x' by (auto simp add: o_def) |
|
723 qed |
|
724 qed |
|
725 qed |
638 qed |
726 qed |
639 qed simp |
|
640 |
|
641 lemma fold_graph_insertE: |
|
642 assumes "fold_graph f z (insert x A) v" and "x \<notin> A" |
|
643 obtains y where "v = f x y" and "fold_graph f z A y" |
|
644 using assms by (auto dest: fold_graph_insertE_aux [OF _ insertI1]) |
727 |
645 |
728 lemma fold_graph_determ: |
646 lemma fold_graph_determ: |
729 "fold_graph f z A x \<Longrightarrow> fold_graph f z A y \<Longrightarrow> y = x" |
647 "fold_graph f z A x \<Longrightarrow> fold_graph f z A y \<Longrightarrow> y = x" |
730 apply (frule fold_graph_imp_finite [THEN finite_imp_nat_seg_image_inj_on]) |
648 proof (induct arbitrary: y set: fold_graph) |
731 apply (blast intro: fold_graph_determ_aux [rule_format]) |
649 case (insertI x A y v) |
732 done |
650 from `fold_graph f z (insert x A) v` and `x \<notin> A` |
|
651 obtain y' where "v = f x y'" and "fold_graph f z A y'" |
|
652 by (rule fold_graph_insertE) |
|
653 from `fold_graph f z A y'` have "y' = y" by (rule insertI) |
|
654 with `v = f x y'` show "v = f x y" by simp |
|
655 qed fast |
733 |
656 |
734 lemma fold_equality: |
657 lemma fold_equality: |
735 "fold_graph f z A y \<Longrightarrow> fold f z A = y" |
658 "fold_graph f z A y \<Longrightarrow> fold f z A = y" |
736 by (unfold fold_def) (blast intro: fold_graph_determ) |
659 by (unfold fold_def) (blast intro: fold_graph_determ) |
737 |
660 |
|
661 lemma fold_graph_fold: "finite A \<Longrightarrow> fold_graph f z A (fold f z A)" |
|
662 unfolding fold_def |
|
663 apply (rule theI') |
|
664 apply (rule ex_ex1I) |
|
665 apply (erule finite_imp_fold_graph) |
|
666 apply (erule (1) fold_graph_determ) |
|
667 done |
|
668 |
738 text{* The base case for @{text fold}: *} |
669 text{* The base case for @{text fold}: *} |
739 |
670 |
740 lemma (in -) fold_empty [simp]: "fold f z {} = z" |
671 lemma (in -) fold_empty [simp]: "fold f z {} = z" |
741 by (unfold fold_def) blast |
672 by (unfold fold_def) blast |
742 |
673 |
743 text{* The various recursion equations for @{const fold}: *} |
674 text{* The various recursion equations for @{const fold}: *} |
744 |
675 |
745 lemma fold_insert_aux: "x \<notin> A |
|
746 \<Longrightarrow> fold_graph f z (insert x A) v \<longleftrightarrow> |
|
747 (\<exists>y. fold_graph f z A y \<and> v = f x y)" |
|
748 apply auto |
|
749 apply (rule_tac A1 = A and f1 = f in finite_imp_fold_graph [THEN exE]) |
|
750 apply (fastsimp dest: fold_graph_imp_finite) |
|
751 apply (blast intro: fold_graph_determ) |
|
752 done |
|
753 |
|
754 lemma fold_insert [simp]: |
676 lemma fold_insert [simp]: |
755 "finite A ==> x \<notin> A ==> fold f z (insert x A) = f x (fold f z A)" |
677 "finite A ==> x \<notin> A ==> fold f z (insert x A) = f x (fold f z A)" |
756 apply (simp add: fold_def fold_insert_aux) |
678 apply (rule fold_equality) |
757 apply (rule the_equality) |
679 apply (erule fold_graph.insertI) |
758 apply (auto intro: finite_imp_fold_graph |
680 apply (erule fold_graph_fold) |
759 cong add: conj_cong simp add: fold_def[symmetric] fold_equality) |
|
760 done |
681 done |
761 |
682 |
762 lemma fold_fun_comm: |
683 lemma fold_fun_comm: |
763 "finite A \<Longrightarrow> f x (fold f z A) = fold f (f x z) A" |
684 "finite A \<Longrightarrow> f x (fold f z A) = fold f (f x z) A" |
764 proof (induct rule: finite_induct) |
685 proof (induct rule: finite_induct) |