880 unfolding pair_pmf_def set_bind_pmf set_return_pmf by auto |
880 unfolding pair_pmf_def set_bind_pmf set_return_pmf by auto |
881 |
881 |
882 lemma measure_pmf_in_subprob_space[measurable (raw)]: |
882 lemma measure_pmf_in_subprob_space[measurable (raw)]: |
883 "measure_pmf M \<in> space (subprob_algebra (count_space UNIV))" |
883 "measure_pmf M \<in> space (subprob_algebra (count_space UNIV))" |
884 by (simp add: space_subprob_algebra) intro_locales |
884 by (simp add: space_subprob_algebra) intro_locales |
|
885 |
|
886 lemma nn_integral_pair_pmf': "(\<integral>\<^sup>+x. f x \<partial>pair_pmf A B) = (\<integral>\<^sup>+a. \<integral>\<^sup>+b. f (a, b) \<partial>B \<partial>A)" |
|
887 proof - |
|
888 have "(\<integral>\<^sup>+x. f x \<partial>pair_pmf A B) = (\<integral>\<^sup>+x. max 0 (f x) * indicator (A \<times> B) x \<partial>pair_pmf A B)" |
|
889 by (subst nn_integral_max_0[symmetric]) |
|
890 (auto simp: AE_measure_pmf_iff set_pair_pmf intro!: nn_integral_cong_AE) |
|
891 also have "\<dots> = (\<integral>\<^sup>+a. \<integral>\<^sup>+b. max 0 (f (a, b)) * indicator (A \<times> B) (a, b) \<partial>B \<partial>A)" |
|
892 by (simp add: pair_pmf_def) |
|
893 also have "\<dots> = (\<integral>\<^sup>+a. \<integral>\<^sup>+b. max 0 (f (a, b)) \<partial>B \<partial>A)" |
|
894 by (auto intro!: nn_integral_cong_AE simp: AE_measure_pmf_iff) |
|
895 finally show ?thesis |
|
896 unfolding nn_integral_max_0 . |
|
897 qed |
|
898 |
|
899 lemma pair_map_pmf1: "pair_pmf (map_pmf f A) B = map_pmf (apfst f) (pair_pmf A B)" |
|
900 proof (safe intro!: pmf_eqI) |
|
901 fix a :: "'a" and b :: "'b" |
|
902 have [simp]: "\<And>c d. indicator (apfst f -` {(a, b)}) (c, d) = indicator (f -` {a}) c * (indicator {b} d::ereal)" |
|
903 by (auto split: split_indicator) |
|
904 |
|
905 have "ereal (pmf (pair_pmf (map_pmf f A) B) (a, b)) = |
|
906 ereal (pmf (map_pmf (apfst f) (pair_pmf A B)) (a, b))" |
|
907 unfolding pmf_pair ereal_pmf_map |
|
908 by (simp add: nn_integral_pair_pmf' max_def emeasure_pmf_single nn_integral_multc pmf_nonneg |
|
909 emeasure_map_pmf[symmetric] del: emeasure_map_pmf) |
|
910 then show "pmf (pair_pmf (map_pmf f A) B) (a, b) = pmf (map_pmf (apfst f) (pair_pmf A B)) (a, b)" |
|
911 by simp |
|
912 qed |
|
913 |
|
914 lemma pair_map_pmf2: "pair_pmf A (map_pmf f B) = map_pmf (apsnd f) (pair_pmf A B)" |
|
915 proof (safe intro!: pmf_eqI) |
|
916 fix a :: "'a" and b :: "'b" |
|
917 have [simp]: "\<And>c d. indicator (apsnd f -` {(a, b)}) (c, d) = indicator {a} c * (indicator (f -` {b}) d::ereal)" |
|
918 by (auto split: split_indicator) |
|
919 |
|
920 have "ereal (pmf (pair_pmf A (map_pmf f B)) (a, b)) = |
|
921 ereal (pmf (map_pmf (apsnd f) (pair_pmf A B)) (a, b))" |
|
922 unfolding pmf_pair ereal_pmf_map |
|
923 by (simp add: nn_integral_pair_pmf' max_def emeasure_pmf_single nn_integral_cmult nn_integral_multc pmf_nonneg |
|
924 emeasure_map_pmf[symmetric] del: emeasure_map_pmf) |
|
925 then show "pmf (pair_pmf A (map_pmf f B)) (a, b) = pmf (map_pmf (apsnd f) (pair_pmf A B)) (a, b)" |
|
926 by simp |
|
927 qed |
|
928 |
|
929 lemma map_pair: "map_pmf (\<lambda>(a, b). (f a, g b)) (pair_pmf A B) = pair_pmf (map_pmf f A) (map_pmf g B)" |
|
930 by (simp add: pair_map_pmf2 pair_map_pmf1 map_pmf_comp split_beta') |
885 |
931 |
886 lemma bind_pair_pmf: |
932 lemma bind_pair_pmf: |
887 assumes M[measurable]: "M \<in> measurable (count_space UNIV \<Otimes>\<^sub>M count_space UNIV) (subprob_algebra N)" |
933 assumes M[measurable]: "M \<in> measurable (count_space UNIV \<Otimes>\<^sub>M count_space UNIV) (subprob_algebra N)" |
888 shows "measure_pmf (pair_pmf A B) \<guillemotright>= M = (measure_pmf A \<guillemotright>= (\<lambda>x. measure_pmf B \<guillemotright>= (\<lambda>y. M (x, y))))" |
934 shows "measure_pmf (pair_pmf A B) \<guillemotright>= M = (measure_pmf A \<guillemotright>= (\<lambda>x. measure_pmf B \<guillemotright>= (\<lambda>y. M (x, y))))" |
889 (is "?L = ?R") |
935 (is "?L = ?R") |
1382 qed } |
1428 qed } |
1383 then show "rel_pmf R OO rel_pmf S \<le> rel_pmf (R OO S)" |
1429 then show "rel_pmf R OO rel_pmf S \<le> rel_pmf (R OO S)" |
1384 by(auto simp add: le_fun_def) |
1430 by(auto simp add: le_fun_def) |
1385 qed (fact natLeq_card_order natLeq_cinfinite)+ |
1431 qed (fact natLeq_card_order natLeq_cinfinite)+ |
1386 |
1432 |
|
1433 lemma rel_pmf_return_pmf1: "rel_pmf R (return_pmf x) M \<longleftrightarrow> (\<forall>a\<in>M. R x a)" |
|
1434 proof safe |
|
1435 fix a assume "a \<in> M" "rel_pmf R (return_pmf x) M" |
|
1436 then obtain pq where *: "\<And>a b. (a, b) \<in> set_pmf pq \<Longrightarrow> R a b" |
|
1437 and eq: "return_pmf x = map_pmf fst pq" "M = map_pmf snd pq" |
|
1438 by (force elim: rel_pmf.cases) |
|
1439 moreover have "set_pmf (return_pmf x) = {x}" |
|
1440 by (simp add: set_return_pmf) |
|
1441 with `a \<in> M` have "(x, a) \<in> pq" |
|
1442 by (force simp: eq set_map_pmf) |
|
1443 with * show "R x a" |
|
1444 by auto |
|
1445 qed (auto intro!: rel_pmf.intros[where pq="pair_pmf (return_pmf x) M"] |
|
1446 simp: map_fst_pair_pmf map_snd_pair_pmf set_pair_pmf set_return_pmf) |
|
1447 |
|
1448 lemma rel_pmf_return_pmf2: "rel_pmf R M (return_pmf x) \<longleftrightarrow> (\<forall>a\<in>M. R a x)" |
|
1449 by (subst pmf.rel_flip[symmetric]) (simp add: rel_pmf_return_pmf1) |
|
1450 |
|
1451 lemma rel_pmf_rel_prod: |
|
1452 "rel_pmf (rel_prod R S) (pair_pmf A A') (pair_pmf B B') \<longleftrightarrow> rel_pmf R A B \<and> rel_pmf S A' B'" |
|
1453 proof safe |
|
1454 assume "rel_pmf (rel_prod R S) (pair_pmf A A') (pair_pmf B B')" |
|
1455 then obtain pq where pq: "\<And>a b c d. ((a, c), (b, d)) \<in> set_pmf pq \<Longrightarrow> R a b \<and> S c d" |
|
1456 and eq: "map_pmf fst pq = pair_pmf A A'" "map_pmf snd pq = pair_pmf B B'" |
|
1457 by (force elim: rel_pmf.cases) |
|
1458 show "rel_pmf R A B" |
|
1459 proof (rule rel_pmf.intros) |
|
1460 let ?f = "\<lambda>(a, b). (fst a, fst b)" |
|
1461 have [simp]: "(\<lambda>x. fst (?f x)) = fst o fst" "(\<lambda>x. snd (?f x)) = fst o snd" |
|
1462 by auto |
|
1463 |
|
1464 show "map_pmf fst (map_pmf ?f pq) = A" |
|
1465 by (simp add: map_pmf_comp pmf.map_comp[symmetric] eq map_fst_pair_pmf) |
|
1466 show "map_pmf snd (map_pmf ?f pq) = B" |
|
1467 by (simp add: map_pmf_comp pmf.map_comp[symmetric] eq map_fst_pair_pmf) |
|
1468 |
|
1469 fix a b assume "(a, b) \<in> set_pmf (map_pmf ?f pq)" |
|
1470 then obtain c d where "((a, c), (b, d)) \<in> set_pmf pq" |
|
1471 by (auto simp: set_map_pmf) |
|
1472 from pq[OF this] show "R a b" .. |
|
1473 qed |
|
1474 show "rel_pmf S A' B'" |
|
1475 proof (rule rel_pmf.intros) |
|
1476 let ?f = "\<lambda>(a, b). (snd a, snd b)" |
|
1477 have [simp]: "(\<lambda>x. fst (?f x)) = snd o fst" "(\<lambda>x. snd (?f x)) = snd o snd" |
|
1478 by auto |
|
1479 |
|
1480 show "map_pmf fst (map_pmf ?f pq) = A'" |
|
1481 by (simp add: map_pmf_comp pmf.map_comp[symmetric] eq map_snd_pair_pmf) |
|
1482 show "map_pmf snd (map_pmf ?f pq) = B'" |
|
1483 by (simp add: map_pmf_comp pmf.map_comp[symmetric] eq map_snd_pair_pmf) |
|
1484 |
|
1485 fix c d assume "(c, d) \<in> set_pmf (map_pmf ?f pq)" |
|
1486 then obtain a b where "((a, c), (b, d)) \<in> set_pmf pq" |
|
1487 by (auto simp: set_map_pmf) |
|
1488 from pq[OF this] show "S c d" .. |
|
1489 qed |
|
1490 next |
|
1491 assume "rel_pmf R A B" "rel_pmf S A' B'" |
|
1492 then obtain Rpq Spq |
|
1493 where Rpq: "\<And>a b. (a, b) \<in> set_pmf Rpq \<Longrightarrow> R a b" |
|
1494 "map_pmf fst Rpq = A" "map_pmf snd Rpq = B" |
|
1495 and Spq: "\<And>a b. (a, b) \<in> set_pmf Spq \<Longrightarrow> S a b" |
|
1496 "map_pmf fst Spq = A'" "map_pmf snd Spq = B'" |
|
1497 by (force elim: rel_pmf.cases) |
|
1498 |
|
1499 let ?f = "(\<lambda>((a, c), (b, d)). ((a, b), (c, d)))" |
|
1500 let ?pq = "map_pmf ?f (pair_pmf Rpq Spq)" |
|
1501 have [simp]: "(\<lambda>x. fst (?f x)) = (\<lambda>(a, b). (fst a, fst b))" "(\<lambda>x. snd (?f x)) = (\<lambda>(a, b). (snd a, snd b))" |
|
1502 by auto |
|
1503 |
|
1504 show "rel_pmf (rel_prod R S) (pair_pmf A A') (pair_pmf B B')" |
|
1505 by (rule rel_pmf.intros[where pq="?pq"]) |
|
1506 (auto simp: map_snd_pair_pmf map_fst_pair_pmf set_pair_pmf set_map_pmf map_pmf_comp Rpq Spq |
|
1507 map_pair) |
|
1508 qed |
|
1509 |
1387 end |
1510 end |
1388 |
1511 |