/tests/covmat.R

https://github.com/kingaa/pomp · R · 74 lines · 62 code · 12 blank · 0 comment · 0 complexity · bbe47a0fc3e0480f3fd09c5d4b74fd36 MD5 · raw file

  1. options(digits=3)
  2. library(pomp)
  3. library(tidyr)
  4. library(dplyr)
  5. gompertz() -> gompertz
  6. set.seed(1546383977L)
  7. plist <- list(
  8. y1.mean=probe.mean(var="Y"),
  9. probe.acf(var="Y",lags=c(0,4,8))
  10. )
  11. gompertz %>%
  12. probe(probes=plist,nsim=100) %>%
  13. as.data.frame() %>%
  14. filter(.id=="sim") %>%
  15. select(-.id) %>%
  16. pivot_longer(everything()) %>%
  17. group_by(name) %>%
  18. summarize(value=(sd(value))) %>%
  19. ungroup() %>%
  20. pivot_wider(name) %>%
  21. unlist() -> scale.dat
  22. abc(
  23. gompertz,
  24. dprior=Csnippet("
  25. lik = dunif(K,0,2,1)+dunif(r,0,1,1)+
  26. dunif(tau,0,1,1)+dunif(sigma,0,1,1);
  27. lik = (give_log) ? lik : exp(lik);"),
  28. paramnames=c("K","sigma","tau","r"),
  29. Nabc=100,probes=plist,
  30. scale=scale.dat,epsilon=10,
  31. proposal=mvn.diag.rw(c(K=0.01,r=0.01,sigma=0.01,tau=0.01))
  32. ) -> a1
  33. replicate(3,
  34. abc(
  35. a1,
  36. Nabc=500,probes=plist,
  37. scale=scale.dat,epsilon=10,
  38. proposal=mvn.diag.rw(c(K=0.01,r=0.01,sigma=0.01,tau=0.01))
  39. )) -> a1
  40. do.call(c,a1) -> a1
  41. covmat(a1[[1]]) -> v1
  42. covmat(a1) -> v2
  43. covmat(a1,thin=20) -> v3
  44. stopifnot(
  45. dim(v1)==dim(v2),
  46. dim(v1)==dim(v3),
  47. identical(dimnames(v1),dimnames(v2)),
  48. identical(dimnames(v1),dimnames(v3))
  49. )
  50. po <- window(gompertz,end=10)
  51. prop1 <- mvn.diag.rw(c(r=0.01,sigma=0.01))
  52. mcmc1 <- pmcmc(po,Nmcmc=100,Np=100,dprior=Csnippet("
  53. lik = dunif(r,0,1,1)+dnorm(sigma,0,1,1);
  54. lik = (give_log) ? lik : exp(lik);"),
  55. paramnames=c("r","sigma"),
  56. proposal=prop1)
  57. covmat(mcmc1) -> v1
  58. covmat(c(mcmc1,mcmc1)) -> v2
  59. stopifnot(
  60. dim(v1)==dim(v2),
  61. identical(dimnames(v1),dimnames(v2))
  62. )