add conditional density function

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: vinereg
 Type: Package
 Title: D-Vine Quantile Regression
-Version: 0.9.2
+Version: 0.10.0
 Authors@R: c(
         person("Thomas", "Nagler",, "mail@tnagler.com", role = c("aut", "cre")),
         person("Dani", "Kraus",,, role = c("ctb"))
@@ -26,7 +26,7 @@ LinkingTo:
   wdm,
   RcppThread, 
   kde1d
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.3
 Roxygen: list(markdown = TRUE)
 Suggests: 
   knitr,

NAMESPACE

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

R/RcppExports.R

@@ -17,6 +17,10 @@ cond_dist_cpp <- function(u, vinecop_r, num_threads) {
     .Call(`_vinereg_cond_dist_cpp`, u, vinecop_r, num_threads)
 }
 
+cond_dens_cpp <- function(u, vinecop_r, num_threads) {
+    .Call(`_vinereg_cond_dens_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)
 }

R/cpit.R

@@ -64,3 +64,38 @@ cll <- function(object, newdata, cores = 1) {
   ll_cop <- cond_loglik_cpp(newdata, object$vine, cores)
   ll_cop + ll_marg
 }
+
+#' Conditional density
+#'
+#' Calculates the conditional density 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 density
+#' @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)
+#'
+#' cdens(fit, dat)
+cdens <- function(object, newdata, cores = 1) {
+  newdata <- prepare_newdata(newdata, object, use_response = TRUE)
+  dens_marg <- if (inherits(object$margins[[1]], "kde1d")) {
+    kde1d::dkde1d(newdata[, 1], object$margins[[1]])
+  } else {
+    1
+  }
+  newdata <- to_uscale(newdata, object$margins)
+  cond_dens_cpp(newdata, object$vine, cores) * dens_marg
+}

src/RcppExports.cpp

@@ -79,6 +79,19 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// cond_dens_cpp
+Eigen::VectorXd cond_dens_cpp(const Eigen::MatrixXd& u, const Rcpp::List& vinecop_r, size_t num_threads);
+RcppExport SEXP _vinereg_cond_dens_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_dens_cpp(u, vinecop_r, num_threads));
+    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) {
@@ -110,6 +123,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_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_dens_cpp", (DL_FUNC) &_vinereg_cond_dens_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}

src/vinereg.cpp

@@ -318,10 +318,10 @@ cond_dist_cpp(const Eigen::MatrixXd& u,
 }
 
 // [[Rcpp::export]]
-double
-cond_loglik_cpp(const Eigen::MatrixXd& u,
-                const Rcpp::List& vinecop_r,
-                size_t num_threads)
+Eigen::VectorXd
+cond_dens_cpp(const Eigen::MatrixXd& u,
+              const Rcpp::List& vinecop_r,
+              size_t num_threads)
 {
     tools_eigen::check_if_in_unit_cube(u);
     auto vinecop_cpp = vinecop_wrap(vinecop_r);
@@ -429,7 +429,16 @@ cond_loglik_cpp(const Eigen::MatrixXd& u,
         pool.join();
     }
 
-    return pdf.array().log().sum();
+    return pdf;
+}
+
+// [[Rcpp::export]]
+double
+cond_loglik_cpp(const Eigen::MatrixXd& u,
+                const Rcpp::List& vinecop_r,
+                size_t num_threads)
+{
+  return cond_dens_cpp(u, vinecop_r, num_threads).array().log().sum();
 }
 
 // [[Rcpp::export()]]