-
-
Notifications
You must be signed in to change notification settings - Fork 10
/
server.R
1244 lines (1239 loc) · 93.5 KB
/
server.R
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
server <- function(input, output) {
output$results_distribution <- renderUI({
if (input$distribution == "Beta") {
withMathJax(
paste0("\\(X \\sim Beta(\\alpha = \\)", " ", input$alpha_beta, ", ", "\\(\\beta = \\)", " ", input$beta_beta, "\\()\\)", " and ", case_when(
input$lower_tail_beta == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_beta, "\\()\\)", " ", "\\( = \\)", " ", round(pbeta(input$x1_beta, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = TRUE), 4)),
input$lower_tail_beta == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_beta, "\\()\\)", " ", "\\( = \\)", " ", round(pbeta(input$x2_beta, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = FALSE), 4)),
input$lower_tail_beta == "interval" ~ paste0("\\(P(\\)", input$a_beta, " ", "\\(\\leq X\\leq \\)", " ", input$b_beta, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_beta > input$b_beta, "a must be less than or equal to b", round(pbeta(input$b_beta, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = TRUE) - pbeta(input$a_beta, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Binomial") {
withMathJax(
paste0("\\(X \\sim Bin(n = \\)", " ", input$n_binomial, ", ", "\\(p = \\)", " ", input$p_binomial, "\\()\\)", " and ", case_when(
input$lower_tail_binomial == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_binomial, "\\()\\)", " ", "\\( = \\)", " ", round(pbinom(input$x1_binomial, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE), 4)),
input$lower_tail_binomial == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_binomial, "\\()\\)", " ", "\\( = \\)", " ", round(pbinom(input$x2_binomial, size = input$n_binomial, prob = input$p_binomial, lower.tail = FALSE), 4)),
input$lower_tail_binomial == "interval" ~ paste0("\\(P(\\)", input$a_binomial, " ", "\\(\\leq X\\leq \\)", " ", input$b_binomial, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_binomial > input$b_binomial, "a must be less than or equal to b", round(pbinom(input$b_binomial, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE) - pbinom(input$a_binomial - 1, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Cauchy") {
withMathJax(
paste0("\\(X \\sim Cauchy(x_0 = \\)", " ", input$location_cauchy, ", ", "\\(\\gamma = \\)", " ", input$scale_cauchy, "\\()\\)", " and ", case_when(
input$lower_tail_cauchy == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_cauchy, "\\()\\)", " ", "\\( = \\)", " ", round(pcauchy(input$x1_cauchy, location = input$location_cauchy, scale = input$scale_cauchy, lower.tail = TRUE), 4)),
input$lower_tail_cauchy == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_cauchy, "\\()\\)", " ", "\\( = \\)", " ", round(pcauchy(input$x2_cauchy, location = input$location_cauchy, scale = input$scale_cauchy, lower.tail = FALSE), 4)),
input$lower_tail_cauchy == "interval" ~ paste0("\\(P(\\)", input$a_cauchy, " ", "\\(\\leq X\\leq \\)", " ", input$b_cauchy, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_cauchy > input$b_cauchy, "a must be less than or equal to b", round(pcauchy(input$b_cauchy, location = input$location_cauchy, scale = input$scale_cauchy, lower.tail = TRUE) - pcauchy(input$a_cauchy, location = input$location_cauchy, scale = input$scale_cauchy, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Chi-square") {
withMathJax(
paste0("\\(X \\sim \\chi^2(df = \\)", " ", input$df_chisquare, "\\()\\)", " and ", case_when(
input$lower_tail_chisquare == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_chisquare, "\\()\\)", " ", "\\( = \\)", " ", round(pchisq(input$x1_chisquare, df = input$df_chisquare, lower.tail = TRUE), 4)),
input$lower_tail_chisquare == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_chisquare, "\\()\\)", " ", "\\( = \\)", " ", round(pchisq(input$x2_chisquare, df = input$df_chisquare, lower.tail = FALSE), 4)),
input$lower_tail_chisquare == "interval" ~ paste0("\\(P(\\)", input$a_chisquare, " ", "\\(\\leq X\\leq \\)", " ", input$b_chisquare, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_chisquare > input$b_chisquare, "a must be less than or equal to b", round(pchisq(input$b_chisquare, df = input$df_chisquare, lower.tail = TRUE) - pchisq(input$a_chisquare, df = input$df_chisquare, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Exponential") {
withMathJax(
paste0("\\(X \\sim Exp(\\lambda = \\)", " ", input$rate_exponential, "\\()\\)", " and ", case_when(
input$lower_tail_exponential == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_exponential, "\\()\\)", " ", "\\( = \\)", " ", round(pexp(input$x1_exponential, rate = input$rate_exponential, lower.tail = TRUE), 4)),
input$lower_tail_exponential == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_exponential, "\\()\\)", " ", "\\( = \\)", " ", round(pexp(input$x2_exponential, rate = input$rate_exponential, lower.tail = FALSE), 4)),
input$lower_tail_exponential == "interval" ~ paste0("\\(P(\\)", input$a_exponential, " ", "\\(\\leq X\\leq \\)", " ", input$b_exponential, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_exponential > input$b_exponential, "a must be less than or equal to b", round(pexp(input$b_exponential, rate = input$rate_exponential, lower.tail = TRUE) - pexp(input$a_exponential, rate = input$rate_exponential, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Fisher") {
withMathJax(
paste0("\\(X \\sim F(df_1 = \\)", " ", input$df1_fisher, ", ", "\\(df_2\\)", " = ", input$df2_fisher, "\\()\\)", " and ", case_when(
input$lower_tail_fisher == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_fisher, "\\()\\)", " ", "\\( = \\)", " ", round(pf(input$x1_fisher, df1 = input$df1_fisher, df2 = input$df2_fisher, lower.tail = TRUE), 4)),
input$lower_tail_fisher == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_fisher, "\\()\\)", " ", "\\( = \\)", " ", round(pf(input$x2_fisher, df1 = input$df1_fisher, df2 = input$df2_fisher, lower.tail = FALSE), 4)),
input$lower_tail_fisher == "interval" ~ paste0("\\(P(\\)", input$a_fisher, " ", "\\(\\leq X\\leq \\)", " ", input$b_fisher, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_fisher > input$b_fisher, "a must be less than or equal to b", round(pf(input$b_fisher, df1 = input$df1_fisher, df = input$df2_fisher, lower.tail = TRUE) - pf(input$a_fisher, df1 = input$df1_fisher, df = input$df2_fisher, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Gamma") {
withMathJax(
paste0("\\(X \\sim Gamma(\\alpha = \\)", " ", input$alpha_gamma, ", ", "\\(\\beta = \\)", " ", input$beta_gamma, "\\()\\)", " and ", case_when(
input$lower_tail_gamma == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_gamma, "\\()\\)", " ", "\\( = \\)", " ", round(pgamma(input$x1_gamma, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = TRUE), 4)),
input$lower_tail_gamma == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_gamma, "\\()\\)", " ", "\\( = \\)", " ", round(pgamma(input$x2_gamma, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = FALSE), 4)),
input$lower_tail_gamma == "interval" ~ paste0("\\(P(\\)", input$a_gamma, " ", "\\(\\leq X\\leq \\)", " ", input$b_gamma, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_gamma > input$b_gamma, "a must be less than or equal to b", round(pgamma(input$b_gamma, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = TRUE) - pgamma(input$a_gamma, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Geometric (I)") {
withMathJax(
paste0("\\(X \\sim Geom(p = \\)", " ", input$p_geometric, "\\()\\)", " and ", case_when(
input$lower_tail_geometric == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_geometric, "\\()\\)", " ", "\\( = \\)", " ", round(pgeom(input$x1_geometric, prob = input$p_geometric, lower.tail = TRUE), 4)),
input$lower_tail_geometric == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_geometric, "\\()\\)", " ", "\\( = \\)", " ", round(pgeom(input$x2_geometric, prob = input$p_geometric, lower.tail = FALSE), 4)),
input$lower_tail_geometric == "interval" ~ paste0("\\(P(\\)", input$a_geometric, " ", "\\(\\leq X\\leq \\)", " ", input$b_geometric, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_geometric > input$b_geometric, "a must be less than or equal to b", round(pgeom(input$b_geometric, prob = input$p_geometric, lower.tail = TRUE) - pgeom(input$a_geometric - 1, prob = input$p_geometric, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Geometric (II)") {
withMathJax(
paste0("\\(X \\sim Geom(p = \\)", " ", input$p_geometric2, "\\()\\)", " and ", case_when(
input$lower_tail_geometric2 == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_geometric2, "\\()\\)", " ", "\\( = \\)", " ", round(pgeom(input$x1_geometric2 - 1, prob = input$p_geometric2, lower.tail = TRUE), 4)),
input$lower_tail_geometric2 == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_geometric2, "\\()\\)", " ", "\\( = \\)", " ", round(pgeom(input$x2_geometric2 - 1, prob = input$p_geometric2, lower.tail = FALSE), 4)),
input$lower_tail_geometric2 == "interval" ~ paste0("\\(P(\\)", input$a_geometric2, " ", "\\(\\leq X\\leq \\)", " ", input$b_geometric2, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_geometric2 > input$b_geometric2, "a must be less than or equal to b", round(pgeom(input$b_geometric2 - 1, prob = input$p_geometric2, lower.tail = TRUE) - pgeom(input$a_geometric2 - 2, prob = input$p_geometric2, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Hypergeometric") {
withMathJax(
paste0("\\(X \\sim HG(n = \\)", " ", input$n_hypergeometric, ", ", "\\(N = \\)", " ", input$N_hypergeometric, ", ", "\\(M = \\)", " ", input$M_hypergeometric, "\\()\\)", " and ", case_when(
input$lower_tail_hypergeometric == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_hypergeometric, "\\()\\)", " ", "\\( = \\)", " ", round(phyper(input$x1_hypergeometric, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE), 4)),
input$lower_tail_hypergeometric == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_hypergeometric, "\\()\\)", " ", "\\( = \\)", " ", round(phyper(input$x2_hypergeometric, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = FALSE), 4)),
input$lower_tail_hypergeometric == "interval" ~ paste0("\\(P(\\)", input$a_hypergeometric, " ", "\\(\\leq X\\leq \\)", " ", input$b_hypergeometric, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_hypergeometric > input$b_hypergeometric, "a must be less than or equal to b", round(phyper(input$b_hypergeometric, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE) - phyper(input$a_hypergeometric - 1, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Logistic") {
withMathJax(
paste0("\\(X \\sim Logi(\\mu = \\)", " ", input$location_logistic, ", ", "\\(s = \\)", " ", input$scale_logistic, "\\()\\)", " and ", case_when(
input$lower_tail_logistic == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_logistic, "\\()\\)", " ", "\\( = \\)", " ", round(plogis(input$x1_logistic, location = input$location_logistic, scale = input$scale_logistic, lower.tail = TRUE), 4)),
input$lower_tail_logistic == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_logistic, "\\()\\)", " ", "\\( = \\)", " ", round(plogis(input$x2_logistic, location = input$location_logistic, scale = input$scale_logistic, lower.tail = FALSE), 4)),
input$lower_tail_logistic == "interval" ~ paste0("\\(P(\\)", input$a_logistic, " ", "\\(\\leq X\\leq \\)", " ", input$b_logistic, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_logistic > input$b_logistic, "a must be less than or equal to b", round(plogis(input$b_logistic, location = input$location_logistic, scale = input$scale_logistic, lower.tail = TRUE) - plogis(input$a_logistic, location = input$location_logistic, scale = input$scale_logistic, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Log-Normal") {
withMathJax(
paste0("\\(X \\sim Lognormal(\\mu = \\)", " ", input$mean_lognormal, ", ", ifelse(input$variance_sd_lognormal == "variance_true", paste0("\\(\\sigma^2 = \\)", " ", input$variance_lognormal), paste0("\\(\\sigma^2 = \\)", " ", input$sd_lognormal^2)), "\\()\\)", " and ", case_when(
input$lower_tail_lognormal == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_lognormal, "\\()\\)", " ", "\\( = \\)", " ", round(plnorm(input$x1_lognormal, meanlog = input$mean_lognormal, sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal), lower.tail = TRUE), 4)),
input$lower_tail_lognormal == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_lognormal, "\\()\\)", " ", "\\( = \\)", " ", "\\( = \\)", " ", round(plnorm(input$x2_lognormal, meanlog = input$mean_lognormal, sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal), lower.tail = FALSE), 4)),
input$lower_tail_lognormal == "interval" ~ paste0("\\(P(\\)", input$a_lognormal, " ", "\\(\\leq X\\leq \\)", " ", input$b_lognormal, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_lognormal > input$b_lognormal, "a must be less than or equal to b", round(plnorm(input$b_lognormal, meanlog = input$mean_lognormal, sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal), lower.tail = TRUE) - plnorm(input$a_lognormal, meanlog = input$mean_lognormal, sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal), lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Negative Binomial (I)") {
withMathJax(
paste0("\\(X \\sim NG(r = \\)", " ", input$r_negativebinomial, ", ", "\\(p = \\)", " ", input$p_negativebinomial, "\\()\\)", " and ", case_when(
input$lower_tail_negativebinomial == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_negativebinomial, "\\()\\)", " ", "\\( = \\)", " ", round(pnbinom(input$x1_negativebinomial, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE), 4)),
input$lower_tail_negativebinomial == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_negativebinomial, "\\()\\)", " ", "\\( = \\)", " ", round(pnbinom(input$x2_negativebinomial, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = FALSE), 4)),
input$lower_tail_negativebinomial == "interval" ~ paste0("\\(P(\\)", input$a_negativebinomial, " ", "\\(\\leq X\\leq \\)", " ", input$b_negativebinomial, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_negativebinomial > input$b_negativebinomial, "a must be less than or equal to b", round(pnbinom(input$b_negativebinomial, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE) - pnbinom(input$a_negativebinomial - 1, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Negative Binomial (II)") {
withMathJax(
paste0("\\(X \\sim NG(r = \\)", " ", input$r_negativebinomial2, ", ", "\\(p = \\)", " ", input$p_negativebinomial2, "\\()\\)", " and ", case_when(
input$lower_tail_negativebinomial2 == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_negativebinomial2, "\\()\\)", " ", "\\( = \\)", " ", round(pnbinom(input$x1_negativebinomial2 - input$r_negativebinomial2, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE), 4)),
input$lower_tail_negativebinomial2 == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_negativebinomial2, "\\()\\)", " ", "\\( = \\)", " ", round(pnbinom(input$x2_negativebinomial2 - input$r_negativebinomial2, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = FALSE), 4)),
input$lower_tail_negativebinomial2 == "interval" ~ paste0("\\(P(\\)", input$a_negativebinomial2, " ", "\\(\\leq X\\leq \\)", " ", input$b_negativebinomial2, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_negativebinomial2 > input$b_negativebinomial2, "a must be less than or equal to b", round(pnbinom(input$b_negativebinomial2 - input$r_negativebinomial2, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE) - pnbinom(input$a_negativebinomial2 - 1 - input$r_negativebinomial2, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Normal") {
withMathJax(
paste0("\\(X \\sim N(\\mu = \\)", " ", input$mean_normal, ", ", ifelse(input$variance_sd == "variance_true", paste0("\\(\\sigma^2 = \\)", " ", input$variance_normal), paste0("\\(\\sigma^2 = \\)", " ", input$sd_normal^2)), "\\()\\)", " and ", case_when(
input$lower_tail_normal == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_normal, "\\()\\)", " ", "\\( = \\)", " ", "\\(P(Z \\leq \\)", " ", "\\((\\)", input$x1_normal, " ", "\\(-\\)", " ", input$mean_normal, "\\()\\)", " ", "\\(/\\)", " ", ifelse(input$variance_sd == "variance_true", round(sqrt(input$variance_normal), 2), input$sd_normal), "\\()\\)", " ", "\\( = \\)", " ", "\\(P(Z \\leq \\)", " ", round((input$x1_normal - input$mean_normal) / ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), 2), "\\()\\)", " ", "\\( = \\)", " ", round(pnorm(input$x1_normal, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = TRUE), 4)),
input$lower_tail_normal == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_normal, "\\()\\)", " ", "\\( = \\)", " ", "\\(P(Z > \\)", " ", "\\((\\)", input$x2_normal, " ", "\\(-\\)", " ", input$mean_normal, "\\()\\)", " ", "\\(/\\)", " ", ifelse(input$variance_sd == "variance_true", round(sqrt(input$variance_normal), 2), input$sd_normal), "\\()\\)", " ", "\\( = \\)", " ", "\\(P(Z > \\)", " ", round((input$x2_normal - input$mean_normal) / ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), 2), "\\()\\)", " ", "\\( = \\)", " ", round(pnorm(input$x2_normal, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = FALSE), 4)),
input$lower_tail_normal == "interval" ~ paste0("\\(P(\\)", input$a_normal, " ", "\\(\\leq X\\leq \\)", " ", input$b_normal, "\\()\\)", " ", "\\( = \\)", " ", "\\(P(\\)", "\\((\\)", input$a_normal, " ", "\\(-\\)", " ", input$mean_normal, "\\()\\)", " ", "\\(/\\)", " ", ifelse(input$variance_sd == "variance_true", round(sqrt(input$variance_normal), 2), input$sd_normal), "\\()\\)", " ", "\\(\\leq Z\\leq \\)", " ", "\\((\\)", input$b_normal, " ", "\\(-\\)", " ", input$mean_normal, "\\()\\)", " ", "\\(/\\)", " ", ifelse(input$variance_sd == "variance_true", round(sqrt(input$variance_normal), 2), input$sd_normal), "\\()\\)", " ", "\\( = \\)", " ","\\(P(\\)", round((input$a_normal - input$mean_normal) / ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), 2), " ", "\\(\\leq Z\\leq \\)", " ", round((input$b_normal - input$mean_normal) / ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), 2), "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_normal > input$b_normal, "a must be less than or equal to b", round(pnorm(input$b_normal, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = TRUE) - pnorm(input$a_normal, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Poisson") {
withMathJax(
paste0("\\(X \\sim Pois(\\lambda = \\)", " ", input$lambda_poisson, "\\()\\)", " and ", case_when(
input$lower_tail_poisson == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_poisson, "\\()\\)", " ", "\\( = \\)", " ", round(ppois(input$x1_poisson, lambda = input$lambda_poisson, lower.tail = TRUE), 4)),
input$lower_tail_poisson == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_poisson, "\\()\\)", " ", "\\( = \\)", " ", round(ppois(input$x2_poisson, lambda = input$lambda_poisson, lower.tail = FALSE), 4)),
input$lower_tail_poisson == "interval" ~ paste0("\\(P(\\)", input$a_poisson, " ", "\\(\\leq X\\leq \\)", " ", input$b_poisson, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_poisson > input$b_poisson, "a must be less than or equal to b", round(ppois(input$b_poisson, lambda = input$lambda_poisson, lower.tail = TRUE) - ppois(input$a_poisson - 1, lambda = input$lambda_poisson, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Student") {
withMathJax(
paste0("\\(X \\sim St(df = \\)", " ", input$df_student, "\\()\\)", " and ", case_when(
input$lower_tail_student == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_student, "\\()\\)", " ", "\\( = \\)", " ", round(pt(input$x1_student, df = input$df_student, lower.tail = TRUE), 4)),
input$lower_tail_student == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_student, "\\()\\)", " ", "\\( = \\)", " ", round(pt(input$x2_student, df = input$df_student, lower.tail = FALSE), 4)),
input$lower_tail_student == "interval" ~ paste0("\\(P(\\)", input$a_student, " ", "\\(\\leq X\\leq \\)", " ", input$b_student, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_student > input$b_student, "a must be less than or equal to b", round(pt(input$b_student, df = input$df_student, lower.tail = TRUE) - pt(input$a_student, df = input$df_student, lower.tail = TRUE), 4)))
))
)
} else if (input$distribution == "Weibull") {
withMathJax(
paste0("\\(X \\sim Weibull(\\alpha = \\)", " ", input$alpha_weibull, ", ", "\\(\\beta = \\)", " ", input$beta_weibull, "\\()\\)", " and ", case_when(
input$lower_tail_weibull == "lower.tail" ~ paste0("\\(P(X \\leq \\)", " ", input$x1_weibull, "\\()\\)", " ", "\\( = \\)", " ", round(pweibull(input$x1_weibull, shape = input$alpha_weibull, scale = input$beta_weibull, lower.tail = TRUE), 4)),
input$lower_tail_weibull == "upper.tail" ~ paste0("\\(P(X > \\)", " ", input$x2_weibull, "\\()\\)", " ", "\\( = \\)", " ", round(pweibull(input$x2_weibull, shape = input$alpha_weibull, scale = input$beta_weibull, lower.tail = FALSE), 4)),
input$lower_tail_weibull == "interval" ~ paste0("\\(P(\\)", input$a_weibull, " ", "\\(\\leq X\\leq \\)", " ", input$b_weibull, "\\()\\)", " ", "\\( = \\)", " ", ifelse(input$a_weibull > input$b_weibull, "a must be less than or equal to b", round(pweibull(input$b_weibull, shape = input$alpha_weibull, scale = input$beta_weibull, lower.tail = TRUE) - pweibull(input$a_weibull, shape = input$alpha_weibull, scale = input$beta_weibull, lower.tail = TRUE), 4)))
))
)
} else {
print("loading...")
}
})
# reactive to contain plot:
r_plot <- reactive({
res <- if (input$distribution == "Beta" && input$lower_tail_beta == "lower.tail") {
funcShaded <- function(x) {
y <- dbeta(x, shape1 = input$alpha_beta, shape2 = input$beta_beta)
y[x > input$x1_beta] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qbeta(0.99999, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = FALSE), qbeta(0.99999, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dbeta, args = list(shape1 = input$alpha_beta, shape2 = input$beta_beta)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Beta(", input$alpha_beta, ", ", input$beta_beta, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Beta' && input$lower_tail_beta == 'upper.tail') {
funcShaded <- function(x) {
y <- dbeta(x, shape1 = input$alpha_beta, shape2 = input$beta_beta)
y[x < input$x2_beta] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qbeta(0.99999, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = FALSE), qbeta(0.99999, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dbeta, args = list(shape1 = input$alpha_beta, shape2 = input$beta_beta)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Beta(", input$alpha_beta, ", ", input$beta_beta, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Beta' && input$lower_tail_beta == 'interval') {
funcShaded <- function(x) {
y <- dbeta(x, shape1 = input$alpha_beta, shape2 = input$beta_beta)
y[x < input$a_beta | x > input$b_beta] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qbeta(0.99999, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = FALSE), qbeta(0.99999, shape1 = input$alpha_beta, shape2 = input$beta_beta, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dbeta, args = list(shape1 = input$alpha_beta, shape2 = input$beta_beta)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Beta(", input$alpha_beta, ", ", input$beta_beta, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Binomial' && input$lower_tail_binomial == 'lower.tail') {
p <- data.frame(heads = qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = FALSE):qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE), prob = dbinom(x = qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = FALSE):qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE), size = input$n_binomial, prob = input$p_binomial)) %>%
mutate(Heads = ifelse(heads <= input$x1_binomial, "2", "Other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Bin(", input$n_binomial, ", ", input$p_binomial, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Binomial' && input$lower_tail_binomial == 'upper.tail') {
p <- data.frame(heads = qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = FALSE):qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE), prob = dbinom(x = qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = FALSE):qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE), size = input$n_binomial, prob = input$p_binomial)) %>%
mutate(Heads = ifelse(heads > input$x2_binomial, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Bin(", input$n_binomial, ", ", input$p_binomial, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Binomial' && input$lower_tail_binomial == 'interval') {
p <- data.frame(heads = qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = FALSE):qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE), prob = dbinom(x = qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = FALSE):qbinom(0.99999, size = input$n_binomial, prob = input$p_binomial, lower.tail = TRUE), size = input$n_binomial, prob = input$p_binomial)) %>%
mutate(Heads = ifelse(heads >= input$a_binomial & heads <= input$b_binomial, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Bin(", input$n_binomial, ", ", input$p_binomial, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Cauchy' && input$lower_tail_cauchy == 'lower.tail') {
funcShaded <- function(x) {
y <- dcauchy(x, location = input$location_cauchy, scale = input$scale_cauchy)
y[x > input$x1_cauchy] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(input$location_cauchy - (6 * input$scale_cauchy), input$location_cauchy + (6 * input$scale_cauchy))), aes(x = x)) +
stat_function(fun = dcauchy, args = list(location = input$location_cauchy, scale = input$scale_cauchy)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Cauchy(", input$location_cauchy, ", ", input$scale_cauchy, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Cauchy' && input$lower_tail_cauchy == 'upper.tail') {
funcShaded <- function(x) {
y <- dcauchy(x, location = input$location_cauchy, scale = input$scale_cauchy)
y[x < input$x2_cauchy] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(input$location_cauchy - (6 * input$scale_cauchy), input$location_cauchy + (6 * input$scale_cauchy))), aes(x = x)) +
stat_function(fun = dcauchy, args = list(location = input$location_cauchy, scale = input$scale_cauchy)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Cauchy(", input$location_cauchy, ", ", input$scale_cauchy, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Cauchy' && input$lower_tail_cauchy == 'interval') {
funcShaded <- function(x) {
y <- dcauchy(x, location = input$location_cauchy, scale = input$scale_cauchy)
y[x < input$a_cauchy | x > input$b_cauchy] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(input$location_cauchy - (6 * input$scale_cauchy), input$location_cauchy + (6 * input$scale_cauchy))), aes(x = x)) +
stat_function(fun = dcauchy, args = list(location = input$location_cauchy, scale = input$scale_cauchy)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Cauchy(", input$location_cauchy, ", ", input$scale_cauchy, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Chi-square' && input$lower_tail_chisquare == 'lower.tail') {
funcShaded <- function(x) {
y <- dchisq(x, df = input$df_chisquare)
y[x > input$x1_chisquare] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qchisq(0.99999, df = input$df_chisquare, lower.tail = FALSE), qchisq(0.99999, df = input$df_chisquare, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dchisq, args = list(df = input$df_chisquare)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Chi(", input$df_chisquare, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Chi-square' && input$lower_tail_chisquare == 'upper.tail') {
funcShaded <- function(x) {
y <- dchisq(x, df = input$df_chisquare)
y[x < input$x2_chisquare] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qchisq(0.99999, df = input$df_chisquare, lower.tail = FALSE), qchisq(0.99999, df = input$df_chisquare, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dchisq, args = list(df = input$df_chisquare)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Chi(", input$df_chisquare, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Chi-square' && input$lower_tail_chisquare == 'interval') {
funcShaded <- function(x) {
y <- dchisq(x, df = input$df_chisquare)
y[x < input$a_chisquare | x > input$b_chisquare] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qchisq(0.99999, df = input$df_chisquare, lower.tail = FALSE), qchisq(0.99999, df = input$df_chisquare, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dchisq, args = list(df = input$df_chisquare)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Chi(", input$df_chisquare, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Exponential' && input$lower_tail_exponential == 'lower.tail') {
funcShaded <- function(x) {
y <- dexp(x, rate = input$rate_exponential)
y[x > input$x1_exponential] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qexp(0.99999, rate = input$rate_exponential, lower.tail = FALSE), qexp(0.99999, rate = input$rate_exponential, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dexp, args = list(rate = input$rate_exponential)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Exp(", input$rate_exponential, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Exponential' && input$lower_tail_exponential == 'upper.tail') {
funcShaded <- function(x) {
y <- dexp(x, rate = input$rate_exponential)
y[x < input$x2_exponential] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qexp(0.99999, rate = input$rate_exponential, lower.tail = FALSE), qexp(0.99999, rate = input$rate_exponential, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dexp, args = list(rate = input$rate_exponential)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Exp(", input$rate_exponential, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Exponential' && input$lower_tail_exponential == 'interval') {
funcShaded <- function(x) {
y <- dexp(x, rate = input$rate_exponential)
y[x < input$a_exponential | x > input$b_exponential] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qexp(0.99999, rate = input$rate_exponential, lower.tail = FALSE), qexp(0.99999, rate = input$rate_exponential, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dexp, args = list(rate = input$rate_exponential)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Exp(", input$rate_exponential, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Fisher' && input$lower_tail_fisher == 'lower.tail') {
funcShaded <- function(x) {
y <- df(x, df1 = input$df1_fisher, df2 = input$df2_fisher)
y[x > input$x1_fisher] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(0, 5)), aes(x = x)) +
stat_function(fun = df, args = list(df1 = input$df1_fisher, df2 = input$df2_fisher)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: F(", input$df1_fisher, ", ", input$df2_fisher, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Fisher' && input$lower_tail_fisher == 'upper.tail') {
funcShaded <- function(x) {
y <- df(x, df1 = input$df1_fisher, df2 = input$df2_fisher)
y[x < input$x2_fisher] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(0, 5)), aes(x = x)) +
stat_function(fun = df, args = list(df1 = input$df1_fisher, df2 = input$df2_fisher)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: F(", input$df1_fisher, ", ", input$df2_fisher, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Fisher' && input$lower_tail_fisher == 'interval') {
funcShaded <- function(x) {
y <- df(x, df1 = input$df1_fisher, df2 = input$df2_fisher)
y[x < input$a_fisher | x > input$b_fisher] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(0, 5)), aes(x = x)) +
stat_function(fun = df, args = list(df1 = input$df1_fisher, df2 = input$df2_fisher)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: F(", input$df1_fisher, ", ", input$df2_fisher, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Gamma' && input$lower_tail_gamma == 'lower.tail') {
funcShaded <- function(x) {
y <- dgamma(x, shape = input$alpha_gamma, rate = input$beta_gamma)
y[x > input$x1_gamma] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qgamma(0.99999, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = FALSE), qgamma(0.99999, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dgamma, args = list(shape = input$alpha_gamma, rate = input$beta_gamma)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Gamma(", input$alpha_gamma, ", ", input$beta_gamma, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Gamma' && input$lower_tail_gamma == 'upper.tail') {
funcShaded <- function(x) {
y <- dgamma(x, shape = input$alpha_gamma, rate = input$beta_gamma)
y[x < input$x2_gamma] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qgamma(0.99999, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = FALSE), qgamma(0.99999, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dgamma, args = list(shape = input$alpha_gamma, rate = input$beta_gamma)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Gamma(", input$alpha_gamma, ", ", input$beta_gamma, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Gamma' && input$lower_tail_gamma == 'interval') {
funcShaded <- function(x) {
y <- dgamma(x, shape = input$alpha_gamma, rate = input$beta_gamma)
y[x < input$a_gamma | x > input$b_gamma] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qgamma(0.99999, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = FALSE), qgamma(0.99999, shape = input$alpha_gamma, rate = input$beta_gamma, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dgamma, args = list(shape = input$alpha_gamma, rate = input$beta_gamma)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Gamma(", input$alpha_gamma, ", ", input$beta_gamma, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Geometric (I)' && input$lower_tail_geometric == 'lower.tail') {
p <- data.frame(heads = 0:(input$p_geometric + (5 * sqrt((1 - input$p_geometric) / (input$p_geometric^2)))), prob = dgeom(x = 0:(input$p_geometric + (5 * sqrt((1 - input$p_geometric) / (input$p_geometric^2)))), prob = input$p_geometric)) %>%
mutate(Heads = ifelse(heads <= input$x1_geometric, "2", "Other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Geom(", input$p_geometric, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Geometric (I)' && input$lower_tail_geometric == 'upper.tail') {
p <- data.frame(heads = 0:(input$p_geometric + (5 * sqrt((1 - input$p_geometric) / (input$p_geometric^2)))), prob = dgeom(x = 0:(input$p_geometric + (5 * sqrt((1 - input$p_geometric) / (input$p_geometric^2)))), prob = input$p_geometric)) %>%
mutate(Heads = ifelse(heads > input$x2_geometric, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Geom(", input$p_geometric, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Geometric (I)' && input$lower_tail_geometric == 'interval') {
p <- data.frame(heads = 0:(input$p_geometric + (5 * sqrt((1 - input$p_geometric) / (input$p_geometric^2)))), prob = dgeom(x = 0:(input$p_geometric + (5 * sqrt((1 - input$p_geometric) / (input$p_geometric^2)))), prob = input$p_geometric)) %>%
mutate(Heads = ifelse(heads >= input$a_geometric & heads <= input$b_geometric, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Geom(", input$p_geometric, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Geometric (II)' && input$lower_tail_geometric2 == 'lower.tail') {
p <- data.frame(heads = 1:(input$p_geometric2 + (5 * sqrt((1 - input$p_geometric2) / (input$p_geometric2^2))) + 1), prob = dgeom(x = 0:(input$p_geometric2 + (5 * sqrt((1 - input$p_geometric2) / (input$p_geometric2^2)))), prob = input$p_geometric2)) %>%
mutate(Heads = ifelse(heads <= input$x1_geometric2, "2", "Other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Geom(", input$p_geometric2, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Geometric (II)' && input$lower_tail_geometric2 == 'upper.tail') {
p <- data.frame(heads = 1:(input$p_geometric2 + (5 * sqrt((1 - input$p_geometric2) / (input$p_geometric2^2))) + 1), prob = dgeom(x = 0:(input$p_geometric2 + (5 * sqrt((1 - input$p_geometric2) / (input$p_geometric2^2)))), prob = input$p_geometric2)) %>%
mutate(Heads = ifelse(heads > input$x2_geometric2, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Geom(", input$p_geometric2, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Geometric (II)' && input$lower_tail_geometric2 == 'interval') {
p <- data.frame(heads = 1:(input$p_geometric2 + (5 * sqrt((1 - input$p_geometric2) / (input$p_geometric2^2))) + 1), prob = dgeom(x = 0:(input$p_geometric2 + (5 * sqrt((1 - input$p_geometric2) / (input$p_geometric2^2)))), prob = input$p_geometric2)) %>%
mutate(Heads = ifelse(heads >= input$a_geometric2 & heads <= input$b_geometric2, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Geom(", input$p_geometric2, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Hypergeometric' && input$lower_tail_hypergeometric == 'lower.tail') {
p <- data.frame(heads = qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = FALSE):qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE), prob = dhyper(x = qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = FALSE):qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE), m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric)) %>%
mutate(Heads = ifelse(heads <= input$x1_hypergeometric, "2", "Other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: HG(", input$n_hypergeometric, ", ", input$N_hypergeometric, ", ", input$M_hypergeometric, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Hypergeometric' && input$lower_tail_hypergeometric == 'upper.tail') {
p <- data.frame(heads = qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = FALSE):qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE), prob = dhyper(x = qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = FALSE):qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE), m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric)) %>%
mutate(Heads = ifelse(heads > input$x2_hypergeometric, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: HG(", input$n_hypergeometric, ", ", input$N_hypergeometric, ", ", input$M_hypergeometric, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Hypergeometric' && input$lower_tail_hypergeometric == 'interval') {
p <- data.frame(heads = qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = FALSE):qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE), prob = dhyper(x = qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = FALSE):qhyper(0.99999, m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric, lower.tail = TRUE), m = input$M_hypergeometric, n = (input$N_hypergeometric - input$M_hypergeometric), k = input$n_hypergeometric)) %>%
mutate(Heads = ifelse(heads >= input$a_hypergeometric & heads <= input$b_hypergeometric, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: HG(", input$n_hypergeometric, ", ", input$N_hypergeometric, ", ", input$M_hypergeometric, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Logistic' && input$lower_tail_logistic == 'lower.tail') {
funcShaded <- function(x) {
y <- dlogis(x, location = input$location_logistic, scale = input$scale_logistic)
y[x > input$x1_logistic] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qlogis(0.99999, location = input$location_logistic, scale = input$scale_logistic, lower.tail = FALSE), qlogis(0.99999, location = input$location_logistic, scale = input$scale_logistic, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dlogis, args = list(location = input$location_logistic, scale = input$scale_logistic)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Logi(", input$location_logistic, ", ", input$scale_logistic, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Logistic' && input$lower_tail_logistic == 'upper.tail') {
funcShaded <- function(x) {
y <- dlogis(x, location = input$location_logistic, scale = input$scale_logistic)
y[x < input$x2_logistic] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qlogis(0.99999, location = input$location_logistic, scale = input$scale_logistic, lower.tail = FALSE), qlogis(0.99999, location = input$location_logistic, scale = input$scale_logistic, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dlogis, args = list(location = input$location_logistic, scale = input$scale_logistic)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Logi(", input$location_logistic, ", ", input$scale_logistic, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Logistic' && input$lower_tail_logistic == 'interval') {
funcShaded <- function(x) {
y <- dlogis(x, location = input$location_logistic, scale = input$scale_logistic)
y[x < input$a_logistic | x > input$b_logistic] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qlogis(0.99999, location = input$location_logistic, scale = input$scale_logistic, lower.tail = FALSE), qlogis(0.99999, location = input$location_logistic, scale = input$scale_logistic, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dlogis, args = list(location = input$location_logistic, scale = input$scale_logistic)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Logi(", input$location_logistic, ", ", input$scale_logistic, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Log-Normal' && input$lower_tail_lognormal == 'lower.tail') {
funcShaded <- function(x) {
y <- dlnorm(x,
meanlog = input$mean_lognormal,
sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal)
)
y[x > input$x1_lognormal] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(0, qlnorm(0.9, meanlog = input$mean_lognormal, sdlog = input$sd_lognormal))), aes(x = x)) +
stat_function(fun = dlnorm, args = list(
meanlog = input$mean_lognormal,
sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal)
)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Lognormal(", input$mean_lognormal, ", ", ifelse(input$variance_sd_lognormal == "variance_true", input$variance_lognormal, (input$sd_lognormal^2)), ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Log-Normal' && input$lower_tail_lognormal == 'upper.tail') {
funcShaded <- function(x) {
y <- dlnorm(x,
meanlog = input$mean_lognormal,
sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal)
)
y[x < input$x2_lognormal] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(0, qlnorm(0.9, meanlog = input$mean_lognormal, sdlog = input$sd_lognormal))), aes(x = x)) +
stat_function(fun = dlnorm, args = list(
meanlog = input$mean_lognormal,
sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal)
)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Lognormal(", input$mean_lognormal, ", ", ifelse(input$variance_sd_lognormal == "variance_true", input$variance_lognormal, (input$sd_lognormal^2)), ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Log-Normal' && input$lower_tail_lognormal == 'interval') {
funcShaded <- function(x) {
y <- dlnorm(x,
meanlog = input$mean_lognormal,
sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal)
)
y[x < input$a_lognormal | x > input$b_lognormal] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(0, qlnorm(0.9, meanlog = input$mean_lognormal, sdlog = input$sd_lognormal))), aes(x = x)) +
stat_function(fun = dlnorm, args = list(
meanlog = input$mean_lognormal,
sdlog = ifelse(input$variance_sd_lognormal == "variance_true", sqrt(input$variance_lognormal), input$sd_lognormal)
)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: Lognormal(", input$mean_lognormal, ", ", ifelse(input$variance_sd_lognormal == "variance_true", input$variance_lognormal, (input$sd_lognormal^2)), ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Negative Binomial (I)' && input$lower_tail_negativebinomial == 'lower.tail') {
p <- data.frame(heads = qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = FALSE):qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE), prob = dnbinom(x = qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = FALSE):qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE), size = input$r_negativebinomial, prob = input$p_negativebinomial)) %>%
mutate(Heads = ifelse(heads <= input$x1_negativebinomial, "2", "Other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: NG(", input$r_negativebinomial, ", ", input$p_negativebinomial, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Negative Binomial (I)' && input$lower_tail_negativebinomial == 'upper.tail') {
p <- data.frame(heads = qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = FALSE):qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE), prob = dnbinom(x = qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = FALSE):qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE), size = input$r_negativebinomial, prob = input$p_negativebinomial)) %>%
mutate(Heads = ifelse(heads > input$x2_negativebinomial, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: NG(", input$r_negativebinomial, ", ", input$p_negativebinomial, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Negative Binomial (I)' && input$lower_tail_negativebinomial == 'interval') {
p <- data.frame(heads = qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = FALSE):qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE), prob = dnbinom(x = qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = FALSE):qnbinom(0.999, size = input$r_negativebinomial, prob = input$p_negativebinomial, lower.tail = TRUE), size = input$r_negativebinomial, prob = input$p_negativebinomial)) %>%
mutate(Heads = ifelse(heads >= input$a_negativebinomial & heads <= input$b_negativebinomial, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: NG(", input$r_negativebinomial, ", ", input$p_negativebinomial, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Negative Binomial (II)' && input$lower_tail_negativebinomial2 == 'lower.tail') {
p <- data.frame(heads = input$r_negativebinomial2:(qnbinom(0.999, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE) + input$r_negativebinomial2), prob = dnbinom(x = 0:qnbinom(0.999, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE), size = input$r_negativebinomial2, prob = input$p_negativebinomial2)) %>%
mutate(Heads = ifelse(heads <= input$x1_negativebinomial2, "2", "Other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: NG(", input$r_negativebinomial2, ", ", input$p_negativebinomial2, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Negative Binomial (II)' && input$lower_tail_negativebinomial2 == 'upper.tail') {
p <- data.frame(heads = input$r_negativebinomial2:(qnbinom(0.999, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE) + input$r_negativebinomial2), prob = dnbinom(x = 0:qnbinom(0.999, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE), size = input$r_negativebinomial2, prob = input$p_negativebinomial2)) %>%
mutate(Heads = ifelse(heads > input$x2_negativebinomial2, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: NG(", input$r_negativebinomial2, ", ", input$p_negativebinomial2, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Negative Binomial (II)' && input$lower_tail_negativebinomial2 == 'interval') {
p <- data.frame(heads = input$r_negativebinomial2:(qnbinom(0.999, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE) + input$r_negativebinomial2), prob = dnbinom(x = 0:qnbinom(0.999, size = input$r_negativebinomial2, prob = input$p_negativebinomial2, lower.tail = TRUE), size = input$r_negativebinomial2, prob = input$p_negativebinomial2)) %>%
mutate(Heads = ifelse(heads >= input$a_negativebinomial2 & heads <= input$b_negativebinomial2, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: NG(", input$r_negativebinomial2, ", ", input$p_negativebinomial2, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Normal' && input$lower_tail_normal == 'lower.tail') {
funcShaded <- function(x) {
y <- dnorm(x,
mean = input$mean_normal,
sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal)
)
y[x > input$x1_normal] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qnorm(0.99999, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = FALSE), qnorm(0.99999, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dnorm, args = list(
mean = input$mean_normal,
sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal)
)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: N(", input$mean_normal, ", ", ifelse(input$variance_sd == "variance_true", input$variance_normal, (input$sd_normal^2)), ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Normal' && input$lower_tail_normal == 'upper.tail') {
funcShaded <- function(x) {
y <- dnorm(x,
mean = input$mean_normal,
sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal)
)
y[x < input$x2_normal] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qnorm(0.99999, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = FALSE), qnorm(0.99999, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dnorm, args = list(
mean = input$mean_normal,
sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal)
)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: N(", input$mean_normal, ", ", ifelse(input$variance_sd == "variance_true", input$variance_normal, (input$sd_normal^2)), ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Normal' && input$lower_tail_normal == 'interval') {
funcShaded <- function(x) {
y <- dnorm(x,
mean = input$mean_normal,
sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal)
)
y[x < input$a_normal | x > input$b_normal] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qnorm(0.99999, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = FALSE), qnorm(0.99999, mean = input$mean_normal, sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal), lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dnorm, args = list(
mean = input$mean_normal,
sd = ifelse(input$variance_sd == "variance_true", sqrt(input$variance_normal), input$sd_normal)
)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: N(", input$mean_normal, ", ", ifelse(input$variance_sd == "variance_true", input$variance_normal, (input$sd_normal^2)), ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Poisson' && input$lower_tail_poisson == 'lower.tail') {
p <- data.frame(heads = qpois(0.99999, lambda = input$lambda_poisson, lower.tail = FALSE):qpois(0.99999, lambda = input$lambda_poisson, lower.tail = TRUE), prob = dpois(x = qpois(0.99999, lambda = input$lambda_poisson, lower.tail = FALSE):qpois(0.99999, lambda = input$lambda_poisson, lower.tail = TRUE), lambda = input$lambda_poisson)) %>%
mutate(Heads = ifelse(heads <= input$x1_poisson, "2", "Other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Pois(", input$lambda_poisson, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Poisson' && input$lower_tail_poisson == 'upper.tail') {
p <- data.frame(heads = qpois(0.99999, lambda = input$lambda_poisson, lower.tail = FALSE):qpois(0.99999, lambda = input$lambda_poisson, lower.tail = TRUE), prob = dpois(x = qpois(0.99999, lambda = input$lambda_poisson, lower.tail = FALSE):qpois(0.99999, lambda = input$lambda_poisson, lower.tail = TRUE), lambda = input$lambda_poisson)) %>%
mutate(Heads = ifelse(heads > input$x2_poisson, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Pois(", input$lambda_poisson, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Poisson' && input$lower_tail_poisson == 'interval') {
p <- data.frame(heads = qpois(0.99999, lambda = input$lambda_poisson, lower.tail = FALSE):qpois(0.99999, lambda = input$lambda_poisson, lower.tail = TRUE), prob = dpois(x = qpois(0.99999, lambda = input$lambda_poisson, lower.tail = FALSE):qpois(0.99999, lambda = input$lambda_poisson, lower.tail = TRUE), lambda = input$lambda_poisson)) %>%
mutate(Heads = ifelse(heads >= input$a_poisson & heads <= input$b_poisson, "2", "other")) %>%
ggplot(aes(x = factor(heads), y = prob, fill = Heads)) +
geom_col() +
geom_text(
aes(label = round(prob, 3), y = prob + 0.005),
position = position_dodge(0.9),
size = 3,
vjust = 0
) +
theme_minimal() +
theme(legend.position = "none") +
ggtitle(paste0(input$distribution, " distribution: Pois(", input$lambda_poisson, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Probability mass function") +
xlab("x")
p
} else if (input$distribution == 'Student' && input$lower_tail_student == 'lower.tail') {
funcShaded <- function(x) {
y <- dt(x, df = input$df_student)
y[x > input$x1_student] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qt(0.99999, df = input$df_student, lower.tail = FALSE), qt(0.99999, df = input$df_student, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dt, args = list(df = input$df_student)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: St(", input$df_student, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +
xlab("x")
p
} else if (input$distribution == 'Student' && input$lower_tail_student == 'upper.tail') {
funcShaded <- function(x) {
y <- dt(x, df = input$df_student)
y[x < input$x2_student] <- NA
return(y)
}
p <- ggplot(data.frame(x = c(qt(0.99999, df = input$df_student, lower.tail = FALSE), qt(0.99999, df = input$df_student, lower.tail = TRUE))), aes(x = x)) +
stat_function(fun = dt, args = list(df = input$df_student)) +
stat_function(fun = funcShaded, geom = "area", alpha = 0.8) +
theme_minimal() +
ggtitle(paste0(input$distribution, " distribution: St(", input$df_student, ")")) +
theme(plot.title = element_text(face = "bold", hjust = 0.5)) +
ylab("Density") +