search

hsloot / rmo

An R package for Marshall--Olkin distributions and copulas.
https://hsloot.github.io/rmo/
GNU General Public License v3.0
5 stars 2 forks source link

Wip/rcpp refactoring #27

Closed hsloot closed 4 years ago

hsloot commented 4 years ago

Description

Refactor all sampling algorithms in with Rcpp to improve speed.

Checklist

Only for new or refactored algorithms:

Optional, but recommended:

lintr-bot commented 4 years ago

inst/Rprofile/prof_v2_0_0.R:1:2: style: Commented code should be removed.

​#+ setup
 ^~~~~~~
hsloot commented 4 years ago 
library("rmo")
library("magrittr")
library("ggplot2")
library("microbenchmark")
use_seed <- 1632L
n <- 1e2L
d <- 7L

We use a compound Poisson process with intensity 0 and fixed deterministic jumps of size eta. Additionally, we allow killing and a drift. This model is convenient, as it can be used to parametrise all used models from this package.

rate <- 0
eta <- 1 # dummy
rate_killing <- 0.1 / 0.4
rate_drift <- 0.3 / 0.4

psi <- function(x) {
  ifelse(x > 0, rate_killing, 0) + rate_drift * x +
    rate * (1 - exp(-eta * x))
}
ex_intensities <- numeric(d)
ex_intensities[1] <- rate_drift
ex_intensities[d] <- rate_killing
intensities <- numeric(2^d-1)
for (j in 1:(2^d-1)) {
  tmp <- 0
  for (i in 1:d) {
    tmp <- tmp + rmo:::is_within(i, j)
  }
  intensities[j] <- ex_intensities[[tmp]]
}
alpha <- rate_drift
beta <- rate_killing
set.seed(use_seed)
mb1 <- microbenchmark(
  ESM = rmo_esm(n, d, intensities),
  Arnold = rmo_arnold(n, d, intensities),
  Ex_Arnold = rmo_ex_arnold(n, d, ex_intensities),
  LFM_CPP = rmo_lfm_cpp(n, d, rate, rate_killing, rate_drift,
    rjump_name = "rposval", rjump_arg_list = list("value"=1)),
  Cuadras_Auge = rmo_esm_cuadras_auge(n, d, alpha, beta)
)
detach("package:rmo", unload = TRUE)
tmpdir <- tempdir()
suppressMessages(devtools::install_github("hsloot/rmo@v0.1.2", lib = tmpdir, quiet = TRUE))
library(rmo, lib.loc = tmpdir)
set.seed(1632L)
mb2 <- microbenchmark(
  ESM = rmo_esm(n, d, intensities),
  Arnold = rmo_arnold(n, d, intensities),
  Ex_Arnold = rmo_ex_arnold(n, d, ex_intensities),
  LFM_CPP = rmo_lfm_cpp(n, d, rate, rate_killing, rate_drift,
    rjump_name = "rposval", rjump_arg_list = list("value"=1)),
  Cuadras_Auge = rmo_esm_cuadras_auge(n, d, alpha, beta)
)
detach("package:rmo", unload = TRUE)
# invisible(print(unlink(tmpdir, recursive = TRUE)))
mb1 %>%
  autoplot()
#> Coordinate system already present. Adding new coordinate system, which will replace the existing one.

mb2 %>%
  autoplot()
#> Coordinate system already present. Adding new coordinate system, which will replace the existing one.

Created on 2020-02-10 by the reprex package (v0.3.0)

