7.2 Practice Set

library(tidyverse)

Warning: package 'tidyverse' was built under R version 4.3.3

Warning: package 'tibble' was built under R version 4.3.3

Warning: package 'tidyr' was built under R version 4.3.3

Warning: package 'readr' was built under R version 4.3.3

Warning: package 'purrr' was built under R version 4.3.3

Warning: package 'dplyr' was built under R version 4.3.3

Warning: package 'stringr' was built under R version 4.3.3

Warning: package 'forcats' was built under R version 4.3.3

Warning: package 'lubridate' was built under R version 4.3.3

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   4.0.1     ✔ tibble    3.2.1
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(purrrfect)

Attaching package: 'purrrfect'

The following objects are masked from 'package:base':

    replicate, tabulate

library(patchwork)

Practice Set 7.2

Problem 7

A

Creating Function and DataFrame

kth_st <- \(n,k) {
  ns <-sort(n)
  kth = ns[k]
  return(kth)
}

(p7df <- parameters(~n,c(4,8,12,16))
  %>%add_trials(10000)
  %>%mutate(Y = pmap(list(n),\(x) runif(x,0,1)),Y1 = map_dbl(Y,\(x) kth_st(x,1)),Y3 = map_dbl(Y,\(x) kth_st(x,3)),Yn = pmap_dbl(list(Y,n),\(x,y) kth_st(x,y)),f1=pmap_dbl(list(Y1,n),\(y,x) dbeta(y,1,x-1+1)),f3=pmap_dbl(list(Y3,n),\(y,x) dbeta(y,3,x-3+1)),fn=pmap_dbl(list(Yn,n),\(y,x) dbeta(y,x,x-x+1)))
)

# A tibble: 40,000 × 9
       n .trial Y             Y1    Y3    Yn    f1    f3    fn
   <dbl>  <dbl> <list>     <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
 1     4      1 <dbl [4]> 0.0974 0.666 0.973 2.94  1.78  3.68 
 2     4      2 <dbl [4]> 0.0170 0.619 1.000 3.80  1.75  3.99 
 3     4      3 <dbl [4]> 0.362  0.883 0.918 1.04  1.10  3.10 
 4     4      4 <dbl [4]> 0.153  0.486 0.654 2.43  1.46  1.12 
 5     4      5 <dbl [4]> 0.253  0.885 0.927 1.67  1.08  3.18 
 6     4      6 <dbl [4]> 0.220  0.627 0.944 1.90  1.76  3.36 
 7     4      7 <dbl [4]> 0.693  0.926 0.945 0.115 0.766 3.37 
 8     4      8 <dbl [4]> 0.223  0.696 0.922 1.88  1.77  3.13 
 9     4      9 <dbl [4]> 0.133  0.504 0.726 2.60  1.51  1.53 
10     4     10 <dbl [4]> 0.230  0.325 0.503 1.83  0.854 0.511
# ℹ 39,990 more rows

Plotting the Simulated vs Analytic Density.

Y1

(ggplot(data = p7df)
+ geom_histogram(aes(x = Y1,y = after_stat(density)), fill = "gold",binwidth = .01,center = .05)
+ geom_line(aes(x=Y1,y=f1),color = "blue")
+ facet_grid(~n,labeller =label_both,scales = "free")
+ theme_classic()
+ labs(title = "Y1")
)

Y3

(ggplot(data = p7df)
+ geom_histogram(aes(x = Y3,y = after_stat(density)), fill = "gold",binwidth = .01,center = .05)
+ geom_line(aes(x=Y3,y=f3),color = "blue")
+ facet_grid(~n,labeller =label_both,scales = "free")
+ theme_classic()
+ labs(title = "Y3")
)

Yn

(ggplot(data = p7df)
+ geom_histogram(aes(x = Yn,y = after_stat(density)), fill = "gold",binwidth = .01,center = .05)
+ geom_line(aes(x=Yn,y=fn),color = "blue")
+ facet_grid(~n,labeller =label_both,scales = "free")
+ theme_classic()
+ labs(title = "Yn")
)