-
Notifications
You must be signed in to change notification settings - Fork 0
/
HW2.nb
2011 lines (1887 loc) · 77.2 KB
/
HW2.nb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(* Content-type: application/vnd.wolfram.mathematica *)
(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)
(* CreatedBy='Mathematica 10.2' *)
(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[ 158, 7]
NotebookDataLength[ 78873, 2002]
NotebookOptionsPosition[ 73456, 1864]
NotebookOutlinePosition[ 73818, 1880]
CellTagsIndexPosition[ 73775, 1877]
WindowFrame->Normal*)
(* Beginning of Notebook Content *)
Notebook[{
Cell[CellGroupData[{
Cell["SDS 384.7 HW2", "Title",
CellChangeTimes->{{3.682781015471445*^9, 3.682781024631447*^9}}],
Cell["Qi Chen(qc586)", "Author",
CellChangeTimes->{{3.682781032981227*^9, 3.682781038125985*^9}}],
Cell[CellGroupData[{
Cell["Problem 1", "Section",
CellChangeTimes->{{3.682781406300202*^9, 3.68278140915191*^9}}],
Cell[TextData[{
"Consider the Gamma prior distribution for a single (scalar) parameter ",
Cell[BoxData[
FormBox["\[Theta]", TraditionalForm]], "None",
FormatType->"TraditionalForm"],
", given on pages 33 of the Text by CJBH. Assume that ",
Cell[BoxData[
FormBox[
RowBox[{"a", "=", "2.3"}], TraditionalForm]],
FormatType->"TraditionalForm"],
" and ",
Cell[BoxData[
FormBox[
RowBox[{"b", "=", "9.8"}], TraditionalForm]],
FormatType->"TraditionalForm"],
" are the hyper-parameters of this distribution. Let ",
Cell[BoxData[
FormBox[
RowBox[{
SubscriptBox["\[Tau]", "1"], "=",
RowBox[{"log", "(", "\[Theta]", ")"}]}], TraditionalForm]],
FormatType->"TraditionalForm"],
". ",
"State (NOT prove /derive) the answers, and provide the necessary R-code, \
for the following questions:"
}], "TextNoIndent",
CellChangeTimes->{{3.68278141521681*^9, 3.682781485828392*^9}}],
Cell[TextData[{
"The support,or the set of ",
Cell[BoxData[
FormBox[
RowBox[{"values", ",",
SubscriptBox["S", "\[Theta]"]}], TraditionalForm]],
FormatType->"TraditionalForm"],
",that ",
Cell[BoxData[
FormBox["\[Theta]", TraditionalForm]],
FormatType->"TraditionalForm"],
" can possibly take"
}], "Item",
CellChangeTimes->{{3.682782476452744*^9, 3.682782508780572*^9}}],
Cell["Solution: The support is given by", "TextNoIndent",
CellChangeTimes->{{3.682782224779746*^9, 3.682782241045129*^9}, {
3.682782832228788*^9, 3.682782845038754*^9}}],
Cell[BoxData[
FormBox[
RowBox[{" ",
RowBox[{
FormBox[
RowBox[{
RowBox[{
SubscriptBox["I",
RowBox[{"(",
RowBox[{"0", ",", "\[Infinity]"}], ")"}]], "(", "\[Theta]", ")"}],
"=",
RowBox[{"{",
RowBox[{
RowBox[{"1", " ", "for", " ", "0"}], "<", "y", "<", "\[Infinity]"}],
"}"}]}],
TraditionalForm], "."}]}], TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682782522913541*^9, 3.682782572759643*^9}, {
3.682782837944314*^9, 3.682782850674656*^9}}],
Cell[TextData[{
"Is ",
Cell[BoxData[
FormBox["\[Theta]", TraditionalForm]],
FormatType->"TraditionalForm"],
" a discrete or continuous random variable?"
}], "Item",
CellChangeTimes->{{3.682782581720634*^9, 3.682782586227131*^9}}],
Cell["Solution: \[Theta] is a continuous random variable in the support.", \
"TextNoIndent",
CellChangeTimes->{{3.68278285736832*^9, 3.682782859222801*^9}, {
3.6827829022632027`*^9, 3.6827829471983624`*^9}}],
Cell[TextData[{
"Fill the blank: ",
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{
SubscriptBox["p", "1"], "(", "\[Theta]", ")"}], "="}], TraditionalForm]],
FormatType->"TraditionalForm"]
}], "Item",
CellChangeTimes->{{3.682782667596005*^9, 3.682782681153109*^9}}],
Cell["Solution: The Gamma prior distribution is given by", "TextNoIndent",
CellChangeTimes->{{3.682782862896891*^9, 3.682782864649007*^9}, {
3.682782921907105*^9, 3.6827829224360933`*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{
SubscriptBox["p", "1"], "(", "\[Theta]", ")"}], "=",
RowBox[{
RowBox[{"[",
RowBox[{
SuperscriptBox["b", "2.3"], "/",
RowBox[{"\[CapitalGamma]", "(", "a", ")"}]}], "]"}],
SuperscriptBox["\[Theta]", "1.3"],
SuperscriptBox["\[ExponentialE]",
RowBox[{
RowBox[{"-", "9.8"}], " ", "\[Theta]"}]],
RowBox[{
SubscriptBox["I",
RowBox[{"(",
RowBox[{"0", ",", "\[Infinity]"}], ")"}]], "(", "\[Theta]", ")"}]}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682782254060851*^9, 3.6827822967323112`*^9}, {
3.682789963575543*^9, 3.682789974133644*^9}}],
Cell[TextData[{
"The normalizing constant of ",
Cell[BoxData[
FormBox[
RowBox[{
SubscriptBox["p", "1"], "(", "\[Theta]", ")"}], TraditionalForm]],
FormatType->"TraditionalForm"]
}], "Item",
CellChangeTimes->{{3.6827827911148643`*^9, 3.682782803904948*^9}}],
Cell["Solution: The normalizing constant is given by", "TextNoIndent",
CellChangeTimes->{{3.6827828865214577`*^9, 3.682782888772011*^9}, {
3.682782955544825*^9, 3.682782962152452*^9}}],
Cell[BoxData[
FormBox[
RowBox[{"C", "=",
RowBox[{
RowBox[{"[",
RowBox[{
SuperscriptBox["b", "a"], "/",
RowBox[{"\[CapitalGamma]", "(", "a", ")"}]}], "]"}], "=",
RowBox[{
RowBox[{
SuperscriptBox["9.8", "2.3"], "/",
RowBox[{"\[CapitalGamma]", "(", "2.3", ")"}]}], "=",
"163.25118584248568`"}]}]}], TraditionalForm]], "DisplayFormulaNumbered",\
CellChangeTimes->{{3.682782892726246*^9, 3.682782897117866*^9}, {
3.6827899825839567`*^9, 3.68279001934409*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{
SuperscriptBox["9.8", "2.3"], "/",
RowBox[{"Gamma", "[", "2.3", "]"}]}]], "Input",
CellChangeTimes->{{3.682790002713801*^9, 3.682790013146924*^9}}],
Cell[BoxData["163.25118584248568`"], "Output",
CellChangeTimes->{{3.682790006065399*^9, 3.682790013616005*^9}}]
}, Open ]],
Cell[TextData[{
"The kernel of ",
Cell[BoxData[
FormBox[
RowBox[{
SubscriptBox["p", "1"], "(", "\[Theta]", ")"}], TraditionalForm]],
FormatType->"TraditionalForm"]
}], "Item",
CellChangeTimes->{{3.682782965574692*^9, 3.682782973359763*^9}}],
Cell["Solution: The kernel is given by", "TextNoIndent",
CellChangeTimes->{{3.682782827230051*^9, 3.682782833731739*^9},
3.682782900761221*^9, {3.682782980097431*^9, 3.682782985576497*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"K", "(", "\[Theta]", ")"}], "=",
RowBox[{
SuperscriptBox["\[Theta]", "1.3"],
SuperscriptBox["\[ExponentialE]",
RowBox[{
RowBox[{"-", "9.8"}], " ", "\[Theta]"}]]}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682782989941442*^9, 3.682783000146659*^9}, {
3.6827900281243963`*^9, 3.682790035573497*^9}}],
Cell[TextData[{
"The prior mean of ",
Cell[BoxData[
FormBox["\[Theta]", TraditionalForm]],
FormatType->"TraditionalForm"]
}], "Item",
CellChangeTimes->{{3.682783015224708*^9, 3.6827830230292273`*^9}}],
Cell["Solution: ", "TextNoIndent",
CellChangeTimes->{{3.682783027109651*^9, 3.682783029067175*^9}, {
3.682783212630006*^9, 3.682783214788727*^9}, {3.682790041767728*^9,
3.6827900438190928`*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"E", "(", "\[Theta]", ")"}], "=",
RowBox[{
RowBox[{"a", "/", "b"}], "=",
RowBox[{
RowBox[{"2.3", "/", "9.8"}], "=", "0.23469387755102036`"}]}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682790047400175*^9, 3.682790079597628*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
FormBox[
RowBox[{"2.3", "/", "9.8"}], TraditionalForm]], "Input"],
Cell[BoxData["0.23469387755102036`"], "Output",
CellChangeTimes->{3.682790075489771*^9}]
}, Open ]],
Cell[TextData[{
"The prior variance of ",
Cell[BoxData[
FormBox["\[Theta]", TraditionalForm]],
FormatType->"TraditionalForm"]
}], "Item",
CellChangeTimes->{{3.682783117685845*^9, 3.682783123562552*^9}}],
Cell["Solution: ", "TextNoIndent",
CellChangeTimes->{{3.682783027109651*^9, 3.682783029067175*^9}, {
3.682783212630006*^9, 3.682783214788727*^9}, {3.6827900870314283`*^9,
3.682790088751112*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"Var", "(", "\[Theta]", ")"}], "=",
RowBox[{
FractionBox["a",
SuperscriptBox["b", "2"]], "=",
RowBox[{
RowBox[{"2.3", "/",
SuperscriptBox["9.8", "2"]}], "=", "0.023948354852144933`"}]}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682790092008192*^9, 3.682790124156528*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
FormBox[
RowBox[{"2.3", "/",
SuperscriptBox["9.8", "2"]}], TraditionalForm]], "Input"],
Cell[BoxData["0.023948354852144933`"], "Output",
CellChangeTimes->{3.6827901180996523`*^9}]
}, Open ]],
Cell[TextData[{
"The prior precision, defined as the reciprocal of the variance, of ",
Cell[BoxData[
FormBox["\[Theta]", TraditionalForm]],
FormatType->"TraditionalForm"]
}], "Item",
CellChangeTimes->{{3.682783127429081*^9, 3.6827831501977262`*^9}}],
Cell["Solution:", "TextNoIndent",
CellChangeTimes->{{3.682783027109651*^9, 3.682783029067175*^9}, {
3.682783212630006*^9, 3.682783214788727*^9}, {3.682790354989635*^9,
3.682790357395082*^9}}],
Cell[BoxData[
FormBox[
RowBox[{"precision", "=",
RowBox[{
FractionBox["1",
RowBox[{"Var", "(", "\[Theta]", ")"}]], "=",
RowBox[{
FractionBox[
SuperscriptBox["b", "2"], "a"], "=", "41.75652173913045`"}]}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682790362216414*^9, 3.682790390503922*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
FormBox[
RowBox[{
SuperscriptBox["9.8", "2"], "/", "2.3"}], TraditionalForm]], "Input",
CellChangeTimes->{{3.6827903834414*^9, 3.68279038505378*^9}}],
Cell[BoxData["41.75652173913045`"], "Output",
CellChangeTimes->{3.682790385745592*^9}]
}, Open ]],
Cell["The prior standard deviation of \[Theta]", "Item",
CellChangeTimes->{{3.682783166753415*^9, 3.682783176550782*^9}}],
Cell["Solution:", "TextNoIndent",
CellChangeTimes->{{3.682783027109651*^9, 3.682783029067175*^9}, {
3.682783212630006*^9, 3.682783214788727*^9}, {3.682790405646612*^9,
3.682790408158248*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"\[Sigma]", "(", "\[Theta]", ")"}], "=",
RowBox[{
SqrtBox[
RowBox[{"Var", "(", "\[Theta]", ")"}]], "=",
RowBox[{
SqrtBox[
RowBox[{"2.3", "/",
SuperscriptBox["9.8", "2"]}]], "=", "0.15475256008268468`"}]}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.6827904114773703`*^9, 3.682790439110014*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
FormBox[
SqrtBox[
RowBox[{"2.3", "/",
SuperscriptBox["9.8", "2"]}]], TraditionalForm]], "Input"],
Cell[BoxData["0.15475256008268468`"], "Output",
CellChangeTimes->{3.682790434966703*^9}]
}, Open ]],
Cell[TextData[{
"The prior mode of ",
Cell[BoxData[
FormBox["\[Theta]", TraditionalForm]],
FormatType->"TraditionalForm"]
}], "Item",
CellChangeTimes->{{3.6827831822603483`*^9, 3.682783187668195*^9}}],
Cell["Solution: ", "TextNoIndent",
CellChangeTimes->{{3.682783027109651*^9, 3.682783029067175*^9}, {
3.682783212630006*^9, 3.682783214788727*^9}, {3.682790624384219*^9,
3.6827906348055477`*^9}}],
Cell[BoxData[
FormBox[
RowBox[{"Mode", "=",
RowBox[{
RowBox[{
RowBox[{"(",
RowBox[{"a", "-", "1"}], ")"}], "/", "b"}], "=",
RowBox[{
RowBox[{"1.3", "/", "9.8"}], "=", "0.13265306122448978`"}]}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.6827906386563997`*^9, 3.682790658029614*^9}}],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"1.3", "/", "9.8"}]], "Input",
CellChangeTimes->{{3.682790651953722*^9, 3.6827906538624496`*^9}}],
Cell[BoxData["0.13265306122448978`"], "Output",
CellChangeTimes->{3.682790654358498*^9}]
}, Open ]],
Cell["\<\
Use the R-function gamma to compute the value of the normalizing constant.\
\>", "Item",
CellChangeTimes->{3.6827876249942093`*^9}],
Cell["Solution: ", "TextNoIndent",
CellChangeTimes->{
3.682787893102901*^9, {3.682791454843566*^9, 3.682791456000227*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"C", " ",
RowBox[{
SubsuperscriptBox["\[Integral]", "0", "\[Infinity]"],
RowBox[{
SuperscriptBox["\[Theta]", "1.3"],
SuperscriptBox["\[ExponentialE]",
RowBox[{
RowBox[{"-", "9.8"}], " ", "\[Theta]"}]],
RowBox[{"\[DifferentialD]", "\[Theta]"}]}]}]}], "=",
RowBox[{
RowBox[{"1", "\[Implies]",
RowBox[{
FractionBox["C",
SuperscriptBox["9.8", "2"]], " ",
RowBox[{"\[CapitalGamma]", "(", "2.3", ")"}]}]}], "=",
RowBox[{
RowBox[{"1", "\[Implies]", "C"}], "=", "82.31681"}]}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682791458494478*^9, 3.6827914846437197`*^9}, {
3.682791527653257*^9, 3.6827915649865913`*^9}, {3.682791692473488*^9,
3.6827916973504963`*^9}}],
Cell["The R-code is as follows", "TextNoIndent",
CellChangeTimes->{{3.6827917007406*^9, 3.682791710407076*^9}}],
Cell[BoxData[
RowBox[{"c", "<",
RowBox[{
RowBox[{
RowBox[{"-",
RowBox[{"9.8", "^", "2"}]}], "/", "gamma"}],
RowBox[{"(", "2.3", ")"}]}]}]], "Code",
CellChangeTimes->{3.682791716178439*^9}],
Cell[TextData[{
"Use the R-function dgamma to compute the value of ",
Cell[BoxData[
FormBox[
RowBox[{
SubscriptBox["p", "1"], "(", "\[Theta]", ")"}], TraditionalForm]],
FormatType->"TraditionalForm"],
" for 3 values, 0.05, 0.2, and 4.5, of \[Theta]. Hint: In R, pass the values \
of the hyper-parameters by shape = 2.3, rate = 9.8."
}], "Item",
CellChangeTimes->{{3.682787634162047*^9, 3.682787678737278*^9}}],
Cell["Solution: The R-code is as follows", "TextNoIndent",
CellChangeTimes->{
3.6827878960100517`*^9, {3.682792031194868*^9, 3.682792037379489*^9}}],
Cell[BoxData[{
RowBox[{"v1", "=",
RowBox[{"dgamma",
RowBox[{"(",
RowBox[{"0.05", ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}]}], "\n",
RowBox[{"v2", "=",
RowBox[{"dgamma",
RowBox[{"(",
RowBox[{"0.2", ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}]}], "\n",
RowBox[{"v3", "=",
RowBox[{"dgamma",
RowBox[{"(",
RowBox[{"4.5", ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}],
")"}]}]}], "\n", "v1", "\n", "v2", "\n", "v3"}], "Code",
CellChangeTimes->{3.6827920419883842`*^9}],
Cell[BoxData[{
FormBox[
RowBox[{
RowBox[{
RowBox[{
SubscriptBox["p", "1"], "(", "0.05", ")"}], "=", "2.035697"}], ";"}],
TraditionalForm], "\[IndentingNewLine]",
FormBox[
RowBox[{
RowBox[{
RowBox[{
SubscriptBox["p", "1"], "(", "0.2", ")"}], "=", "2.837776"}], ";"}],
TraditionalForm], "\[IndentingNewLine]",
FormBox[
RowBox[{
RowBox[{
RowBox[{
SubscriptBox["p", "1"], "(", "4.5", ")"}], "=",
RowBox[{
RowBox[{"8.121682", "e"}], "-", "17"}]}], ";"}],
TraditionalForm]}], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682791891079331*^9, 3.682791911948278*^9}, {
3.6827920613376293`*^9, 3.68279207746056*^9}}],
Cell[TextData[{
"Use the R-function pgamma to compute the values of the prior probabilities,\
\n",
Cell[BoxData[
FormBox[
RowBox[{"P", " ",
RowBox[{"(",
RowBox[{"\[Theta]", " ", "\[LessEqual]", " ", "1.0"}], ")"}]}],
TraditionalForm]],
FormatType->"TraditionalForm"],
", ",
Cell[BoxData[
FormBox[
RowBox[{"P", " ",
RowBox[{"(",
RowBox[{"\[Theta]", " ", "\[LessEqual]", " ", "5.5"}], ")"}]}],
TraditionalForm]],
FormatType->"TraditionalForm"],
", and ",
Cell[BoxData[
FormBox[
RowBox[{"P", "(",
RowBox[{
"1.0", " ", "<", " ", "\[Theta]", " ", "\[LessEqual]", " ", "5.5"}],
")"}], TraditionalForm]],
FormatType->"TraditionalForm"],
"."
}], "Item",
CellChangeTimes->{{3.682787690588875*^9, 3.682787746880319*^9}, {
3.682792341171373*^9, 3.682792341171633*^9}}],
Cell["Solution: The R-code is as follows", "TextNoIndent",
CellChangeTimes->{3.682787899454625*^9, 3.682792938791552*^9}],
Cell[BoxData[{
RowBox[{"pgamma",
RowBox[{"(",
RowBox[{"1.0", ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}], "\n",
RowBox[{"pgamma",
RowBox[{"(",
RowBox[{"5.5", ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}], "\n",
RowBox[{
RowBox[{"pgamma",
RowBox[{"(",
RowBox[{"5.5", ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}], "-",
RowBox[{"pgamma",
RowBox[{"(",
RowBox[{"1.0", ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}]}]}], "Code",
CellChangeTimes->{{3.682792954418741*^9, 3.6827929649133987`*^9}}],
Cell["The values are", "TextNoIndent",
CellChangeTimes->{{3.6827936046218452`*^9, 3.6827936065983267`*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"P", " ",
RowBox[{"(",
RowBox[{"\[Theta]", " ", "\[LessEqual]", " ", "1.0"}], ")"}]}], "=",
"0.9989502"}], TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682793620747861*^9, 3.682793627064149*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"P", " ",
RowBox[{"(",
RowBox[{"\[Theta]", " ", "\[LessEqual]", " ", "5.5"}], ")"}]}], "=",
"1"}], TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682793633108576*^9, 3.6827936387957973`*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"P", "(",
RowBox[{
"1.0", " ", "<", " ", "\[Theta]", " ", "\[LessEqual]", " ", "5.5"}],
")"}], "=", "0.001049784"}], TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682793649183466*^9, 3.682793655382798*^9}}],
Cell[TextData[{
"Use the R-function qgamma to compute the value of the ",
Cell[BoxData[
FormBox[
SuperscriptBox["2.5", "th"], TraditionalForm]],
FormatType->"TraditionalForm"],
", ",
Cell[BoxData[
FormBox[
SuperscriptBox["50", "th"], TraditionalForm]],
FormatType->"TraditionalForm"],
" and ",
Cell[BoxData[
FormBox[
SuperscriptBox["97.5", "th"], TraditionalForm]],
FormatType->"TraditionalForm"],
" percentiles of the prior distribution. Provide a 95% probability interval \
for ",
Cell[BoxData[
FormBox["\[Theta]", TraditionalForm]],
FormatType->"TraditionalForm"],
"."
}], "Item",
CellChangeTimes->{{3.682787763153284*^9, 3.682787809608946*^9}}],
Cell["Solution: The R-code is as follows", "TextNoIndent",
CellChangeTimes->{
3.682787902132443*^9, {3.6827935866657257`*^9, 3.682793591467462*^9}}],
Cell[BoxData[{
RowBox[{"qgamma",
RowBox[{"(",
RowBox[{
RowBox[{"2.5", "/", "100.0"}], ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}], "\n",
RowBox[{"qgamma",
RowBox[{"(",
RowBox[{
RowBox[{"50.0", "/", "100.0"}], ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}], "\n",
RowBox[{"qgamma",
RowBox[{"(",
RowBox[{
RowBox[{"97.5", "/", "100.0"}], ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}]}], "Code",
CellChangeTimes->{3.682793595477069*^9}],
Cell["The values are", "TextNoIndent",
CellChangeTimes->{{3.682793673832316*^9, 3.682793675802944*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
SubscriptBox["x", "0.025"], "=", "0.03492218"}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682793678964789*^9, 3.682793690725512*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
SubscriptBox["x", "0.5"], "=", "0.2016965"}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682793678964789*^9, 3.682793690725512*^9}, {
3.68279373608027*^9, 3.6827937460195217`*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
SubscriptBox["x", "0.975"], "=", "0.6207608"}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682793755359737*^9, 3.6827937652270737`*^9}}],
Cell["\<\
Use the R-function rgamma, and the seed 1379, to draw a Monte-Carlo pseudo- \
random sample of size 1000 from the prior distribution, and use those values \
to estimate the mean, and median of \[Theta].\
\>", "Item",
CellChangeTimes->{{3.682787817650516*^9, 3.6827878283086557`*^9}}],
Cell["Solution: The R-code is as follows", "TextNoIndent",
CellChangeTimes->{
3.6827879050895863`*^9, {3.6827942038367033`*^9, 3.682794208938147*^9}}],
Cell[BoxData[{
RowBox[{
RowBox[{"set", ".", "seed"}],
RowBox[{"(", "1379", ")"}]}], "\n",
RowBox[{"n", "=", "1000"}], "\n",
RowBox[{"y", "=",
RowBox[{"rgamma",
RowBox[{"(",
RowBox[{"n", ",",
RowBox[{"shape", "=", "2.3"}], ",",
RowBox[{"rate", "=", "9.8"}]}], ")"}]}]}], "\n",
RowBox[{"hist",
RowBox[{"(", "y", ")"}]}], "\n",
RowBox[{"mean",
RowBox[{"(", "y", ")"}]}], "\n",
RowBox[{"median",
RowBox[{"(", "y", ")"}]}]}], "Code",
CellChangeTimes->{3.682794214636339*^9}],
Cell["The estimates are as follows", "TextNoIndent",
CellChangeTimes->{{3.682794272691518*^9, 3.68279428172012*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"mean", "(", "\[Theta]", ")"}], "=",
RowBox[{
RowBox[{
FractionBox["1", "n"],
RowBox[{
UnderscriptBox["\[Sum]", "i"],
SubscriptBox["y", "i"]}]}], "=", "0.2301389"}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682794285623914*^9, 3.682794313557919*^9}, {
3.682794343911051*^9, 3.6827943460276937`*^9}}],
Cell[BoxData[
FormBox[
RowBox[{
RowBox[{"median", "(", "\[Theta]", ")"}], "=",
RowBox[{
RowBox[{"median", "(",
RowBox[{"{",
SubscriptBox["y", "i"], "}"}], ")"}], "=", "0.1980338"}]}],
TraditionalForm]], "DisplayFormulaNumbered",
CellChangeTimes->{{3.682794285623914*^9, 3.682794357214892*^9}}],
Cell["The histogram is as follows:", "TextNoIndent",
CellChangeTimes->{{3.682877884304091*^9, 3.682877890847062*^9}}],
Cell[BoxData[
GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJzt3Qm4TfX+x3HDKfNQplSGaCCXuKJCyFBUV06aCyFdpehyuKmTWypPXQpl
KF3kMWWom4oMJU1KZI6OWYhknjmc7/9+f561//vsM+x19s86a+9z3q/n+ZWz
9tp7/dY+Z+312es3rCs697z78Xx58uTpXfB//7m70z9v6dWrU792cf/7oVm/
hK6d8//vH6Py5slT8X/r6EIBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADIAfbv3y+33HKLKf37
9093nQceeMA8fu+99waW7d69O/C8sWPHRrz9s2fPysqVKyN+Ps5ZsmSJ3H77
7VK2bFmpUqWKPPzww35XCQCANDQ/5MmTx5T4+Ph016lYsaJ5/LLLLgss27p1
a+B5iYmJEW37+++/l7p163KOtHT48GG56KKLAr8PLc2bN/e7WgAApBFp7tiz
Z4+0adPGlEmTJkW0bWe75A47S5cuDbyXnTp1kl27dsnvv//ud7UAAEgj0twR
TnJysrkmsmnTJjl27Fi667jNHZpx9u7d62qbW7ZskZSUFNf1VNu3b0+z7MyZ
M7Jz505Zt26deY/cOH78uHlOqEOHDsmff/6ZpToFC7f/M2fODLyX06ZNi3g7
AAB4LdLc8dtvv0mRIkVMGTBgQKrXa9++vcTFxQVeN2/evNKiRQvzHKXfz/V5
zuO6rv789ttvB15Hz+FPP/20VKtWLbCebv+NN94wfUKC6brdunWTggULmvW0
zWHgwIFmXaeOjkWLFgWWffbZZ3L11Veb51SoUEH27dtn1tH9KVmyZKp2i8qV
K8uXX34ZeB091zuvs3r1arnrrrvkggsuMOteccUV8tNPP5kMov1f8ufPb96D
a6+9VlatWuXq9+J2/5s1ayYFChQIrKP/1jrNmTMnzWvqtp069+jRI9VjR48e
lYsvvtg8dt9997mqIwAAWRWcO+rXr2++L4eW0qVLu+7f0bhx40CWqFmzpil6
ztVleg7WaxF6Tg4+pzvlzTffNK9x4sQJk1PSW0fLnXfemWof9GfnsXz58knR
okUD9XWWO7777rvAsnLlygX+ff3115vHP/3008CywoULm3Ox87Pmil9//dWs
99FHHwWWly9f3mw3+PU0++j2dd9LlCgRWH755ZebTJGZrOz/TTfdlO46s2bN
Sve1r7vuOvO49j/VazqOqVOncs0EAOC54NwRroTLHdqnwFn27rvvBtadPHmy
1KlTRx599FHZvHmznDx5UjZs2BBYV/uI6M8HDhww6z/55JOBxzp06GDaOr79
9lvz3d5Z/t5775l1FyxYEFjWsGFDkwu0n6XWKbjujuDcoWXo0KHm2sXnn39u
Hn/kkUdM1rj11lvl9OnTJicNGzYssP6YMWPMesG549JLLw1cy3niiScCyzWv
aTuT5ogHH3wwsFyvj2QmK/v/xx9/mH8Hv+9aF91menR/nXW/+OKLwHIdq6TL
9DqP/n4AAPBCaO7Q7+2hxW3u0PO9tinosmLFiplz5vjx400/x/Rk1L/Dadcp
VapUqu/keg53nnPjjTeaZcH5YsqUKYF1NTM41z0yyh133HFHhu+LPl9pW8ng
wYMDz9F2DhWcOwYNGhR4XvB1g+eeey6wXPveOsv1mkpmsrL/6uOPPw4s//DD
DzN9be1n4rQHPf7442aZ9r/RazvBywAA8ML5Hkf7zDPPpLlOom0N2oaj1xWC
pZc79HpI8Hf9UNpuo49pptBrEcHXEUL7bv7tb3/LNHe8+OKL6e7vJ598Il26
dDF9PkL3RTOICs4dwXlHn+ssHzVqVGB5cDaYMWNGutuNZP9DXztc7lB33313
4HqM9sXV+jjP1/cHAACvnO/coefC6dOnS8uWLVP1d3SKPuZIL3fotRFneefO
ndPUpVatWoHrKbqthx56KLC+007jaNCgQaa5Q9scQgW3cej8Wz179pQRI0YE
ljl9UIJzx3//+9/A84P7h+i1D4fb3JHV/Q99bTe5I7iO8+bNM/PC6b+rVq0a
9rkAANg437lDvz9rHwu9dq99DHQMSHCfh3bt2gXWdZZpdgimY0d0eZkyZVKN
3QjeZnrtLMHtF3rtI7iNyBGcO0aOHJlquzt27Ag89thjjwWWL1++PE1WcZM7
gvtnus0dWd3/0Nd2kzv0d3TJJZcEMp/THpXR9R8AAM6X85k79HzqjJ/t27dv
YF2de+LCCy80y7X9wuH0M2jatKnJKM44Vm1fcF5bx8fqtpYtW2bmAXeWO/0q
f/nll8B4GT2XvvXWWyYH3HDDDamusziCc0dw31cV3Ef1n//8Z2B59+7dA8tf
eeUVs8zL3JGV/Q99bTe5Q/Xp08es77x3WjZu3OjquQAAROp85g7NDk7/Ay2V
KlWSm2++WQoVKmR+1uyxePHiwGsEz02h5z/ndbS9JDg3OH1VnaLn32C9evVK
056j81BUr149S7lD71XjjHnV+uiYYN2H4POztrsoL3NHVvc/ktyxdu3aVK+p
Y4EAAPDa+W5n0fYNnas7tG9H7dq1U43bVHpedjKJntc1Pzh0bIy+js534byG
Mx9Y8BgPh7Z/1KtXz4wD1b4lmm90/jIn7zgyyx1q7ty5Zlyss45uX/vD6v1O
9OerrrrKrOdl7sjq/keSO1RwtknvvQAAIFbotQ+dk0PvNRva3zOYzqGl82jq
XOIZ0bnPt23blu5juvybb74x/w89HzvziekcWVmh/R+SkpJMtooGme2/Dc2C
+v5oRszsdwQAAM7RfqvOd/Yrr7zSzHFx5MgRMw+Y018ydH7T3EzndtM8GNw2
FdqvFwAApE+vqzhjS9Mr2jdC+2TiHGfMrFP0Wof2zQUAAO7oXOEJCQlm/gnt
L6LjZ3XOL73OsWTJEr+rF1VeeuklM45I+7xof5j58+f7XSUAAGJaev1O8f90
vjFnzjEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgFnz99dfy1Vdf+VZ++eUXv98CAACQ
DSZOnCh58uSRJk2a+FZ0+9u2bfP7rQAAAB579dVXpV+/fr7WoVq1arJ27Vpf
6wAAALxH7gAAANmF3AEAALILuQMAAGQXcgcAAMgu5A4AAJBdyB0AACC7kDsA
AEB2IXcAAIDsQu4AAADZhdwBAID/lixZIgkJCWFLs2bNZNGiRX5XN2LkDgAA
/Ld69WoZNGhQ2FKxYkX59NNP/a5uxMgdAADEjhtvvFF++OEHv6sRMXIHAACx
g9xhj9wBAIA75A575A4AANwhd9gjdwAA4A65wx65AwAAd8gd9sgdAAC4Q+6w
R+4AAMAdcoc9cgcAAO6QO+yROwAAcIfcYY/cAQCAO+QOe+QOAADcIXfYI3cA
AOAOucMeuQMAAHfIHfbIHQAAuEPusEfuAADAHXKHPXIHAADukDvskTsAAHCH
3GGP3AEAgDvkDnvkDgBArElJSZE9e/bIvn37snW75A575A4AQCzYsWOH9O3b
VypVqiRxcXGSJ08eU4oXLy61atWSXr16yZEjRzytA7nDHrkDABDttm7dKpdf
frlUqFDB5Ivhw4fL5MmTZcqUKTJixAhJSEiQypUrm0yyceNGz+pB7rBH7gAA
RLvu3btLo0aN5OTJkxmuc/r0aWnevLn079/fs3qQO+yROwAA0a5hw4YyevTo
sOtNmDBB6tev71k9yB32yB0AgGjXp08f6dixY9j1OnXqJPHx8Z7Vg9xhj9wB
AIh2y5cvl0KFCkmrVq3MNY1FixZJUlKSbNiwQRYvXixTp06VNm3amP6mCxcu
9Kwe5A575A4AQCzQjNGsWTPJly9fYCxLcGnRooUsWLDA0zqQO+yROwAAseTU
qVMmg8yfP19mz54tK1askL1792bLtskd9sgdAIBYdezYMVm6dKmsX79ezpw5
4/n2yB32yB0AgGg3ePBgSUxMTLVs4MCBUqBAgUA7S9WqVWXu3Lme1oPcYY/c
AQCIdh06dJDWrVsHfh47dqzJGjpfx5gxY2TIkCFm/Kz2PdU+qF4hd9gjdwAA
ol1o7rjppptMBghVp04dV+NtQ2l7zfbt28MWff1vvvnGZld8Re4AACC80NxR
vXp1M1d6qJEjR0rt2rWz/Po6DlfnYQ9XLrzwQnn//fet9sVP5A4AAMLT3NG0
aVMzF7p69tln0z1/dunSxYyn9QrtLPbIHQCAaKdtJ9qfQ/uR1qtXT1q2bClF
ihSRZcuWmce1DaRbt27meoSb+dQjRe6wR+4AAEQ7nbND+4uOGzdOevToIY0b
N5YSJUrI9OnTzePvvPOOySV6/7izZ896Vg9yhz1yBwAgViUnJ5v/79y501zz
8Bq5wx65AwAQS1JSUjJ87Pjx46Z4hdxhj9wBAIgF48ePl8qVK5s+HHr+/+67
79Ks07ZtW7n33ns9qwO5wx65AwAQ7ebNm2f6bzRp0kSef/55Mzep3h/u7bff
TrUeuSNz5A4AAMJr166d3HbbbYGfta3lhRdeMFkkeD4NckfmyB0AAIR3/fXX
p7m2oZ577jm54IILzL1pFbkjc+QOAADCa9OmjcTHx6f7WPv27c2Y2pUrV5I7
wiB3AAAQ3gcffCBxcXHy2GOPBeYKc+hY2rvuuktKlixp+n2QOzIWDbnjmmuu
ke+//17+/PNP34oz7y0AABkZMGCAma/0H//4R5rHTp48KY8++qjp70HuyFg0
5I6CBQua31OpUqV8Kbrt4L5CAABk5MSJE7Jr164MH//xxx9l5syZnm2f3GFP
x0F/+umnvm3/p59+Mv2FAACIduQOe+QOAADcIXfYI3cAAOAOucMeuQMAAHfI
HfbIHQAAuEPusEfuAADAHXKHPXIHAADukDvskTsAAHCH3GGP3AEAgDvkDnvk
DgAA3CF32CN3AABCffPNN/LMM8/IihUr/K5KVCF32CN3AABCrVq1SqpXr27u
oXXdddfJkCFDZM+ePX5Xy3fkDnvkDgBARpYsWSJPP/20lC5dWi644AJzv/mP
Pvoo195HnNxhj9wBAAhHc4aeKzp37izFixc3OaRnz56ybt06v6uWrcgd9sgd
AIBwNm7cKAMGDJDatWubtpf69eubc3DevHklMTHR7+plG3KHPXIHACA9f/75
pwwfPtycazVrlCtXThISEmTNmjWBdaZNm2Ye+/nnn32safYhd9gjdwAAQn39
9demP4eW+Ph4+eSTTyQ5OTnNekePHjW5Y/bs2T7UMvuRO+yROwAAobQ/qZsx
LJpFdu/enU218h+5wx65AwCQnpSUFJk0aZJs2rQpsOyJJ57IdX1Jg5E77JE7
AADpadmypWln+f77783PmkMaNGgg+fPnN9dCcpIvv/zStCeFKxdddJFMnTrV
7+pGjNxB7gCAaLR+/XpzfkhKSkrz2LBhw6Rw4cJy6tQpH2rmjW3btpl5ScKV
q6++WubOnet3dSNG7iB3AEA0GjVqlLm2kZ59+/aZvqQbNmzI5lr5j3YWe+QO
AECor776SuLi4uS3335L89j48eNNW8vx48d9qJm/yB32yB0AgFAnTpyQyy+/
XJo0aWL6Pmzfvt1c35g8ebJUqFBBHnjgAb+r6Atyhz1yBwAgPXqto2bNmqZN
Jbjcc889sn//fr+r5wtyhz1yBwAgM3qtQ88TOjfY5s2b/a6Or8gd9sgdAAC4
Y5M7Dh06lObakR/F7zYycgcAID06b8e9994rN910k9StWzdNyY1scoe2W2mf
GZ0Hxa+ic7Lo79NP5A4AQCg9RxYrVsycJzV7dOnSJU3Jjc5H7vATuYPcAQDR
aNy4cVKiRIlc2380I+QOe+QOAECosWPHSo0aNfyuRtQhd9gjdwAAQm3ZskUK
FSoka9as8bsqUYXcYY/cAQAItWvXLtOHo1SpUvLkk0/KwIED5fXXX09VciNy
hz1yBwAg1Jw5c6R48eKZltyI3GGP3AEAyMzRo0dl5cqVcuTIETl58qTf1fEV
ucMeuQMAkB6dp7Rdu3aB+aYWL14sPXv2lN69e8uxY8f8rp4vyB32yB0AgFCn
Tp2SOnXqmPuzDBkyRAoXLmxyx4wZM8z42q5du/pdRV+QO+yROwAAoWbNmiVl
y5aVgwcPmp+1P4fmDjVv3jwpX768mf8ytyF32CN3AABCDR06VG655ZbAz8G5
48CBA6bdJTfeI47cYY/cAQAINXPmTHN+2LNnj/k5OHeMGjVK4uLiTFtMbkPu
sEfuAACE0rErVapUMZ/PkydPlqJFi8rEiRMlMTFRSpcuLR06dPC1ftrGo5lo
37592bpdcoc9cgcAID06dlb7lobeR71t27amrSW77dixQ/r27SuVKlUy11uc
+ui1mFq1akmvXr1MXvISucMeuQMAkJGzZ8+az+lJkybJ9OnTZe3atb7UY+vW
reacXaFCBZMvhg8fbq7DTJkyRUaMGCEJCQlSuXJlk0k2btzoWT3IHfbIHQCA
aNe9e3dp1KhRpvOWnT59Wpo3by79+/f3rB7kDnvkDgBAKD23NmnSJNOSnRo2
bCijR48Ou96ECROkfv36ntWD3GGP3AEACLVs2TJ54IEHUpXbb7/d9DXV84b2
s8hOffr0kY4dO4Zdr1OnThIfH+9ZPcgd9sgdAAC3dByJtnloDslOy5cvl0KF
CkmrVq3MNY1FixZJUlKSbNiwwYzvnTp1qrRp08b0N124cKFn9SB32CN3AACy
YsuWLZI/f37Px46E0ozRrFkzyZcvX5oxNlpatGghCxYs8LQO5A575A4AQFb8
+OOP5jyv41r9oPOVaQaZP3++zJ49W1asWCF79+7Nlm2TO+yROwAAofSaxrBh
w1KVN99808wbVq5cOalWrZrfVTT0vrhLly6V9evXy5kzZzzfHrnDHrkDABBK
7wun54fQctFFF5n7tqxatSpb6zN48GCTeYINHDhQChQoEGhnqVq1qsydO9fT
epA77JE7AADRTudlb926deDnsWPHmqyh83WMGTNGhgwZYsbPat9T7YPqFXKH
PXIHACDaheYOPXdqBgil87q7GW8bavfu3WYcTLhy7bXXyhdffBHRPpA7ziF3
AABCuZk3LLhs2rTJ0/qE5o7q1aubudJDjRw5UmrXrp3l19f+qW72s1ixYmZ+
9kiQO84hdwAAQv36669mroy8efOa8ak9evSQe+65R0qWLGnaN7SPR/CcYtu2
bfO0Ppo7mjZtauZCV88++6z069cvzXpdunQx9fUK7Sz2yB0AgFA6RvaSSy6R
L7/8MtVyHTPSrVs3M295dtK2E8072o+0Xr165vxZpEgRM6+q2r59u6mXntPc
zKceKXKHPXIHACCU9tsMbtcIpplEM8Dvv/+ebfXROTu0v+i4cePMtZfGjRtL
iRIlzD1y1TvvvGPqpHOp6j10vULusEfuAACEmjFjhpQqVSrdOUl1vgydM/Tw
4cM+1Cy15ORk8/+dO3eaax5eI3fYI3cAAEIdPHjQtGNonw6dD1Tzxx9//CEf
fvihXHHFFdl+f5ZoQe6wFw25o0aNGvLdd9/5VvSeQgCA1DRvVKhQIc19UO67
7z45dOiQ39XzBbnDnt+5Q9vm9O+4QYMGvhXd/scff+zbewAA0UrHjzj9KqZN
mybr1q3zu0q+InfY8zt3vP/++1K4cGHftq+efvppc+8BAEBaR48elZUrV5q2
lpMnT/pSh7p165q5SN2Uhx9+2LN6kDvskTvIHQCQHu2n2a5du0D7irZJ9+zZ
U3r37m3ux5advvnmGylTpowZwzJo0CB54403MixentPIHfbIHeQOAAil41Z1
zvGaNWuae5/o57TmDh3nouf+rl27ZnudkpKSzPWM1157Ldu37SB32CN3kDsA
IJTej7Zs2bJmXIsqXrx4oA/+vHnzpHz58pKSkpLt9dL70hYtWlT27t2b7dtW
5A575A5yBwCEGjp0qJkL3RGcOw4cOGDaXTZv3pzt9dL5UhcsWGDG9PqB3GGP
3EHuAIBQM2fONOeHPXv2mJ+Dc8eoUaMkLi7OtMXkNuQOe+QOcgcAhNKxK1Wq
VDHzOur9V7VtY+LEiZKYmCilS5c292nLjcgd9sgd5A4ASI+OndW+paHzhrVt
29a0teRG5A575A5yBwCE0lyh1zmOHz9u5pWeNGmSmedx7dq1flfNV+QOe+QO
cgcAhNI2Fb22kR33Wosl5A575A5yBwCEmjNnjskda9as8bsqUYXcYY/cQe4A
gFC7d++Whx56SC6++GLp0qWLDBw4MM28oLkRucMeuYPcAQChPv/8c/PZnFnJ
jcgd9sgd5A4AgDvkDnvkDnIHAKjk5GQ5ceKE39WIauQOe+QOcgcAKL33id53
JZiOZ8ntY2eDkTvskTvIHQCg0ssdvXr1krp16/pUo+hD7rBH7iB3AIAid4RH
7rBH7iB3AIAid4RH7rBH7iB3AIAid4RH7rBH7iB3AIAid4RH7rBH7iB3AIDS
3BEXFyc1atQIlFKlSknBggVTLXNKbkTusEfuIHcAgPr444/NPe7dltyI3GGP
3EHuAAC4Q+6wR+4gdwAA3CF32CN3kDsAILfTNqbrrrsubNHz1YQJEyLaBrnj
HHIHuQMAcrv9+/fLihUrwpaaNWvKV199FdE2yB3nkDvIHQAAd2hnsUfuIHcA
ANwhd9gjd5A7AADukDvskTvIHQAAd8gd9sgd5A4AgDvkDnvkDnIHAMAdcoc9
cge5AwDgDrnDHrmD3AEAcIfcYY/cQe4AALhD7rBH7iB3AADcIXfYI3eQOwAA
7pA77JE7yB0AAHfIHfbIHeQOAIA75A575A5yBwDAHXKHPXIHuQMA4A65wx65
g9wBAHCH3GGP3EHuAAC4Q+6wR+4gdwAA3CF32CN3kDsAAO6QO+yRO8gdAAB3
yB32yB3kDgCAO+QOe+QOcgcAwB1yhz1yB7kDAOAOucMeuYPcAQBwh9xhj9wh
8uSTT8q9994rI0eO9K189913vr4HABBLUlJSZM+ePbJv375s3S65wx65Q6R2
7dqSL18+6datm28lT548cvDgQV/fBwCIZjt27JC+fftKpUqVJC4uznxuaile
vLjUqlVLevXqJUeOHPG0DuQOe+QOMX+vd999t691KFmypOzfv9/XOgBAtNq6
das5Z1eoUMHki+HDh8vkyZNlypQpMmLECElISJDKlSubTLJx40bP6kHusEfu
IHcAQLTr3r27NGrUSE6ePJnhOqdPn5bmzZtL//79PasHucMeuYPcAQDRrmHD
hjJ69Oiw602YMEHq16/vWT3IHfbIHeQOAIh2ffr0kY4dO4Zdr1OnThIfH+9Z
Pcgd9sgd5A4AiHbLly+XQoUKSatWrcw1jUWLFklSUpJs2LBBFi9eLFOnTpU2
bdqY/qYLFy70rB7kDnvkDnIHAMQCzRjNmjUz4w+dsSzBpUWLFrJgwYKIXnv9
+vUyZsyYsKVKlSoye/bsiLZB7jiH3EHuAIBYcurUKZNB5s+fbzLAihUrZO/e
vVavqXMode7cOWwpU6aMzJgxI6JtkDvOIXeQOwAgVh07dkyWLl1qrlecOXPG
8+3RzmKP3EHuAIBoN3jwYElMTEy1bODAgVKgQIFAO0vVqlVl7ty5ntaD3GGP
3EHuAIBo16FDB2ndunXg57Fjx5qsofN1aL+LIUOGmPGz2vdU+6B6hdxhj9xB
7gCAaBeaO/TcqRkgVJ06dVyNt40UucMeuYPcAQDRLjR3VK9e3cyVHkrvs6n3
3PIKucMeuYPcAQDRTnNH06ZNzVzo6tlnn5V+/fqlWa9Lly5mPK1XyB32yB3k
DgCIdtp2ov05tB9pvXr1zPmzSJEismzZMvP49u3bzb299ZzmZj71SJE77JE7
yB0AEO10zg7tLzpu3Djp0aOHNG7cWEqUKCHTp083j7/zzjsml+j9486ePetZ
Pcgd9sgd5A4AiFXJycnm/zt37jTXPLxG7rBH7iB3AADcIXfYI3eQOwAA7pA7
7JE7yB0AAHfIHfbIHeQOAIA75A575I7oyB3FihWT9957T6ZMmeJbIfcAQObI
HfbIHdGRO3T8l851c//99/tSLrnkErntttt8fQ8AINqRO+yRO6Ijd+TNm1c2
b97s2/b1b+COO+7wbfsAEAvIHfbIHeQORe4AgPDIHfbIHeQORe4AgPDIHfbI
HeQORe4AgPDIHfbIHeQORe4AgPDIHfbIHeQORe4AgPDIHfbIHeQORe4AgPDI
HfbIHeQORe4AgPDIHfbIHeQORe4AgPDIHfbIHeQORe4AgPDIHfbIHeQORe4A
gPDIHfbIHeQONX36dKlQoYI8/PDDvpU777zTFD/rMGzYMN9+BwCiH7nDHrmD
3KFeeOEFKVmypEyYMMG3UqZMGXnkkUd82/748ePN/fkAICPkDnvkDnKH0txR
tmxZ37av9HpLjx49fNv+yZMnzfEAIPqlpKTInj17ZN++fdm6XXKHPXIHuUOR
O8gdQLTbsWOH9O3bVypVqiRxcXHm+qSW4sWLm8/xXr16yZEjRzytA7nDHrmD
3KHIHedyR/78+aVDhw6+Ff073Lhxo2/vARCttm7das7Z+jmh+WL48OEyefJk
mTJliowYMUISEhKkcuXKJpN4eQyRO+yRO8gditwhcujQIfPdSf8m/Sovv/yy
PProo769B0C06t69uzRq1Mh8P8jI6dOnpXnz5tK/f3/P6kHusEfuIHcocsf/
5w4/6Xe4q666ymQPv8r9998v9913n2/b13FFfm5fi34eHDhwwNe/BaTWsGFD
GT16dNj1tI94/fr1s/z6+ryiRYuGLfny5ZMxY8ZEsgty8OBB8xlTpEgR34rT
NpWb66DXtXP7e+DUQbNHbn8P/KxDoUKFouY9oPhfPvvss4jOLfBGnz59pGPH
jmHX69Spk8THx2f59ZOTk03fkHBF+7LqupHS6zVutuNlOXr0aK7efjTUwe/t
U4fo2D51iI7tR0sdEF2WL19uvhu0atXKXJtYtGiRJCUlyYYNG2Tx4sUydepU
adOmjelvunDhQr+rCwAAYpxmjGbNmpm2jvSuUbVo0UIWLFjgdzUBAEAOcurU
KZNB5s+fL7Nnz5YVK1bI3r17/a4WAAAAAAAAAAAAAAAAYtyuXbukffv2Zp6e
3Fx0PPS///1v3+vhZ3nmmWekX79+vtfDzzJgwADp1q2b7/Xws7z11ltmziy/
6+F36dq1q7zyyiu+18PPonNFjB071u/TFHKY1atXm7nHdO7V3Fz03ucPPfSQ
7/Xws9SsWVNuvvlm3+vhZ7njjjvMfQ38roefRXOXjs/zux5+l0svvVTatm3r
ez38LDrfpWZQ4HzSedJ1Xubcrlq1arJu3Tq/q+Grp59+2nzXzc10rvw777zT
72r4SucRLFCggN/V8F3jxo3l66+/9rsavtL75CQmJvpdDeQw5I5zyB3kDkXu
IHc4yB3kDniD3HEOuYPcocgd5A4HuYPcAW+QO84hd5A7FLmD3OEgd5A74A1y
xznkDnKHIneQOxzkDnIHvEHuOIfcQe5Q5A5yh4PcQe6AN8gd55A7yB2K3EHu
cJA7yB3wBrnjHHIHuUORO8gdDnIHuQPeIHecQ+4gdyhyB7nDQe4gd8Abp0+f
zvXnW5WUlGQ+b3OznTt3yt69e/2uhq8OHz4sW7Zs8bsavkpJSTHzGOd2mzZt
kqNHj/pdDV/98ccfsnv3br+rAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAACAK3rPhex4TjSLdH/Onj17nmvir5z2e41EpO9BTnrveA/OOXXq
lJw5cyZLz8lp74Huv74PWZHTPhdx/rz//vvSpEkTKViwoNSrV0+++uqrsM9Z
tmyZPPTQQ1KiRAm54oorZMCAAd5X1EOR7M8vv/wirVu3lmLFipl7c9atW1fm
zZuXDbX1xpEjR6Rv375y5ZVXSsmSJSU+Pj5L94DT+2NVqVJFunfv7mEtvRfJ
8bBr1y65++675eKLL5aKFStKQkKC7Nixw/vKeiSS40H3V9+DokWLSqFChaR5
8+bmGIl1mzdvllKlSslnn30Wdl3bYyhaaX64/fbbpWPHjmHX1c+B3r17S/ny
5SVv3rzmeHj11VclOTnZ+4oiJug9nC+88EJ5++23Zfny5dKtWzfzebty5coM
n3Ps2DFzfnnwwQfN59O4ceOkcOHC8sorr2Rjzc+fSPZn3759ctlll8lf//pX
mTRpksydO1fuuOMOueCCC+Tnn3/OxtqfP3qP+6pVq8r8+fPN38V1110ntWvX
dv297cknn5Q8efLEdO6I5HjQexTrZ2v9+vXliy++kMmTJ8tVV10lDz/8cDbW
/PyJ5HjQvxHNaPq8Dz74QGbPni3XX3+9VKhQQQ4dOpSNtT+/NHP85S9/MX/X
bnKH7TEUjfTvW48DfQ/c5I4OHTrIRRddZLLGDz/8IM8995zExcVJYmKi95VF
TKhevXqaz0c9zjp37pzhc/71r39J8eLF5cSJE4FlL730kpQuXTom7xMfyf6M
GTPGHIc//fRTYJl+vup3vaeeesrzOp9vq1atknz58snHH38cWLZ27Vqzj3Pm
zAn7fD3f6nd9/Y4Ty7kjkuNh9OjR5nP2t99+CyybNWuWOefG4v3BIzkeNm7c
aP5W9Lhw6HlXl3366aee19kLI0eOlCJFisg111zjKnfYHkPRaOnSpXLttdea
azdly5YNmzsOHjxo3oM+ffqkWt6uXTvzfGD79u3mmJgxY0aq5c8//7xccskl
GT7vxhtvlPvvvz/VshUrVpjX+vbbbz2pq5ci2R/9Ljxq1Kg0yytXrizt27f3
pJ5eeuONN8z3+tD226uvvtp8h8vM4cOHpVKlSjJ+/Hhzjo7F3KUiPR4aNWpk
vg/mFJEcD9qWoOebIUOGBJZ9+eWX5jmaP2KRXs989tlnZdOmTa5yh80xFK30
77ply5ayZcsW83cRLnfodeB3333XXCcKpu2O2vYWy9d9cH4sWLDAHE96LSyY
5vz8+fNn2CdIv/f06tUr1bI///zTvNb06dM9q69Xztf+6GeyPmfEiBHnu4qe
e+KJJ8z381BNmzaV++67L9PnPvbYY6afi4rl3BHp8aBtLPo71/aFVq1amfYG
7Q8Rq+3ZkR4Pek66/PLL5b333pMPP/zQtDHoexGr78OePXvM/508Gi532BxD
0cp5D5Sb3JEePW40w+n7AMycOdMcT+vXr0+1fMqUKWZ58N9cMG3/1ra7YPrZ
os8ZPny4Z/X1yvnYH/3OX6tWLalWrVqW+3xHA21b0PNEKO0Xp30sM/L555+b
a/JOG0Ms545Ijgf9/qZ/P82aNTPf57p06WLeL11f+0fEokiPB+1P6PSF0KLX
5oPbnmKV29wR6TEUKyLNHdrPVq+FLV68+PxXCjFH26D1eNqwYUOq5c7nbEb9
8bXNc+DAgamW6RgrfU7wddZYYbs/2q/j5ptvNp+zej06Fj366KNSp06dNMt1
fMJNN92U7nMOHDhgvse88847gWWxnDsiOR6OHz9uHtN++9rHwfHiiy+a5do+
HmsiOR50PI+O4bjhhhtM/wZtY9HxD9o+lVmf3FjgNndEcgzFkkhyx8svv2ze
u0GDBnlTKcQc7auufxNLlixJtVyvK+ty/Q6fHu2vHdpvSNt39Tn/+c9/PKuv
V2z2R9fTMS06zi70fYwl2o6tfVNC3XLLLXLbbbel+xxtX9ExlnqO0bGmWvQ1
2rZta/4d3C8xFkR6POg46saNG6da9uuvv5rnpNcHKNpFcjxo39rQzKaZTK+F
9ezZ09P6es1t7ojkGIolWc0d2qdD37fXX3/du0oh5vz+++/m7+KTTz5Jtbx/
//6mjTcjDRs2TNN3cvXq1ea13Mx1EG0i3R/tQ6Vj5LRNO9bnKRg2bJj5nhs6
N5KO79B26/ToOEnnmnp6ZevWrdlR9fMm0uNBxzs88sgjqZY5/fqDrwXFikiO
Bz0f6d9KqHvuucfMaxPL3OaOSI6hWJKV3KHzd+jfv/YxBULVqFFD/v73v6da
pt/fM+sHpePsypQpk+r4eu2118x3m4y+E0azSPZH+0rpfA06jiPWzq/pWbNm
jfls1fGwDqcff0Z9CfXa+rZt21IV7buvn03676zO7xgNIjkedNywfs8N7tej
c3joe6fjnmJNJMfDCy+8YPq36NwfDu0TUq5cObnrrrs8r7OX3OaOSI6hWOI2
d+j1Dc0c2s8aSI9eB9axXzp2UPspaLuu/qzHi2PChAnmc1evmyr9XqjzY+nn
7f79+2XhwoVm7oahQ4f6tRtW3OyPXj/W90DHPCjN8fp5ouPM9BpzcNE5k2KR
Xg/W/hlJSUmmL4P2ldQxosFj33RusNA+h8FiuX+HcnM8hL4H2q9D50XSax56
jtLfv/Yv1j4/sZi93BwPoZ8JOm5S5xbTPh3aL1f/hrp27WqOEZ1TL5ZllDtC
PxOUm2MoVmWUO4KPB91n/TvQa6Ghn4taTp8+nc21RjTSz0UdM6efM3ps6TVB
nYchmNNOF/xdR49Bvfasy/Uz6fHHH4/Jz1hHuP3RvtjB7dt6LTqj9oVYbcvV
z4wGDRqYfdDzqI7b13mPgumY0cz2L9Zzh5vjIb33QOeo0Gseznun559Ynh87
3PGQ3meC9vPRvqXOcaB9nnSu01iXUe4I/UxQbo6hWJVR7gg+HrStKbO211ie
uxbnn/YB1GvjWaEZXueTidXx+aFy2v5ESudq0L4ruVkkx4PS805O+WyN9HjQ
9jd9Xk74jh8pjiEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAIDc5dVXX5Vbb701zfLevXvLU0895UONAABATjVnzhzJ
kyePLF68OLDs2LFjUqRIEXn33Xd9rBkAAMhpzpw5I+XKlTPXNxxTp06VCy+8
UPbt2+djzQAAQE7Us2dPqVixoqSkpJif4+PjpU2bNj7XCgAA5ERLliwxbS2L
Fi2SQ4cOSYECBeSDDz7wu1oAACCHuvrqq01by8SJE6Vo0aJy/Phxv6sEAABy
qJdeekmuueYaefDBB6V9+/Z+VwcAAORgGzduNG0thQsXls8//9zv6gAAgBzu
xhtvlLJly0pycrLfVQEAADmc5o5nnnnG72oAAIAcSq9tHD16VKZNmyZ58+aV
devW+V0lAACQQ+3evdv069CSmJjod3UAAEAON2vWLPn555/9rgYAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAn/0fdllNzQ==
"], {{0, 407}, {542, 0}}, {0, 255},
ColorFunction->RGBColor],
BoxForm`ImageTag["Byte", ColorSpace -> ColorProfileData[CompressedData["
1:eJyNVV1s21QUPomvU6QWP5V1dFJnxs+qqavSDUGraYP8LclW0shtOjYhgePc
xKZubGwnXac9TUggXijwhiYh/t4qISExjZ9pGw/sZWhIU0e7VUggHjbxI6RJ
e4EuHF87tdelDEe+/vyd755z7vHJvY+VDakaBQD7IRwkeS5hWfL8JMGX5LxD
yxEEy104QNeybJp6VASYrTuWlE2KLx49JnatQBQehW7oh25Zsc1EsTjuql0t
3HfduQauQ7i6u7P9P6/uCrUVgIibqFGxlVnExwH404ppOZhfL/Kjc47pYjeH
XgsTRPyKi2sedlxc9vCbTDMlpRCfRiwoqlxBvIh4qBziayHs5cCu3iytU0tT