99 from setsum_def show "comm_monoid_set.F plus 0 = setsum" by rule |
99 from setsum_def show "comm_monoid_set.F plus 0 = setsum" by rule |
100 qed |
100 qed |
101 |
101 |
102 end |
102 end |
103 |
103 |
104 text {* Some syntactic sugar for summing a function over a list: *} |
104 text \<open>Some syntactic sugar for summing a function over a list:\<close> |
105 |
105 |
106 syntax |
106 syntax |
107 "_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3SUM _<-_. _)" [0, 51, 10] 10) |
107 "_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3SUM _<-_. _)" [0, 51, 10] 10) |
108 syntax (xsymbols) |
108 syntax (xsymbols) |
109 "_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10) |
109 "_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10) |
110 syntax (HTML output) |
110 syntax (HTML output) |
111 "_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10) |
111 "_listsum" :: "pttrn => 'a list => 'b => 'b" ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10) |
112 |
112 |
113 translations -- {* Beware of argument permutation! *} |
113 translations -- \<open>Beware of argument permutation!\<close> |
114 "SUM x<-xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
114 "SUM x<-xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
115 "\<Sum>x\<leftarrow>xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
115 "\<Sum>x\<leftarrow>xs. b" == "CONST listsum (CONST map (%x. b) xs)" |
116 |
116 |
117 text {* TODO duplicates *} |
117 text \<open>TODO duplicates\<close> |
118 lemmas listsum_simps = listsum.Nil listsum.Cons |
118 lemmas listsum_simps = listsum.Nil listsum.Cons |
119 lemmas listsum_append = listsum.append |
119 lemmas listsum_append = listsum.append |
120 lemmas listsum_rev = listsum.rev |
120 lemmas listsum_rev = listsum.rev |
121 |
121 |
122 lemma (in monoid_add) fold_plus_listsum_rev: |
122 lemma (in monoid_add) fold_plus_listsum_rev: |
188 |
188 |
189 lemma (in monoid_add) listsum_0 [simp]: |
189 lemma (in monoid_add) listsum_0 [simp]: |
190 "(\<Sum>x\<leftarrow>xs. 0) = 0" |
190 "(\<Sum>x\<leftarrow>xs. 0) = 0" |
191 by (induct xs) (simp_all add: distrib_right) |
191 by (induct xs) (simp_all add: distrib_right) |
192 |
192 |
193 text{* For non-Abelian groups @{text xs} needs to be reversed on one side: *} |
193 text\<open>For non-Abelian groups @{text xs} needs to be reversed on one side:\<close> |
194 lemma (in ab_group_add) uminus_listsum_map: |
194 lemma (in ab_group_add) uminus_listsum_map: |
195 "- listsum (map f xs) = listsum (map (uminus \<circ> f) xs)" |
195 "- listsum (map f xs) = listsum (map (uminus \<circ> f) xs)" |
196 by (induct xs) simp_all |
196 by (induct xs) simp_all |
197 |
197 |
198 lemma (in comm_monoid_add) listsum_addf: |
198 lemma (in comm_monoid_add) listsum_addf: |
230 |
230 |
231 lemma (in monoid_add) interv_listsum_conv_setsum_set_int: |
231 lemma (in monoid_add) interv_listsum_conv_setsum_set_int: |
232 "listsum (map f [k..l]) = setsum f (set [k..l])" |
232 "listsum (map f [k..l]) = setsum f (set [k..l])" |
233 by (simp add: listsum_distinct_conv_setsum_set) |
233 by (simp add: listsum_distinct_conv_setsum_set) |
234 |
234 |
235 text {* General equivalence between @{const listsum} and @{const setsum} *} |
235 text \<open>General equivalence between @{const listsum} and @{const setsum}\<close> |
236 lemma (in monoid_add) listsum_setsum_nth: |
236 lemma (in monoid_add) listsum_setsum_nth: |
237 "listsum xs = (\<Sum> i = 0 ..< length xs. xs ! i)" |
237 "listsum xs = (\<Sum> i = 0 ..< length xs. xs ! i)" |
238 using interv_listsum_conv_setsum_set_nat [of "op ! xs" 0 "length xs"] by (simp add: map_nth) |
238 using interv_listsum_conv_setsum_set_nat [of "op ! xs" 0 "length xs"] by (simp add: map_nth) |
239 |
239 |
240 lemma listsum_map_eq_setsum_count: |
240 lemma listsum_map_eq_setsum_count: |
243 case (Cons x xs) |
243 case (Cons x xs) |
244 show ?case (is "?l = ?r") |
244 show ?case (is "?l = ?r") |
245 proof cases |
245 proof cases |
246 assume "x \<in> set xs" |
246 assume "x \<in> set xs" |
247 have "?l = f x + (\<Sum>x\<in>set xs. count_list xs x * f x)" by (simp add: Cons.IH) |
247 have "?l = f x + (\<Sum>x\<in>set xs. count_list xs x * f x)" by (simp add: Cons.IH) |
248 also have "set xs = insert x (set xs - {x})" using `x \<in> set xs`by blast |
248 also have "set xs = insert x (set xs - {x})" using \<open>x \<in> set xs\<close>by blast |
249 also have "f x + (\<Sum>x\<in>insert x (set xs - {x}). count_list xs x * f x) = ?r" |
249 also have "f x + (\<Sum>x\<in>insert x (set xs - {x}). count_list xs x * f x) = ?r" |
250 by (simp add: setsum.insert_remove eq_commute) |
250 by (simp add: setsum.insert_remove eq_commute) |
251 finally show ?thesis . |
251 finally show ?thesis . |
252 next |
252 next |
253 assume "x \<notin> set xs" |
253 assume "x \<notin> set xs" |
254 hence "\<And>xa. xa \<in> set xs \<Longrightarrow> x \<noteq> xa" by blast |
254 hence "\<And>xa. xa \<in> set xs \<Longrightarrow> x \<noteq> xa" by blast |
255 thus ?thesis by (simp add: Cons.IH `x \<notin> set xs`) |
255 thus ?thesis by (simp add: Cons.IH \<open>x \<notin> set xs\<close>) |
256 qed |
256 qed |
257 qed simp |
257 qed simp |
258 |
258 |
259 lemma listsum_map_eq_setsum_count2: |
259 lemma listsum_map_eq_setsum_count2: |
260 assumes "set xs \<subseteq> X" "finite X" |
260 assumes "set xs \<subseteq> X" "finite X" |
268 by(simp add: setsum.union_disjoint[OF _ _ Diff_disjoint] del: Un_Diff_cancel) |
268 by(simp add: setsum.union_disjoint[OF _ _ Diff_disjoint] del: Un_Diff_cancel) |
269 finally show ?thesis by(simp add:listsum_map_eq_setsum_count) |
269 finally show ?thesis by(simp add:listsum_map_eq_setsum_count) |
270 qed |
270 qed |
271 |
271 |
272 |
272 |
273 subsection {* Further facts about @{const List.n_lists} *} |
273 subsection \<open>Further facts about @{const List.n_lists}\<close> |
274 |
274 |
275 lemma length_n_lists: "length (List.n_lists n xs) = length xs ^ n" |
275 lemma length_n_lists: "length (List.n_lists n xs) = length xs ^ n" |
276 by (induct n) (auto simp add: comp_def length_concat listsum_triv) |
276 by (induct n) (auto simp add: comp_def length_concat listsum_triv) |
277 |
277 |
278 lemma distinct_n_lists: |
278 lemma distinct_n_lists: |
296 finally show "card (set (List.n_lists n xs)) = length (List.n_lists n xs)" |
296 finally show "card (set (List.n_lists n xs)) = length (List.n_lists n xs)" |
297 by (simp add: length_n_lists) |
297 by (simp add: length_n_lists) |
298 qed |
298 qed |
299 |
299 |
300 |
300 |
301 subsection {* Tools setup *} |
301 subsection \<open>Tools setup\<close> |
302 |
302 |
303 lemmas setsum_code = setsum.set_conv_list |
303 lemmas setsum_code = setsum.set_conv_list |
304 |
304 |
305 lemma setsum_set_upto_conv_listsum_int [code_unfold]: |
305 lemma setsum_set_upto_conv_listsum_int [code_unfold]: |
306 "setsum f (set [i..j::int]) = listsum (map f [i..j])" |
306 "setsum f (set [i..j::int]) = listsum (map f [i..j])" |
368 from setprod_def show "comm_monoid_set.F times 1 = setprod" by rule |
368 from setprod_def show "comm_monoid_set.F times 1 = setprod" by rule |
369 qed |
369 qed |
370 |
370 |
371 end |
371 end |
372 |
372 |
373 text {* Some syntactic sugar: *} |
373 text \<open>Some syntactic sugar:\<close> |
374 |
374 |
375 syntax |
375 syntax |
376 "_listprod" :: "pttrn => 'a list => 'b => 'b" ("(3PROD _<-_. _)" [0, 51, 10] 10) |
376 "_listprod" :: "pttrn => 'a list => 'b => 'b" ("(3PROD _<-_. _)" [0, 51, 10] 10) |
377 syntax (xsymbols) |
377 syntax (xsymbols) |
378 "_listprod" :: "pttrn => 'a list => 'b => 'b" ("(3\<Prod>_\<leftarrow>_. _)" [0, 51, 10] 10) |
378 "_listprod" :: "pttrn => 'a list => 'b => 'b" ("(3\<Prod>_\<leftarrow>_. _)" [0, 51, 10] 10) |
379 syntax (HTML output) |
379 syntax (HTML output) |
380 "_listprod" :: "pttrn => 'a list => 'b => 'b" ("(3\<Prod>_\<leftarrow>_. _)" [0, 51, 10] 10) |
380 "_listprod" :: "pttrn => 'a list => 'b => 'b" ("(3\<Prod>_\<leftarrow>_. _)" [0, 51, 10] 10) |
381 |
381 |
382 translations -- {* Beware of argument permutation! *} |
382 translations -- \<open>Beware of argument permutation!\<close> |
383 "PROD x<-xs. b" == "CONST listprod (CONST map (%x. b) xs)" |
383 "PROD x<-xs. b" == "CONST listprod (CONST map (%x. b) xs)" |
384 "\<Prod>x\<leftarrow>xs. b" == "CONST listprod (CONST map (%x. b) xs)" |
384 "\<Prod>x\<leftarrow>xs. b" == "CONST listprod (CONST map (%x. b) xs)" |
385 |
385 |
386 end |
386 end |