695 ultimately have "fold f z (insert x A) = f x (fold f z (insert x A - {x}))" |
695 ultimately have "fold f z (insert x A) = f x (fold f z (insert x A - {x}))" |
696 by (rule fold_rec) |
696 by (rule fold_rec) |
697 then show ?thesis by simp |
697 then show ?thesis by simp |
698 qed |
698 qed |
699 |
699 |
|
700 text{* Other properties of @{const fold}: *} |
|
701 |
|
702 lemma fold_image: |
|
703 assumes "finite A" and "inj_on g A" |
|
704 shows "fold f x (g ` A) = fold (f \<circ> g) x A" |
|
705 using assms |
|
706 proof induction |
|
707 case (insert a F) |
|
708 interpret comp_fun_commute "\<lambda>x. f (g x)" by default (simp add: comp_fun_commute) |
|
709 from insert show ?case by auto |
|
710 qed (simp) |
|
711 |
700 end |
712 end |
701 |
713 |
702 text{* A simplified version for idempotent functions: *} |
714 text{* A simplified version for idempotent functions: *} |
703 |
715 |
704 locale comp_fun_idem = comp_fun_commute + |
716 locale comp_fun_idem = comp_fun_commute + |
774 proof - |
786 proof - |
775 interpret comp_fun_idem Set.remove by (fact comp_fun_idem_remove) |
787 interpret comp_fun_idem Set.remove by (fact comp_fun_idem_remove) |
776 from `finite A` have "fold Set.remove B A = B - A" by (induct A arbitrary: B) auto |
788 from `finite A` have "fold Set.remove B A = B - A" by (induct A arbitrary: B) auto |
777 then show ?thesis .. |
789 then show ?thesis .. |
778 qed |
790 qed |
|
791 |
|
792 definition filter :: "('a \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'a set" |
|
793 where "filter P A = fold (\<lambda>x A'. if P x then Set.insert x A' else A') {} A" |
|
794 |
|
795 lemma comp_fun_commute_filter_fold: "comp_fun_commute (\<lambda>x A'. if P x then Set.insert x A' else A')" |
|
796 proof - |
|
797 interpret comp_fun_idem Set.insert by (fact comp_fun_idem_insert) |
|
798 show ?thesis by default (auto simp: fun_eq_iff) |
|
799 qed |
|
800 |
|
801 lemma inter_filter: |
|
802 assumes "finite B" |
|
803 shows "A \<inter> B = filter (\<lambda>x. x \<in> A) B" |
|
804 using assms |
|
805 by (induct B) (auto simp: filter_def comp_fun_commute.fold_insert[OF comp_fun_commute_filter_fold]) |
|
806 |
|
807 lemma project_filter: |
|
808 assumes "finite A" |
|
809 shows "Set.project P A = filter P A" |
|
810 using assms |
|
811 by (induct A) |
|
812 (auto simp add: filter_def project_def comp_fun_commute.fold_insert[OF comp_fun_commute_filter_fold]) |
|
813 |
|
814 lemma image_fold_insert: |
|
815 assumes "finite A" |
|
816 shows "image f A = fold (\<lambda>k A. Set.insert (f k) A) {} A" |
|
817 using assms |
|
818 proof - |
|
819 interpret comp_fun_commute "\<lambda>k A. Set.insert (f k) A" by default auto |
|
820 show ?thesis using assms by (induct A) auto |
|
821 qed |
|
822 |
|
823 lemma Ball_fold: |
|
824 assumes "finite A" |
|
825 shows "Ball A P = fold (\<lambda>k s. s \<and> P k) True A" |
|
826 using assms |
|
827 proof - |
|
828 interpret comp_fun_commute "\<lambda>k s. s \<and> P k" by default auto |
|
829 show ?thesis using assms by (induct A) auto |
|
830 qed |
|
831 |
|
832 lemma Bex_fold: |
|
833 assumes "finite A" |
|
834 shows "Bex A P = fold (\<lambda>k s. s \<or> P k) False A" |
|
835 using assms |
|
836 proof - |
|
837 interpret comp_fun_commute "\<lambda>k s. s \<or> P k" by default auto |
|
838 show ?thesis using assms by (induct A) auto |
|
839 qed |
|
840 |
|
841 lemma comp_fun_commute_Pow_fold: |
|
842 "comp_fun_commute (\<lambda>x A. A \<union> Set.insert x ` A)" |
|
843 by (clarsimp simp: fun_eq_iff comp_fun_commute_def) blast |
|
844 |
|
845 lemma Pow_fold: |
|
846 assumes "finite A" |
|
847 shows "Pow A = fold (\<lambda>x A. A \<union> Set.insert x ` A) {{}} A" |
|
848 using assms |
|
849 proof - |
|
850 interpret comp_fun_commute "\<lambda>x A. A \<union> Set.insert x ` A" by (rule comp_fun_commute_Pow_fold) |
|
851 show ?thesis using assms by (induct A) (auto simp: Pow_insert) |
|
852 qed |
|
853 |
|
854 lemma fold_union_pair: |
|
855 assumes "finite B" |
|
856 shows "(\<Union>y\<in>B. {(x, y)}) \<union> A = fold (\<lambda>y. Set.insert (x, y)) A B" |
|
857 proof - |
|
858 interpret comp_fun_commute "\<lambda>y. Set.insert (x, y)" by default auto |
|
859 show ?thesis using assms by (induct B arbitrary: A) simp_all |
|
860 qed |
|
861 |
|
862 lemma comp_fun_commute_product_fold: |
|
863 assumes "finite B" |
|
864 shows "comp_fun_commute (\<lambda>x A. fold (\<lambda>y. Set.insert (x, y)) A B)" |
|
865 by default (auto simp: fold_union_pair[symmetric] assms) |
|
866 |
|
867 lemma product_fold: |
|
868 assumes "finite A" |
|
869 assumes "finite B" |
|
870 shows "A \<times> B = fold (\<lambda>x A. fold (\<lambda>y. Set.insert (x, y)) A B) {} A" |
|
871 using assms unfolding Sigma_def |
|
872 by (induct A) |
|
873 (simp_all add: comp_fun_commute.fold_insert[OF comp_fun_commute_product_fold] fold_union_pair) |
|
874 |
779 |
875 |
780 context complete_lattice |
876 context complete_lattice |
781 begin |
877 begin |
782 |
878 |
783 lemma inf_Inf_fold_inf: |
879 lemma inf_Inf_fold_inf: |