873 hence "Finite_Set.fold (\<lambda>a'. If (a = a') b') b A = (if a \<in> A then b' else b)" |
873 hence "Finite_Set.fold (\<lambda>a'. If (a = a') b') b A = (if a \<in> A then b' else b)" |
874 by induct auto } |
874 by induct auto } |
875 from this[of UNIV] show "Finite_Set.fold (\<lambda>a'. If (a = a') b') b UNIV = b'" by simp |
875 from this[of UNIV] show "Finite_Set.fold (\<lambda>a'. If (a = a') b') b UNIV = b'" by simp |
876 qed |
876 qed |
877 |
877 |
878 lemma finfun_apply_def: "finfun_apply = (\<lambda>f a. finfun_rec (\<lambda>b. b) (\<lambda>a' b c. if (a = a') then b else c) f)" |
878 lemma finfun_apply_def: "op $ = (\<lambda>f a. finfun_rec (\<lambda>b. b) (\<lambda>a' b c. if (a = a') then b else c) f)" |
879 proof(rule finfun_rec_unique) |
879 proof(rule finfun_rec_unique) |
880 fix c show "finfun_apply (\<lambda>\<^isup>f c) = (\<lambda>a. c)" by(simp add: finfun_const.rep_eq) |
880 fix c show "op $ (\<lambda>\<^isup>f c) = (\<lambda>a. c)" by(simp add: finfun_const.rep_eq) |
881 next |
881 next |
882 fix g a b show "finfun_apply g(\<^sup>f a := b) = (\<lambda>c. if c = a then b else finfun_apply g c)" |
882 fix g a b show "op $ g(\<^sup>f a := b) = (\<lambda>c. if c = a then b else g $ c)" |
883 by(auto simp add: finfun_update_def fun_upd_finfun Abs_finfun_inverse finfun_apply) |
883 by(auto simp add: finfun_update_def fun_upd_finfun Abs_finfun_inverse finfun_apply) |
884 qed auto |
884 qed auto |
885 |
885 |
886 lemma finfun_upd_apply: "f(\<^sup>fa := b)\<^sub>f a' = (if a = a' then b else f\<^sub>f a')" |
886 lemma finfun_upd_apply: "f(\<^sup>fa := b) $ a' = (if a = a' then b else f $ a')" |
887 and finfun_upd_apply_code [code]: "(finfun_update_code f a b)\<^sub>f a' = (if a = a' then b else f\<^sub>f a')" |
887 and finfun_upd_apply_code [code]: "(finfun_update_code f a b) $ a' = (if a = a' then b else f $ a')" |
888 by(simp_all add: finfun_apply_def) |
888 by(simp_all add: finfun_apply_def) |
889 |
889 |
890 lemma finfun_const_apply [simp, code]: "(\<lambda>\<^isup>f b)\<^sub>f a = b" |
890 lemma finfun_const_apply [simp, code]: "(\<lambda>\<^isup>f b) $ a = b" |
891 by(simp add: finfun_apply_def) |
891 by(simp add: finfun_apply_def) |
892 |
892 |
893 lemma finfun_upd_apply_same [simp]: |
893 lemma finfun_upd_apply_same [simp]: |
894 "f(\<^sup>fa := b)\<^sub>f a = b" |
894 "f(\<^sup>fa := b) $ a = b" |
895 by(simp add: finfun_upd_apply) |
895 by(simp add: finfun_upd_apply) |
896 |
896 |
897 lemma finfun_upd_apply_other [simp]: |
897 lemma finfun_upd_apply_other [simp]: |
898 "a \<noteq> a' \<Longrightarrow> f(\<^sup>fa := b)\<^sub>f a' = f\<^sub>f a'" |
898 "a \<noteq> a' \<Longrightarrow> f(\<^sup>fa := b) $ a' = f $ a'" |
899 by(simp add: finfun_upd_apply) |
899 by(simp add: finfun_upd_apply) |
900 |
900 |
901 lemma finfun_ext: "(\<And>a. f\<^sub>f a = g\<^sub>f a) \<Longrightarrow> f = g" |
901 lemma finfun_ext: "(\<And>a. f $ a = g $ a) \<Longrightarrow> f = g" |
902 by(auto simp add: finfun_apply_inject[symmetric] simp del: finfun_apply_inject) |
902 by(auto simp add: finfun_apply_inject[symmetric] simp del: finfun_apply_inject) |
903 |
903 |
904 lemma expand_finfun_eq: "(f = g) = (f\<^sub>f = g\<^sub>f)" |
904 lemma expand_finfun_eq: "(f = g) = (op $ f = op $ g)" |
905 by(auto intro: finfun_ext) |
905 by(auto intro: finfun_ext) |
906 |
906 |
907 lemma finfun_const_inject [simp]: "(\<lambda>\<^isup>f b) = (\<lambda>\<^isup>f b') \<equiv> b = b'" |
907 lemma finfun_const_inject [simp]: "(\<lambda>\<^isup>f b) = (\<lambda>\<^isup>f b') \<equiv> b = b'" |
908 by(simp add: expand_finfun_eq fun_eq_iff) |
908 by(simp add: expand_finfun_eq fun_eq_iff) |
909 |
909 |
910 lemma finfun_const_eq_update: |
910 lemma finfun_const_eq_update: |
911 "((\<lambda>\<^isup>f b) = f(\<^sup>f a := b')) = (b = b' \<and> (\<forall>a'. a \<noteq> a' \<longrightarrow> f\<^sub>f a' = b))" |
911 "((\<lambda>\<^isup>f b) = f(\<^sup>f a := b')) = (b = b' \<and> (\<forall>a'. a \<noteq> a' \<longrightarrow> f $ a' = b))" |
912 by(auto simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply) |
912 by(auto simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply) |
913 |
913 |
914 subsection {* Function composition *} |
914 subsection {* Function composition *} |
915 |
915 |
916 definition finfun_comp :: "('a \<Rightarrow> 'b) \<Rightarrow> 'c \<Rightarrow>f 'a \<Rightarrow> 'c \<Rightarrow>f 'b" (infixr "\<circ>\<^isub>f" 55) |
916 definition finfun_comp :: "('a \<Rightarrow> 'b) \<Rightarrow> 'c \<Rightarrow>f 'a \<Rightarrow> 'c \<Rightarrow>f 'b" (infixr "\<circ>\<^isub>f" 55) |
956 lemma finfun_comp_conv_comp: "g \<circ>\<^isub>f f = Abs_finfun (g \<circ> finfun_apply f)" |
956 lemma finfun_comp_conv_comp: "g \<circ>\<^isub>f f = Abs_finfun (g \<circ> finfun_apply f)" |
957 including finfun |
957 including finfun |
958 proof - |
958 proof - |
959 have "(\<lambda>f. g \<circ>\<^isub>f f) = (\<lambda>f. Abs_finfun (g \<circ> finfun_apply f))" |
959 have "(\<lambda>f. g \<circ>\<^isub>f f) = (\<lambda>f. Abs_finfun (g \<circ> finfun_apply f))" |
960 proof(rule finfun_rec_unique) |
960 proof(rule finfun_rec_unique) |
961 { fix c show "Abs_finfun (g \<circ> (\<lambda>\<^isup>f c)\<^sub>f) = (\<lambda>\<^isup>f g c)" |
961 { fix c show "Abs_finfun (g \<circ> op $ (\<lambda>\<^isup>f c)) = (\<lambda>\<^isup>f g c)" |
962 by(simp add: finfun_comp_def o_def)(simp add: finfun_const_def) } |
962 by(simp add: finfun_comp_def o_def)(simp add: finfun_const_def) } |
963 { fix g' a b show "Abs_finfun (g \<circ> g'(\<^sup>f a := b)\<^sub>f) = (Abs_finfun (g \<circ> g'\<^sub>f))(\<^sup>f a := g b)" |
963 { fix g' a b show "Abs_finfun (g \<circ> op $ g'(\<^sup>f a := b)) = (Abs_finfun (g \<circ> op $ g'))(\<^sup>f a := g b)" |
964 proof - |
964 proof - |
965 obtain y where y: "y \<in> finfun" and g': "g' = Abs_finfun y" by(cases g') |
965 obtain y where y: "y \<in> finfun" and g': "g' = Abs_finfun y" by(cases g') |
966 moreover hence "(g \<circ> g'\<^sub>f) \<in> finfun" by(simp add: finfun_left_compose) |
966 moreover hence "(g \<circ> op $ g') \<in> finfun" by(simp add: finfun_left_compose) |
967 moreover have "g \<circ> y(a := b) = (g \<circ> y)(a := g b)" by(auto intro: ext) |
967 moreover have "g \<circ> y(a := b) = (g \<circ> y)(a := g b)" by(auto) |
968 ultimately show ?thesis by(simp add: finfun_comp_def finfun_update_def) |
968 ultimately show ?thesis by(simp add: finfun_comp_def finfun_update_def) |
969 qed } |
969 qed } |
970 qed auto |
970 qed auto |
971 thus ?thesis by(auto simp add: fun_eq_iff) |
971 thus ?thesis by(auto simp add: fun_eq_iff) |
972 qed |
972 qed |
973 |
973 |
974 definition finfun_comp2 :: "'b \<Rightarrow>f 'c \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow>f 'c" (infixr "\<^sub>f\<circ>" 55) |
974 definition finfun_comp2 :: "'b \<Rightarrow>f 'c \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow>f 'c" (infixr "\<^sub>f\<circ>" 55) |
975 where [code del]: "finfun_comp2 g f = Abs_finfun (finfun_apply g \<circ> f)" |
975 where [code del]: "finfun_comp2 g f = Abs_finfun (op $ g \<circ> f)" |
976 |
976 |
977 lemma finfun_comp2_const [code, simp]: "finfun_comp2 (\<lambda>\<^isup>f c) f = (\<lambda>\<^isup>f c)" |
977 lemma finfun_comp2_const [code, simp]: "finfun_comp2 (\<lambda>\<^isup>f c) f = (\<lambda>\<^isup>f c)" |
978 including finfun |
978 including finfun |
979 by(simp add: finfun_comp2_def finfun_const_def comp_def) |
979 by(simp add: finfun_comp2_def finfun_const_def comp_def) |
980 |
980 |
982 includes finfun |
982 includes finfun |
983 assumes inj: "inj f" |
983 assumes inj: "inj f" |
984 shows "finfun_comp2 (g(\<^sup>f b := c)) f = (if b \<in> range f then (finfun_comp2 g f)(\<^sup>f inv f b := c) else finfun_comp2 g f)" |
984 shows "finfun_comp2 (g(\<^sup>f b := c)) f = (if b \<in> range f then (finfun_comp2 g f)(\<^sup>f inv f b := c) else finfun_comp2 g f)" |
985 proof(cases "b \<in> range f") |
985 proof(cases "b \<in> range f") |
986 case True |
986 case True |
987 from inj have "\<And>x. (finfun_apply g)(f x := c) \<circ> f = (finfun_apply g \<circ> f)(x := c)" by(auto intro!: ext dest: injD) |
987 from inj have "\<And>x. (op $ g)(f x := c) \<circ> f = (op $ g \<circ> f)(x := c)" by(auto intro!: ext dest: injD) |
988 with inj True show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def finfun_right_compose) |
988 with inj True show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def finfun_right_compose) |
989 next |
989 next |
990 case False |
990 case False |
991 hence "(finfun_apply g)(b := c) \<circ> f = finfun_apply g \<circ> f" by(auto simp add: fun_eq_iff) |
991 hence "(op $ g)(b := c) \<circ> f = op $ g \<circ> f" by(auto simp add: fun_eq_iff) |
992 with False show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def) |
992 with False show ?thesis by(auto simp add: finfun_comp2_def finfun_update_def) |
993 qed |
993 qed |
994 |
994 |
995 subsection {* Universal quantification *} |
995 subsection {* Universal quantification *} |
996 |
996 |
997 definition finfun_All_except :: "'a list \<Rightarrow> 'a \<Rightarrow>f bool \<Rightarrow> bool" |
997 definition finfun_All_except :: "'a list \<Rightarrow> 'a \<Rightarrow>f bool \<Rightarrow> bool" |
998 where [code del]: "finfun_All_except A P \<equiv> \<forall>a. a \<in> set A \<or> P\<^sub>f a" |
998 where [code del]: "finfun_All_except A P \<equiv> \<forall>a. a \<in> set A \<or> P $ a" |
999 |
999 |
1000 lemma finfun_All_except_const: "finfun_All_except A (\<lambda>\<^isup>f b) \<longleftrightarrow> b \<or> set A = UNIV" |
1000 lemma finfun_All_except_const: "finfun_All_except A (\<lambda>\<^isup>f b) \<longleftrightarrow> b \<or> set A = UNIV" |
1001 by(auto simp add: finfun_All_except_def) |
1001 by(auto simp add: finfun_All_except_def) |
1002 |
1002 |
1003 lemma finfun_All_except_const_finfun_UNIV_code [code]: |
1003 lemma finfun_All_except_const_finfun_UNIV_code [code]: |
1004 "finfun_All_except A (\<lambda>\<^isup>f b) = (b \<or> is_list_UNIV A)" |
1004 "finfun_All_except A (\<lambda>\<^isup>f b) = (b \<or> is_list_UNIV A)" |
1005 by(simp add: finfun_All_except_const is_list_UNIV_iff) |
1005 by(simp add: finfun_All_except_const is_list_UNIV_iff) |
1006 |
1006 |
1007 lemma finfun_All_except_update: |
1007 lemma finfun_All_except_update: |
1008 "finfun_All_except A f(\<^sup>f a := b) = ((a \<in> set A \<or> b) \<and> finfun_All_except (a # A) f)" |
1008 "finfun_All_except A f(\<^sup>f a := b) = ((a \<in> set A \<or> b) \<and> finfun_All_except (a # A) f)" |
1009 by(fastforce simp add: finfun_All_except_def finfun_upd_apply) |
1009 by(fastforce simp add: finfun_All_except_def finfun_upd_apply) |
1010 |
1010 |
1011 lemma finfun_All_except_update_code [code]: |
1011 lemma finfun_All_except_update_code [code]: |
1012 fixes a :: "'a :: card_UNIV" |
1012 fixes a :: "'a :: card_UNIV" |
1020 by(simp add: finfun_All_def finfun_All_except_def) |
1020 by(simp add: finfun_All_def finfun_All_except_def) |
1021 |
1021 |
1022 lemma finfun_All_update: "finfun_All f(\<^sup>f a := b) = (b \<and> finfun_All_except [a] f)" |
1022 lemma finfun_All_update: "finfun_All f(\<^sup>f a := b) = (b \<and> finfun_All_except [a] f)" |
1023 by(simp add: finfun_All_def finfun_All_except_update) |
1023 by(simp add: finfun_All_def finfun_All_except_update) |
1024 |
1024 |
1025 lemma finfun_All_All: "finfun_All P = All P\<^sub>f" |
1025 lemma finfun_All_All: "finfun_All P = All (op $ P)" |
1026 by(simp add: finfun_All_def finfun_All_except_def) |
1026 by(simp add: finfun_All_def finfun_All_except_def) |
1027 |
1027 |
1028 |
1028 |
1029 definition finfun_Ex :: "'a \<Rightarrow>f bool \<Rightarrow> bool" |
1029 definition finfun_Ex :: "'a \<Rightarrow>f bool \<Rightarrow> bool" |
1030 where "finfun_Ex P = Not (finfun_All (Not \<circ>\<^isub>f P))" |
1030 where "finfun_Ex P = Not (finfun_All (Not \<circ>\<^isub>f P))" |
1031 |
1031 |
1032 lemma finfun_Ex_Ex: "finfun_Ex P = Ex P\<^sub>f" |
1032 lemma finfun_Ex_Ex: "finfun_Ex P = Ex (op $ P)" |
1033 unfolding finfun_Ex_def finfun_All_All by simp |
1033 unfolding finfun_Ex_def finfun_All_All by simp |
1034 |
1034 |
1035 lemma finfun_Ex_const [simp]: "finfun_Ex (\<lambda>\<^isup>f b) = b" |
1035 lemma finfun_Ex_const [simp]: "finfun_Ex (\<lambda>\<^isup>f b) = b" |
1036 by(simp add: finfun_Ex_def) |
1036 by(simp add: finfun_Ex_def) |
1037 |
1037 |
1038 |
1038 |
1039 subsection {* A diagonal operator for FinFuns *} |
1039 subsection {* A diagonal operator for FinFuns *} |
1040 |
1040 |
1041 definition finfun_Diag :: "'a \<Rightarrow>f 'b \<Rightarrow> 'a \<Rightarrow>f 'c \<Rightarrow> 'a \<Rightarrow>f ('b \<times> 'c)" ("(1'(_,/ _')\<^sup>f)" [0, 0] 1000) |
1041 definition finfun_Diag :: "'a \<Rightarrow>f 'b \<Rightarrow> 'a \<Rightarrow>f 'c \<Rightarrow> 'a \<Rightarrow>f ('b \<times> 'c)" ("(1'(_,/ _')\<^sup>f)" [0, 0] 1000) |
1042 where [code del]: "finfun_Diag f g = finfun_rec (\<lambda>b. Pair b \<circ>\<^isub>f g) (\<lambda>a b c. c(\<^sup>f a := (b, g\<^sub>f a))) f" |
1042 where [code del]: "finfun_Diag f g = finfun_rec (\<lambda>b. Pair b \<circ>\<^isub>f g) (\<lambda>a b c. c(\<^sup>f a := (b, g $ a))) f" |
1043 |
1043 |
1044 interpretation finfun_Diag_aux: finfun_rec_wf_aux "\<lambda>b. Pair b \<circ>\<^isub>f g" "\<lambda>a b c. c(\<^sup>f a := (b, g\<^sub>f a))" |
1044 interpretation finfun_Diag_aux: finfun_rec_wf_aux "\<lambda>b. Pair b \<circ>\<^isub>f g" "\<lambda>a b c. c(\<^sup>f a := (b, g $ a))" |
1045 by(unfold_locales)(simp_all add: expand_finfun_eq fun_eq_iff finfun_upd_apply) |
1045 by(unfold_locales)(simp_all add: expand_finfun_eq fun_eq_iff finfun_upd_apply) |
1046 |
1046 |
1047 interpretation finfun_Diag: finfun_rec_wf "\<lambda>b. Pair b \<circ>\<^isub>f g" "\<lambda>a b c. c(\<^sup>f a := (b, g\<^sub>f a))" |
1047 interpretation finfun_Diag: finfun_rec_wf "\<lambda>b. Pair b \<circ>\<^isub>f g" "\<lambda>a b c. c(\<^sup>f a := (b, g $ a))" |
1048 proof |
1048 proof |
1049 fix b' b :: 'a |
1049 fix b' b :: 'a |
1050 assume fin: "finite (UNIV :: 'c set)" |
1050 assume fin: "finite (UNIV :: 'c set)" |
1051 { fix A :: "'c set" |
1051 { fix A :: "'c set" |
1052 interpret comp_fun_commute "\<lambda>a c. c(\<^sup>f a := (b', g\<^sub>f a))" by(rule finfun_Diag_aux.upd_left_comm) |
1052 interpret comp_fun_commute "\<lambda>a c. c(\<^sup>f a := (b', g $ a))" by(rule finfun_Diag_aux.upd_left_comm) |
1053 from fin have "finite A" by(auto intro: finite_subset) |
1053 from fin have "finite A" by(auto intro: finite_subset) |
1054 hence "Finite_Set.fold (\<lambda>a c. c(\<^sup>f a := (b', g\<^sub>f a))) (Pair b \<circ>\<^isub>f g) A = |
1054 hence "Finite_Set.fold (\<lambda>a c. c(\<^sup>f a := (b', g $ a))) (Pair b \<circ>\<^isub>f g) A = |
1055 Abs_finfun (\<lambda>a. (if a \<in> A then b' else b, g\<^sub>f a))" |
1055 Abs_finfun (\<lambda>a. (if a \<in> A then b' else b, g $ a))" |
1056 by(induct)(simp_all add: finfun_const_def finfun_comp_conv_comp o_def, |
1056 by(induct)(simp_all add: finfun_const_def finfun_comp_conv_comp o_def, |
1057 auto simp add: finfun_update_def Abs_finfun_inverse_finite fun_upd_def Abs_finfun_inject_finite fun_eq_iff fin) } |
1057 auto simp add: finfun_update_def Abs_finfun_inverse_finite fun_upd_def Abs_finfun_inject_finite fun_eq_iff fin) } |
1058 from this[of UNIV] show "Finite_Set.fold (\<lambda>a c. c(\<^sup>f a := (b', g\<^sub>f a))) (Pair b \<circ>\<^isub>f g) UNIV = Pair b' \<circ>\<^isub>f g" |
1058 from this[of UNIV] show "Finite_Set.fold (\<lambda>a c. c(\<^sup>f a := (b', g $ a))) (Pair b \<circ>\<^isub>f g) UNIV = Pair b' \<circ>\<^isub>f g" |
1059 by(simp add: finfun_const_def finfun_comp_conv_comp o_def) |
1059 by(simp add: finfun_const_def finfun_comp_conv_comp o_def) |
1060 qed |
1060 qed |
1061 |
1061 |
1062 lemma finfun_Diag_const1: "(\<lambda>\<^isup>f b, g)\<^sup>f = Pair b \<circ>\<^isub>f g" |
1062 lemma finfun_Diag_const1: "(\<lambda>\<^isup>f b, g)\<^sup>f = Pair b \<circ>\<^isub>f g" |
1063 by(simp add: finfun_Diag_def) |
1063 by(simp add: finfun_Diag_def) |
1069 lemma finfun_Diag_const_code [code]: |
1069 lemma finfun_Diag_const_code [code]: |
1070 "(\<lambda>\<^isup>f b, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>\<^isup>f (b, c))" |
1070 "(\<lambda>\<^isup>f b, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>\<^isup>f (b, c))" |
1071 "(\<lambda>\<^isup>f b, g(\<^sup>fc a := c))\<^sup>f = (\<lambda>\<^isup>f b, g)\<^sup>f(\<^sup>fc a := (b, c))" |
1071 "(\<lambda>\<^isup>f b, g(\<^sup>fc a := c))\<^sup>f = (\<lambda>\<^isup>f b, g)\<^sup>f(\<^sup>fc a := (b, c))" |
1072 by(simp_all add: finfun_Diag_const1) |
1072 by(simp_all add: finfun_Diag_const1) |
1073 |
1073 |
1074 lemma finfun_Diag_update1: "(f(\<^sup>f a := b), g)\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (b, g\<^sub>f a))" |
1074 lemma finfun_Diag_update1: "(f(\<^sup>f a := b), g)\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (b, g $ a))" |
1075 and finfun_Diag_update1_code [code]: "(finfun_update_code f a b, g)\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (b, g\<^sub>f a))" |
1075 and finfun_Diag_update1_code [code]: "(finfun_update_code f a b, g)\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (b, g $ a))" |
1076 by(simp_all add: finfun_Diag_def) |
1076 by(simp_all add: finfun_Diag_def) |
1077 |
1077 |
1078 lemma finfun_Diag_const2: "(f, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>b. (b, c)) \<circ>\<^isub>f f" |
1078 lemma finfun_Diag_const2: "(f, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>b. (b, c)) \<circ>\<^isub>f f" |
1079 by(induct f rule: finfun_weak_induct)(auto intro!: finfun_ext simp add: finfun_upd_apply finfun_Diag_const1 finfun_Diag_update1) |
1079 by(induct f rule: finfun_weak_induct)(auto intro!: finfun_ext simp add: finfun_upd_apply finfun_Diag_const1 finfun_Diag_update1) |
1080 |
1080 |
1081 lemma finfun_Diag_update2: "(f, g(\<^sup>f a := c))\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (f\<^sub>f a, c))" |
1081 lemma finfun_Diag_update2: "(f, g(\<^sup>f a := c))\<^sup>f = (f, g)\<^sup>f(\<^sup>f a := (f $ a, c))" |
1082 by(induct f rule: finfun_weak_induct)(auto intro!: finfun_ext simp add: finfun_upd_apply finfun_Diag_const1 finfun_Diag_update1) |
1082 by(induct f rule: finfun_weak_induct)(auto intro!: finfun_ext simp add: finfun_upd_apply finfun_Diag_const1 finfun_Diag_update1) |
1083 |
1083 |
1084 lemma finfun_Diag_const_const [simp]: "(\<lambda>\<^isup>f b, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>\<^isup>f (b, c))" |
1084 lemma finfun_Diag_const_const [simp]: "(\<lambda>\<^isup>f b, \<lambda>\<^isup>f c)\<^sup>f = (\<lambda>\<^isup>f (b, c))" |
1085 by(simp add: finfun_Diag_const1) |
1085 by(simp add: finfun_Diag_const1) |
1086 |
1086 |
1091 lemma finfun_Diag_update_const: |
1091 lemma finfun_Diag_update_const: |
1092 "(f(\<^sup>f a := b), \<lambda>\<^isup>f c)\<^sup>f = (f, \<lambda>\<^isup>f c)\<^sup>f(\<^sup>f a := (b, c))" |
1092 "(f(\<^sup>f a := b), \<lambda>\<^isup>f c)\<^sup>f = (f, \<lambda>\<^isup>f c)\<^sup>f(\<^sup>f a := (b, c))" |
1093 by(simp add: finfun_Diag_def) |
1093 by(simp add: finfun_Diag_def) |
1094 |
1094 |
1095 lemma finfun_Diag_update_update: |
1095 lemma finfun_Diag_update_update: |
1096 "(f(\<^sup>f a := b), g(\<^sup>f a' := c))\<^sup>f = (if a = a' then (f, g)\<^sup>f(\<^sup>f a := (b, c)) else (f, g)\<^sup>f(\<^sup>f a := (b, g\<^sub>f a))(\<^sup>f a' := (f\<^sub>f a', c)))" |
1096 "(f(\<^sup>f a := b), g(\<^sup>f a' := c))\<^sup>f = (if a = a' then (f, g)\<^sup>f(\<^sup>f a := (b, c)) else (f, g)\<^sup>f(\<^sup>f a := (b, g $ a))(\<^sup>f a' := (f $ a', c)))" |
1097 by(auto simp add: finfun_Diag_update1 finfun_Diag_update2) |
1097 by(auto simp add: finfun_Diag_update1 finfun_Diag_update2) |
1098 |
1098 |
1099 lemma finfun_Diag_apply [simp]: "(f, g)\<^sup>f\<^sub>f = (\<lambda>x. (f\<^sub>f x, g\<^sub>f x))" |
1099 lemma finfun_Diag_apply [simp]: "op $ (f, g)\<^sup>f = (\<lambda>x. (f $ x, g $ x))" |
1100 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_Diag_const1 finfun_Diag_update1 finfun_upd_apply intro: ext) |
1100 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_Diag_const1 finfun_Diag_update1 finfun_upd_apply) |
1101 |
1101 |
1102 lemma finfun_Diag_conv_Abs_finfun: |
1102 lemma finfun_Diag_conv_Abs_finfun: |
1103 "(f, g)\<^sup>f = Abs_finfun ((\<lambda>x. (finfun_apply f x, finfun_apply g x)))" |
1103 "(f, g)\<^sup>f = Abs_finfun ((\<lambda>x. (f $ x, g $ x)))" |
1104 including finfun |
1104 including finfun |
1105 proof - |
1105 proof - |
1106 have "(\<lambda>f :: 'a \<Rightarrow>f 'b. (f, g)\<^sup>f) = (\<lambda>f. Abs_finfun ((\<lambda>x. (finfun_apply f x, finfun_apply g x))))" |
1106 have "(\<lambda>f :: 'a \<Rightarrow>f 'b. (f, g)\<^sup>f) = (\<lambda>f. Abs_finfun ((\<lambda>x. (f $ x, g $ x))))" |
1107 proof(rule finfun_rec_unique) |
1107 proof(rule finfun_rec_unique) |
1108 { fix c show "Abs_finfun (\<lambda>x. (finfun_apply (\<lambda>\<^isup>f c) x, finfun_apply g x)) = Pair c \<circ>\<^isub>f g" |
1108 { fix c show "Abs_finfun (\<lambda>x. ((\<lambda>\<^isup>f c) $ x, g $ x)) = Pair c \<circ>\<^isub>f g" |
1109 by(simp add: finfun_comp_conv_comp o_def finfun_const_def) } |
1109 by(simp add: finfun_comp_conv_comp o_def finfun_const_def) } |
1110 { fix g' a b |
1110 { fix g' a b |
1111 show "Abs_finfun (\<lambda>x. (finfun_apply g'(\<^sup>f a := b) x, finfun_apply g x)) = |
1111 show "Abs_finfun (\<lambda>x. (g'(\<^sup>f a := b) $ x, g $ x)) = |
1112 (Abs_finfun (\<lambda>x. (finfun_apply g' x, finfun_apply g x)))(\<^sup>f a := (b, g\<^sub>f a))" |
1112 (Abs_finfun (\<lambda>x. (g' $ x, g $ x)))(\<^sup>f a := (b, g $ a))" |
1113 by(auto simp add: finfun_update_def fun_eq_iff simp del: fun_upd_apply) simp } |
1113 by(auto simp add: finfun_update_def fun_eq_iff simp del: fun_upd_apply) simp } |
1114 qed(simp_all add: finfun_Diag_const1 finfun_Diag_update1) |
1114 qed(simp_all add: finfun_Diag_const1 finfun_Diag_update1) |
1115 thus ?thesis by(auto simp add: fun_eq_iff) |
1115 thus ?thesis by(auto simp add: fun_eq_iff) |
1116 qed |
1116 qed |
1117 |
1117 |
1163 by(induct f rule: finfun_weak_induct)(simp_all add: finfun_fst_const finfun_snd_const finfun_fst_update finfun_snd_update finfun_Diag_update_update) |
1163 by(induct f rule: finfun_weak_induct)(simp_all add: finfun_fst_const finfun_snd_const finfun_fst_update finfun_snd_update finfun_Diag_update_update) |
1164 |
1164 |
1165 subsection {* Currying for FinFuns *} |
1165 subsection {* Currying for FinFuns *} |
1166 |
1166 |
1167 definition finfun_curry :: "('a \<times> 'b) \<Rightarrow>f 'c \<Rightarrow> 'a \<Rightarrow>f 'b \<Rightarrow>f 'c" |
1167 definition finfun_curry :: "('a \<times> 'b) \<Rightarrow>f 'c \<Rightarrow> 'a \<Rightarrow>f 'b \<Rightarrow>f 'c" |
1168 where [code del]: "finfun_curry = finfun_rec (finfun_const \<circ> finfun_const) (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c)))" |
1168 where [code del]: "finfun_curry = finfun_rec (finfun_const \<circ> finfun_const) (\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c)))" |
1169 |
1169 |
1170 interpretation finfun_curry_aux: finfun_rec_wf_aux "finfun_const \<circ> finfun_const" "\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))" |
1170 interpretation finfun_curry_aux: finfun_rec_wf_aux "finfun_const \<circ> finfun_const" "\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))" |
1171 apply(unfold_locales) |
1171 apply(unfold_locales) |
1172 apply(auto simp add: split_def finfun_update_twist finfun_upd_apply split_paired_all finfun_update_const_same) |
1172 apply(auto simp add: split_def finfun_update_twist finfun_upd_apply split_paired_all finfun_update_const_same) |
1173 done |
1173 done |
1174 |
1174 |
1175 interpretation finfun_curry: finfun_rec_wf "finfun_const \<circ> finfun_const" "\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))" |
1175 interpretation finfun_curry: finfun_rec_wf "finfun_const \<circ> finfun_const" "\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))" |
1176 proof(unfold_locales) |
1176 proof(unfold_locales) |
1177 fix b' b :: 'b |
1177 fix b' b :: 'b |
1178 assume fin: "finite (UNIV :: ('c \<times> 'a) set)" |
1178 assume fin: "finite (UNIV :: ('c \<times> 'a) set)" |
1179 hence fin1: "finite (UNIV :: 'c set)" and fin2: "finite (UNIV :: 'a set)" |
1179 hence fin1: "finite (UNIV :: 'c set)" and fin2: "finite (UNIV :: 'a set)" |
1180 unfolding UNIV_Times_UNIV[symmetric] |
1180 unfolding UNIV_Times_UNIV[symmetric] |
1181 by(fastforce dest: finite_cartesian_productD1 finite_cartesian_productD2)+ |
1181 by(fastforce dest: finite_cartesian_productD1 finite_cartesian_productD2)+ |
1182 note [simp] = Abs_finfun_inverse_finite[OF fin] Abs_finfun_inverse_finite[OF fin1] Abs_finfun_inverse_finite[OF fin2] |
1182 note [simp] = Abs_finfun_inverse_finite[OF fin] Abs_finfun_inverse_finite[OF fin1] Abs_finfun_inverse_finite[OF fin2] |
1183 { fix A :: "('c \<times> 'a) set" |
1183 { fix A :: "('c \<times> 'a) set" |
1184 interpret comp_fun_commute "\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b'" |
1184 interpret comp_fun_commute "\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))) a b'" |
1185 by(rule finfun_curry_aux.upd_left_comm) |
1185 by(rule finfun_curry_aux.upd_left_comm) |
1186 from fin have "finite A" by(auto intro: finite_subset) |
1186 from fin have "finite A" by(auto intro: finite_subset) |
1187 hence "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) A = Abs_finfun (\<lambda>a. Abs_finfun (\<lambda>b''. if (a, b'') \<in> A then b' else b))" |
1187 hence "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) A = Abs_finfun (\<lambda>a. Abs_finfun (\<lambda>b''. if (a, b'') \<in> A then b' else b))" |
1188 by induct (simp_all, auto simp add: finfun_update_def finfun_const_def split_def intro!: arg_cong[where f="Abs_finfun"] ext) } |
1188 by induct (simp_all, auto simp add: finfun_update_def finfun_const_def split_def intro!: arg_cong[where f="Abs_finfun"] ext) } |
1189 from this[of UNIV] |
1189 from this[of UNIV] |
1190 show "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f\<^sub>f a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) UNIV = (finfun_const \<circ> finfun_const) b'" |
1190 show "Finite_Set.fold (\<lambda>a :: 'c \<times> 'a. (\<lambda>(a, b) c f. f(\<^sup>f a := (f $ a)(\<^sup>f b := c))) a b') ((finfun_const \<circ> finfun_const) b) UNIV = (finfun_const \<circ> finfun_const) b'" |
1191 by(simp add: finfun_const_def) |
1191 by(simp add: finfun_const_def) |
1192 qed |
1192 qed |
1193 |
1193 |
1194 lemma finfun_curry_const [simp, code]: "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" |
1194 lemma finfun_curry_const [simp, code]: "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" |
1195 by(simp add: finfun_curry_def) |
1195 by(simp add: finfun_curry_def) |
1196 |
1196 |
1197 lemma finfun_curry_update [simp]: |
1197 lemma finfun_curry_update [simp]: |
1198 "finfun_curry (f(\<^sup>f (a, b) := c)) = (finfun_curry f)(\<^sup>f a := ((finfun_curry f)\<^sub>f a)(\<^sup>f b := c))" |
1198 "finfun_curry (f(\<^sup>f (a, b) := c)) = (finfun_curry f)(\<^sup>f a := (finfun_curry f $ a)(\<^sup>f b := c))" |
1199 and finfun_curry_update_code [code]: |
1199 and finfun_curry_update_code [code]: |
1200 "finfun_curry (f(\<^sup>fc (a, b) := c)) = (finfun_curry f)(\<^sup>f a := ((finfun_curry f)\<^sub>f a)(\<^sup>f b := c))" |
1200 "finfun_curry (f(\<^sup>fc (a, b) := c)) = (finfun_curry f)(\<^sup>f a := (finfun_curry f $ a)(\<^sup>f b := c))" |
1201 by(simp_all add: finfun_curry_def) |
1201 by(simp_all add: finfun_curry_def) |
1202 |
1202 |
1203 lemma finfun_Abs_finfun_curry: assumes fin: "f \<in> finfun" |
1203 lemma finfun_Abs_finfun_curry: assumes fin: "f \<in> finfun" |
1204 shows "(\<lambda>a. Abs_finfun (curry f a)) \<in> finfun" |
1204 shows "(\<lambda>a. Abs_finfun (curry f a)) \<in> finfun" |
1205 including finfun |
1205 including finfun |
1220 proof - |
1220 proof - |
1221 have "finfun_curry = (\<lambda>f :: ('a \<times> 'b) \<Rightarrow>f 'c. Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply f) a)))" |
1221 have "finfun_curry = (\<lambda>f :: ('a \<times> 'b) \<Rightarrow>f 'c. Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply f) a)))" |
1222 proof(rule finfun_rec_unique) |
1222 proof(rule finfun_rec_unique) |
1223 fix c show "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" by simp |
1223 fix c show "finfun_curry (\<lambda>\<^isup>f c) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" by simp |
1224 fix f a |
1224 fix f a |
1225 show "finfun_curry (f(\<^sup>f a := c)) = (finfun_curry f)(\<^sup>f fst a := ((finfun_curry f)\<^sub>f (fst a))(\<^sup>f snd a := c))" |
1225 show "finfun_curry (f(\<^sup>f a := c)) = (finfun_curry f)(\<^sup>f fst a := (finfun_curry f $ (fst a))(\<^sup>f snd a := c))" |
1226 by(cases a) simp |
1226 by(cases a) simp |
1227 show "Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply (\<lambda>\<^isup>f c)) a)) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" |
1227 show "Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply (\<lambda>\<^isup>f c)) a)) = (\<lambda>\<^isup>f \<lambda>\<^isup>f c)" |
1228 by(simp add: finfun_curry_def finfun_const_def curry_def) |
1228 by(simp add: finfun_curry_def finfun_const_def curry_def) |
1229 fix g b |
1229 fix g b |
1230 show "Abs_finfun (\<lambda>aa. Abs_finfun (curry (finfun_apply g(\<^sup>f a := b)) aa)) = |
1230 show "Abs_finfun (\<lambda>aa. Abs_finfun (curry (op $ g(\<^sup>f a := b)) aa)) = |
1231 (Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply g) a)))(\<^sup>f |
1231 (Abs_finfun (\<lambda>a. Abs_finfun (curry (op $ g) a)))(\<^sup>f |
1232 fst a := ((Abs_finfun (\<lambda>a. Abs_finfun (curry (finfun_apply g) a)))\<^sub>f (fst a))(\<^sup>f snd a := b))" |
1232 fst a := ((Abs_finfun (\<lambda>a. Abs_finfun (curry (op $ g) a))) $ (fst a))(\<^sup>f snd a := b))" |
1233 by(cases a)(auto intro!: ext arg_cong[where f=Abs_finfun] simp add: finfun_curry_def finfun_update_def finfun_curry finfun_Abs_finfun_curry) |
1233 by(cases a)(auto intro!: ext arg_cong[where f=Abs_finfun] simp add: finfun_curry_def finfun_update_def finfun_Abs_finfun_curry) |
1234 qed |
1234 qed |
1235 thus ?thesis by(auto simp add: fun_eq_iff) |
1235 thus ?thesis by(auto simp add: fun_eq_iff) |
1236 qed |
1236 qed |
1237 |
1237 |
1238 subsection {* Executable equality for FinFuns *} |
1238 subsection {* Executable equality for FinFuns *} |
1295 |
1295 |
1296 lemma finfun_dom_update_code [code]: |
1296 lemma finfun_dom_update_code [code]: |
1297 "finfun_dom (finfun_update_code f a b) = finfun_update_code (finfun_dom f) a (b \<noteq> finfun_default f)" |
1297 "finfun_dom (finfun_update_code f a b) = finfun_update_code (finfun_dom f) a (b \<noteq> finfun_default f)" |
1298 by(simp) |
1298 by(simp) |
1299 |
1299 |
1300 lemma finite_finfun_dom: "finite {x. (finfun_dom f)\<^sub>f x}" |
1300 lemma finite_finfun_dom: "finite {x. finfun_dom f $ x}" |
1301 proof(induct f rule: finfun_weak_induct) |
1301 proof(induct f rule: finfun_weak_induct) |
1302 case (const b) |
1302 case (const b) |
1303 thus ?case |
1303 thus ?case |
1304 by (cases "finite (UNIV :: 'a set) \<and> b \<noteq> undefined") |
1304 by (cases "finite (UNIV :: 'a set) \<and> b \<noteq> undefined") |
1305 (auto simp add: finfun_dom_const UNIV_def [symmetric] Set.empty_def [symmetric]) |
1305 (auto simp add: finfun_dom_const UNIV_def [symmetric] Set.empty_def [symmetric]) |
1306 next |
1306 next |
1307 case (update f a b) |
1307 case (update f a b) |
1308 have "{x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x} = |
1308 have "{x. finfun_dom f(\<^sup>f a := b) $ x} = |
1309 (if b = finfun_default f then {x. (finfun_dom f)\<^sub>f x} - {a} else insert a {x. (finfun_dom f)\<^sub>f x})" |
1309 (if b = finfun_default f then {x. finfun_dom f $ x} - {a} else insert a {x. finfun_dom f $ x})" |
1310 by (auto simp add: finfun_upd_apply split: split_if_asm) |
1310 by (auto simp add: finfun_upd_apply split: split_if_asm) |
1311 thus ?case using update by simp |
1311 thus ?case using update by simp |
1312 qed |
1312 qed |
1313 |
1313 |
1314 |
1314 |
1315 subsection {* The domain of a FinFun as a sorted list *} |
1315 subsection {* The domain of a FinFun as a sorted list *} |
1316 |
1316 |
1317 definition finfun_to_list :: "('a :: linorder) \<Rightarrow>f 'b \<Rightarrow> 'a list" |
1317 definition finfun_to_list :: "('a :: linorder) \<Rightarrow>f 'b \<Rightarrow> 'a list" |
1318 where |
1318 where |
1319 "finfun_to_list f = (THE xs. set xs = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs \<and> distinct xs)" |
1319 "finfun_to_list f = (THE xs. set xs = {x. finfun_dom f $ x} \<and> sorted xs \<and> distinct xs)" |
1320 |
1320 |
1321 lemma set_finfun_to_list [simp]: "set (finfun_to_list f) = {x. (finfun_dom f)\<^sub>f x}" (is ?thesis1) |
1321 lemma set_finfun_to_list [simp]: "set (finfun_to_list f) = {x. finfun_dom f $ x}" (is ?thesis1) |
1322 and sorted_finfun_to_list: "sorted (finfun_to_list f)" (is ?thesis2) |
1322 and sorted_finfun_to_list: "sorted (finfun_to_list f)" (is ?thesis2) |
1323 and distinct_finfun_to_list: "distinct (finfun_to_list f)" (is ?thesis3) |
1323 and distinct_finfun_to_list: "distinct (finfun_to_list f)" (is ?thesis3) |
1324 proof - |
1324 proof - |
1325 have "?thesis1 \<and> ?thesis2 \<and> ?thesis3" |
1325 have "?thesis1 \<and> ?thesis2 \<and> ?thesis3" |
1326 unfolding finfun_to_list_def |
1326 unfolding finfun_to_list_def |
1327 by(rule theI')(rule finite_sorted_distinct_unique finite_finfun_dom)+ |
1327 by(rule theI')(rule finite_sorted_distinct_unique finite_finfun_dom)+ |
1328 thus ?thesis1 ?thesis2 ?thesis3 by simp_all |
1328 thus ?thesis1 ?thesis2 ?thesis3 by simp_all |
1329 qed |
1329 qed |
1330 |
1330 |
1331 lemma finfun_const_False_conv_bot: "(\<lambda>\<^isup>f False)\<^sub>f = bot" |
1331 lemma finfun_const_False_conv_bot: "op $ (\<lambda>\<^isup>f False) = bot" |
1332 by auto |
1332 by auto |
1333 |
1333 |
1334 lemma finfun_const_True_conv_top: "(\<lambda>\<^isup>f True)\<^sub>f = top" |
1334 lemma finfun_const_True_conv_top: "op $ (\<lambda>\<^isup>f True) = top" |
1335 by auto |
1335 by auto |
1336 |
1336 |
1337 lemma finfun_to_list_const: |
1337 lemma finfun_to_list_const: |
1338 "finfun_to_list ((\<lambda>\<^isup>f c) :: ('a :: {linorder} \<Rightarrow>f 'b)) = |
1338 "finfun_to_list ((\<lambda>\<^isup>f c) :: ('a :: {linorder} \<Rightarrow>f 'b)) = |
1339 (if \<not> finite (UNIV :: 'a set) \<or> c = undefined then [] else THE xs. set xs = UNIV \<and> sorted xs \<and> distinct xs)" |
1339 (if \<not> finite (UNIV :: 'a set) \<or> c = undefined then [] else THE xs. set xs = UNIV \<and> sorted xs \<and> distinct xs)" |
1348 lemma remove1_insort_insert_same: |
1348 lemma remove1_insort_insert_same: |
1349 "x \<notin> set xs \<Longrightarrow> remove1 x (insort_insert x xs) = xs" |
1349 "x \<notin> set xs \<Longrightarrow> remove1 x (insort_insert x xs) = xs" |
1350 by (metis insort_insert_insort remove1_insort) |
1350 by (metis insort_insert_insort remove1_insort) |
1351 |
1351 |
1352 lemma finfun_dom_conv: |
1352 lemma finfun_dom_conv: |
1353 "(finfun_dom f)\<^sub>f x \<longleftrightarrow> f\<^sub>f x \<noteq> finfun_default f" |
1353 "finfun_dom f $ x \<longleftrightarrow> f $ x \<noteq> finfun_default f" |
1354 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_dom_const finfun_default_const finfun_default_update_const finfun_upd_apply) |
1354 by(induct f rule: finfun_weak_induct)(auto simp add: finfun_dom_const finfun_default_const finfun_default_update_const finfun_upd_apply) |
1355 |
1355 |
1356 lemma finfun_to_list_update: |
1356 lemma finfun_to_list_update: |
1357 "finfun_to_list (f(\<^sup>f a := b)) = |
1357 "finfun_to_list (f(\<^sup>f a := b)) = |
1358 (if b = finfun_default f then List.remove1 a (finfun_to_list f) else List.insort_insert a (finfun_to_list f))" |
1358 (if b = finfun_default f then List.remove1 a (finfun_to_list f) else List.insort_insert a (finfun_to_list f))" |
1359 proof(subst finfun_to_list_def, rule the_equality) |
1359 proof(subst finfun_to_list_def, rule the_equality) |
1360 fix xs |
1360 fix xs |
1361 assume "set xs = {x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x} \<and> sorted xs \<and> distinct xs" |
1361 assume "set xs = {x. finfun_dom f(\<^sup>f a := b) $ x} \<and> sorted xs \<and> distinct xs" |
1362 hence eq: "set xs = {x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x}" |
1362 hence eq: "set xs = {x. finfun_dom f(\<^sup>f a := b) $ x}" |
1363 and [simp]: "sorted xs" "distinct xs" by simp_all |
1363 and [simp]: "sorted xs" "distinct xs" by simp_all |
1364 show "xs = (if b = finfun_default f then remove1 a (finfun_to_list f) else insort_insert a (finfun_to_list f))" |
1364 show "xs = (if b = finfun_default f then remove1 a (finfun_to_list f) else insort_insert a (finfun_to_list f))" |
1365 proof(cases "b = finfun_default f") |
1365 proof(cases "b = finfun_default f") |
1366 case True [simp] |
1366 case True [simp] |
1367 show ?thesis |
1367 show ?thesis |
1368 proof(cases "(finfun_dom f)\<^sub>f a") |
1368 proof(cases "finfun_dom f $ a") |
1369 case True |
1369 case True |
1370 have "finfun_to_list f = insort_insert a xs" |
1370 have "finfun_to_list f = insort_insert a xs" |
1371 unfolding finfun_to_list_def |
1371 unfolding finfun_to_list_def |
1372 proof(rule the_equality) |
1372 proof(rule the_equality) |
1373 have "set (insort_insert a xs) = insert a (set xs)" by(simp add: set_insort_insert) |
1373 have "set (insort_insert a xs) = insert a (set xs)" by(simp add: set_insort_insert) |
1374 also note eq also |
1374 also note eq also |
1375 have "insert a {x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x} = {x. (finfun_dom f)\<^sub>f x}" using True |
1375 have "insert a {x. finfun_dom f(\<^sup>f a := b) $ x} = {x. finfun_dom f $ x}" using True |
1376 by(auto simp add: finfun_upd_apply split: split_if_asm) |
1376 by(auto simp add: finfun_upd_apply split: split_if_asm) |
1377 finally show 1: "set (insort_insert a xs) = {x. (finfun_dom f)\<^sub>f x} \<and> sorted (insort_insert a xs) \<and> distinct (insort_insert a xs)" |
1377 finally show 1: "set (insort_insert a xs) = {x. finfun_dom f $ x} \<and> sorted (insort_insert a xs) \<and> distinct (insort_insert a xs)" |
1378 by(simp add: sorted_insort_insert distinct_insort_insert) |
1378 by(simp add: sorted_insort_insert distinct_insort_insert) |
1379 |
1379 |
1380 fix xs' |
1380 fix xs' |
1381 assume "set xs' = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs' \<and> distinct xs'" |
1381 assume "set xs' = {x. finfun_dom f $ x} \<and> sorted xs' \<and> distinct xs'" |
1382 thus "xs' = insort_insert a xs" using 1 by(auto dest: sorted_distinct_set_unique) |
1382 thus "xs' = insort_insert a xs" using 1 by(auto dest: sorted_distinct_set_unique) |
1383 qed |
1383 qed |
1384 with eq True show ?thesis by(simp add: remove1_insort_insert_same) |
1384 with eq True show ?thesis by(simp add: remove1_insort_insert_same) |
1385 next |
1385 next |
1386 case False |
1386 case False |
1387 hence "f\<^sub>f a = b" by(auto simp add: finfun_dom_conv) |
1387 hence "f $ a = b" by(auto simp add: finfun_dom_conv) |
1388 hence f: "f(\<^sup>f a := b) = f" by(simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply) |
1388 hence f: "f(\<^sup>f a := b) = f" by(simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply) |
1389 from eq have "finfun_to_list f = xs" unfolding f finfun_to_list_def |
1389 from eq have "finfun_to_list f = xs" unfolding f finfun_to_list_def |
1390 by(auto elim: sorted_distinct_set_unique intro!: the_equality) |
1390 by(auto elim: sorted_distinct_set_unique intro!: the_equality) |
1391 with eq False show ?thesis unfolding f by(simp add: remove1_idem) |
1391 with eq False show ?thesis unfolding f by(simp add: remove1_idem) |
1392 qed |
1392 qed |
1393 next |
1393 next |
1394 case False |
1394 case False |
1395 show ?thesis |
1395 show ?thesis |
1396 proof(cases "(finfun_dom f)\<^sub>f a") |
1396 proof(cases "finfun_dom f $ a") |
1397 case True |
1397 case True |
1398 have "finfun_to_list f = xs" |
1398 have "finfun_to_list f = xs" |
1399 unfolding finfun_to_list_def |
1399 unfolding finfun_to_list_def |
1400 proof(rule the_equality) |
1400 proof(rule the_equality) |
1401 have "finfun_dom f = finfun_dom f(\<^sup>f a := b)" using False True |
1401 have "finfun_dom f = finfun_dom f(\<^sup>f a := b)" using False True |
1402 by(simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply) |
1402 by(simp add: expand_finfun_eq fun_eq_iff finfun_upd_apply) |
1403 with eq show 1: "set xs = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs \<and> distinct xs" |
1403 with eq show 1: "set xs = {x. finfun_dom f $ x} \<and> sorted xs \<and> distinct xs" |
1404 by(simp del: finfun_dom_update) |
1404 by(simp del: finfun_dom_update) |
1405 |
1405 |
1406 fix xs' |
1406 fix xs' |
1407 assume "set xs' = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs' \<and> distinct xs'" |
1407 assume "set xs' = {x. finfun_dom f $ x} \<and> sorted xs' \<and> distinct xs'" |
1408 thus "xs' = xs" using 1 by(auto elim: sorted_distinct_set_unique) |
1408 thus "xs' = xs" using 1 by(auto elim: sorted_distinct_set_unique) |
1409 qed |
1409 qed |
1410 thus ?thesis using False True eq by(simp add: insort_insert_triv) |
1410 thus ?thesis using False True eq by(simp add: insort_insert_triv) |
1411 next |
1411 next |
1412 case False |
1412 case False |
1413 have "finfun_to_list f = remove1 a xs" |
1413 have "finfun_to_list f = remove1 a xs" |
1414 unfolding finfun_to_list_def |
1414 unfolding finfun_to_list_def |
1415 proof(rule the_equality) |
1415 proof(rule the_equality) |
1416 have "set (remove1 a xs) = set xs - {a}" by simp |
1416 have "set (remove1 a xs) = set xs - {a}" by simp |
1417 also note eq also |
1417 also note eq also |
1418 have "{x. (finfun_dom f(\<^sup>f a := b))\<^sub>f x} - {a} = {x. (finfun_dom f)\<^sub>f x}" using False |
1418 have "{x. finfun_dom f(\<^sup>f a := b) $ x} - {a} = {x. finfun_dom f $ x}" using False |
1419 by(auto simp add: finfun_upd_apply split: split_if_asm) |
1419 by(auto simp add: finfun_upd_apply split: split_if_asm) |
1420 finally show 1: "set (remove1 a xs) = {x. (finfun_dom f)\<^sub>f x} \<and> sorted (remove1 a xs) \<and> distinct (remove1 a xs)" |
1420 finally show 1: "set (remove1 a xs) = {x. finfun_dom f $ x} \<and> sorted (remove1 a xs) \<and> distinct (remove1 a xs)" |
1421 by(simp add: sorted_remove1) |
1421 by(simp add: sorted_remove1) |
1422 |
1422 |
1423 fix xs' |
1423 fix xs' |
1424 assume "set xs' = {x. (finfun_dom f)\<^sub>f x} \<and> sorted xs' \<and> distinct xs'" |
1424 assume "set xs' = {x. finfun_dom f $ x} \<and> sorted xs' \<and> distinct xs'" |
1425 thus "xs' = remove1 a xs" using 1 by(blast intro: sorted_distinct_set_unique) |
1425 thus "xs' = remove1 a xs" using 1 by(blast intro: sorted_distinct_set_unique) |
1426 qed |
1426 qed |
1427 thus ?thesis using False eq `b \<noteq> finfun_default f` |
1427 thus ?thesis using False eq `b \<noteq> finfun_default f` |
1428 by (simp add: insort_insert_insort insort_remove1) |
1428 by (simp add: insort_insert_insort insort_remove1) |
1429 qed |
1429 qed |