[Depmix-commits] r677 - in pkg/depmix: . R inst src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Dec 8 15:38:37 CET 2018
Author: ingmarvisser
Date: 2018-12-08 15:38:37 +0100 (Sat, 08 Dec 2018)
New Revision: 677
Added:
pkg/depmix/src/depmix_init.c
Removed:
pkg/depmix/src/npsolfit.h
Modified:
pkg/depmix/CHANGES
pkg/depmix/DESCRIPTION
pkg/depmix/NAMESPACE
pkg/depmix/R/depmix-internal.R
pkg/depmix/R/depmix.R
pkg/depmix/inst/CITATION
pkg/depmix/src/logl.cc
Log:
=removed NPSOL support and added registration of native routines
Modified: pkg/depmix/CHANGES
===================================================================
--- pkg/depmix/CHANGES 2018-11-14 16:15:17 UTC (rev 676)
+++ pkg/depmix/CHANGES 2018-12-08 14:38:37 UTC (rev 677)
@@ -1,4 +1,9 @@
+Changes in 0.9.15
+
+1) Removed NPSOL support in both C and R code (as it produced errors and no one seems to be using it anyway).
+2) Added registration of native routines.
+
Changes from 0.9.8 to 0.9.9
1) Fixed a bug which led to an error when specifying multigroup models
Modified: pkg/depmix/DESCRIPTION
===================================================================
--- pkg/depmix/DESCRIPTION 2018-11-14 16:15:17 UTC (rev 676)
+++ pkg/depmix/DESCRIPTION 2018-12-08 14:38:37 UTC (rev 677)
@@ -1,10 +1,10 @@
Package: depmix
-Version: 0.9.14
-Date: 2016-02-11
+Version: 0.9.15
+Date: 2018-12-08
Title: Dependent Mixture Models
Author: Ingmar Visser <i.visser at uva.nl>
Maintainer: Ingmar Visser <i.visser at uva.nl>
-Depends: R (>= 3.1.2), MASS
+Depends: R (>= 3.5.0), MASS
Suggests: Rdonlp2
Additional_repositories: http://R-Forge.R-project.org
Description: Fits (multigroup) mixtures of latent or hidden Markov models on mixed categorical and continuous (timeseries) data. The Rdonlp2 package can optionally be used for optimization of the log-likelihood and is available from R-forge.
Modified: pkg/depmix/NAMESPACE
===================================================================
--- pkg/depmix/NAMESPACE 2018-11-14 16:15:17 UTC (rev 676)
+++ pkg/depmix/NAMESPACE 2018-12-08 14:38:37 UTC (rev 677)
@@ -1,5 +1,3 @@
-useDynLib(depmix)
-
import(MASS)
importFrom("graphics", "layout.show")
@@ -20,5 +18,4 @@
S3method(summary,fit)
-
-
+useDynLib(depmix, .registration=TRUE)
Modified: pkg/depmix/R/depmix-internal.R
===================================================================
--- pkg/depmix/R/depmix-internal.R 2018-11-14 16:15:17 UTC (rev 676)
+++ pkg/depmix/R/depmix-internal.R 2018-12-08 14:38:37 UTC (rev 677)
@@ -1,4 +1,4 @@
-#
+##################################
# DEPMIX INTERNAL FUNCTIONS, NOT TO BE CALLED BY USER
#
Modified: pkg/depmix/R/depmix.R
===================================================================
--- pkg/depmix/R/depmix.R 2018-11-14 16:15:17 UTC (rev 676)
+++ pkg/depmix/R/depmix.R 2018-12-08 14:38:37 UTC (rev 677)
@@ -1,4 +1,4 @@
-## package for fitting dependent mixture models
+### package for fitting dependent mixture models
# .onLoad <- function(lib, pkg) {
# library.dynam("depmix", pkg, lib)
@@ -175,26 +175,26 @@
pars=fitpars[which(fixed==1)]
## call npmain to optimize the model (non-linear constraints not implemented yet)
- if(method=="npsol") {
+# if(method=="npsol") {
- bu=bu[which(fixed==1)]
- bl=bl[which(fixed==1)]
-
- if(printlevel>29) {
- print(A)
- print(bl)
- print(bu)
- print(bllin)
- print(bulin)
- }
+# bu=bu[which(fixed==1)]
+# bl=bl[which(fixed==1)]
+#
+# if(printlevel>29) {
+# print(A)
+# print(bl)
+# print(bu)
+# print(bllin)
+# print(bulin)
+# }
# npsol specific inputs
- fixedvals=fitpars
- A=A[,which(fixed==1),drop=FALSE]
- if(nrow(A)>0) {
- bl=c(bl,bllin)
- bu=c(bu,bulin)
- } # else nothing to do, bl and bu are already defined
+# fixedvals=fitpars
+# A=A[,which(fixed==1),drop=FALSE]
+# if(nrow(A)>0) {
+# bl=c(bl,bllin)
+# bu=c(bu,bulin)
+# } # else nothing to do, bl and bu are already defined
## npsol optimization options
# itlim=paste(c("Iteration Limit = ", iterlim , " "), collapse=" ")
@@ -211,50 +211,50 @@
# optset=lapply(npopts,FUN=optfor <- function(opt) {.Fortran("npoptn",as.character(opt),PACKAGE="depmix") } )
# optfile can be used to read in an optionsfile called npoptn from the working directory
- optfile=1 # using this will override above specified default options
- derivatives=der # are derivatives to be used or not
- cj=1 # non linear constraints are not supported yet, hence cj=1
- maxnpcalls=1 # maxnpcalls is not used at the moment
- nctotl=length(pars)+nrow(A)+0 # latter zero is for the number of non-linear constraints
- npars=length(pars) # nr of pars to be optimized
+# optfile=1 # using this will override above specified default options
+# derivatives=der # are derivatives to be used or not
+# cj=1 # non linear constraints are not supported yet, hence cj=1
+# maxnpcalls=1 # maxnpcalls is not used at the moment
+# nctotl=length(pars)+nrow(A)+0 # latter zero is for the number of non-linear constraints
+# npars=length(pars) # nr of pars to be optimized
- timeUsed <- system.time(z <- .C("npsolc",
- as.integer(npars), # nr of pars to be optimized
- as.integer(nrow(A)), # nr of lin constraints
- as.integer(0), # nr of non-linear constraints
- as.integer(nrow(A)), # lead dimension of A
- as.integer(1), # lead dimension of Jacobian of non-linear constr
- as.integer(npars), # lead dimension of matrix R
- as.double(A), # linear constraint matrix
- as.double(bl), # lower bounds on pars and constraints
- as.double(bu), # upper bounds on pars and constraints
- inform=integer(1), # inform
- iter=integer(1), # nr of iterations
- istate=as.integer(rep(0,nctotl)), # return value indicating whether constraints are satisfied
- as.double(1), # par for non-linear constraints, not implemented
- as.double(0), # not accessed, non-linear constraint var
- as.double(rep(0,nctotl)), # clamda, bounds and linear constraints
- objf=double(1), # return value: final logl
- gradu=double(npars), # return value: gradients at final iterate
- R=as.double(rep(0,npars*npars)),# return value: augmented hessian
- pars=as.double(pars), # initial values and return values with final values of pars
- totMem=integer(1), # memory usage
- as.integer(maxnpcalls), # may be used to restart iterations after perturbing parameters
- as.integer(optfile), # logical indicating whether an options file should be read
- as.integer(printlevel), # printlevel
- as.integer(derivatives), # logical indicating whether analytical gradients are available or not
- as.integer(tdcov), # logical indicating whether time dependent covariates pars are fitted or not
- as.integer(fixed), # logical indicating which pars are fixed zeroes
- as.double(fixedvals), # values of fixed parameters
- as.integer(length(fixed)), # self evident
- PACKAGE="depmix"))
- z$timeUsed=timeUsed[3]
- if(printlevel>19) print(z)
- fitpars=xgmod$pars
- fitpars[which(fixed==1)]=z$pars
- z$pars=fitpars
- z
- }
+# timeUsed <- system.time(z <- .C("npsolc",
+# as.integer(npars), # nr of pars to be optimized
+# as.integer(nrow(A)), # nr of lin constraints
+# as.integer(0), # nr of non-linear constraints
+# as.integer(nrow(A)), # lead dimension of A
+# as.integer(1), # lead dimension of Jacobian of non-linear constr
+# as.integer(npars), # lead dimension of matrix R
+# as.double(A), # linear constraint matrix
+# as.double(bl), # lower bounds on pars and constraints
+# as.double(bu), # upper bounds on pars and constraints
+# inform=integer(1), # inform
+# iter=integer(1), # nr of iterations
+# istate=as.integer(rep(0,nctotl)), # return value indicating whether constraints are satisfied
+# as.double(1), # par for non-linear constraints, not implemented
+# as.double(0), # not accessed, non-linear constraint var
+# as.double(rep(0,nctotl)), # clamda, bounds and linear constraints
+# objf=double(1), # return value: final logl
+# gradu=double(npars), # return value: gradients at final iterate
+# R=as.double(rep(0,npars*npars)),# return value: augmented hessian
+# pars=as.double(pars), # initial values and return values with final values of pars
+# totMem=integer(1), # memory usage
+# as.integer(maxnpcalls), # may be used to restart iterations after perturbing parameters
+# as.integer(optfile), # logical indicating whether an options file should be read
+# as.integer(printlevel), # printlevel
+# as.integer(derivatives), # logical indicating whether analytical gradients are available or not
+# as.integer(tdcov), # logical indicating whether time dependent covariates pars are fitted or not
+# as.integer(fixed), # logical indicating which pars are fixed zeroes
+# as.double(fixedvals), # values of fixed parameters
+# as.integer(length(fixed)), # self evident
+# PACKAGE="depmix"))
+# z$timeUsed=timeUsed[3]
+# if(printlevel>19) print(z)
+# fitpars=xgmod$pars
+# fitpars[which(fixed==1)]=z$pars
+# z$pars=fitpars
+# z
+# }
## call npmain to optimize the model (non-linear constraints not implemented yet)
if(method=="donlp") {
Modified: pkg/depmix/inst/CITATION
===================================================================
--- pkg/depmix/inst/CITATION 2018-11-14 16:15:17 UTC (rev 676)
+++ pkg/depmix/inst/CITATION 2018-12-08 14:38:37 UTC (rev 677)
@@ -6,7 +6,7 @@
author = person(given="Ingmar", family="Visser"),
journal = "R-package manual",
year = "2007",
- url = "http://cran.r-project.org",
+ url = "https://CRAN.R-project.org",
textVersion = paste("Ingmar Visser (2007). Depmix: An R-package
for fitting mixture models on mixed multivariate data with Markov
dependencies. R-package manual and introduction into Dependent
Added: pkg/depmix/src/depmix_init.c
===================================================================
--- pkg/depmix/src/depmix_init.c (rev 0)
+++ pkg/depmix/src/depmix_init.c 2018-12-08 14:38:37 UTC (rev 677)
@@ -0,0 +1,38 @@
+#include <stdlib.h> // for NULL
+#include <R_ext/Rdynload.h>
+
+/* FIXME:
+ Check these declarations against the C/Fortran source code.
+*/
+
+/* .C calls */
+extern void covSetUp(void *, void *, void *, void *, void *, void *, void *, void *);
+extern void loglikelihood(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void mixModelSetUp(void *, void *, void *, void *, void *, void *, void *, void *);
+extern void multiCovSetUp(void *, void *);
+extern void multiDataSetUp(void *, void *);
+extern void ngCovSetUp(void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void ngDataSetUp(void *, void *, void *, void *, void *, void *, void *, void *, void *);
+// extern void npsolc(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void posteriors(void *, void *, void *, void *, void *, void *, void *);
+extern void setCrit(void *);
+
+static const R_CMethodDef CEntries[] = {
+ {"covSetUp", (DL_FUNC) &covSetUp, 8},
+ {"loglikelihood", (DL_FUNC) &loglikelihood, 13},
+ {"mixModelSetUp", (DL_FUNC) &mixModelSetUp, 8},
+ {"multiCovSetUp", (DL_FUNC) &multiCovSetUp, 2},
+ {"multiDataSetUp", (DL_FUNC) &multiDataSetUp, 2},
+ {"ngCovSetUp", (DL_FUNC) &ngCovSetUp, 9},
+ {"ngDataSetUp", (DL_FUNC) &ngDataSetUp, 9},
+// {"npsolc", (DL_FUNC) &npsolc, 28},
+ {"posteriors", (DL_FUNC) &posteriors, 7},
+ {"setCrit", (DL_FUNC) &setCrit, 1},
+ {NULL, NULL, 0}
+};
+
+void R_init_depmix(DllInfo *dll)
+{
+ R_registerRoutines(dll, CEntries, NULL, NULL, NULL);
+ R_useDynamicSymbols(dll, FALSE);
+}
Modified: pkg/depmix/src/logl.cc
===================================================================
--- pkg/depmix/src/logl.cc 2018-11-14 16:15:17 UTC (rev 676)
+++ pkg/depmix/src/logl.cc 2018-12-08 14:38:37 UTC (rev 677)
@@ -1,6 +1,6 @@
#include "logl.h"
-#include "npsolfit.h"
+// #include "npsolfit.h"
extern "C" {
Deleted: pkg/depmix/src/npsolfit.h
===================================================================
--- pkg/depmix/src/npsolfit.h 2018-11-14 16:15:17 UTC (rev 676)
+++ pkg/depmix/src/npsolfit.h 2018-12-08 14:38:37 UTC (rev 677)
@@ -1,66 +0,0 @@
-
-#ifndef NPSOLFIT
-#define NPSOLFIT 1
-
-#include <stdio.h>
-#include <stdlib.h>
-/* #include <fstream.h> */
-
-#include <R.h>
-#include <Rmath.h>
-
-extern "C" {
-
-//globals needed in npsolc and funobj
-int derivatives;
-int tdc;
-int *fixed;
-double *fixedvalues;
-int npars;
-
-
-/************************************************************/
-/* */
-/* FUNCTION DECLARATIONS */
-/* */
-/************************************************************/
-
-//should this be pointers to functions
-void funobj(int *mode, int *n, double *x, double *f, double *g, int *nstate);
-void funcon(int *mode, int *ncnln, int *n, int *ldJ, int *needc, double *x, double *c, double *cJac, int *nstate);
-
-// declare objective function to be optimized by npsol such that it can be called by Fortran
-void F77_SUB (funobj) (int *mode, int *n, double *x, double *f, double *g, int *nstate);
-
-// declare non-linear constraint function such that it can be called by Fortran
-void F77_SUB (funcon) (int *mode, int * ncnln, int *n, int *ldJ, int *needc, double *x, double *c, double *cJac);
-
-//declare npsol for use in C
-void F77_NAME (npsol) (int *n, int *nclin, int *ncnln, int *ldA, int *ldJu, int *ldR,
- double *A, double *bl, double *bu,
- void funcon(int *mode, int *ncnln, int *n, int *ldJ, int *needc, double *x, double *c, double *cJac, int *nstate),
- void funobj(int *mode, int *n, double *x, double *f, double *g, int *nstate),
- int *inform, int *iter, int *istate, double *c, double *cJacu, double *clamda,
- double *objf, double *gradu, double *R, double *x,
- int *iw, int *leniw, double *w, int *lenw);
-
-
-// npsol options read from file with logical unit ioptns, inform will return 0 if all is okay
-void F77_NAME (npfile) (int *ioptns, int *inform);
-void F77_NAME (npoptn) (char *option); //char *option
-
-// set, open and close file "npsoloptions" on logical unit 33
-void F77_NAME (opoptf)();
-void F77_NAME (cloptf)();
-
-//this is the C-wrapper for npsol which is called from R
-void npsolc(int *n, int *nclin, int *ncnln, int *ldA, int *ldJu, int *ldR,
- double *A, double *bl, double *bu,
- int *inform, int *iter, int *istate, double *c, double *cJacu, double *clamda,
- double *objf, double *gradu, double *R, double *x,
- int *totMem, int *maxnpcalls, int *optfile,
- int *print, int *derivatives, int *tdcov, int *fixedlogical, double *fixedvals, int *nrpars);
-
-} //end extern "C"
-
-#endif
\ No newline at end of file
More information about the depmix-commits
mailing list