Practice_set_9.1

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 9.1

Question 8

q8df <-(parameters(~mu,~n,c(-2,-1,0,1,2),c(5,10,20,40,80))
        %>%add_trials(10000)
        %>%mutate(Yn = pmap(list(mu,n),\(m,n) rnorm(n,m,1)),Y1hat = map_dbl(Yn,mean),Y2hat= map_dbl(Yn,\(y) mean(y^2)),theta1 = (Y1hat)^2-1/n,theta2 = Y2hat - 1)
)
q8df

# A tibble: 250,000 × 8
      mu     n .trial Yn        Y1hat Y2hat theta1 theta2
   <dbl> <dbl>  <dbl> <list>    <dbl> <dbl>  <dbl>  <dbl>
 1    -2     5      1 <dbl [5]> -2.84  8.98  7.85   7.98 
 2    -2     5      2 <dbl [5]> -1.29  2.03  1.47   1.03 
 3    -2     5      3 <dbl [5]> -1.71  4.16  2.71   3.16 
 4    -2     5      4 <dbl [5]> -2.35  6.10  5.31   5.10 
 5    -2     5      5 <dbl [5]> -2.24  5.52  4.80   4.52 
 6    -2     5      6 <dbl [5]> -1.09  1.91  0.996  0.914
 7    -2     5      7 <dbl [5]> -2.03  5.60  3.90   4.60 
 8    -2     5      8 <dbl [5]> -2.51  7.69  6.11   6.69 
 9    -2     5      9 <dbl [5]> -1.90  5.71  3.41   4.71 
10    -2     5     10 <dbl [5]> -2.14  5.00  4.40   4.00 
# ℹ 249,990 more rows

q8df1 <- (q8df %>%
  select(mu,n,theta1,theta2) %>%
  pivot_longer(theta1:theta2,
                       names_to = "Estimator",
                       values_to = "Estimate") %>%
    summarize("Bias" = mean(Estimate - mu^2),"Variance" = var(Estimate),.by = c(mu,n,Estimator))
  
  
)
q8df1

# A tibble: 50 × 5
      mu     n Estimator     Bias Variance
   <dbl> <dbl> <chr>        <dbl>    <dbl>
 1    -2     5 theta1    0.0296      3.30 
 2    -2     5 theta2    0.0240      3.61 
 3    -2    10 theta1    0.0243      1.63 
 4    -2    10 theta2    0.0154      1.80 
 5    -2    20 theta1    0.00191     0.796
 6    -2    20 theta2    0.000855    0.892
 7    -2    40 theta1    0.0124      0.396
 8    -2    40 theta2    0.0125      0.442
 9    -2    80 theta1    0.00415     0.204
10    -2    80 theta2    0.00565     0.228
# ℹ 40 more rows

ggplot(data = q8df1) +
  geom_line(aes(x = n,y = Bias,colour = Estimator)) +
  geom_hline(aes(yintercept = 0)) +
  facet_grid(~mu,labeller =label_both) +
  lims(y = c(-.05,.05)) + 
  theme_classic()

As shown in the above visual both \(\hat{\theta}_1\) and \(\hat{\theta}_2\) simulated bias are both nearly unbiased for all \(n\).

ggplot(data = q8df1) +
  geom_line(aes(x = n,y = Variance,colour = Estimator)) +
  facet_grid(~mu,labeller =label_both) +
  theme_classic()

As shown in the above visual, the for all \(n\) ,\(\mu\) combinations, \(\hat{\theta}_1\) has lower variance than \(\hat{\theta}_2\).