From 29b922af8614bea60d34c76cb7100c51b8c21721 Mon Sep 17 00:00:00 2001 From: Reto Buergin Date: Tue, 17 Oct 2017 20:42:31 +0000 Subject: [PATCH] version 1.0-1 --- DESCRIPTION | 8 ++-- MD5 | 14 +++---- NEWS | 11 ++++++ R/tvcm-utils.R | 5 ++- inst/doc/vcrpart.Rnw | 3 +- inst/doc/vcrpart.pdf | Bin 607192 -> 607192 bytes src/olmm.c | 84 +++++++++++++++++++++++++----------------- vignettes/vcrpart.Rnw | 3 +- 8 files changed, 80 insertions(+), 48 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ef98cd8..3fc5ed5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,8 +2,8 @@ Package: vcrpart Type: Package Title: Tree-Based Varying Coefficient Regression for Generalized Linear and Ordinal Mixed Models -Version: 1.0-0 -Date: 2017-08-21 +Version: 1.0-1 +Date: 2017-10-17 Authors@R: c( person("Reto", "Buergin", role = c("aut", "cre", "cph"), email = "rbuergin@gmx.ch"), person("Gilbert", "Ritschard", role = c("ctb", "ths"), @@ -16,8 +16,8 @@ Imports: stats, grid, graphics, methods, nlme (>= 3.1-123), rpart, formula.tools, numDeriv, ucminf, zoo, sandwich, strucchange LazyLoad: yes NeedsCompilation: yes -Packaged: 2017-08-21 21:04:26 UTC; reto +Packaged: 2017-10-17 20:47:15 UTC; reto Author: Reto Buergin [aut, cre, cph], Gilbert Ritschard [ctb, ths] Repository: CRAN -Date/Publication: 2017-08-22 15:35:07 UTC +Date/Publication: 2017-10-17 21:42:31 UTC diff --git a/MD5 b/MD5 index ac84f50..594cac4 100644 --- a/MD5 +++ b/MD5 @@ -1,6 +1,6 @@ -6f97001bc9307a6c61fc6c2dec447ede *DESCRIPTION +00fa11f453239d83c49a391f1d7dd2b2 *DESCRIPTION 88f2a7e8732471db378d8c7ad4d414b7 *NAMESPACE -db2354e4a737b45a2d4e1f9416f8752a *NEWS +ef76328b52cdee76b9eb87f36c8d18c4 *NEWS 8b40e51cf24df0eb99503a7070b84a93 *R/AAA.R 160b81f4ae1117bfe2f84236b2d2af0f *R/AllGeneric.R 594f5359a79fc4cd908512f91da3f439 *R/fvcm.R @@ -12,7 +12,7 @@ db2354e4a737b45a2d4e1f9416f8752a *NEWS 0d61b66e97dd63d12acc811055982b13 *R/tvcm-cv.R a56eb3ce150852b6e0f89bae76045145 *R/tvcm-methods.R 773603a317d64e5674e7257c9a857409 *R/tvcm-plot.R -9da6909d2a597d6d4d64de42c05b593b *R/tvcm-utils.R +6b7a6de9c4bf75d4c88e81c11df5124b *R/tvcm-utils.R 86cd70f18d32eb1b9a58ff4e7d0b4338 *R/tvcm.R 9d40db38c5fd987f14b5716ed08da2b1 *R/utils.R 60387778eacc623d54ae76f33d4de60c *ToDo @@ -26,8 +26,8 @@ ea62be4e5d10df5bc683725a7f7935f6 *data/schizo.RData cb803decf95c39567f648e1e5e0ddb45 *data/vcrpart_2.RData 3ddf5ac69dc37253946b83c5bfd5fca7 *data/vcrpart_3.RData 073dbc46eee3af9fc409b395fef38eaa *inst/CITATION -596630a3792956eede699a719233bae1 *inst/doc/vcrpart.Rnw -3a6075206932b1be8110c82c31679adb *inst/doc/vcrpart.pdf +2cc6e45ac533eb0551eab45747d2b613 *inst/doc/vcrpart.Rnw +6ad00ccbe8d06fe5532c01aa1632c940 *inst/doc/vcrpart.pdf 38f1299f8a057cb18bbe99fb630249f3 *man/PL.Rd ef7899f341e4dd14895e0f20af9ff4bf *man/contr-wsum.Rd d019d09b94cae8c5342c3b4bb42838da *man/fvcm-methods.Rd @@ -53,7 +53,7 @@ c77bcd03b4cb28c5a91036575b93d716 *man/tvcolmm.Rd 873a11355678ee053f51b38089f893f4 *man/vcrpart-formula.Rd 2a6f9e9e044a78154d3cfda5936d6f48 *src/Makevars bdcec3746d75f6748e912f41ccab8baa *src/init.c -35966357c5a95456455ed60954652fb3 *src/olmm.c +405cbdb2b8f51375ddec28bfdff553a0 *src/olmm.c 79ee30a544c9bd2e26891000e3bb2a59 *src/olmm.h 0af72621bd0a3d74afc3a3a0220f92c4 *src/tvcm.c e8b96835ed09462a3fef4b1f581279cd *src/tvcm.h @@ -70,4 +70,4 @@ dca495b2e307300047257c547e9795ed *vignettes/Figures/jss2564-school-fig-tree.pdf 31aee9b5f0da739c73a2117f48a42c67 *vignettes/Figures/jss2564-ucba-fig-cv.pdf 287d69566937f6e73e6f421d1a9b4bb9 *vignettes/Figures/jss2564-ucba-fig-vcm.pdf fd41663f2eacaabf3a9ebf47b94eac4d *vignettes/Figures/jss2564-ucba-fig-vcmL.pdf -596630a3792956eede699a719233bae1 *vignettes/vcrpart.Rnw +2cc6e45ac533eb0551eab45747d2b613 *vignettes/vcrpart.Rnw diff --git a/NEWS b/NEWS index ea3eb5e..8264a8e 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,14 @@ +Changes in Version 1.0-1 + + o Internal modification for the 'singular.ok' argument of future + R versions. + + o Replaced 'memcpy' calls in C-code with 'for' loops because they + were used for small objects. + + o Improve R-Code for 'alloca' calls (adding 'R_CheckStack()' + after calls) + Changes in Version 1.0-0 o Added vignette. diff --git a/R/tvcm-utils.R b/R/tvcm-utils.R index 6ee9a4b..29190e6 100644 --- a/R/tvcm-utils.R +++ b/R/tvcm-utils.R @@ -51,6 +51,8 @@ ## tvcm_grow_splitpath: creates a 'splitpath.tvcm' object ## ## Last modifications: +## 2017-10-16: add argument 'singular.ok' for 'glm.doNotFit', see mail +## of Martin Maechler, 2017-09-30 ## 2017-08-21: - rename arguments for 'tvcm_get_terms'. ## - bug fix for 'tvcm_get_estimates' for situations where ## 'fe' terms include factor variables or operators @@ -574,7 +576,8 @@ tvcm_grow <- function(object, subset = NULL, weights = NULL) { glm.doNotFit <- function(x, y, weights = NULL, start = NULL, etastart = NULL, mustart = NULL, offset = NULL, family = gaussian(), - control = list(), intercept = TRUE) { + control = list(), intercept = TRUE, + singular.ok = TRUE) { coefficients <- rep.int(0, NCOL(x)) names(coefficients) <- colnames(x) if (is.null(weights)) weights <- rep.int(1.0, NROW(x)) diff --git a/inst/doc/vcrpart.Rnw b/inst/doc/vcrpart.Rnw index 790c154..9e60df4 100644 --- a/inst/doc/vcrpart.Rnw +++ b/inst/doc/vcrpart.Rnw @@ -53,7 +53,8 @@ empirical applications. E-mail: \email{Gilbert.Ritschard@unige.ch} } -\usepackage[utf8x]{inputenc} +\usepackage[utf8]{inputenc} % 2017-08-23 +%\usepackage[utf8x]{inputenc} %\usepackage{Sweave.sty} % \usepackage{Sweave} % \SweaveOpts{eps=TRUE} diff --git a/inst/doc/vcrpart.pdf b/inst/doc/vcrpart.pdf index 2e056413663b1455ebb775099d0da5dc091ec77a..de67c2158ec92bd374a67223ba7e99b79a08f1fe 100644 GIT binary patch delta 566 zcmcc7u6m|$*iKBsyq+hG=u4h2bh$nH*hj?ZdPto z>>!|UJ5b>zSptf{rfr|D&Ui?bfXeMteHqXA;#Z`yeco(Fb1MRhrUMmmY?r#m_*aW4 zl`)J=7p?KDRG!Wk#l*e6#Fi;ehJecLK$XcZ_!Vhw-!hMBiXv`B?ZB7-VrC#_0b*7l zW&>jO?TH6Cu4Ho=8W@@z8JUvT!qW fF*I>;aWrx=v@kL=H#f1cQ?MbVWV^04=V}fBK4Q4= delta 566 zcmcc7u6m|Nq5i6>!|UJ5b>zSptf{rfr|D&Ui?bfXeMteHqXA;#Z`yeco(Fb1MRhrUMmmY?r#m_*aW4 zl`)J=7p?KDRG!Wk#l*e6#Fi;ehJecLK$XcZ_!Vhw-!hMBiXv`B?ZB7-VrC#_0b*7l zW&>jO?TH6Cu4Ho=SQr@^85@`wnNGLY;gm$;Z%@+U?BH`Yad9?xF)?&8b#rkuGBUGp fHL`SaHgs_^Fg7$WHF0vbQ?MbVWV^04=V}fBO;oP< diff --git a/src/olmm.c b/src/olmm.c index 64b85d6..1c781d0 100644 --- a/src/olmm.c +++ b/src/olmm.c @@ -143,12 +143,15 @@ SEXP olmm_setPar(SEXP x, SEXP par) { const double zero = 0.0, one = 1.0; /* for matrix manipulations */ /* overwrite coefficients slot */ - Memcpy(coefficients, newPar, nPar); - + for (int i = 0; i < nPar; i++) + coefficients[i] = newPar[i]; + /* overwrite fixed effect parameter slot */ for (int i = 0; i < nEta; i++) { - Memcpy(fixef + i * pEta, newPar + i * pCe, pCe); - Memcpy(fixef + i * pEta + pCe, newPar + pCe*nEta, pGe); + for (int j = 0; j < pCe; j++) + fixef[i * pEta + j] = newPar[i * pCe + j]; + for (int j = 0; j < pGe; j++) + fixef[i * pEta + pCe + j] = newPar[pCe * nEta + j]; } /* set predictor-invariant fixed effects of adjacent-category model @@ -163,9 +166,12 @@ SEXP olmm_setPar(SEXP x, SEXP par) { } /* overwrite (cholesky decompositioned) random effect parameters */ - double *vRanefCholFac = Memcpy(Alloca(lenVRanefCholFac, double), - newPar + p, lenVRanefCholFac); - + double *vRanefCholFac = Alloca(lenVRanefCholFac, double); + R_CheckStack(); + + for (int i = 0; i < lenVRanefCholFac; i++) + vRanefCholFac[i] = newPar[p + i]; + F77_CALL(dgemv)("T", /* multiply with l. t. elimination matrix */ &lenVRanefCholFac, &lenVecRanefCholFac, &one, ranefElMat, @@ -177,7 +183,7 @@ SEXP olmm_setPar(SEXP x, SEXP par) { SET_VECTOR_ELT(rvalR, 1, vecRanefCholFacR); SET_VECTOR_ELT(rvalR, 2, coefficientsR); SET_VECTOR_ELT(rvalR, 3, ranefElMatR); - + UNPROTECT(5); return rvalR; } @@ -201,7 +207,8 @@ SEXP olmm_update_marg(SEXP x, SEXP par) { /* get subject slot */ int *subject = INTEGER(coerceVector(getListElement(x, "subject"), INTSXP)); - + R_CheckStack(); + /* integer valued slots */ int *dims = DIMS_SLOT(x); @@ -231,9 +238,7 @@ SEXP olmm_update_marg(SEXP x, SEXP par) { *score_sbj = REAL(score_sbjR), *score = REAL(scoreR), *info = REAL(infoR); - - R_CheckStack(); - + /* set constants (dimensions of vectors etc.) */ const int n = dims[n_POS], N = dims[N_POS], p = dims[p_POS], pEta = dims[pEta_POS], @@ -249,9 +254,8 @@ SEXP olmm_update_marg(SEXP x, SEXP par) { /* get response variable */ int *yI = INTEGER(coerceVector(getListElement(x, "y"), INTSXP)); - /* double *yD = REAL(coerceVector(getListElement(x, "y"), REALSXP));xs */ R_CheckStack(); - + /* variables for matrix operations etc. */ int i1 = 1, tmpJ, subsTmp; double one = 1.0, zero = 0.0, @@ -354,8 +358,10 @@ SEXP olmm_update_marg(SEXP x, SEXP par) { /* ranefVec (vector) to ranef (matrix) */ for (int i = 0; i < nEta; i++) { - Memcpy(ranef + i * qEta, ranefVec + i * qCe, qCe); - Memcpy(ranef + i*qEta + qCe, ranefVec + qCe*nEta, qGe); + for (int j = 0; j < qCe; j++) + ranef[i * qEta + j] = ranefVec[i * qCe + j]; + for (int j = 0; j < qGe; j++) + ranef[i * qEta + qCe + j] = ranefVec[qCe * nEta + j]; } /* set predictor-invariant random effects of adjacent-category models @@ -614,7 +620,9 @@ SEXP olmm_update_marg(SEXP x, SEXP par) { if (numHess == 0) { AllocVal(info, nPar * nPar, zero); /* reset info matrix*/ - double *hDerVec = Alloca(nPar, double), hInv2; + double *hDerVec = Alloca(nPar, double), + hInv2; + R_CheckStack(); for (int i = 0; i < N; i++) { hInv2 = - weights_sbj[i] / (logLik_sbj[i] * logLik_sbj[i]); @@ -692,8 +700,10 @@ SEXP olmm_update_marg(SEXP x, SEXP par) { SEXP olmm_update_u(SEXP x) { /* get subject slot */ - int *subject = INTEGER(coerceVector(getListElement(x, "subject"), INTSXP)); - + int *subject = + INTEGER(coerceVector(getListElement(x, "subject"), INTSXP)); + R_CheckStack(); + /* integer valued slots */ int *dims = DIMS_SLOT(x); @@ -722,7 +732,6 @@ SEXP olmm_update_u(SEXP x) { /* get response variable */ int *yI = INTEGER(coerceVector(getListElement(x, "y"), INTSXP)); - /* double *yD = REAL(coerceVector(getListElement(x, "y"), REALSXP)); */ R_CheckStack(); /* variables for matrix operations */ @@ -764,7 +773,8 @@ SEXP olmm_update_u(SEXP x) { *ranef = Alloca(q, double), *logLikCond_obs = Calloc(n, double), *logLikCond_sbj = Calloc(N, double); - + R_CheckStack(); + for (int k = 0; k < nQP; k++) { /* clear temporary objects */ @@ -785,8 +795,10 @@ SEXP olmm_update_u(SEXP x) { /* ranefVec (vector) to ranef (matrix) */ for (int i = 0; i < nEta; i++) { - Memcpy(ranef + i * qEta, ranefVec + i * qCe, qCe); - Memcpy(ranef + i*qEta + qCe, ranefVec + qCe*nEta, qGe); + for (int j = 0; j < qCe; j++) + ranef[i * qEta + j] = ranefVec[i * qCe + j]; + for (int j = 0; j < qGe; j++) + ranef[i * qEta + qCe + j] = ranefVec[qCe * nEta + j]; } /* set predictor-invariant random effects of adjacent-category model @@ -860,9 +872,7 @@ SEXP olmm_update_u(SEXP x) { if (family == 1) Free(etaCLM); if (family == 1) Free(etaRanefCLM); if ((family == 2) | (family == 3)) Free(sumBL); - - UNPROTECT(1); - + UNPROTECT(1); return uR; } @@ -938,8 +948,10 @@ SEXP olmm_pred_marg(SEXP x, SEXP eta, SEXP W, SEXP n, SEXP pred) { /* ranefVec (vector) to ranef (matrix) */ for (int i = 0; i < nEta; i++) { - Memcpy(ranef + i * qEta, ranefVec + i * qCe, qCe); - Memcpy(ranef + i*qEta + qCe, ranefVec + qCe*nEta, qGe); + for (int j = 0; j < qCe; j++) + ranef[i * qEta + j] = ranefVec[i * qCe + j]; + for (int j = 0; j < qGe; j++) + ranef[i * qEta + qCe + j] = ranefVec[qCe * nEta + j]; } /* set predictor-invariant random effects of adjacent-category models @@ -987,6 +999,7 @@ SEXP olmm_pred_marg(SEXP x, SEXP eta, SEXP W, SEXP n, SEXP pred) { gq_weight = 1; /* reset integration weight */ } + Free(etaRanef); Free(predCond); UNPROTECT(1); @@ -1006,8 +1019,10 @@ SEXP olmm_pred_margNew(SEXP x, SEXP etaNew, SEXP WNew, SEXP subjectNew, const int rnNew = INTEGER(nNew)[0]; /* get subject slot */ - int *subject = INTEGER(coerceVector(getListElement(x, "subject"), INTSXP)); - + int *subject = + INTEGER(coerceVector(getListElement(x, "subject"), INTSXP)); + R_CheckStack(); + /* integer valued slots */ int *dims = DIMS_SLOT(x); @@ -1015,7 +1030,6 @@ SEXP olmm_pred_margNew(SEXP x, SEXP etaNew, SEXP WNew, SEXP subjectNew, double *ranefCholFac = RANEFCHOLFAC_SLOT(x), *ghw = GHW_SLOT(x), *ghx = GHX_SLOT(x), *eta = ETA_SLOT(x), *W = W_SLOT(x), *logLik_sbj = LOGLIKSBJ_SLOT(x); - R_CheckStack(); /* set constants (dimensions of vectors etc.) */ const int q = dims[q_POS], qEta = dims[qEta_POS], @@ -1026,7 +1040,6 @@ SEXP olmm_pred_margNew(SEXP x, SEXP etaNew, SEXP WNew, SEXP subjectNew, /* get response variable */ int *yI = INTEGER(coerceVector(getListElement(x, "y"), INTSXP)); - /* double *yD = REAL(coerceVector(getListElement(x, "y"), REALSXP)); */ R_CheckStack(); /* variables for matrix operations etc. */ @@ -1065,10 +1078,13 @@ SEXP olmm_pred_margNew(SEXP x, SEXP etaNew, SEXP WNew, SEXP subjectNew, /* ranefVec (vector) to ranef (matrix) */ for (int i = 0; i < nEta; i++) { - Memcpy(ranef + i * qEta, ranefVec + i * qCe, qCe); - Memcpy(ranef + i*qEta + qCe, ranefVec + qCe*nEta, qGe); + for (int j = 0; j < qCe; j++) + ranef[i * qEta + j] = ranefVec[i * qCe + j]; + for (int j = 0; j < qGe; j++) + ranef[i * qEta + qCe + j] = ranefVec[qCe * nEta + j]; } + /* set predictor-invariant random effects of adjacent-category models to use the Likelihood of the baseline-category model */ if (family == 3) { diff --git a/vignettes/vcrpart.Rnw b/vignettes/vcrpart.Rnw index 790c154..9e60df4 100644 --- a/vignettes/vcrpart.Rnw +++ b/vignettes/vcrpart.Rnw @@ -53,7 +53,8 @@ empirical applications. E-mail: \email{Gilbert.Ritschard@unige.ch} } -\usepackage[utf8x]{inputenc} +\usepackage[utf8]{inputenc} % 2017-08-23 +%\usepackage[utf8x]{inputenc} %\usepackage{Sweave.sty} % \usepackage{Sweave} % \SweaveOpts{eps=TRUE}