Theme Song 



colorize <- function(x, color) {
  if (knitr::is_latex_output()) {
    sprintf("\\textcolor{%s}{%s}", color, x)
  } else if (knitr::is_html_output()) {
    sprintf("<span style='color: %s;'>%s</span>", color, 
      x)
  } else x
}
/* https://stackoverflow.com/a/66029010/3806250 */
h1 { color: #002C54; }
h2 { color: #2F496E; }
h3 { color: #375E97; }

/* https://bookdown.org/yihui/rmarkdown-cookbook/chunk-styling.html */
.gradient1 {
  background: linear-gradient(155deg, #F9BA32 0%, #FFEB94 100%);
}
    
.gradient2 {
  color: #FFD64D;
  background: linear-gradient(155deg, #002C54 0%, #4CB5F5 100%);
  /*background-image: linear-gradient(to right,golden,golden, yellow, yellow);*/
  /*-webkit-background-clip: text;*/
  /*display: inline-block;*/
  /*padding: 14px;*/
  /*-webkit-text-fill-color: transparent;*/
  /*font-family: 'Stay Out Regular';*/
}

.shine {
    background: #FFD64D -webkit-gradient(linear, left top, right top, from(#222), to(#222), color-stop(0.5, yellow)) 0 0 no-repeat;
    -webkit-background-size: 150px;
    color: $text-color;
    -webkit-background-clip: text;
    -webkit-animation-name: shine;
    -webkit-animation-duration: $duration;
    -webkit-animation-iteration-count: infinite;
    text-shadow: 0 0px 0px golden-rod;
}
knitr::opts_chunk$set(class.source = 'gradient1', class.output = 'gradient2')



1 受講生によるテスト：Likelihood function for mixture models

これは初めての受講生による相互テストのようです。 詳細

課題を受ける準備はできていますか？ 以下に提出のための指示が表示されます。

1.1 説明

Consider the code provided in the lesson “Sample code for simulating from a Mixture Model”:

# Generate n observations from a mixture of two Gaussian 
# distributions
n     = 50           # Size of the sample to be generated
w     = c(0.6, 0.4)  # Weights
mu    = c(0, 5)      # Means
sigma = c(1, 2)      # Standard deviations
cc    = sample(1:2, n, replace=TRUE, prob=w)
x     = rnorm(n, mu[cc], sigma[cc])
x
##  [1] -0.08074239  6.39528190  7.71814255  7.12083241 -0.52750805  4.59499262
##  [7]  4.70277685 -0.39792852  7.54490895  1.65579612  2.78905455  4.20777270
## [13]  1.08565458  0.69795647 -0.02692528  1.46498435  0.23677432  2.86876417
## [19] -0.33415616  5.04199936  0.01756138  3.13329151  5.15981695  4.75469514
## [25] -0.53386498 -0.87514285  0.86974401  2.16827075  1.20615264 -0.48163180
## [31]  1.11254012 -0.02797385 -0.27335763  0.72426552  5.11790057 -1.38955013
## [37]  7.33655264  4.58720880 -0.98730694  3.49299974  0.02172098 -0.35948738
## [43]  0.62515860  1.94379273  0.03328663  1.60968466  5.27086855  1.66141346
## [49]  3.08545456  5.68667228

Modify the code above to sample 200 random numbers from a mixture of 3 Poisson distributions with means 1, 2 and 6 and weights 0.7, 0.2 and 0.1, respectively, and generate a barplot with the empirical frequencies of all the integers included in the sample.



1.1.1 Review criteria

The response should follow the same template as the sample code provided above. Peer reviewers will be asked to check whether the different pieces of code have been adequately modified to reflect the fact that (1) you are working now with 3 components rather than 2, (2) that the components of the mixture are Poisson distributions rather than Gaussians, (3) that the empirical frequencies associated with the sample generated are correctly computed, (4) that a barplot is used to represent the empirical frequencies.



1.2 自分の提出物

プロジェクト名 Likelihood function for mixture models

プロジェクトにわかりやすいタイトルを付けてください

Enter code to sample 100 random numbers from a mixture of 4 exponential distributions with means 1, 4, 7 and 10 and weights 0.3, 0.25, 0.25 and 0.2, respectively.

# Generate n observations from a mixture of two Gaussian 
# distributions
n   = 100                      # Size of the sample to be generated
w   = c(0.3, 0.25, 0.25, 0.2)  # Weights
mu  = c(1, 4, 7, 10)           # Means
cc  = sample(1:4, n, replace=TRUE, prob=w)
x   = rexp(n, 1/mu[cc])
x
##   [1] 18.340719956 43.246508730  2.533307588  0.134090208  5.388871328
##   [6]  0.116399245 23.304638861  0.512406153  1.587890735  1.388059607
##  [11]  8.265532963  0.965037725  9.374211374  0.447060796  3.557260678
##  [16]  9.698167242  0.306809288  2.714990761  5.301947396  0.630419871
##  [21] 16.742752086  0.174212199 16.958053415  6.472640603 19.232117009
##  [26]  0.303570907  0.336385044  4.366551322  1.209150867 11.806705566
##  [31]  7.178726958  3.641789216 10.652579544  2.875194380  2.443497227
##  [36]  9.513856254  0.021253127 12.858903622 18.688936968  1.142709649
##  [41]  1.032735537  1.312298965 31.603768877  0.140332252  6.018729356
##  [46]  5.674053900  5.682170726 15.998000524 21.751031457  1.365986215
##  [51]  0.344387457  1.588630664  1.480360579 10.346487946 23.839950281
##  [56]  1.105212746  3.327505302  2.390969547  3.486187179  1.329746963
##  [61]  1.220080495  0.361334701  8.798610717  0.471925168  4.144668775
##  [66]  6.482775528  6.442180098  0.389642569  1.708779126  0.290222323
##  [71]  1.002151940  0.757500124  0.007297152  4.389511484  0.476419631
##  [76]  0.224691078  0.543737839  1.785901778  0.501141130  0.894213374
##  [81]  1.752307284  0.836013021  1.432934132 14.313704125  0.878522543
##  [86]  4.278550390  7.873319208  5.939449313  0.303121166  0.252574664
##  [91]  2.668014945  9.128732011  0.135948084  0.279723894 25.544764789
##  [96] 11.744293345 15.033354553  0.494676943  7.685935780  5.187462054

あなたの答えはもう少し長くする必要があります。課題を完了するために、いくつかの文章を書いてください。

Use these sample to approximate the mean and variance of the mixture.

paste('mean =', mean(x))
## [1] "mean = 5.80908650218049"
paste('var =', var(x))
## [1] "var = 59.8868907242027"

あなたの答えはもう少し長くする必要があります。課題を完了するために、いくつかの文章を書いてください。

1.3 ピアレビューディスカッション

1.3.1 ルーブリック

Have the parameters of the mixture (both weights and component-specific parameters) been correctly specified?

n = 50
w = c(0.6, 0.4)  # Weights
mu = c(0, 5)     # Means
sigma = c(1, 2)  # Standard deviations

in the original code should have been replaced by something like

n = 100
w = c(0.3, 0.25, 0.25, 0.2)  # Weights
lambda = c(1, 4, 7, 10)      # Means

  • 0点 No

  • 1点 Yes

Is the sampling of the indicator variables done correctly?

cc = sample(1:2, n, replace=TRUE, prob=w)
## Error in sample.int(length(x), size, replace, prob): incorrect number of probabilities

in the original code should now be something like

cc = sample(1:4, n, replace=TRUE, prob=w)

to reflect the fact that we now have 4 components in the mixture.

  • 0点 No

  • 1点 Yes

Assuming that the indicator variables have been correctly sampled, are the observations being sampled correctly?

x = rnorm(n, mu[cc], sigma[cc])
## Warning in rnorm(n, mu[cc], sigma[cc]): NAs produced

should now be something like

x = rexp(n, 1/lambda[cc])

to reflect the fact that the components of the mixture are all exponential distributions. Note that rexp() takes the rate of the distribution (the inverse of the main) as an input. Make sure that this part has been coded correctly!

  • 0点 No

  • 1点 Yes

1.3.2 ルーブリック

Is the procedure to approximate the mean and variance correct?

The mean and variance of the mixture can be approximated by the empirical mean and variance of the observations

mean(x)
## [1] 5.419553
var(x)
## [1] 68.81067

  • 0点 No

  • 1点 Yes

2 Appendix

2.1 Blooper

2.2 Documenting File Creation

It’s useful to record some information about how your file was created.

  • File creation date: 2021-05-10
  • File latest updated date: 2021-05-11
  • R version 4.0.5 (2021-03-31)
  • rmarkdown package version: 2.8
  • File version: 1.0.0
  • Author Profile: ®γσ, Eng Lian Hu
  • GitHub: Source Code
  • Additional session information:
suppressMessages(require('dplyr', quietly = TRUE))
suppressMessages(require('magrittr', quietly = TRUE))
suppressMessages(require('formattable', quietly = TRUE))
suppressMessages(require('knitr', quietly = TRUE))
suppressMessages(require('kableExtra', quietly = TRUE))

sys1 <- devtools::session_info()$platform %>% 
  unlist %>% data.frame(Category = names(.), session_info = .)
rownames(sys1) <- NULL

sys2 <- data.frame(Sys.info()) %>% 
  dplyr::mutate(Category = rownames(.)) %>% .[2:1]
names(sys2)[2] <- c('Sys.info')
rownames(sys2) <- NULL

if (nrow(sys1) == 9 & nrow(sys2) == 8) {
  sys2 %<>% rbind(., data.frame(
  Category = 'Current time', 
  Sys.info = paste(as.character(lubridate::now('Asia/Tokyo')), 'JST🗾')))
} else {
  sys1 %<>% rbind(., data.frame(
  Category = 'Current time', 
  session_info = paste(as.character(lubridate::now('Asia/Tokyo')), 'JST🗾')))
}

sys <- cbind(sys1, sys2) %>% 
  kbl(caption = 'Additional session information:') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  row_spec(0, background = 'DimGrey', color = 'yellow') %>% 
  column_spec(1, background = 'CornflowerBlue', color = 'red') %>% 
  column_spec(2, background = 'grey', color = 'black') %>% 
  column_spec(3, background = 'CornflowerBlue', color = 'blue') %>% 
  column_spec(4, background = 'grey', color = 'white') %>% 
  row_spec(9, bold = T, color = 'yellow', background = '#D7261E')

rm(sys1, sys2)
sys
Additional session information:
Category session_info Category Sys.info
version R version 4.0.5 (2021-03-31) sysname Linux
os Ubuntu 20.04.2 LTS release 5.8.0-52-generic
system x86_64, linux-gnu version #59~20.04.1-Ubuntu SMP Fri Apr 30 16:10:51 UTC 2021
ui X11 nodename Scibrokes-Trading
language en machine x86_64
collate C login englianhu
ctype en_US.UTF-8 user englianhu
tz Asia/Tokyo effective_user englianhu
date 2021-05-11 Current time 2021-05-11 02:54:13 JST🗾