From 38f11daf7d6dfe37e8c15ea3e838bbecfe4b0354 Mon Sep 17 00:00:00 2001 From: tnagler Date: Fri, 9 Feb 2024 10:28:43 +0100 Subject: [PATCH] add conditional density function --- DESCRIPTION | 4 ++-- NAMESPACE | 1 + R/RcppExports.R | 4 ++++ R/cpit.R | 35 +++++++++++++++++++++++++++++++++++ man/cdens.Rd | 33 +++++++++++++++++++++++++++++++++ src/RcppExports.cpp | 14 ++++++++++++++ src/vinereg.cpp | 19 ++++++++++++++----- 7 files changed, 103 insertions(+), 7 deletions(-) create mode 100644 man/cdens.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 0172870..9afbbda 100755 --- a/DESCRIPTION +++ b/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, diff --git a/NAMESPACE b/NAMESPACE index bc1b4ab..b5f93ea 100755 --- a/NAMESPACE +++ b/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) diff --git a/R/RcppExports.R b/R/RcppExports.R index 50ca71d..876acbc 100644 --- a/R/RcppExports.R +++ b/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) } diff --git a/R/cpit.R b/R/cpit.R index 27d2fee..ddabe9f 100644 --- a/R/cpit.R +++ b/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 +} diff --git a/man/cdens.Rd b/man/cdens.Rd new file mode 100644 index 0000000..efaaabd --- /dev/null +++ b/man/cdens.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cpit.R +\name{cdens} +\alias{cdens} +\title{Conditional density} +\usage{ +cdens(object, newdata, cores = 1) +} +\arguments{ +\item{object}{an object of class \code{vinereg}.} + +\item{newdata}{matrix of response and covariate values for which to compute +the conditional density} + +\item{cores}{integer; the number of cores to use for computations.} +} +\description{ +Calculates the conditional density of the response given the covariates. +} +\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) +} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 87fa3dd..f468dd0 100644 --- a/src/RcppExports.cpp +++ b/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} diff --git a/src/vinereg.cpp b/src/vinereg.cpp index 32f5846..375535a 100644 --- a/src/vinereg.cpp +++ b/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()]]