Please follow the coding standards.
If there are parameters you need to specify for an algorithm you should state what you used, and why, in your report.
For simulation studies you should include some indication of accuracy in plots and tables.
A simulation size of 1,000 or 2,000 for a simple problem such as this is too small. You should use at least 10,000 independent replicates unless there are compelling reasons not to.
One way to run the simulation for gam
(this takes about 90 seconds on my laptop):
library(mgcv)
m <- function(x) 1 - sin(5 * x)^2 * exp(-5 * x)
n <- 50
x <- (1 : n) / (n + 1)
R <- 10000
sim <- function(fitfun, sigma = 0.1) {
sapply(seq_len(R), function(i) {
y <- rnorm(n, m(x), sigma)
predict(fitfun(x, y))
})
}
yhat <- sim(function(x, y) gam(y ~ s(x)))
A plot of the estimated bias, with dashed lines showing \(\pm\) one simulation standard error:
eb <- rowMeans(yhat) - m(x)
ese <- apply(yhat, 1, sd)
plot(x, eb, type = "l", main = "Estimated Bias")
lines(x, eb + ese / sqrt(R), lty = 2)
lines(x, eb - ese / sqrt(R), lty = 2)
Assuming the estimates are approximately normal we can use the gamma (scaled \(\chi^2\)) distribution of the sample variance and the delta method to obtain approximate simulation standard errors of the standard errors of the function estimates:
\[\begin{equation*}
\frac{1}{2 S} \sqrt{\frac{2 S^2}{R - 1}} =
\frac{S}{\sqrt{2 (R - 1)}} \approx
\frac{S}{\sqrt{2 R}}.
\end{equation*}\]
If we do not use normality then using a Slutsky theorem argument we can estimate the variance of the sample variance using the variance of the squared deviations from the sample mean and again apply the delta method for the square root.
plot(x, ese, type = "l", main = "Estimated Standard Error")
## Chi-square approximation with delta method
lines(x, ese * (1 + 1 / sqrt(2 * R)), lty = 2)
lines(x, ese * (1 - 1 / sqrt(2 * R)), lty = 2)
## SE of squared deviations with delta method
sse <- apply(sweep(yhat, 1, rowMeans(yhat)) ^ 2, 1, sd) / (2 * ese * sqrt(R))
lines(x, ese + sse, lty = 2, col = "red")
lines(x, ese - sse, lty = 2, col = "red")
The estimates assuming normality are slightly smaller:
plot(x, sse / (ese / sqrt(2 * R)), type = "l", ylim = c(0, 1.2),
main = "Ratio of Standard Error Estimates")
abline(h = 1, lty = 2)
The estimated average mean square error and the simulation standard error of the estimate:
ase <- colMeans(sweep(yhat, 1, m(x)) ^ 2)
amse <- mean(ase)
sea <- sd(ase) / sqrt(R)
sea / amse
## [1] 0.005565873
LS0tCnRpdGxlOiAiSFc4IE5vdGVzIgphdXRob3I6ICJMdWtlIFRpZXJuZXkiCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiB5ZXMKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKLS0tCgpgYGB7ciBnbG9iYWxfb3B0aW9ucywgaW5jbHVkZSA9IEZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoY29sbGFwc2UgPSBUUlVFLAogICAgICAgICAgICAgICAgICAgICAgY2xhc3Muc291cmNlID0gImZvbGQtc2hvdyIsCiAgICAgICAgICAgICAgICAgICAgICBmaWcuYWxpZ24gPSAiY2VudGVyIikKc2V0LnNlZWQoMjAyMS0wNC0wMSkKYGBgCgoqIFBsZWFzZSBmb2xsb3cgdGhlIGNvZGluZyBzdGFuZGFyZHMuCgoqIElmIHRoZXJlIGFyZSBwYXJhbWV0ZXJzIHlvdSBuZWVkIHRvIHNwZWNpZnkgZm9yIGFuIGFsZ29yaXRobSB5b3UKICBzaG91bGQgc3RhdGUgd2hhdCB5b3UgdXNlZCwgYW5kIHdoeSwgaW4geW91ciByZXBvcnQuCgoqIEZvciBzaW11bGF0aW9uIHN0dWRpZXMgeW91IHNob3VsZCBpbmNsdWRlIHNvbWUgaW5kaWNhdGlvbiBvZgogIGFjY3VyYWN5IGluIHBsb3RzIGFuZCB0YWJsZXMuCgoqIEEgc2ltdWxhdGlvbiBzaXplIG9mIDEsMDAwIG9yIDIsMDAwIGZvciBhIHNpbXBsZSBwcm9ibGVtIHN1Y2ggYXMKICB0aGlzIGlzIHRvbyBzbWFsbC4gWW91IHNob3VsZCB1c2UgYXQgbGVhc3QgMTAsMDAwIGluZGVwZW5kZW50CiAgcmVwbGljYXRlcyB1bmxlc3MgdGhlcmUgYXJlIGNvbXBlbGxpbmcgcmVhc29ucyBub3QgdG8uCgpPbmUgd2F5IHRvIHJ1biB0aGUgc2ltdWxhdGlvbiBmb3IgYGdhbWAgKHRoaXMgdGFrZXMgYWJvdXQgOTAKc2Vjb25kcyBvbiBteSBsYXB0b3ApOgoKYGBge3IsIGNhY2hlID0gVFJVRSwgbWVzc2FnZSA9IEZBTFNFfQpsaWJyYXJ5KG1nY3YpCgptIDwtIGZ1bmN0aW9uKHgpIDEgLSBzaW4oNSAqIHgpXjIgKiBleHAoLTUgKiB4KQpuIDwtIDUwCnggPC0gKDEgOiBuKSAvIChuICsgMSkKClIgPC0gMTAwMDAKCnNpbSA8LSBmdW5jdGlvbihmaXRmdW4sIHNpZ21hID0gMC4xKSB7CiAgICBzYXBwbHkoc2VxX2xlbihSKSwgZnVuY3Rpb24oaSkgewogICAgICAgIHkgPC0gcm5vcm0obiwgbSh4KSwgc2lnbWEpCiAgICAgICAgcHJlZGljdChmaXRmdW4oeCwgeSkpCiAgICB9KQp9Cgp5aGF0IDwtIHNpbShmdW5jdGlvbih4LCB5KSBnYW0oeSB+IHMoeCkpKQpgYGAKCkEgcGxvdCBvZiB0aGUgZXN0aW1hdGVkIGJpYXMsIHdpdGggZGFzaGVkIGxpbmVzIHNob3dpbmcgJFxwbSQgb25lCnNpbXVsYXRpb24gc3RhbmRhcmQgZXJyb3I6CgpgYGB7cn0KZWIgPC0gcm93TWVhbnMoeWhhdCkgLSBtKHgpCmVzZSA8LSBhcHBseSh5aGF0LCAxLCBzZCkKcGxvdCh4LCBlYiwgdHlwZSA9ICJsIiwgbWFpbiA9ICJFc3RpbWF0ZWQgQmlhcyIpCmxpbmVzKHgsIGViICsgIGVzZSAvIHNxcnQoUiksIGx0eSA9IDIpCmxpbmVzKHgsIGViIC0gIGVzZSAvIHNxcnQoUiksIGx0eSA9IDIpCmBgYAoKQXNzdW1pbmcgdGhlIGVzdGltYXRlcyBhcmUgYXBwcm94aW1hdGVseSBub3JtYWwgd2UgY2FuIHVzZSB0aGUgZ2FtbWEKKHNjYWxlZCAkXGNoaV4yJCkgZGlzdHJpYnV0aW9uIG9mIHRoZSBzYW1wbGUgdmFyaWFuY2UgYW5kIHRoZSBkZWx0YQptZXRob2QgdG8gb2J0YWluIGFwcHJveGltYXRlIHNpbXVsYXRpb24gc3RhbmRhcmQgZXJyb3JzIG9mIHRoZQpzdGFuZGFyZCBlcnJvcnMgb2YgdGhlIGZ1bmN0aW9uIGVzdGltYXRlczoKClxiZWdpbntlcXVhdGlvbip9CiAgXGZyYWN7MX17MiBTfSBcc3FydHtcZnJhY3syIFNeMn17UiAtIDF9fSA9CiAgXGZyYWN7U317XHNxcnR7MiAoUiAtIDEpfX0gXGFwcHJveAogIFxmcmFje1N9e1xzcXJ0ezIgUn19LgpcZW5ke2VxdWF0aW9uKn0KCklmIHdlIGRvIG5vdCB1c2Ugbm9ybWFsaXR5IHRoZW4gdXNpbmcgYSBTbHV0c2t5IHRoZW9yZW0gYXJndW1lbnQgd2UKY2FuIGVzdGltYXRlIHRoZSB2YXJpYW5jZSBvZiB0aGUgc2FtcGxlIHZhcmlhbmNlIHVzaW5nIHRoZSB2YXJpYW5jZQpvZiB0aGUgc3F1YXJlZCBkZXZpYXRpb25zIGZyb20gdGhlIHNhbXBsZSBtZWFuIGFuZCBhZ2FpbiBhcHBseSB0aGUKZGVsdGEgbWV0aG9kIGZvciB0aGUgc3F1YXJlIHJvb3QuCgpgYGB7cn0KcGxvdCh4LCBlc2UsIHR5cGUgPSAibCIsIG1haW4gPSAiRXN0aW1hdGVkIFN0YW5kYXJkIEVycm9yIikKCiMjIENoaS1zcXVhcmUgYXBwcm94aW1hdGlvbiB3aXRoIGRlbHRhIG1ldGhvZApsaW5lcyh4LCBlc2UgKiAoMSArIDEgLyBzcXJ0KDIgKiBSKSksIGx0eSA9IDIpCmxpbmVzKHgsIGVzZSAqICgxIC0gMSAvIHNxcnQoMiAqIFIpKSwgbHR5ID0gMikKCiMjIFNFIG9mIHNxdWFyZWQgZGV2aWF0aW9ucyB3aXRoIGRlbHRhIG1ldGhvZApzc2UgPC0gYXBwbHkoc3dlZXAoeWhhdCwgMSwgcm93TWVhbnMoeWhhdCkpIF4gMiwgMSwgc2QpIC8gKDIgKiBlc2UgKiBzcXJ0KFIpKQpsaW5lcyh4LCBlc2UgKyBzc2UsIGx0eSA9IDIsIGNvbCA9ICJyZWQiKQpsaW5lcyh4LCBlc2UgLSBzc2UsIGx0eSA9IDIsIGNvbCA9ICJyZWQiKQpgYGAKClRoZSBlc3RpbWF0ZXMgYXNzdW1pbmcgbm9ybWFsaXR5IGFyZSBzbGlnaHRseSBzbWFsbGVyOgoKYGBge3J9CnBsb3QoeCwgc3NlIC8gKGVzZSAvIHNxcnQoMiAqIFIpKSwgdHlwZSA9ICJsIiwgeWxpbSA9IGMoMCwgMS4yKSwKICAgICBtYWluID0gIlJhdGlvIG9mIFN0YW5kYXJkIEVycm9yIEVzdGltYXRlcyIpCmFibGluZShoID0gMSwgbHR5ID0gMikKYGBgCgpUaGUgZXN0aW1hdGVkIGF2ZXJhZ2UgbWVhbiBzcXVhcmUgZXJyb3IgYW5kIHRoZSBzaW11bGF0aW9uIHN0YW5kYXJkCmVycm9yIG9mIHRoZSBlc3RpbWF0ZToKCmBgYHtyfQphc2UgPC0gY29sTWVhbnMoc3dlZXAoeWhhdCwgMSwgbSh4KSkgXiAyKQphbXNlIDwtIG1lYW4oYXNlKQpzZWEgPC0gc2QoYXNlKSAvIHNxcnQoUikKc2VhIC8gYW1zZQpgYGAKCg==