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

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

NEWS.md

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

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 PDF
+#'
+#' 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)
+#'
+#' cpdf(fit, dat)
+cpdf <- 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
+}