Skip to content

Commit d5fcf50

Browse files
author
tnagler
committed
adapt to new kde1d version
1 parent 40ef057 commit d5fcf50

File tree

6 files changed

+43
-30
lines changed

6 files changed

+43
-30
lines changed

‎R/RcppExports.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
22
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
33

4-
fit_margins_cpp <- function(data, nlevels, mult, xmin, xmax, bw, deg, weights, num_threads) {
5-
.Call(`_vinereg_fit_margins_cpp`, data, nlevels, mult, xmin, xmax, bw, deg, weights, num_threads)
4+
fit_margins_cpp <- function(data, xmin, xmax, type, mult, bw, deg, weights, num_threads) {
5+
.Call(`_vinereg_fit_margins_cpp`, data, xmin, xmax, type, mult, bw, deg, weights, num_threads)
66
}
77

88
select_dvine_cpp <- function(data, family_set, par_method, nonpar_method, mult, selcrit, weights, psi0, preselect_families, cores, var_types) {

‎R/tools.R

Lines changed: 18 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -179,17 +179,23 @@ process_par_1d <- function(data, pars) {
179179
d <- ncol(data)
180180
if (!is.null(pars$xmin)) {
181181
if (length(pars$xmin) != d)
182-
stop("'xmin' must be a vector with one value for each variable")
182+
stop("'xmin' must be a vector with one value for each variable")
183183
} else {
184184
pars$xmin = rep(NaN, d)
185185
}
186186
if (!is.null(pars$xmax)) {
187187
if (length(pars$xmax) != d)
188-
stop("'xmax' must be a vector with one value for each variable")
188+
stop("'xmax' must be a vector with one value for each variable")
189189
} else {
190190
pars$xmax = rep(NaN, d)
191191
}
192192

193+
if (!is.null(pars$type)) {
194+
if (length(pars$type) != d)
195+
stop("'type' must be a vector with one value for each variable")
196+
} else {
197+
pars$type = rep("c", d)
198+
}
193199

194200
if (is.null(pars$bw))
195201
pars$bw <- NA
@@ -199,11 +205,18 @@ process_par_1d <- function(data, pars) {
199205
pars$mult <- 1
200206
if (length(pars$mult) == 1)
201207
pars$mult <- rep(pars$mult, d)
202-
203208
if (is.null(pars$deg))
204209
pars$deg <- 2
205210
if (length(pars$deg) == 1)
206211
pars$deg <- rep(pars$deg, d)
212+
if (is.null(pars$type))
213+
pars$type <- "c"
214+
if (length(pars$type) == 1)
215+
pars$type <- rep(pars$type, d)
216+
217+
for (k in which(sapply(data, is.ordered))) {
218+
pars$type[k] <- "d"
219+
}
207220

208221
check_par_1d(data, pars)
209222
pars
@@ -218,20 +231,18 @@ check_par_1d <- function(data, ctrl) {
218231
}
219232
lapply(seq_len(NCOL(data)), function(k) {
220233
msg_var <- paste0("Problem with par_1d for variable ", nms[k], ": ")
234+
allowed_margins_controls <- c("xmin", "xmax", "type", "mult", "bw", "deg")
221235
tryCatch(
222236
assert_that(
223237
is.numeric(ctrl$mult[k]), ctrl$mult[k] > 0,
224238
is.numeric(ctrl$xmin[k]), is.numeric(ctrl$xmax[k]),
239+
assert_that(all(names(ctrl) %in% allowed_margins_controls)),
225240
is.na(ctrl$bw[k]) | (is.numeric(ctrl$bw[k]) & (ctrl$bw[k] > 0)),
226241
is.numeric(ctrl$deg[k])
227242
),
228243
error = function(e) stop(msg_var, e$message)
229244
)
230245

231-
if (is.ordered(data[, k]) & (!is.nan(ctrl$xmin[k]) | !is.nan(ctrl$xmax[k]))) {
232-
stop(msg_var, "xmin and xmax are not meaningful for x of type ordered.")
233-
}
234-
235246
if (!is.nan(ctrl$xmax[k]) & !is.nan(ctrl$xmin[k])) {
236247
if (ctrl$xmin[k] > ctrl$xmax[k]) {
237248
stop(msg_var, "xmin is larger than xmax.")

‎R/vinereg.R

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -131,14 +131,14 @@ vinereg <- function(formula, data, family_set = "parametric", selcrit = "aic",
131131
if (!uscale) {
132132
par_1d <- process_par_1d(mfx, par_1d)
133133
margins <- fit_margins_cpp(prep_for_kde1d(mfx),
134-
sapply(mfx, nlevels),
135-
mult = par_1d$mult,
136134
xmin = par_1d$xmin,
137135
xmax = par_1d$xmax,
136+
type = par_1d$type,
137+
mult = par_1d$mult,
138138
bw = par_1d$bw,
139139
deg = par_1d$deg,
140140
weights = weights,
141-
cores)
141+
num_threads = cores)
142142
margins <- finalize_margins(margins, mfx)
143143
u <- to_uscale(mfx, margins)
144144
} else {
@@ -166,14 +166,14 @@ vinereg <- function(formula, data, family_set = "parametric", selcrit = "aic",
166166
if (!uscale) {
167167
par_1d <- process_par_1d(mfx, par_1d)
168168
margins <- fit_margins_cpp(prep_for_kde1d(mfx),
169-
sapply(mfx, nlevels),
170-
mult = par_1d$mult,
171169
xmin = par_1d$xmin,
172170
xmax = par_1d$xmax,
171+
type = par_1d$type,
172+
mult = par_1d$mult,
173173
bw = par_1d$bw,
174174
deg = par_1d$deg,
175175
weights = weights,
176-
cores)
176+
num_threads = cores)
177177
margins <- finalize_margins(margins, mfx)
178178
u <- to_uscale(mfx, margins)
179179
} else {

‎src/RcppExports.cpp

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -13,21 +13,21 @@ Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
1313
#endif
1414

1515
// fit_margins_cpp
16-
std::vector<Rcpp::List> fit_margins_cpp(const Eigen::MatrixXd& data, const Eigen::VectorXi& nlevels, const Eigen::VectorXd& mult, const Eigen::VectorXd& xmin, const Eigen::VectorXd& xmax, const Eigen::VectorXd& bw, const Eigen::VectorXi& deg, const Eigen::VectorXd& weights, size_t num_threads);
17-
RcppExport SEXP _vinereg_fit_margins_cpp(SEXP dataSEXP, SEXP nlevelsSEXP, SEXP multSEXP, SEXP xminSEXP, SEXP xmaxSEXP, SEXP bwSEXP, SEXP degSEXP, SEXP weightsSEXP, SEXP num_threadsSEXP) {
16+
std::vector<Rcpp::List> fit_margins_cpp(const Eigen::MatrixXd& data, const Eigen::VectorXd& xmin, const Eigen::VectorXd& xmax, const std::vector<std::string>& type, const Eigen::VectorXd& mult, const Eigen::VectorXd& bw, const Eigen::VectorXi& deg, const Eigen::VectorXd& weights, size_t num_threads);
17+
RcppExport SEXP _vinereg_fit_margins_cpp(SEXP dataSEXP, SEXP xminSEXP, SEXP xmaxSEXP, SEXP typeSEXP, SEXP multSEXP, SEXP bwSEXP, SEXP degSEXP, SEXP weightsSEXP, SEXP num_threadsSEXP) {
1818
BEGIN_RCPP
1919
Rcpp::RObject rcpp_result_gen;
2020
Rcpp::RNGScope rcpp_rngScope_gen;
2121
Rcpp::traits::input_parameter< const Eigen::MatrixXd& >::type data(dataSEXP);
22-
Rcpp::traits::input_parameter< const Eigen::VectorXi& >::type nlevels(nlevelsSEXP);
23-
Rcpp::traits::input_parameter< const Eigen::VectorXd& >::type mult(multSEXP);
2422
Rcpp::traits::input_parameter< const Eigen::VectorXd& >::type xmin(xminSEXP);
2523
Rcpp::traits::input_parameter< const Eigen::VectorXd& >::type xmax(xmaxSEXP);
24+
Rcpp::traits::input_parameter< const std::vector<std::string>& >::type type(typeSEXP);
25+
Rcpp::traits::input_parameter< const Eigen::VectorXd& >::type mult(multSEXP);
2626
Rcpp::traits::input_parameter< const Eigen::VectorXd& >::type bw(bwSEXP);
2727
Rcpp::traits::input_parameter< const Eigen::VectorXi& >::type deg(degSEXP);
2828
Rcpp::traits::input_parameter< const Eigen::VectorXd& >::type weights(weightsSEXP);
2929
Rcpp::traits::input_parameter< size_t >::type num_threads(num_threadsSEXP);
30-
rcpp_result_gen = Rcpp::wrap(fit_margins_cpp(data, nlevels, mult, xmin, xmax, bw, deg, weights, num_threads));
30+
rcpp_result_gen = Rcpp::wrap(fit_margins_cpp(data, xmin, xmax, type, mult, bw, deg, weights, num_threads));
3131
return rcpp_result_gen;
3232
END_RCPP
3333
}

‎src/vinereg.cpp

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -24,10 +24,10 @@ using namespace vinecopulib;
2424
// [[Rcpp::export]]
2525
std::vector<Rcpp::List>
2626
fit_margins_cpp(const Eigen::MatrixXd& data,
27-
const Eigen::VectorXi& nlevels,
28-
const Eigen::VectorXd& mult,
2927
const Eigen::VectorXd& xmin,
3028
const Eigen::VectorXd& xmax,
29+
const std::vector<std::string>& type,
30+
const Eigen::VectorXd& mult,
3131
const Eigen::VectorXd& bw,
3232
const Eigen::VectorXi& deg,
3333
const Eigen::VectorXd& weights,
@@ -40,14 +40,15 @@ fit_margins_cpp(const Eigen::MatrixXd& data,
4040
0,
4141
d,
4242
[&](const size_t& k) {
43-
fits_cpp[k] = kde1d::Kde1d(data.col(k),
44-
nlevels(k),
45-
bw(k),
46-
mult(k),
47-
xmin(k),
48-
xmax(k),
49-
deg(k),
50-
weights);
43+
fits_cpp[k] = kde1d::Kde1d(
44+
xmin(k),
45+
xmax(k),
46+
type.at(k),
47+
mult(k),
48+
bw(k),
49+
deg(k)
50+
);
51+
fits_cpp[k].fit(data.col(k), weights);
5152
},
5253
num_threads);
5354

‎vinereg.Rproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
Version: 1.0
2+
ProjectId: 76bfb091-450e-4604-82db-a841c0327a32
23

34
RestoreWorkspace: Default
45
SaveWorkspace: Default

0 commit comments

Comments
 (0)