add conditional loglik function

.github/workflows/R-CMD-check.yaml

@@ -14,67 +14,33 @@ jobs:
         config:
           - {os: macOS-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
-          - {os: ubuntu-20.04,   r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest", http-user-agent: "R/4.0.0 (ubuntu-16.04) R (4.0.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" }
-          - {os: ubuntu-20.04,   r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
-          - {os: ubuntu-20.04,   r: 'oldrel',  rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
+          - {os: ubuntu-22.04,   r: 'devel'}
+          - {os: ubuntu-22.04,   r: 'release'}
+          - {os: ubuntu-22.04,   r: 'oldrel'}
 
     env:
-      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
-      RSPM: ${{ matrix.config.rspm }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/setup-r@master
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
           http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
 
-      - uses: r-lib/actions/setup-pandoc@master
-
-      - name: Query dependencies
-        run: |
-          install.packages('remotes')
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
-
-      - name: Cache R packages
-        if: runner.os != 'Windows'
-        uses: actions/cache@v1
+      - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
-
-      - name: Install system dependencies
-        if: runner.os == 'Linux'
-        run: |
-          while read -r cmd
-          do
-            eval sudo $cmd
-          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "16.04"))')
-      - name: Install dependencies
-        run: |
-          remotes::install_deps(dependencies = TRUE)
-          remotes::install_cran("rcmdcheck")
-        shell: Rscript {0}
+          extra-packages: any::rcmdcheck, any::remotes
+          needs: check
 
-      - name: Session info
-        run: |
-          options(width = 100)
-          pkgs <- installed.packages()[, "Package"]
-          sessioninfo::session_info(pkgs, include_base = TRUE)
-        shell: Rscript {0}
-
-      - name: Check
-        env:
-          _R_CHECK_CRAN_INCOMING_: false
-        run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
-        shell: Rscript {0}
-        # run: cd .. && R CMD build RcppThread && R CMD check RcppThread_1.1.0.tar.gz 
-        # shell: bash
+      - uses: r-lib/actions/check-r-package@v2
+        with:
+          upload-snapshots: true
 
       - name: Show testthat output
         if: always()
@@ -83,13 +49,13 @@ jobs:
 
       - name: Upload check results
         if: failure()
-        uses: actions/upload-artifact@main
+        uses: actions/upload-artifact@v2
         with:
           name: ${{ runner.os }}-r${{ matrix.config.r }}-results
           path: check
 
       - name: Test coverage
-        if: matrix.config.os == 'macOS-latest' && matrix.config.r == '3.6'
+        if: matrix.config.os == 'macOS-latest'
         run: |
           Rscript -e 'remotes::install_github("r-lib/covr@gh-actions")'
           Rscript -e 'covr::codecov(token = "${{secrets.CODECOV_TOKEN}}")'

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: vinereg
 Type: Package
 Title: D-Vine Quantile Regression
-Version: 0.8.3
+Version: 0.9.0
 Authors@R: c(
         person("Thomas", "Nagler",, "mail@tnagler.com", role = c("aut", "cre")),
         person("Dani", "Kraus",,, role = c("ctb"))

NAMESPACE

@@ -4,6 +4,7 @@ S3method(fitted,vinereg)
 S3method(predict,vinereg)
 S3method(print,vinereg)
 S3method(summary,vinereg)
+export(cll)
 export(cpit)
 export(plot_effects)
 export(vinereg)

NEWS.md

@@ -1,3 +1,10 @@
+# vinereg 0.9.0
+
+NEW FEATURE
+
+* New function `cll()` to compute the conditional log-likelihood.
+
+
 # vinereg 0.8.3
 
 BUG FIX

R/RcppExports.R

@@ -17,3 +17,11 @@ cond_dist_cpp <- function(u, vinecop_r, num_threads) {
     .Call(`_vinereg_cond_dist_cpp`, u, vinecop_r, num_threads)
 }
 
+cond_loglik_cpp <- function(u, vinecop_r, num_threads) {
+    .Call(`_vinereg_cond_loglik_cpp`, u, vinecop_r, num_threads)
+}
+
+with_parameters_cop_cpp <- function(vinecop_r, parameters) {
+    .Call(`_vinereg_with_parameters_cop_cpp`, vinecop_r, parameters)
+}
+

R/cpit.R

@@ -27,3 +27,40 @@ cpit <- function(object, newdata, cores = 1) {
   newdata <- to_uscale(newdata, object$margins)
   cond_dist_cpp(newdata, object$vine, cores)
 }
+
+#' Conditional log-likelihood
+#'
+#' Calculates the conditional log-likelihood of the response given the covariates.
+#'
+#' @param object an object of class \code{vinereg}.
+#' @param newdata matrix of response and covariate values for which to compute
+#'   the conditional distribution.
+#' @param cores integer; the number of cores to use for computations.
+#'
+#' @export
+#'
+#' @examples
+#' \dontshow{
+#' set.seed(1)
+#' }
+#' # simulate data
+#' x <- matrix(rnorm(500), 250, 2)
+#' y <- x %*% c(1, -2)
+#' dat <- data.frame(y = y, x = x, z = as.factor(rbinom(250, 2, 0.5)))
+#'
+#' # fit vine regression model
+#' fit <- vinereg(y ~ ., dat)
+#'
+#' cll(fit, dat)
+#' fit$stats$cll
+cll <- function(object, newdata, cores = 1) {
+  newdata <- prepare_newdata(newdata, object, use_response = TRUE)
+  ll_marg <- if (inherits(object$margins[[1]], "kde1d")) {
+    sum(log(kde1d::dkde1d(newdata[, 1], object$margins[[1]])))
+  } else {
+    0
+  }
+  newdata <- to_uscale(newdata, object$margins)
+  ll_cop <- cond_loglik_cpp(newdata, object$vine, cores)
+  ll_cop + ll_marg
+}

R/vinereg.R

@@ -223,10 +223,10 @@ finalize_vinereg_object <- function(formula, selcrit, model_frame, margins, vine
     pchisq(2 * var_cll, var_edf, lower.tail = FALSE)
   )
   var_p_value[1] <- NA
-  cll <- sum(var_cll)
-  edf <- sum(var_edf)
-  caic <- sum(var_caic)
-  cbic <- sum(var_cbic)
+  cll <- sum(var_cll, na.rm = TRUE)
+  edf <- sum(var_edf, na.rm = TRUE)
+  caic <- sum(var_caic, na.rm = TRUE)
+  cbic <- sum(var_cbic, na.rm = TRUE)
 
   stats <- list(
     nobs = nobs,

README.Rmd

@@ -31,8 +31,8 @@ An R package for D-vine copula based mean and quantile regression.
 - the latest development version:
 
     ``` r
-    # install.packages("devtools")
-    devtools::install_github("tnagler/vinereg", build_vignettes = TRUE)
+    # install.packages("remotes")
+    remotes::install_github("tnagler/vinereg", build_vignettes = TRUE)
     ```
 
 ## Functionality

README.md

@@ -19,8 +19,8 @@ An R package for D-vine copula based mean and quantile regression.
 
 -   the latest development version:
 
-        # install.packages("devtools")
-        devtools::install_github("tnagler/vinereg", build_vignettes = TRUE)
+        # install.packages("remotes")
+        remotes::install_github("tnagler/vinereg", build_vignettes = TRUE)
 
 ## Functionality
 
@@ -40,14 +40,14 @@ See the [package website](https://tnagler.github.io/vinereg/).
     # fit model
     (fit <- vinereg(mpg ~ ., family = "nonpar", data = mtcars))
     #> D-vine regression model: mpg | disp, qsec, hp 
-    #> nobs = 32, edf = 21.86, cll = -55.94, caic = 155.59, cbic = 187.63
+    #> nobs = 32, edf = 24.35, cll = -56.11, caic = 160.93, cbic = 196.63
 
     summary(fit)
     #>    var       edf         cll       caic        cbic      p_value
     #> 1  mpg  0.000000 -100.189867 200.379733 200.3797334           NA
-    #> 2 disp 11.177711   29.363521 -36.371618 -19.9880453 1.873313e-08
-    #> 3 qsec  2.328636    4.167727  -3.678182  -0.2650159 2.180106e-02
-    #> 4   hp  8.353178   10.723533  -4.740711   7.5028411 7.480400e-03
+    #> 2 disp 12.663078   29.654825 -33.983493 -15.4227648 5.284917e-08
+    #> 3 qsec  2.447922    4.326359  -3.756874  -0.1688666 2.101665e-02
+    #> 4   hp  9.242147   10.096325  -1.708356  11.8381898 1.898984e-02
 
     # show marginal effects for all selected variables
     plot_effects(fit)
@@ -59,10 +59,10 @@ See the [package website](https://tnagler.github.io/vinereg/).
     # predict mean and median
     head(predict(fit, mtcars, alpha = c(NA, 0.5)), 4)
     #>       mean      0.5
-    #> 1 22.36600 22.27170
-    #> 2 22.18247 22.01755
-    #> 3 25.33357 24.90170
-    #> 4 20.24950 20.03959
+    #> 1 22.39380 22.29866
+    #> 2 22.23677 22.08015
+    #> 3 25.33841 24.92450
+    #> 4 20.33708 20.16153
 
 ## Vignettes
 

src/RcppExports.cpp

@@ -79,12 +79,39 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// cond_loglik_cpp
+double cond_loglik_cpp(const Eigen::MatrixXd& u, const Rcpp::List& vinecop_r, size_t num_threads);
+RcppExport SEXP _vinereg_cond_loglik_cpp(SEXP uSEXP, SEXP vinecop_rSEXP, SEXP num_threadsSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const Eigen::MatrixXd& >::type u(uSEXP);
+    Rcpp::traits::input_parameter< const Rcpp::List& >::type vinecop_r(vinecop_rSEXP);
+    Rcpp::traits::input_parameter< size_t >::type num_threads(num_threadsSEXP);
+    rcpp_result_gen = Rcpp::wrap(cond_loglik_cpp(u, vinecop_r, num_threads));
+    return rcpp_result_gen;
+END_RCPP
+}
+// with_parameters_cop_cpp
+Rcpp::List with_parameters_cop_cpp(const Rcpp::List& vinecop_r, const Eigen::VectorXd parameters);
+RcppExport SEXP _vinereg_with_parameters_cop_cpp(SEXP vinecop_rSEXP, SEXP parametersSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const Rcpp::List& >::type vinecop_r(vinecop_rSEXP);
+    Rcpp::traits::input_parameter< const Eigen::VectorXd >::type parameters(parametersSEXP);
+    rcpp_result_gen = Rcpp::wrap(with_parameters_cop_cpp(vinecop_r, parameters));
+    return rcpp_result_gen;
+END_RCPP
+}
 
 static const R_CallMethodDef CallEntries[] = {
     {"_vinereg_fit_margins_cpp", (DL_FUNC) &_vinereg_fit_margins_cpp, 9},
     {"_vinereg_select_dvine_cpp", (DL_FUNC) &_vinereg_select_dvine_cpp, 11},
     {"_vinereg_cond_quantile_cpp", (DL_FUNC) &_vinereg_cond_quantile_cpp, 4},
     {"_vinereg_cond_dist_cpp", (DL_FUNC) &_vinereg_cond_dist_cpp, 3},
+    {"_vinereg_cond_loglik_cpp", (DL_FUNC) &_vinereg_cond_loglik_cpp, 3},
+    {"_vinereg_with_parameters_cop_cpp", (DL_FUNC) &_vinereg_with_parameters_cop_cpp, 2},
     {NULL, NULL, 0}
 };