Session info ``` r devtools::session_info() #> ─ Session info ─────────────────────────────────────────────────────────────── #> setting value #> version R version 3.6.2 (2019-12-12) #> os macOS Catalina 10.15.2 #> system x86_64, darwin19.2.0 #> ui unknown #> language (EN) #> collate de_DE.UTF-8 #> ctype de_DE.UTF-8 #> tz Europe/Berlin #> date 2020-02-10 #> #> ─ Packages ─────────────────────────────────────────────────────────────────── #> package * version date lib source #> assertthat 0.2.1 2019-03-21 [1] CRAN (R 3.6.0) #> backports 1.1.5 2019-10-02 [1] CRAN (R 3.6.1) #> callr 3.4.1 2020-01-24 [1] CRAN (R 3.6.2) #> cli 2.0.1 2020-01-08 [1] CRAN (R 3.6.1) #> colorspace 1.4-1 2019-03-18 [1] CRAN (R 3.6.0) #> crayon 1.3.4 2017-09-16 [1] CRAN (R 3.6.0) #> curl 4.3 2019-12-02 [1] CRAN (R 3.6.1) #> desc 1.2.0 2018-05-01 [1] CRAN (R 3.6.0) #> devtools 2.2.1 2019-09-24 [1] CRAN (R 3.6.1) #> digest 0.6.23 2019-11-23 [1] CRAN (R 3.6.1) #> dplyr 0.8.4 2020-01-31 [1] CRAN (R 3.6.2) #> ellipsis 0.3.0 2019-09-20 [1] CRAN (R 3.6.1) #> evaluate 0.14 2019-05-28 [1] CRAN (R 3.6.0) #> fansi 0.4.1 2020-01-08 [1] CRAN (R 3.6.1) #> farver 2.0.3 2020-01-16 [1] CRAN (R 3.6.1) #> fs 1.3.1 2019-05-06 [1] CRAN (R 3.6.0) #> ggplot2 * 3.2.1 2019-08-10 [1] CRAN (R 3.6.1) #> glue 1.3.1 2019-03-12 [1] CRAN (R 3.6.0) #> gtable 0.3.0 2019-03-25 [1] CRAN (R 3.6.0) #> highr 0.8 2019-03-20 [1] CRAN (R 3.6.0) #> htmltools 0.4.0 2019-10-04 [1] CRAN (R 3.6.1) #> httr 1.4.1 2019-08-05 [1] CRAN (R 3.6.1) #> knitr 1.28 2020-02-06 [1] CRAN (R 3.6.2) #> lazyeval 0.2.2 2019-03-15 [1] CRAN (R 3.6.0) #> lifecycle 0.1.0 2019-08-01 [1] CRAN (R 3.6.1) #> magrittr * 1.5 2014-11-22 [1] CRAN (R 3.6.0) #> memoise 1.1.0 2017-04-21 [1] CRAN (R 3.6.0) #> microbenchmark * 1.4-7 2019-09-24 [1] CRAN (R 3.6.1) #> mime 0.9 2020-02-04 [1] CRAN (R 3.6.2) #> munsell 0.5.0 2018-06-12 [1] CRAN (R 3.6.0) #> pillar 1.4.3 2019-12-20 [1] CRAN (R 3.6.1) #> pkgbuild 1.0.6 2019-10-09 [1] CRAN (R 3.6.1) #> pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 3.6.1) #> pkgload 1.0.2 2018-10-29 [1] CRAN (R 3.6.0) #> prettyunits 1.1.1 2020-01-24 [1] CRAN (R 3.6.2) #> processx 3.4.2 2020-02-09 [1] CRAN (R 3.6.2) #> ps 1.3.0 2018-12-21 [1] CRAN (R 3.6.0) #> purrr 0.3.3 2019-10-18 [1] CRAN (R 3.6.1) #> R6 2.4.1 2019-11-12 [1] CRAN (R 3.6.1) #> Rcpp 1.0.3 2019-11-08 [1] CRAN (R 3.6.1) #> remotes 2.1.0 2019-06-24 [1] CRAN (R 3.6.0) #> rlang 0.4.4 2020-01-28 [1] CRAN (R 3.6.2) #> rmarkdown 2.1 2020-01-20 [1] CRAN (R 3.6.2) #> rprojroot 1.3-2 2018-01-03 [1] CRAN (R 3.6.0) #> scales 1.1.0 2019-11-18 [1] CRAN (R 3.6.1) #> sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 3.6.0) #> stringi 1.4.5 2020-01-11 [1] CRAN (R 3.6.1) #> stringr 1.4.0 2019-02-10 [1] CRAN (R 3.6.0) #> testthat 2.3.1 2019-12-01 [1] CRAN (R 3.6.1) #> tibble 2.1.3 2019-06-06 [1] CRAN (R 3.6.0) #> tidyselect 1.0.0 2020-01-27 [1] CRAN (R 3.6.2) #> usethis 1.5.1 2019-07-04 [1] CRAN (R 3.6.0) #> withr 2.1.2 2018-03-15 [1] CRAN (R 3.6.0) #> xfun 0.12 2020-01-13 [1] CRAN (R 3.6.1) #> xml2 1.2.2 2019-08-09 [1] CRAN (R 3.6.1) #> yaml 2.2.1 2020-02-01 [1] CRAN (R 3.6.2) #> #> [1] /usr/local/lib/R/3.6/site-library #> [2] /usr/local/Cellar/r/3.6.2/lib/R/library ```