Practice_set_8.3

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

Practice Set 8.3

Problem 8

q8df <- (parameters(~n,~theta,seq(50,1000,50),c(.2,.5,.8))
         %>%add_trials(5000)
         %>%mutate(Yn = pmap(list(n,theta),\(n,t) rbeta(n,t,3)),U = map(Yn,\(y) y/(1-y)), t_hat = pmap_dbl(list(U,n),\(u,n) 2*sum(u)/n),eps = ifelse(abs(t_hat-theta)< .1,1,0))
)
q8df

# A tibble: 300,000 × 7
       n theta .trial Yn         U          t_hat   eps
   <dbl> <dbl>  <dbl> <list>     <list>     <dbl> <dbl>
 1    50   0.2      1 <dbl [50]> <dbl [50]> 0.302     0
 2    50   0.2      2 <dbl [50]> <dbl [50]> 0.191     1
 3    50   0.2      3 <dbl [50]> <dbl [50]> 0.138     1
 4    50   0.2      4 <dbl [50]> <dbl [50]> 0.185     1
 5    50   0.2      5 <dbl [50]> <dbl [50]> 0.210     1
 6    50   0.2      6 <dbl [50]> <dbl [50]> 0.215     1
 7    50   0.2      7 <dbl [50]> <dbl [50]> 0.167     1
 8    50   0.2      8 <dbl [50]> <dbl [50]> 0.175     1
 9    50   0.2      9 <dbl [50]> <dbl [50]> 0.143     1
10    50   0.2     10 <dbl [50]> <dbl [50]> 0.330     0
# ℹ 299,990 more rows

qdf <- (q8df %>% summarize("Within_Epsilon" = mean(eps),.by = c(n,theta))

)

ggplot(data = qdf) +
  geom_line(aes(x=n,y=Within_Epsilon)) +
  labs(x="n",y=expression(P(abs(hat(theta) - theta) < epsilon))) +
  facet_grid(~theta,labeller = label_both) +
  theme_classic()

As shown in the plot above, the rate of convergence appears to be higher when theta is lower, looking to be approaching \(1\) at around \(n=400\) , for \(\theta = .2\) . For \(\theta = .5\), it looks to be approaching \(1\) at \(n=1000\) , but for \(\theta = .8\) , even after \(n=1000\), the probability of being within \(\epsilon\) has still not really “settled down”, and still has a ways to go.