[r-cran-mcmcpack] 24/90: Imported Upstream version 0.9-1
Andreas Tille
tille at debian.org
Fri Dec 16 09:07:36 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-mcmcpack.
commit 3ecc122377d6b84cc4a99296756ade9e242fef1f
Author: Andreas Tille <tille at debian.org>
Date: Fri Dec 16 08:07:10 2016 +0100
Imported Upstream version 0.9-1
---
DESCRIPTION | 10 +-
HISTORY | 6 +
LICENSE | 2 +-
NAMESPACE | 1 -
R/MCMCfactanal.R | 4 +-
R/MCMCirt1d.R | 2 +-
R/MCMCirtKdRob.R | 2 +-
R/MCMCmixfactanal.R | 2 +-
R/MCMCmnl.R | 3 +-
R/MCMCoprobit.R | 2 +-
R/MCMCordfactanal.R | 4 +-
R/MCMCpanel.R | 247 --
R/hidden.R | 2 +-
configure | 3938 +++++++++++---------
man/MCMCpanel.Rd | 158 -
src/MCMCSVDreg.cc | 200 +-
src/MCMCdistn.cc | 466 ---
src/MCMCdynamicEI.cc | 467 +--
src/MCMCfactanal.cc | 280 +-
src/MCMCfcds.cc | 400 ---
src/MCMCfcds.h | 457 ++-
src/MCMChierEI.cc | 563 ++-
src/MCMCirt1d.cc | 259 +-
src/MCMCirtKdRob.cc | 1006 +++---
src/MCMClogit.cc | 209 +-
src/MCMClogituserprior.cc | 221 +-
src/MCMCmetrop1R.cc | 252 +-
src/MCMCmixfactanal.cc | 590 +--
src/MCMCmnl.h | 74 +
src/MCMCmnlMH.cc | 199 +-
src/MCMCmnlslice.cc | 417 +--
src/MCMCoprobit.cc | 195 +-
src/MCMCordfactanal.cc | 397 +-
src/MCMCpanel.cc | 229 --
src/MCMCpoisson.cc | 180 +-
src/MCMCprobit.cc | 149 +-
src/MCMCprobitres.cc | 176 +-
src/MCMCregress.cc | 272 +-
src/MCMCrng.cc | 59 -
src/MCMCrng.h | 46 +-
src/MCMCtobit.cc | 169 +-
src/Makevars | 2 +-
src/Makevars.in | 2 +-
src/algorithm.h | 202 ++
src/datablock.h | 361 ++
src/defs.h | 261 ++
src/distributions.cc | 2055 -----------
src/distributions.h | 2601 ++++++++++++--
src/error.h | 362 +-
src/ide.cc | 534 ---
src/ide.h | 1797 +++++++++-
src/la.cc | 392 --
src/la.h | 1041 +++++-
src/lapack.h | 131 +
src/lecuyer.cc | 689 +---
src/lecuyer.h | 733 +++-
src/matrix.h | 6750 +++++++++++++++++++++++++----------
src/matrix_bidirectional_iterator.h | 474 +++
src/matrix_forward_iterator.h | 427 +++
src/matrix_iterator.h | 1842 ----------
src/matrix_random_access_iterator.h | 626 ++++
src/mersenne.cc | 125 -
src/mersenne.h | 227 +-
src/optimize.cc | 642 ----
src/optimize.h | 1012 +++++-
src/rng.cc | 1161 ------
src/rng.h | 1580 +++++++-
src/rtmvnorm.h | 266 ++
src/smath.cc | 625 ----
src/smath.h | 1123 ++++--
src/stat.cc | 431 ---
src/stat.h | 710 +++-
src/util.h | 74 -
73 files changed, 23816 insertions(+), 17757 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index de09038..1aa6ce7 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,15 +1,15 @@
Package: MCMCpack
-Version: 0.8-2
-Date: 2007-4-23
+Version: 0.9-1
+Date: 2007-08-22
Title: Markov chain Monte Carlo (MCMC) Package
Author: Andrew D. Martin <admartin at wustl.edu>, and
Kevin M. Quinn <kevin_quinn at harvard.edu>
Maintainer: Andrew D. Martin <admartin at wustl.edu>
-Depends: R (>= 2.2.0), coda (>= 0.10-5), MASS, stats
+Depends: R (>= 2.5.0), coda (>= 0.11-3), MASS, stats
Description: This package contains functions to perform Bayesian
inference using posterior simulation for a number of statistical
models. Most simulation is done in compiled C++ written in the Scythe
- Statistical Library Version 1.0. All models return coda mcmc objects
+ Statistical Library Version 1.0.2. All models return coda mcmc objects
that can then be summarized using the coda package. MCMCpack
also contains some useful utility functions, including some
additional density functions and pseudo-random number generators
@@ -17,4 +17,4 @@ Description: This package contains functions to perform Bayesian
sampling algorithm, and tools for visualization.
License: GPL version 2
URL: http://mcmcpack.wustl.edu
-Packaged: Mon Apr 23 15:23:25 2007; adm
+Packaged: Tue Aug 21 14:49:42 2007; adm
diff --git a/HISTORY b/HISTORY
index 26e2d0b..04b9ce7 100644
--- a/HISTORY
+++ b/HISTORY
@@ -2,6 +2,12 @@
// Changes and Bug Fixes
//
+0.8-2 to 0.9-1
+ * first release of JStatSoft version
+ * full port to Scythe 1.0.2 (nearly all C++ has been radically changed)
+ * MCMCpanel() deprecated
+ * a number of minor fixes [thanks to anonymous reviewers]
+
0.8-1 to 0.8-2
* models with multivariate normal priors now check for symmetry and positive
semi-definiteness of precision matrix
diff --git a/LICENSE b/LICENSE
index ac61a0c..cd38f59 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,5 +1,5 @@
Markov chain Monte Carlo Package (MCMCpack)
-Copyright (C) 2003-2005 Andrew D. Martin and Kevin M. Quinn
+Copyright (C) 2003-2007 Andrew D. Martin and Kevin M. Quinn
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/NAMESPACE b/NAMESPACE
index 73a789b..135cfb5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -28,7 +28,6 @@ export(
MCMCmnl,
MCMCoprobit,
MCMCordfactanal,
- MCMCpanel,
MCMCpoisson,
MCMCpoissonChangepoint,
MCMCprobit,
diff --git a/R/MCMCfactanal.R b/R/MCMCfactanal.R
index 2214f3b..2c4e79c 100644
--- a/R/MCMCfactanal.R
+++ b/R/MCMCfactanal.R
@@ -140,8 +140,8 @@
output <- form.mcmc.object(posterior, par.names, title)
## get rid of columns for constrained parameters
output.df <- as.data.frame(as.matrix(output))
- output.var <- diag(var(output.df))
- output.df <- output.df[,output.var != 0]
+ output.sd <- apply(output.df, 2, sd)
+ output.df <- output.df[,output.sd != 0]
output <- mcmc(as.matrix(output.df), start=burnin+1, end=mcmc+burnin,
thin=thin)
diff --git a/R/MCMCirt1d.R b/R/MCMCirt1d.R
index 5efdb22..1591060 100644
--- a/R/MCMCirt1d.R
+++ b/R/MCMCirt1d.R
@@ -183,7 +183,7 @@
# put together matrix and build MCMC object to return
sample <- matrix(posterior$sampledata, posterior$samplerow,
posterior$samplecol,
- byrow=TRUE)
+ byrow=FALSE)
output <- mcmc(data=sample, start=burnin+1, end=burnin+mcmc, thin=thin)
names <- NULL
diff --git a/R/MCMCirtKdRob.R b/R/MCMCirtKdRob.R
index f2fa4f7..2a1c879 100644
--- a/R/MCMCirtKdRob.R
+++ b/R/MCMCirtKdRob.R
@@ -367,7 +367,7 @@
## put together matrix and build MCMC object to return
sample <- matrix(posterior$samdata, posterior$samrow, posterior$samcol,
- byrow=TRUE)
+ byrow=FALSE)
output <- mcmc(data=sample,start=1, end=mcmc, thin=thin)
par.names <- NULL
diff --git a/R/MCMCmixfactanal.R b/R/MCMCmixfactanal.R
index 0b9a3e6..35525a3 100644
--- a/R/MCMCmixfactanal.R
+++ b/R/MCMCmixfactanal.R
@@ -324,7 +324,7 @@
# put together matrix and build MCMC object to return
sample <- matrix(posterior$samdata, posterior$samrow, posterior$samcol,
- byrow=TRUE)
+ byrow=FALSE)
output <- mcmc(data=sample,start=1, end=mcmc, thin=thin)
par.names <- NULL
diff --git a/R/MCMCmnl.R b/R/MCMCmnl.R
index 19f476a..1d41b06 100644
--- a/R/MCMCmnl.R
+++ b/R/MCMCmnl.R
@@ -271,7 +271,8 @@
else if (mcmc.method=="slice"){
## call C++ code to draw sample
auto.Scythe.call(output.object="posterior", cc.fun.name="MCMCmnlslice",
- sample=sample, Y=Y, X=X, burnin=as.integer(burnin),
+ sample.nonconst=sample, Y=Y, X=X,
+ burnin=as.integer(burnin),
mcmc=as.integer(mcmc), thin=as.integer(thin),
lecuyer=as.integer(lecuyer),
seedarray=as.integer(seed.array),
diff --git a/R/MCMCoprobit.R b/R/MCMCoprobit.R
index 36633dd..0e96596 100644
--- a/R/MCMCoprobit.R
+++ b/R/MCMCoprobit.R
@@ -126,7 +126,7 @@
## put together matrix and build MCMC object to return
sample <- matrix(posterior$sampledata, posterior$samplerow,
- posterior$samplecol, byrow=TRUE)
+ posterior$samplecol, byrow=FALSE)
sample <- sample[,c(1:K, (K+3):(K+ncat))]
output <- mcmc(data=sample, start=burnin+1, end=burnin+mcmc, thin=thin)
xnames <- c(X.names, paste("gamma", 2:(ncat-1), sep=""))
diff --git a/R/MCMCordfactanal.R b/R/MCMCordfactanal.R
index 31a0d90..12f94db 100644
--- a/R/MCMCordfactanal.R
+++ b/R/MCMCordfactanal.R
@@ -290,7 +290,7 @@
)
if(case.switch==1) {
accepts <- matrix(posterior$accepts, posterior$acceptsrow,
- posterior$acceptscol, byrow=TRUE)
+ posterior$acceptscol, byrow=FALSE)
rownames(accepts) <- X.names
colnames(accepts) <- ""
cat("\n\nAcceptance rates:\n")
@@ -300,7 +300,7 @@
# put together matrix and build MCMC object to return
sample <- matrix(posterior$samdata, posterior$samrow, posterior$samcol,
- byrow=TRUE)
+ byrow=FALSE)
output <- mcmc(data=sample,start=1, end=mcmc, thin=thin)
par.names <- NULL
diff --git a/R/MCMCpanel.R b/R/MCMCpanel.R
deleted file mode 100644
index 64ac758..0000000
--- a/R/MCMCpanel.R
+++ /dev/null
@@ -1,247 +0,0 @@
-# sample from the posterior distribution of general linear panel
-# model in R using linked C++ code in Scythe
-#
-# NOTE: this does not take a data argument because only
-# matrices are passed. This should probably be fixed. Also,
-# re-implementing using something likes Bates' syntax
-# would be nice. The helper functions could also be used
-# all over the place here. This is another good project for a grad
-# student.
-#
-#
-# ADM and KQ 8/1/2002
-# updated with Ben Goodrich's feedback and new spec ADM 7/28/2004
-
-
-"MCMCpanel" <-
- function(obs, Y, X, W, burnin = 1000, mcmc = 10000, thin = 5,
- verbose = 0, seed = NA, sigma2.start = NA,
- D.start = NA, b0 = 0, B0 = 1, eta0, R0, nu0 = 0.001,
- delta0 = 0.001, ...) {
-
- # DESCRIPTION:
- #
- # MCMCpanel fits a general linear panel model using Algorithm 2 of
- # Chib and Carlin (1999). The program calls a compiled C++ shared
- # library to perform the actual sampling. The model takes the
- # following form:
- #
- # y_i = X_i \beta + W_i b_i + \varepsilon_i
- #
- # b_i \sim N_q(0,D)
- #
- # \varepsilon_i \sim N_k(0,\sigma^2 I_n)
- #
- # With conjugate priors:
- #
- # \beta \sim N_p(\beta_0, \B_0^-1)
- #
- # D^-1 \sim Wishart(\nu_0^{-1} R_0, \nu_0)
- #
- # \sigma^-2 \sim Gamma(\nu_00/2, \delta_00/2)
- #
- # The model is defined in terms of k (the number of responses
- # per subject, assumed to be constant across subjects), p (the
- # number of columns in the design matrix of covariates), and
- # q (the number of columns in the design matrix), and n (the
- # number of subjects). The components of the model are the
- # following:
- #
- # y_i (k \times 1) vector of responses for subject i
- #
- # X_i (k \times p) matrix of covariates for subject i
- #
- # \beta (p \times 1) vector of fixed effects coefficients
- #
- # W_i (k \times q) design matrix for random effects for subject i
- #
- # b_i (q \times 1) vector of random effects for subject i
- #
- # \varepsilon (k \times 1) vector of errors for subject i
- #
-
- # seeds
- seeds <- form.seeds(seed)
- lecuyer <- seeds[[1]]
- seed.array <- seeds[[2]]
- lecuyer.stream <- seeds[[3]]
-
- # model parameters
- n <- length(unique(obs))
- k <- length(Y) / n
- p <- dim(X)[2]
- q <- dim(W)[2]
-
- # check data conformability
- obs.temp <- as.matrix(obs)
- if (any(obs.temp[,1] != obs)) {
- cat("Error: obs is not a column vector.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
- if(length(unique(tabulate(obs))) != 1) {
- cat("Error: Panel is not balanced [check obs vector].\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
- Y.temp <- as.matrix(Y)
- if (any(Y.temp[,1] != Y)) {
- cat("Error: X matrix is not conformable [does not match Y].\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
- if(dim(W)[1] != n * k) {
- cat("Error: W matrix is not conformable [does not match Y].\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
-
- # check iteration parameters
- check.mcmc.parameters(burnin, mcmc, thin)
- totiter <- mcmc + burnin
-
- # starting values for beta error checking
- beta.start <- NA
- ols.beta <- solve(t(X) %*% X) %*% t(X) %*% Y
- ols.sigma2 <-
- t(Y - X %*% ols.beta) %*% (Y - X %*% ols.beta) / (k*n - p - 1)
- ols.sigma2 <- as.double(ols.sigma2)
- if (is.na(beta.start)){ # use least squares estimates
- beta.start <- ols.beta
- }
- if(is.null(dim(beta.start))) {
- beta.start <- beta.start * matrix(1,p,1)
- }
- if((dim(beta.start)[1] != p) || (dim(beta.start)[2] != 1)) {
- cat("Error: Starting value for beta not conformable.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
-
- # sigma2 starting values error checking
- if (is.na(sigma2.start)){
- sigma2.start <- ols.sigma2
- }
- if(sigma2.start <= 0) {
- cat("Error: Starting value for sigma2 negative.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
-
- # starting values for D error checking
- if (is.na(D.start)){ # use matrix of ones
- D.start <- .5 * ols.sigma2 * diag(q)
- }
- if(is.null(dim(D.start))) {
- D.start <- D.start * diag(q)
- }
- if((dim(D.start)[1] != q) || (dim(D.start)[2] != q)) {
- cat("Error: Starting value for D not conformable.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
-
- # set up prior for beta
- if(is.null(dim(b0))) {
- b0 <- b0 * matrix(1,p,1)
- }
- if((dim(b0)[1] != p) || (dim(b0)[2] != 1)) {
- cat("Error: N(b0,B0^-1) prior b0 not conformable.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
- if(is.null(dim(B0))) {
- B0 <- B0 * diag(p)
- }
- if((dim(B0)[1] != p) || (dim(B0)[2] != p)) {
- cat("Error: N(b0,B0^-1) prior B0 not conformable.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
-
- # set up prior for sigma2
- if(nu0 <= 0) {
- cat("Error: G(nu0,delta0) prior nu0 less than or equal to zero.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
- if(delta0 <= 0) {
- cat("Error: G(nu0,delta0) prior delta0 less than or equal to zero.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
-
- # set up prior for D
- if(eta0 < q) {
- cat("Error: Wishart(eta0,R0) prior eta0 less than or equal to q.\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
- if(is.null(dim(R0))) {
- R0 <- R0 * diag(q)
- }
- if((dim(R0)[1] != q) || (dim(R0)[2] != q)) {
- cat("Error: Wishart(eta0,R0) prior R0 not comformable [q times q].\n")
- stop("Please respecify and call MCMCpanel() again.\n", call.=FALSE)
- }
-
- # set up big holder matrix
- sample <- matrix(0, mcmc/thin, p+q*q+1)
-
- # call C++ code to draw sample
- inv.obj <- .C("panelpost",
- samdata = as.double(sample),
- samrow = as.integer(nrow(sample)),
- samcol = as.integer(ncol(sample)),
- obsdata = as.double(obs),
- obsrow = as.integer(length(obs)),
- obscol = as.integer(1),
- ydata = as.double(Y),
- yrow = as.integer(length(Y)),
- ycol = as.integer(1),
- xdata = as.double(X),
- xrow = as.integer(nrow(X)),
- xcol = as.integer(ncol(X)),
- wdata = as.double(W),
- wrow = as.integer(nrow(W)),
- wcol = as.integer(ncol(W)),
- burnin = as.integer(burnin),
- gibbs = as.integer(mcmc),
- thin = as.integer(thin),
- lecuyer = as.integer(lecuyer),
- seedarray = as.integer(seed.array),
- lecuyerstream = as.integer(lecuyer.stream),
- verbose = as.integer(verbose),
- bstartdata = as.double(beta.start),
- bstartrow = as.integer(nrow(beta.start)),
- bstartcol = as.integer(ncol(beta.start)),
- sigma2start = as.double(sigma2.start),
- Dstartdata = as.double(D.start),
- Dstartrow = as.integer(nrow(D.start)),
- Dstartcol = as.integer(ncol(D.start)),
- b0data = as.double(b0),
- b0row = as.integer(nrow(b0)),
- b0col = as.integer(ncol(b0)),
- B0data = as.double(B0),
- B0row = as.integer(nrow(B0)),
- B0col = as.integer(ncol(B0)),
- nu0 = as.double(nu0),
- delta0 = as.double(delta0),
- eta0 = as.integer(eta0),
- R0data = as.double(R0),
- R0row = as.integer(nrow(R0)),
- R0col = as.integer(ncol(R0)),
- n = as.integer(n),
- k = as.integer(k),
- p = as.integer(p),
- q = as.integer(q),
- PACKAGE="MCMCpack"
- )
-
- # put together matrix and build MCMC object to return
- sample <- matrix(inv.obj$samdata, inv.obj$samrow, inv.obj$samcol,
- byrow=TRUE)
-
- if (length(colnames(X))>0) {
- beta.names <- colnames(X)
- }
- else beta.names <- paste("beta", 1:p, sep = "")
- D.names <- paste("D", 1:(q*q), sep = "")
- sigma2.names <- "sigma2"
- names <- c(beta.names, D.names, sigma2.names)
-
- output <- mcmc(data=sample, start=1, end=mcmc, thin=thin)
- varnames(output) <- names
- attr(output,"title") <-
- "MCMCpack Linear Panel Model Posterior Sample"
- return(output)
- }
-
diff --git a/R/hidden.R b/R/hidden.R
index c481750..a2ce184 100644
--- a/R/hidden.R
+++ b/R/hidden.R
@@ -556,7 +556,7 @@
holder <- matrix(posterior.object$sampledata,
posterior.object$samplerow,
posterior.object$samplecol,
- byrow=TRUE)
+ byrow=FALSE)
output <- mcmc(data=holder, start=(posterior.object$burnin+1),
end=(posterior.object$burnin+posterior.object$mcmc),
diff --git a/configure b/configure
index 10a7769..964e714 100755
--- a/configure
+++ b/configure
@@ -1,25 +1,54 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.59.
+# Generated by GNU Autoconf 2.61.
#
-# Copyright (C) 2003 Free Software Foundation, Inc.
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+# 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization. ##
## --------------------- ##
-# Be Bourne compatible
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
emulate sh
NULLCMD=:
# Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in
+ *posix*) set -o posix ;;
+esac
+
+fi
+
+
+
+
+# PATH needs CR
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
fi
-DUALCASE=1; export DUALCASE # for MKS sh
# Support unset when possible.
if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
@@ -29,8 +58,43 @@ else
fi
+# IFS
+# We need space, tab and new line, in precisely that order. Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+as_nl='
+'
+IFS=" "" $as_nl"
+
+# Find who we are. Look in the path if we contain no directory separator.
+case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+IFS=$as_save_IFS
+
+ ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+ as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+ echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ { (exit 1); exit 1; }
+fi
+
# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
+for as_var in ENV MAIL MAILPATH
+do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+done
PS1='$ '
PS2='> '
PS4='+ '
@@ -44,18 +108,19 @@ do
if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
eval $as_var=C; export $as_var
else
- $as_unset $as_var
+ ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
fi
done
# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
@@ -63,157 +128,388 @@ fi
# Name of the executable.
-as_me=`$as_basename "$0" ||
+as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+# CDPATH.
+$as_unset CDPATH
-# PATH needs CR, and LINENO needs CR and PATH.
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
+if test "x$CONFIG_SHELL" = x; then
+ if (eval ":") 2>/dev/null; then
+ as_have_required=yes
+else
+ as_have_required=no
fi
+ if test $as_have_required = yes && (eval ":
+(as_func_return () {
+ (exit \$1)
+}
+as_func_success () {
+ as_func_return 0
+}
+as_func_failure () {
+ as_func_return 1
+}
+as_func_ret_success () {
+ return 0
+}
+as_func_ret_failure () {
+ return 1
+}
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
+exitcode=0
+if as_func_success; then
+ :
+else
+ exitcode=1
+ echo as_func_success failed.
+fi
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
+if as_func_failure; then
+ exitcode=1
+ echo as_func_failure succeeded.
+fi
+
+if as_func_ret_success; then
+ :
+else
+ exitcode=1
+ echo as_func_ret_success failed.
+fi
+
+if as_func_ret_failure; then
+ exitcode=1
+ echo as_func_ret_failure succeeded.
+fi
+
+if ( set x; as_func_ret_success y && test x = \"\$1\" ); then
+ :
+else
+ exitcode=1
+ echo positional parameters were not saved.
+fi
+
+test \$exitcode = 0) || { (exit 1); exit 1; }
+
+(
+ as_lineno_1=\$LINENO
+ as_lineno_2=\$LINENO
+ test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" &&
+ test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; }
+") 2> /dev/null; then
+ :
+else
+ as_candidate_shells=
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
+ case $as_dir in
/*)
- if ("$as_dir/$as_base" -c '
+ for as_base in sh bash ksh sh5; do
+ as_candidate_shells="$as_candidate_shells $as_dir/$as_base"
+ done;;
+ esac
+done
+IFS=$as_save_IFS
+
+
+ for as_shell in $as_candidate_shells $SHELL; do
+ # Try only shells that exist, to save several forks.
+ if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+ { ("$as_shell") 2> /dev/null <<\_ASEOF
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in
+ *posix*) set -o posix ;;
+esac
+
+fi
+
+
+:
+_ASEOF
+}; then
+ CONFIG_SHELL=$as_shell
+ as_have_required=yes
+ if { "$as_shell" 2> /dev/null <<\_ASEOF
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in
+ *posix*) set -o posix ;;
+esac
+
+fi
+
+
+:
+(as_func_return () {
+ (exit $1)
+}
+as_func_success () {
+ as_func_return 0
+}
+as_func_failure () {
+ as_func_return 1
+}
+as_func_ret_success () {
+ return 0
+}
+as_func_ret_failure () {
+ return 1
+}
+
+exitcode=0
+if as_func_success; then
+ :
+else
+ exitcode=1
+ echo as_func_success failed.
+fi
+
+if as_func_failure; then
+ exitcode=1
+ echo as_func_failure succeeded.
+fi
+
+if as_func_ret_success; then
+ :
+else
+ exitcode=1
+ echo as_func_ret_success failed.
+fi
+
+if as_func_ret_failure; then
+ exitcode=1
+ echo as_func_ret_failure succeeded.
+fi
+
+if ( set x; as_func_ret_success y && test x = "$1" ); then
+ :
+else
+ exitcode=1
+ echo positional parameters were not saved.
+fi
+
+test $exitcode = 0) || { (exit 1); exit 1; }
+
+(
as_lineno_1=$LINENO
as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
+ test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; }
+
+_ASEOF
+}; then
+ break
+fi
+
+fi
+
+ done
+
+ if test "x$CONFIG_SHELL" != x; then
+ for as_var in BASH_ENV ENV
+ do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+ done
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}
+fi
+
+
+ if test $as_have_required = no; then
+ echo This script requires a shell more modern than all the
+ echo shells that I found on your system. Please install a
+ echo modern shell, or manually run the script under such a
+ echo shell if you do have one.
+ { (exit 1); exit 1; }
+fi
+
+
+fi
+
+fi
+
+
+
+(eval "as_func_return () {
+ (exit \$1)
+}
+as_func_success () {
+ as_func_return 0
+}
+as_func_failure () {
+ as_func_return 1
+}
+as_func_ret_success () {
+ return 0
+}
+as_func_ret_failure () {
+ return 1
+}
+
+exitcode=0
+if as_func_success; then
+ :
+else
+ exitcode=1
+ echo as_func_success failed.
+fi
+
+if as_func_failure; then
+ exitcode=1
+ echo as_func_failure succeeded.
+fi
+
+if as_func_ret_success; then
+ :
+else
+ exitcode=1
+ echo as_func_ret_success failed.
+fi
+
+if as_func_ret_failure; then
+ exitcode=1
+ echo as_func_ret_failure succeeded.
+fi
+
+if ( set x; as_func_ret_success y && test x = \"\$1\" ); then
+ :
+else
+ exitcode=1
+ echo positional parameters were not saved.
+fi
+
+test \$exitcode = 0") || {
+ echo No shell found that supports shell functions.
+ echo Please tell autoconf at gnu.org about your system,
+ echo including any error possibly output before this
+ echo message
+}
+
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {
# Create $as_me.lineno as a copy of $as_myself, but with $LINENO
# uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
+ # line-number line after each line using $LINENO; the second 'sed'
+ # does the real work. The second script uses 'N' to pair each
+ # line-number line with the line containing $LINENO, and appends
+ # trailing '-' during substitution so that $LINENO is not a special
+ # case at line end.
# (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
+ # scripts with optimization help from Paolo Bonzini. Blame Lee
+ # E. McMahon (1931-1989) for sed's syntax. :-)
+ sed -n '
+ p
+ /[$]LINENO/=
+ ' <$as_myself |
sed '
+ s/[$]LINENO.*/&-/
+ t lineno
+ b
+ :lineno
N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ :loop
+ s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
+ s/-\n.*//
' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
+ chmod +x "$as_me.lineno" ||
{ echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
{ (exit 1); exit 1; }; }
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
+ # original and so on. Autoconf is especially sensitive to this).
+ . "./$as_me.lineno"
# Exit status is that of the last command.
exit
}
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in
+-n*)
+ case `echo 'x\c'` in
+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.
+ *) ECHO_C='\c';;
+ esac;;
+*)
+ ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1; then
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+ rm -f conf$$.dir/conf$$.file
+else
+ rm -f conf$$.dir
+ mkdir conf$$.dir
+fi
echo >conf$$.file
if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
+ as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -p'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
as_ln_s='cp -p'
- else
- as_ln_s='ln -s'
- fi
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
as_ln_s='cp -p'
fi
-rm -f conf$$ conf$$.exe conf$$.file
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
if mkdir -p . 2>/dev/null; then
as_mkdir_p=:
@@ -222,7 +518,28 @@ else
as_mkdir_p=false
fi
-as_executable_p="test -f"
+if test -x / >/dev/null 2>&1; then
+ as_test_x='test -x'
+else
+ if ls -dL / >/dev/null 2>&1; then
+ as_ls_L_option=L
+ else
+ as_ls_L_option=
+ fi
+ as_test_x='
+ eval sh -c '\''
+ if test -d "$1"; then
+ test -d "$1/.";
+ else
+ case $1 in
+ -*)set "./$1";;
+ esac;
+ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in
+ ???[sx]*):;;*)false;;esac;fi
+ '\'' sh
+ '
+fi
+as_executable_p=$as_test_x
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -231,39 +548,27 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
+exec 7<&0 </dev/null 6>&1
# Name of the host.
# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
-exec 6>&1
-
#
# Initializations.
#
ac_default_prefix=/usr/local
+ac_clean_files=
ac_config_libobj_dir=.
+LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}
-# Maximum number of lines to put in a shell here document.
-# This variable seems obsolete. It should probably be removed, and
-# only ac_max_sed_lines should be used.
-: ${ac_max_here_lines=38}
-
# Identity of this package.
PACKAGE_NAME=
PACKAGE_TARNAME=
@@ -275,42 +580,107 @@ ac_unique_file="DESCRIPTION"
# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
-#if HAVE_SYS_TYPES_H
+#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
#endif
-#if HAVE_SYS_STAT_H
+#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
-#if STDC_HEADERS
+#ifdef STDC_HEADERS
# include <stdlib.h>
# include <stddef.h>
#else
-# if HAVE_STDLIB_H
+# ifdef HAVE_STDLIB_H
# include <stdlib.h>
# endif
#endif
-#if HAVE_STRING_H
-# if !STDC_HEADERS && HAVE_MEMORY_H
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
# include <memory.h>
# endif
# include <string.h>
#endif
-#if HAVE_STRINGS_H
+#ifdef HAVE_STRINGS_H
# include <strings.h>
#endif
-#if HAVE_INTTYPES_H
+#ifdef HAVE_INTTYPES_H
# include <inttypes.h>
-#else
-# if HAVE_STDINT_H
-# include <stdint.h>
-# endif
#endif
-#if HAVE_UNISTD_H
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CXX CXXFLAGS LDFLAGS CPPFLAGS ac_ct_CXX EXEEXT OBJEXT CC CFLAGS ac_ct_CC CPP EGREP MV_HAVE_IEEEFP_H MV_HAVE_TRUNC LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL
+PATH_SEPARATOR
+PACKAGE_NAME
+PACKAGE_TARNAME
+PACKAGE_VERSION
+PACKAGE_STRING
+PACKAGE_BUGREPORT
+exec_prefix
+prefix
+program_transform_name
+bindir
+sbindir
+libexecdir
+datarootdir
+datadir
+sysconfdir
+sharedstatedir
+localstatedir
+includedir
+oldincludedir
+docdir
+infodir
+htmldir
+dvidir
+pdfdir
+psdir
+libdir
+localedir
+mandir
+DEFS
+ECHO_C
+ECHO_N
+ECHO_T
+LIBS
+build_alias
+host_alias
+target_alias
+CXX
+CXXFLAGS
+LDFLAGS
+CPPFLAGS
+ac_ct_CXX
+EXEEXT
+OBJEXT
+CC
+CFLAGS
+ac_ct_CC
+CPP
+GREP
+EGREP
+MV_HAVE_IEEEFP_H
+MV_HAVE_TRUNC
+LIBOBJS
+LTLIBOBJS'
ac_subst_files=''
+ ac_precious_vars='build_alias
+host_alias
+target_alias
+CXX
+CXXFLAGS
+LDFLAGS
+LIBS
+CPPFLAGS
+CCC
+CC
+CFLAGS
+CPP'
+
# Initialize some variables set by options.
ac_init_help=
@@ -337,34 +707,48 @@ x_libraries=NONE
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
-datadir='${prefix}/share'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
-libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
-infodir='${prefix}/info'
-mandir='${prefix}/man'
+docdir='${datarootdir}/doc/${PACKAGE}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
ac_prev=
+ac_dashdash=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
- eval "$ac_prev=\$ac_option"
+ eval $ac_prev=\$ac_option
ac_prev=
continue
fi
- ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+ case $ac_option in
+ *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+ *) ac_optarg=yes ;;
+ esac
# Accept the important Cygnus configure options, so we can diagnose typos.
- case $ac_option in
+ case $ac_dashdash$ac_option in
+ --)
+ ac_dashdash=yes ;;
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
@@ -386,33 +770,45 @@ do
--config-cache | -C)
cache_file=config.cache ;;
- -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ -datadir | --datadir | --datadi | --datad)
ac_prev=datadir ;;
- -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
- | --da=*)
+ -datadir=* | --datadir=* | --datadi=* | --datad=*)
datadir=$ac_optarg ;;
+ -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+ | --dataroo | --dataro | --datar)
+ ac_prev=datarootdir ;;
+ -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+ datarootdir=$ac_optarg ;;
+
-disable-* | --disable-*)
ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null &&
{ echo "$as_me: error: invalid feature name: $ac_feature" >&2
{ (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- eval "enable_$ac_feature=no" ;;
+ ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'`
+ eval enable_$ac_feature=no ;;
+
+ -docdir | --docdir | --docdi | --doc | --do)
+ ac_prev=docdir ;;
+ -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+ docdir=$ac_optarg ;;
+
+ -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+ ac_prev=dvidir ;;
+ -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+ dvidir=$ac_optarg ;;
-enable-* | --enable-*)
ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null &&
{ echo "$as_me: error: invalid feature name: $ac_feature" >&2
{ (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
- esac
- eval "enable_$ac_feature='$ac_optarg'" ;;
+ ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'`
+ eval enable_$ac_feature=\$ac_optarg ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
@@ -439,6 +835,12 @@ do
-host=* | --host=* | --hos=* | --ho=*)
host_alias=$ac_optarg ;;
+ -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+ ac_prev=htmldir ;;
+ -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+ | --ht=*)
+ htmldir=$ac_optarg ;;
+
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
@@ -463,13 +865,16 @@ do
| --libexe=* | --libex=* | --libe=*)
libexecdir=$ac_optarg ;;
+ -localedir | --localedir | --localedi | --localed | --locale)
+ ac_prev=localedir ;;
+ -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+ localedir=$ac_optarg ;;
+
-localstatedir | --localstatedir | --localstatedi | --localstated \
- | --localstate | --localstat | --localsta | --localst \
- | --locals | --local | --loca | --loc | --lo)
+ | --localstate | --localstat | --localsta | --localst | --locals)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
- | --localstate=* | --localstat=* | --localsta=* | --localst=* \
- | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
localstatedir=$ac_optarg ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
@@ -534,6 +939,16 @@ do
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name=$ac_optarg ;;
+ -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+ ac_prev=pdfdir ;;
+ -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+ pdfdir=$ac_optarg ;;
+
+ -psdir | --psdir | --psdi | --psd | --ps)
+ ac_prev=psdir ;;
+ -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+ psdir=$ac_optarg ;;
+
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
@@ -586,24 +1001,20 @@ do
-with-* | --with-*)
ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null &&
{ echo "$as_me: error: invalid package name: $ac_package" >&2
{ (exit 1); exit 1; }; }
- ac_package=`echo $ac_package| sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
- esac
- eval "with_$ac_package='$ac_optarg'" ;;
+ ac_package=`echo $ac_package | sed 's/[-.]/_/g'`
+ eval with_$ac_package=\$ac_optarg ;;
-without-* | --without-*)
ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null &&
{ echo "$as_me: error: invalid package name: $ac_package" >&2
{ (exit 1); exit 1; }; }
- ac_package=`echo $ac_package | sed 's/-/_/g'`
- eval "with_$ac_package=no" ;;
+ ac_package=`echo $ac_package | sed 's/[-.]/_/g'`
+ eval with_$ac_package=no ;;
--x)
# Obsolete; use --with-x.
@@ -634,8 +1045,7 @@ Try \`$0 --help' for more information." >&2
expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
{ echo "$as_me: error: invalid variable name: $ac_envvar" >&2
{ (exit 1); exit 1; }; }
- ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
- eval "$ac_envvar='$ac_optarg'"
+ eval $ac_envvar=\$ac_optarg
export $ac_envvar ;;
*)
@@ -655,27 +1065,19 @@ if test -n "$ac_prev"; then
{ (exit 1); exit 1; }; }
fi
-# Be sure to have absolute paths.
-for ac_var in exec_prefix prefix
-do
- eval ac_val=$`echo $ac_var`
- case $ac_val in
- [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
- esac
-done
-
-# Be sure to have absolute paths.
-for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
- localstatedir libdir includedir oldincludedir infodir mandir
+# Be sure to have absolute directory names.
+for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
+ datadir sysconfdir sharedstatedir localstatedir includedir \
+ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+ libdir localedir mandir
do
- eval ac_val=$`echo $ac_var`
+ eval ac_val=\$$ac_var
case $ac_val in
- [\\/$]* | ?:[\\/]* ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
+ [\\/$]* | ?:[\\/]* ) continue;;
+ NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
esac
+ { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; }
done
# There might be people who depend on the old broken behavior: `$host'
@@ -702,82 +1104,76 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias-
test "$silent" = yes && exec 6>/dev/null
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+ { echo "$as_me: error: Working directory cannot be determined" >&2
+ { (exit 1); exit 1; }; }
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+ { echo "$as_me: error: pwd does not report name of working directory" >&2
+ { (exit 1); exit 1; }; }
+
+
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
- # Try the directory containing this script, then its parent.
- ac_confdir=`(dirname "$0") 2>/dev/null ||
+ # Try the directory containing this script, then the parent directory.
+ ac_confdir=`$as_dirname -- "$0" ||
$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$0" : 'X\(//\)[^/]' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
echo X"$0" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
srcdir=$ac_confdir
- if test ! -r $srcdir/$ac_unique_file; then
+ if test ! -r "$srcdir/$ac_unique_file"; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
-if test ! -r $srcdir/$ac_unique_file; then
- if test "$ac_srcdir_defaulted" = yes; then
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
+if test ! -r "$srcdir/$ac_unique_file"; then
+ test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
{ (exit 1); exit 1; }; }
- else
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+ cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2
{ (exit 1); exit 1; }; }
- fi
-fi
-(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
- { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
- { (exit 1); exit 1; }; }
-srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
-ac_env_build_alias_set=${build_alias+set}
-ac_env_build_alias_value=$build_alias
-ac_cv_env_build_alias_set=${build_alias+set}
-ac_cv_env_build_alias_value=$build_alias
-ac_env_host_alias_set=${host_alias+set}
-ac_env_host_alias_value=$host_alias
-ac_cv_env_host_alias_set=${host_alias+set}
-ac_cv_env_host_alias_value=$host_alias
-ac_env_target_alias_set=${target_alias+set}
-ac_env_target_alias_value=$target_alias
-ac_cv_env_target_alias_set=${target_alias+set}
-ac_cv_env_target_alias_value=$target_alias
-ac_env_CXX_set=${CXX+set}
-ac_env_CXX_value=$CXX
-ac_cv_env_CXX_set=${CXX+set}
-ac_cv_env_CXX_value=$CXX
-ac_env_CXXFLAGS_set=${CXXFLAGS+set}
-ac_env_CXXFLAGS_value=$CXXFLAGS
-ac_cv_env_CXXFLAGS_set=${CXXFLAGS+set}
-ac_cv_env_CXXFLAGS_value=$CXXFLAGS
-ac_env_LDFLAGS_set=${LDFLAGS+set}
-ac_env_LDFLAGS_value=$LDFLAGS
-ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
-ac_cv_env_LDFLAGS_value=$LDFLAGS
-ac_env_CPPFLAGS_set=${CPPFLAGS+set}
-ac_env_CPPFLAGS_value=$CPPFLAGS
-ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
-ac_cv_env_CPPFLAGS_value=$CPPFLAGS
-ac_env_CC_set=${CC+set}
-ac_env_CC_value=$CC
-ac_cv_env_CC_set=${CC+set}
-ac_cv_env_CC_value=$CC
-ac_env_CFLAGS_set=${CFLAGS+set}
-ac_env_CFLAGS_value=$CFLAGS
-ac_cv_env_CFLAGS_set=${CFLAGS+set}
-ac_cv_env_CFLAGS_value=$CFLAGS
-ac_env_CPP_set=${CPP+set}
-ac_env_CPP_value=$CPP
-ac_cv_env_CPP_set=${CPP+set}
-ac_cv_env_CPP_value=$CPP
+ pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+ srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+ eval ac_env_${ac_var}_set=\${${ac_var}+set}
+ eval ac_env_${ac_var}_value=\$${ac_var}
+ eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+ eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
#
# Report the --help message.
@@ -806,9 +1202,6 @@ Configuration:
-n, --no-create do not create output files
--srcdir=DIR find the sources in DIR [configure dir or \`..']
-_ACEOF
-
- cat <<_ACEOF
Installation directories:
--prefix=PREFIX install architecture-independent files in PREFIX
[$ac_default_prefix]
@@ -826,15 +1219,22 @@ Fine tuning of the installation directories:
--bindir=DIR user executables [EPREFIX/bin]
--sbindir=DIR system admin executables [EPREFIX/sbin]
--libexecdir=DIR program executables [EPREFIX/libexec]
- --datadir=DIR read-only architecture-independent data [PREFIX/share]
--sysconfdir=DIR read-only single-machine data [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
--localstatedir=DIR modifiable single-machine data [PREFIX/var]
--libdir=DIR object code libraries [EPREFIX/lib]
--includedir=DIR C header files [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc [/usr/include]
- --infodir=DIR info documentation [PREFIX/info]
- --mandir=DIR man documentation [PREFIX/man]
+ --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
+ --datadir=DIR read-only architecture-independent data [DATAROOTDIR]
+ --infodir=DIR info documentation [DATAROOTDIR/info]
+ --localedir=DIR locale-dependent data [DATAROOTDIR/locale]
+ --mandir=DIR man documentation [DATAROOTDIR/man]
+ --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE]
+ --htmldir=DIR html documentation [DOCDIR]
+ --dvidir=DIR dvi documentation [DOCDIR]
+ --pdfdir=DIR pdf documentation [DOCDIR]
+ --psdir=DIR ps documentation [DOCDIR]
_ACEOF
cat <<\_ACEOF
@@ -850,8 +1250,9 @@ Some influential environment variables:
CXXFLAGS C++ compiler flags
LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
nonstandard directory <lib dir>
- CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
- headers in a nonstandard directory <include dir>
+ LIBS libraries to pass to the linker, e.g. -l<library>
+ CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I<include dir> if
+ you have headers in a nonstandard directory <include dir>
CC C compiler command
CFLAGS C compiler flags
CPP C preprocessor
@@ -860,118 +1261,86 @@ Use these variables to override the choices made by `configure' or to help
it to find libraries and programs with nonstandard names/locations.
_ACEOF
+ac_status=$?
fi
if test "$ac_init_help" = "recursive"; then
# If there are subdirs, report their specific --help.
- ac_popdir=`pwd`
for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
- test -d $ac_dir || continue
+ test -d "$ac_dir" || continue
ac_builddir=.
-if test "$ac_dir" != .; then
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
+ # A ".." for each directory in $ac_dir_suffix.
+ ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'`
+ case $ac_top_builddir_sub in
+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+ esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
case $srcdir in
- .) # No --srcdir option. We are building in place.
+ .) # We are building in place.
ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_top_srcdir=$ac_top_builddir_sub
+ ac_abs_top_srcdir=$ac_pwd ;;
+ [\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
+ ac_top_srcdir=$srcdir
+ ac_abs_top_srcdir=$srcdir ;;
+ *) # Relative name.
+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_build_prefix$srcdir
+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
- cd $ac_dir
- # Check for guested configure; otherwise get Cygnus style configure.
- if test -f $ac_srcdir/configure.gnu; then
- echo
- $SHELL $ac_srcdir/configure.gnu --help=recursive
- elif test -f $ac_srcdir/configure; then
- echo
- $SHELL $ac_srcdir/configure --help=recursive
- elif test -f $ac_srcdir/configure.ac ||
- test -f $ac_srcdir/configure.in; then
- echo
- $ac_configure --help
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+ cd "$ac_dir" || { ac_status=$?; continue; }
+ # Check for guested configure.
+ if test -f "$ac_srcdir/configure.gnu"; then
+ echo &&
+ $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+ elif test -f "$ac_srcdir/configure"; then
+ echo &&
+ $SHELL "$ac_srcdir/configure" --help=recursive
else
echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
- fi
- cd "$ac_popdir"
+ fi || ac_status=$?
+ cd "$ac_pwd" || { ac_status=$?; break; }
done
fi
-test -n "$ac_init_help" && exit 0
+test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
+configure
+generated by GNU Autoconf 2.61
-Copyright (C) 2003 Free Software Foundation, Inc.
+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
- exit 0
+ exit
fi
-exec 5>config.log
-cat >&5 <<_ACEOF
+cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by $as_me, which was
-generated by GNU Autoconf 2.59. Invocation command line was
+generated by GNU Autoconf 2.61. Invocation command line was
$ $0 $@
_ACEOF
+exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
@@ -990,7 +1359,7 @@ uname -v = `(uname -v) 2>/dev/null || echo unknown`
/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
-hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown`
/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
@@ -1004,6 +1373,7 @@ do
test -z "$as_dir" && as_dir=.
echo "PATH: $as_dir"
done
+IFS=$as_save_IFS
} >&5
@@ -1025,7 +1395,6 @@ _ACEOF
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
-ac_sep=
ac_must_keep_next=false
for ac_pass in 1 2
do
@@ -1036,7 +1405,7 @@ do
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
continue ;;
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ *\'*)
ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
esac
case $ac_pass in
@@ -1058,9 +1427,7 @@ do
-* ) ac_must_keep_next=true ;;
esac
fi
- ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
- # Get rid of the leading space.
- ac_sep=" "
+ ac_configure_args="$ac_configure_args '$ac_arg'"
;;
esac
done
@@ -1071,8 +1438,8 @@ $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_
# When interrupted or exit'd, cleanup temporary files, and complete
# config.log. We remove comments because anyway the quotes in there
# would cause problems or look ugly.
-# WARNING: Be sure not to use single quotes in there, as some shells,
-# such as our DU 5.0 friend, will then `close' the trap.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
trap 'exit_status=$?
# Save into config.log some information that might help in debugging.
{
@@ -1085,20 +1452,34 @@ trap 'exit_status=$?
_ASBOX
echo
# The following way of writing the cache mishandles newlines in values,
-{
+(
+ for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+ eval ac_val=\$$ac_var
+ case $ac_val in #(
+ *${as_nl}*)
+ case $ac_var in #(
+ *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5
+echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;;
+ esac
+ case $ac_var in #(
+ _ | IFS | as_nl) ;; #(
+ *) $as_unset $ac_var ;;
+ esac ;;
+ esac
+ done
(set) 2>&1 |
- case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
- *ac_space=\ *)
+ case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
sed -n \
- "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
- ;;
+ "s/'\''/'\''\\\\'\'''\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+ ;; #(
*)
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
- esac;
-}
+ esac |
+ sort
+)
echo
cat <<\_ASBOX
@@ -1109,22 +1490,28 @@ _ASBOX
echo
for ac_var in $ac_subst_vars
do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
+ eval ac_val=\$$ac_var
+ case $ac_val in
+ *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ esac
+ echo "$ac_var='\''$ac_val'\''"
done | sort
echo
if test -n "$ac_subst_files"; then
cat <<\_ASBOX
-## ------------- ##
-## Output files. ##
-## ------------- ##
+## ------------------- ##
+## File substitutions. ##
+## ------------------- ##
_ASBOX
echo
for ac_var in $ac_subst_files
do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
+ eval ac_val=\$$ac_var
+ case $ac_val in
+ *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ esac
+ echo "$ac_var='\''$ac_val'\''"
done | sort
echo
fi
@@ -1136,26 +1523,24 @@ _ASBOX
## ----------- ##
_ASBOX
echo
- sed "/^$/d" confdefs.h | sort
+ cat confdefs.h
echo
fi
test "$ac_signal" != 0 &&
echo "$as_me: caught signal $ac_signal"
echo "$as_me: exit $exit_status"
} >&5
- rm -f core *.core &&
- rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ rm -f core *.core core.conftest.* &&
+ rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
exit $exit_status
- ' 0
+' 0
for ac_signal in 1 2 13 15; do
trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
done
ac_signal=0
# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -rf conftest* confdefs.h
-# AIX cpp loses on an empty file, so make sure it contains at least a newline.
-echo >confdefs.h
+rm -f -r conftest* confdefs.h
# Predefined preprocessor variables.
@@ -1186,14 +1571,17 @@ _ACEOF
# Let the site file select an alternate cache file if it wants to.
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
+if test -n "$CONFIG_SITE"; then
+ set x "$CONFIG_SITE"
+elif test "x$prefix" != xNONE; then
+ set x "$prefix/share/config.site" "$prefix/etc/config.site"
+else
+ set x "$ac_default_prefix/share/config.site" \
+ "$ac_default_prefix/etc/config.site"
fi
-for ac_site_file in $CONFIG_SITE; do
+shift
+for ac_site_file
+do
if test -r "$ac_site_file"; then
{ echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
echo "$as_me: loading site script $ac_site_file" >&6;}
@@ -1209,8 +1597,8 @@ if test -r "$cache_file"; then
{ echo "$as_me:$LINENO: loading cache $cache_file" >&5
echo "$as_me: loading cache $cache_file" >&6;}
case $cache_file in
- [\\/]* | ?:[\\/]* ) . $cache_file;;
- *) . ./$cache_file;;
+ [\\/]* | ?:[\\/]* ) . "$cache_file";;
+ *) . "./$cache_file";;
esac
fi
else
@@ -1222,12 +1610,11 @@ fi
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
-for ac_var in `(set) 2>&1 |
- sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+for ac_var in $ac_precious_vars; do
eval ac_old_set=\$ac_cv_env_${ac_var}_set
eval ac_new_set=\$ac_env_${ac_var}_set
- eval ac_old_val="\$ac_cv_env_${ac_var}_value"
- eval ac_new_val="\$ac_env_${ac_var}_value"
+ eval ac_old_val=\$ac_cv_env_${ac_var}_value
+ eval ac_new_val=\$ac_env_${ac_var}_value
case $ac_old_set,$ac_new_set in
set,)
{ echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
@@ -1252,8 +1639,7 @@ echo "$as_me: current value: $ac_new_val" >&2;}
# Pass precious variables to config.status.
if test "$ac_new_set" = set; then
case $ac_new_val in
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
*) ac_arg=$ac_var=$ac_new_val ;;
esac
case " $ac_configure_args " in
@@ -1270,12 +1656,6 @@ echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start ov
{ (exit 1); exit 1; }; }
fi
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
@@ -1292,6 +1672,11 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
@@ -1302,18 +1687,22 @@ if test -z "${R_HOME}"; then
fi
CXX=`${R_HOME}/bin/R CMD config CXX`
-ac_ext=cc
+ac_ext=cpp
ac_cpp='$CXXCPP $CPPFLAGS'
ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_cxx_compiler_gnu
-if test -n "$ac_tool_prefix"; then
- for ac_prog in $CCC g++ c++ gpp aCC CC cxx cc++ cl FCC KCC RCC xlC_r xlC
+if test -z "$CXX"; then
+ if test -n "$CCC"; then
+ CXX=$CCC
+ else
+ if test -n "$ac_tool_prefix"; then
+ for ac_prog in g++ c++ gpp aCC CC cxx cc++ cl.exe FCC KCC RCC xlC_r xlC
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
if test "${ac_cv_prog_CXX+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -1326,36 +1715,38 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CXX="$ac_tool_prefix$ac_prog"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
+IFS=$as_save_IFS
fi
fi
CXX=$ac_cv_prog_CXX
if test -n "$CXX"; then
- echo "$as_me:$LINENO: result: $CXX" >&5
-echo "${ECHO_T}$CXX" >&6
+ { echo "$as_me:$LINENO: result: $CXX" >&5
+echo "${ECHO_T}$CXX" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
fi
+
test -n "$CXX" && break
done
fi
if test -z "$CXX"; then
ac_ct_CXX=$CXX
- for ac_prog in $CCC g++ c++ gpp aCC CC cxx cc++ cl FCC KCC RCC xlC_r xlC
+ for ac_prog in g++ c++ gpp aCC CC cxx cc++ cl.exe FCC KCC RCC xlC_r xlC
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
if test "${ac_cv_prog_ac_ct_CXX+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -1368,49 +1759,79 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_ac_ct_CXX="$ac_prog"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
+IFS=$as_save_IFS
fi
fi
ac_ct_CXX=$ac_cv_prog_ac_ct_CXX
if test -n "$ac_ct_CXX"; then
- echo "$as_me:$LINENO: result: $ac_ct_CXX" >&5
-echo "${ECHO_T}$ac_ct_CXX" >&6
+ { echo "$as_me:$LINENO: result: $ac_ct_CXX" >&5
+echo "${ECHO_T}$ac_ct_CXX" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
fi
+
test -n "$ac_ct_CXX" && break
done
-test -n "$ac_ct_CXX" || ac_ct_CXX="g++"
- CXX=$ac_ct_CXX
+ if test "x$ac_ct_CXX" = x; then
+ CXX="g++"
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet. If you think this
+configuration is useful to you, please write to autoconf at gnu.org." >&5
+echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet. If you think this
+configuration is useful to you, please write to autoconf at gnu.org." >&2;}
+ac_tool_warned=yes ;;
+esac
+ CXX=$ac_ct_CXX
+ fi
fi
-
+ fi
+fi
# Provide some information about the compiler.
-echo "$as_me:$LINENO:" \
- "checking for C++ compiler version" >&5
+echo "$as_me:$LINENO: checking for C++ compiler version" >&5
ac_compiler=`set X $ac_compile; echo $2`
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
- (eval $ac_compiler --version </dev/null >&5) 2>&5
+{ (ac_try="$ac_compiler --version >&5"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compiler --version >&5") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
- (eval $ac_compiler -v </dev/null >&5) 2>&5
+{ (ac_try="$ac_compiler -v >&5"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compiler -v >&5") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
- (eval $ac_compiler -V </dev/null >&5) 2>&5
+{ (ac_try="$ac_compiler -V >&5"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compiler -V >&5") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
@@ -1435,47 +1856,77 @@ ac_clean_files="$ac_clean_files a.out a.exe b.out"
# Try to create an executable without -o first, disregard a.out.
# It will help us diagnose broken compilers, and finding out an intuition
# of exeext.
-echo "$as_me:$LINENO: checking for C++ compiler default output file name" >&5
-echo $ECHO_N "checking for C++ compiler default output file name... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for C++ compiler default output file name" >&5
+echo $ECHO_N "checking for C++ compiler default output file name... $ECHO_C" >&6; }
ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
-if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
- (eval $ac_link_default) 2>&5
+#
+# List of possible output files, starting from the most likely.
+# The algorithm is not robust to junk in `.', hence go to wildcards (a.*)
+# only as a last resort. b.out is created by i960 compilers.
+ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out'
+#
+# The IRIX 6 linker writes into existing files which may not be
+# executable, retaining their permissions. Remove them first so a
+# subsequent execution test works.
+ac_rmfiles=
+for ac_file in $ac_files
+do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;;
+ * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+ esac
+done
+rm -f $ac_rmfiles
+
+if { (ac_try="$ac_link_default"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_link_default") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; then
- # Find the output, starting from the most likely. This scheme is
-# not robust to junk in `.', hence go to wildcards (a.*) only as a last
-# resort.
-
-# Be careful to initialize this variable, since it used to be cached.
-# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
-ac_cv_exeext=
-# b.out is created by i960 compilers.
-for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+ # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile. We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
do
test -f "$ac_file" || continue
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
- ;;
- conftest.$ac_ext )
- # This is the source file.
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj )
;;
[ab].out )
# We found the default executable, but exeext='' is most
# certainly right.
break;;
*.* )
- ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
- # FIXME: I believe we export ac_cv_exeext for Libtool,
- # but it would be cool to find out if it's true. Does anybody
- # maintain Libtool? --akim.
- export ac_cv_exeext
+ if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+ then :; else
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ fi
+ # We set ac_cv_exeext here because the later test for it is not
+ # safe: cross compilers may not add the suffix if given an `-o'
+ # argument, so we may need to know it at that point already.
+ # Even if this section looks crufty: it has the advantage of
+ # actually working.
break;;
* )
break;;
esac
done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
else
+ ac_file=''
+fi
+
+{ echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6; }
+if test -z "$ac_file"; then
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
@@ -1487,19 +1938,21 @@ See \`config.log' for more details." >&2;}
fi
ac_exeext=$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_file" >&5
-echo "${ECHO_T}$ac_file" >&6
-# Check the compiler produces executables we can run. If not, either
+# Check that the compiler produces executables we can run. If not, either
# the compiler is broken, or we cross compile.
-echo "$as_me:$LINENO: checking whether the C++ compiler works" >&5
-echo $ECHO_N "checking whether the C++ compiler works... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking whether the C++ compiler works" >&5
+echo $ECHO_N "checking whether the C++ compiler works... $ECHO_C" >&6; }
# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
# If not cross compiling, check that we can run a simple program.
if test "$cross_compiling" != yes; then
if { ac_try='./$ac_file'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
+ { (case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_try") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
@@ -1518,22 +1971,27 @@ See \`config.log' for more details." >&2;}
fi
fi
fi
-echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
+{ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6; }
rm -f a.out a.exe conftest$ac_cv_exeext b.out
ac_clean_files=$ac_clean_files_save
-# Check the compiler produces executables we can run. If not, either
+# Check that the compiler produces executables we can run. If not, either
# the compiler is broken, or we cross compile.
-echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
-echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
-echo "$as_me:$LINENO: result: $cross_compiling" >&5
-echo "${ECHO_T}$cross_compiling" >&6
-
-echo "$as_me:$LINENO: checking for suffix of executables" >&5
-echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
+{ echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; }
+{ echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6; }
+
+{ echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; }
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_link") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; then
@@ -1544,9 +2002,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
for ac_file in conftest.exe conftest conftest.*; do
test -f "$ac_file" || continue
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;;
*.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
- export ac_cv_exeext
break;;
* ) break;;
esac
@@ -1560,14 +2017,14 @@ See \`config.log' for more details." >&2;}
fi
rm -f conftest$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
-echo "${ECHO_T}$ac_cv_exeext" >&6
+{ echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6; }
rm -f conftest.$ac_ext
EXEEXT=$ac_cv_exeext
ac_exeext=$EXEEXT
-echo "$as_me:$LINENO: checking for suffix of object files" >&5
-echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; }
if test "${ac_cv_objext+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -1587,14 +2044,20 @@ main ()
}
_ACEOF
rm -f conftest.o conftest.obj
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>&5
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; then
- for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ for ac_file in conftest.o conftest.obj conftest.*; do
+ test -f "$ac_file" || continue;
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;;
*) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
break;;
esac
@@ -1612,12 +2075,12 @@ fi
rm -f conftest.$ac_cv_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
-echo "${ECHO_T}$ac_cv_objext" >&6
+{ echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6; }
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
-echo "$as_me:$LINENO: checking whether we are using the GNU C++ compiler" >&5
-echo $ECHO_N "checking whether we are using the GNU C++ compiler... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking whether we are using the GNU C++ compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C++ compiler... $ECHO_C" >&6; }
if test "${ac_cv_cxx_compiler_gnu+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -1640,49 +2103,49 @@ main ()
}
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_cxx_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
ac_compiler_gnu=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-ac_compiler_gnu=no
+ ac_compiler_gnu=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_cxx_compiler_gnu=$ac_compiler_gnu
fi
-echo "$as_me:$LINENO: result: $ac_cv_cxx_compiler_gnu" >&5
-echo "${ECHO_T}$ac_cv_cxx_compiler_gnu" >&6
+{ echo "$as_me:$LINENO: result: $ac_cv_cxx_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_cxx_compiler_gnu" >&6; }
GXX=`test $ac_compiler_gnu = yes && echo yes`
ac_test_CXXFLAGS=${CXXFLAGS+set}
ac_save_CXXFLAGS=$CXXFLAGS
-CXXFLAGS="-g"
-echo "$as_me:$LINENO: checking whether $CXX accepts -g" >&5
-echo $ECHO_N "checking whether $CXX accepts -g... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking whether $CXX accepts -g" >&5
+echo $ECHO_N "checking whether $CXX accepts -g... $ECHO_C" >&6; }
if test "${ac_cv_prog_cxx_g+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat >conftest.$ac_ext <<_ACEOF
+ ac_save_cxx_werror_flag=$ac_cxx_werror_flag
+ ac_cxx_werror_flag=yes
+ ac_cv_prog_cxx_g=no
+ CXXFLAGS="-g"
+ cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
@@ -1698,156 +2161,133 @@ main ()
}
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_cxx_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
ac_cv_prog_cxx_g=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-ac_cv_prog_cxx_g=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_cxx_g" >&5
-echo "${ECHO_T}$ac_cv_prog_cxx_g" >&6
-if test "$ac_test_CXXFLAGS" = set; then
- CXXFLAGS=$ac_save_CXXFLAGS
-elif test $ac_cv_prog_cxx_g = yes; then
- if test "$GXX" = yes; then
- CXXFLAGS="-g -O2"
- else
- CXXFLAGS="-g"
- fi
-else
- if test "$GXX" = yes; then
- CXXFLAGS="-O2"
- else
- CXXFLAGS=
- fi
-fi
-for ac_declaration in \
- '' \
- 'extern "C" void std::exit (int) throw (); using std::exit;' \
- 'extern "C" void std::exit (int); using std::exit;' \
- 'extern "C" void exit (int) throw ();' \
- 'extern "C" void exit (int);' \
- 'void exit (int);'
-do
- cat >conftest.$ac_ext <<_ACEOF
+ CXXFLAGS=""
+ cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
-$ac_declaration
-#include <stdlib.h>
+
int
main ()
{
-exit (42);
+
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_cxx_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
:
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-continue
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
- cat >conftest.$ac_ext <<_ACEOF
+ ac_cxx_werror_flag=$ac_save_cxx_werror_flag
+ CXXFLAGS="-g"
+ cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
-$ac_declaration
+
int
main ()
{
-exit (42);
+
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- break
+ (exit $ac_status); } && {
+ test -z "$ac_cxx_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
+ ac_cv_prog_cxx_g=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
+
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-done
-rm -f conftest*
-if test -n "$ac_declaration"; then
- echo '#ifdef __cplusplus' >>confdefs.h
- echo $ac_declaration >>confdefs.h
- echo '#endif' >>confdefs.h
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ ac_cxx_werror_flag=$ac_save_cxx_werror_flag
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_prog_cxx_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cxx_g" >&6; }
+if test "$ac_test_CXXFLAGS" = set; then
+ CXXFLAGS=$ac_save_CXXFLAGS
+elif test $ac_cv_prog_cxx_g = yes; then
+ if test "$GXX" = yes; then
+ CXXFLAGS="-g -O2"
+ else
+ CXXFLAGS="-g"
+ fi
+else
+ if test "$GXX" = yes; then
+ CXXFLAGS="-O2"
+ else
+ CXXFLAGS=
+ fi
+fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -1877,8 +2317,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
set dummy ${ac_tool_prefix}gcc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
if test "${ac_cv_prog_CC+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -1891,32 +2331,34 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
fi
+
fi
if test -z "$ac_cv_prog_CC"; then
ac_ct_CC=$CC
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -1929,36 +2371,51 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_ac_ct_CC="gcc"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
+IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
+ { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
fi
- CC=$ac_ct_CC
+ if test "x$ac_ct_CC" = x; then
+ CC=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet. If you think this
+configuration is useful to you, please write to autoconf at gnu.org." >&5
+echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet. If you think this
+configuration is useful to you, please write to autoconf at gnu.org." >&2;}
+ac_tool_warned=yes ;;
+esac
+ CC=$ac_ct_CC
+ fi
else
CC="$ac_cv_prog_CC"
fi
if test -z "$CC"; then
- if test -n "$ac_tool_prefix"; then
- # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
set dummy ${ac_tool_prefix}cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
if test "${ac_cv_prog_CC+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -1971,74 +2428,34 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
-fi
-if test -z "$ac_cv_prog_CC"; then
- ac_ct_CC=$CC
- # Extract the first word of "cc", so it can be a program name with args.
-set dummy cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$ac_ct_CC"; then
- ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_ac_ct_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-ac_ct_CC=$ac_cv_prog_ac_ct_CC
-if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
+ { echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
fi
- CC=$ac_ct_CC
-else
- CC="$ac_cv_prog_CC"
-fi
+ fi
fi
if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
if test "${ac_cv_prog_CC+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -2052,7 +2469,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
@@ -2063,6 +2480,7 @@ do
fi
done
done
+IFS=$as_save_IFS
if test $ac_prog_rejected = yes; then
# We found a bogon in the path, so make sure we never use it.
@@ -2080,22 +2498,23 @@ fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
fi
+
fi
if test -z "$CC"; then
if test -n "$ac_tool_prefix"; then
- for ac_prog in cl
+ for ac_prog in cl.exe
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
if test "${ac_cv_prog_CC+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -2108,36 +2527,38 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
fi
+
test -n "$CC" && break
done
fi
if test -z "$CC"; then
ac_ct_CC=$CC
- for ac_prog in cl
+ for ac_prog in cl.exe
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -2150,29 +2571,45 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
ac_cv_prog_ac_ct_CC="$ac_prog"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
+IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
+ { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
fi
+
test -n "$ac_ct_CC" && break
done
- CC=$ac_ct_CC
+ if test "x$ac_ct_CC" = x; then
+ CC=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet. If you think this
+configuration is useful to you, please write to autoconf at gnu.org." >&5
+echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet. If you think this
+configuration is useful to you, please write to autoconf at gnu.org." >&2;}
+ac_tool_warned=yes ;;
+esac
+ CC=$ac_ct_CC
+ fi
fi
fi
@@ -2185,27 +2622,41 @@ See \`config.log' for more details." >&2;}
{ (exit 1); exit 1; }; }
# Provide some information about the compiler.
-echo "$as_me:$LINENO:" \
- "checking for C compiler version" >&5
+echo "$as_me:$LINENO: checking for C compiler version" >&5
ac_compiler=`set X $ac_compile; echo $2`
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
- (eval $ac_compiler --version </dev/null >&5) 2>&5
+{ (ac_try="$ac_compiler --version >&5"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compiler --version >&5") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
- (eval $ac_compiler -v </dev/null >&5) 2>&5
+{ (ac_try="$ac_compiler -v >&5"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compiler -v >&5") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
- (eval $ac_compiler -V </dev/null >&5) 2>&5
+{ (ac_try="$ac_compiler -V >&5"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compiler -V >&5") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }
-echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
-echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; }
if test "${ac_cv_c_compiler_gnu+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -2228,49 +2679,49 @@ main ()
}
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
ac_compiler_gnu=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-ac_compiler_gnu=no
+ ac_compiler_gnu=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu
fi
-echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
-echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
+{ echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; }
GCC=`test $ac_compiler_gnu = yes && echo yes`
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
-CFLAGS="-g"
-echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
-echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; }
if test "${ac_cv_prog_cc_g+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat >conftest.$ac_ext <<_ACEOF
+ ac_save_c_werror_flag=$ac_c_werror_flag
+ ac_c_werror_flag=yes
+ ac_cv_prog_cc_g=no
+ CFLAGS="-g"
+ cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
@@ -2286,306 +2737,248 @@ main ()
}
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
ac_cv_prog_cc_g=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-ac_cv_prog_cc_g=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
-if test "$ac_test_CFLAGS" = set; then
- CFLAGS=$ac_save_CFLAGS
-elif test $ac_cv_prog_cc_g = yes; then
- if test "$GCC" = yes; then
- CFLAGS="-g -O2"
- else
- CFLAGS="-g"
- fi
-else
- if test "$GCC" = yes; then
- CFLAGS="-O2"
- else
- CFLAGS=
- fi
-fi
-echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
-echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
-if test "${ac_cv_prog_cc_stdc+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_prog_cc_stdc=no
-ac_save_CC=$CC
-cat >conftest.$ac_ext <<_ACEOF
+ CFLAGS=""
+ cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
-#include <stdarg.h>
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
-struct buf { int x; };
-FILE * (*rcsopen) (struct buf *, struct stat *, int);
-static char *e (p, i)
- char **p;
- int i;
-{
- return p[i];
-}
-static char *f (char * (*g) (char **, int), char **p, ...)
-{
- char *s;
- va_list v;
- va_start (v,p);
- s = g (p, va_arg (v,int));
- va_end (v);
- return s;
-}
-
-/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
- function prototypes and stuff, but not '\xHH' hex character constants.
- These don't provoke an error unfortunately, instead are silently treated
- as 'x'. The following induces an error, until -std1 is added to get
- proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
- array size at least. It's necessary to write '\x00'==0 to get something
- that's true only with -std1. */
-int osf4_cc_array ['\x00' == 0 ? 1 : -1];
-int test (int i, double x);
-struct s1 {int (*f) (int a);};
-struct s2 {int (*f) (double a);};
-int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
-int argc;
-char **argv;
int
main ()
{
-return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
+
;
return 0;
}
_ACEOF
-# Don't try gcc -ansi; that turns off useful extensions and
-# breaks some systems' header files.
-# AIX -qlanglvl=ansi
-# Ultrix and OSF/1 -std1
-# HP-UX 10.20 and later -Ae
-# HP-UX older versions -Aa -D_HPUX_SOURCE
-# SVR4 -Xc -D__EXTENSIONS__
-for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
-do
- CC="$ac_save_CC $ac_arg"
- rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_prog_cc_stdc=$ac_arg
-break
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
+ :
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-fi
-rm -f conftest.err conftest.$ac_objext
-done
-rm -f conftest.$ac_ext conftest.$ac_objext
-CC=$ac_save_CC
-
-fi
-
-case "x$ac_cv_prog_cc_stdc" in
- x|xno)
- echo "$as_me:$LINENO: result: none needed" >&5
-echo "${ECHO_T}none needed" >&6 ;;
- *)
- echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
- CC="$CC $ac_cv_prog_cc_stdc" ;;
-esac
-
-# Some people use a C++ compiler to compile C. Since we use `exit',
-# in C++ we need to declare it. In case someone uses the same compiler
-# for both compiling C and C++ we need to have the C++ compiler decide
-# the declaration of exit, since it's the most demanding environment.
-cat >conftest.$ac_ext <<_ACEOF
-#ifndef __cplusplus
- choke me
-#endif
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- for ac_declaration in \
- '' \
- 'extern "C" void std::exit (int) throw (); using std::exit;' \
- 'extern "C" void std::exit (int); using std::exit;' \
- 'extern "C" void exit (int) throw ();' \
- 'extern "C" void exit (int);' \
- 'void exit (int);'
-do
- cat >conftest.$ac_ext <<_ACEOF
+ ac_c_werror_flag=$ac_save_c_werror_flag
+ CFLAGS="-g"
+ cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
-$ac_declaration
-#include <stdlib.h>
+
int
main ()
{
-exit (42);
+
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
+ ac_cv_prog_cc_g=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-continue
+
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
- cat >conftest.$ac_ext <<_ACEOF
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+{ echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5
+echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; }
+if test "${ac_cv_prog_cc_c89+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
-$ac_declaration
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+ char **p;
+ int i;
+{
+ return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+ char *s;
+ va_list v;
+ va_start (v,p);
+ s = g (p, va_arg (v,int));
+ va_end (v);
+ return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
+ function prototypes and stuff, but not '\xHH' hex character constants.
+ These don't provoke an error unfortunately, instead are silently treated
+ as 'x'. The following induces an error, until -std is added to get
+ proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
+ array size at least. It's necessary to write '\x00'==0 to get something
+ that's true only with -std. */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+ inside strings and character constants. */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
int
main ()
{
-exit (42);
+return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+ CC="$ac_save_CC $ac_arg"
+ rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- break
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
+ ac_cv_prog_cc_c89=$ac_arg
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
+
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+rm -f core conftest.err conftest.$ac_objext
+ test "x$ac_cv_prog_cc_c89" != "xno" && break
done
-rm -f conftest*
-if test -n "$ac_declaration"; then
- echo '#ifdef __cplusplus' >>confdefs.h
- echo $ac_declaration >>confdefs.h
- echo '#endif' >>confdefs.h
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+ x)
+ { echo "$as_me:$LINENO: result: none needed" >&5
+echo "${ECHO_T}none needed" >&6; } ;;
+ xno)
+ { echo "$as_me:$LINENO: result: unsupported" >&5
+echo "${ECHO_T}unsupported" >&6; } ;;
+ *)
+ CC="$CC $ac_cv_prog_cc_c89"
+ { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;;
+esac
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -2598,8 +2991,8 @@ ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
-echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
+echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; }
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@@ -2633,24 +3026,22 @@ cat >>conftest.$ac_ext <<_ACEOF
#endif
Syntax error
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+ (exit $ac_status); } >/dev/null && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ }; then
:
else
echo "$as_me: failed program was:" >&5
@@ -2659,9 +3050,10 @@ sed 's/^/| /' conftest.$ac_ext >&5
# Broken: fails on valid input.
continue
fi
+
rm -f conftest.err conftest.$ac_ext
- # OK, works on sane cases. Now check whether non-existent headers
+ # OK, works on sane cases. Now check whether nonexistent headers
# can be detected and how.
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
@@ -2671,24 +3063,22 @@ cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <ac_nonexistent.h>
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+ (exit $ac_status); } >/dev/null && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ }; then
# Broken: success on invalid input.
continue
else
@@ -2699,6 +3089,7 @@ sed 's/^/| /' conftest.$ac_ext >&5
ac_preproc_ok=:
break
fi
+
rm -f conftest.err conftest.$ac_ext
done
@@ -2716,8 +3107,8 @@ fi
else
ac_cv_prog_CPP=$CPP
fi
-echo "$as_me:$LINENO: result: $CPP" >&5
-echo "${ECHO_T}$CPP" >&6
+{ echo "$as_me:$LINENO: result: $CPP" >&5
+echo "${ECHO_T}$CPP" >&6; }
ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
@@ -2740,24 +3131,22 @@ cat >>conftest.$ac_ext <<_ACEOF
#endif
Syntax error
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+ (exit $ac_status); } >/dev/null && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ }; then
:
else
echo "$as_me: failed program was:" >&5
@@ -2766,9 +3155,10 @@ sed 's/^/| /' conftest.$ac_ext >&5
# Broken: fails on valid input.
continue
fi
+
rm -f conftest.err conftest.$ac_ext
- # OK, works on sane cases. Now check whether non-existent headers
+ # OK, works on sane cases. Now check whether nonexistent headers
# can be detected and how.
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
@@ -2778,24 +3168,22 @@ cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <ac_nonexistent.h>
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+ (exit $ac_status); } >/dev/null && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ }; then
# Broken: success on invalid input.
continue
else
@@ -2806,6 +3194,7 @@ sed 's/^/| /' conftest.$ac_ext >&5
ac_preproc_ok=:
break
fi
+
rm -f conftest.err conftest.$ac_ext
done
@@ -2828,23 +3217,170 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking for egrep" >&5
-echo $ECHO_N "checking for egrep... $ECHO_C" >&6
-if test "${ac_cv_prog_egrep+set}" = set; then
+{ echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5
+echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; }
+if test "${ac_cv_path_GREP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ # Extract the first word of "grep ggrep" to use in msg output
+if test -z "$GREP"; then
+set dummy grep ggrep; ac_prog_name=$2
+if test "${ac_cv_path_GREP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_path_GREP_found=false
+# Loop through the user's path and test for each of PROGNAME-LIST
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in grep ggrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+ { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
+ # Check for GNU ac_path_GREP and select it if it is found.
+ # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+ ac_count=0
+ echo $ECHO_N "0123456789$ECHO_C" >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ echo 'GREP' >> "conftest.nl"
+ "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ ac_count=`expr $ac_count + 1`
+ if test $ac_count -gt ${ac_path_GREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_GREP="$ac_path_GREP"
+ ac_path_GREP_max=$ac_count
+ fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+
+ $ac_path_GREP_found && break 3
+ done
+done
+
+done
+IFS=$as_save_IFS
+
+
+fi
+
+GREP="$ac_cv_path_GREP"
+if test -z "$GREP"; then
+ { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5
+echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+else
+ ac_cv_path_GREP=$GREP
+fi
+
+
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5
+echo "${ECHO_T}$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
+
+
+{ echo "$as_me:$LINENO: checking for egrep" >&5
+echo $ECHO_N "checking for egrep... $ECHO_C" >&6; }
+if test "${ac_cv_path_EGREP+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
- if echo a | (grep -E '(a|b)') >/dev/null 2>&1
- then ac_cv_prog_egrep='grep -E'
- else ac_cv_prog_egrep='egrep'
+ if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+ then ac_cv_path_EGREP="$GREP -E"
+ else
+ # Extract the first word of "egrep" to use in msg output
+if test -z "$EGREP"; then
+set dummy egrep; ac_prog_name=$2
+if test "${ac_cv_path_EGREP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_path_EGREP_found=false
+# Loop through the user's path and test for each of PROGNAME-LIST
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in egrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+ { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
+ # Check for GNU ac_path_EGREP and select it if it is found.
+ # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+ ac_count=0
+ echo $ECHO_N "0123456789$ECHO_C" >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ echo 'EGREP' >> "conftest.nl"
+ "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ ac_count=`expr $ac_count + 1`
+ if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_EGREP="$ac_path_EGREP"
+ ac_path_EGREP_max=$ac_count
fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+
+ $ac_path_EGREP_found && break 3
+ done
+done
+
+done
+IFS=$as_save_IFS
+
+
+fi
+
+EGREP="$ac_cv_path_EGREP"
+if test -z "$EGREP"; then
+ { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5
+echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+else
+ ac_cv_path_EGREP=$EGREP
+fi
+
+
+ fi
fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5
-echo "${ECHO_T}$ac_cv_prog_egrep" >&6
- EGREP=$ac_cv_prog_egrep
+{ echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5
+echo "${ECHO_T}$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
-echo "$as_me:$LINENO: checking for ANSI C header files" >&5
-echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking for ANSI C header files" >&5
+echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; }
if test "${ac_cv_header_stdc+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
@@ -2868,34 +3404,31 @@ main ()
}
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
ac_cv_header_stdc=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-ac_cv_header_stdc=no
+ ac_cv_header_stdc=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
if test $ac_cv_header_stdc = yes; then
# SunOS 4.x string.h does not declare mem*, contrary to ANSI.
@@ -2951,6 +3484,7 @@ cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <ctype.h>
+#include <stdlib.h>
#if ((' ' & 0x0FF) == 0x020)
# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
@@ -2970,18 +3504,27 @@ main ()
for (i = 0; i < 256; i++)
if (XOR (islower (i), ISLOWER (i))
|| toupper (i) != TOUPPER (i))
- exit(2);
- exit (0);
+ return 2;
+ return 0;
}
_ACEOF
rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_link") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
+ { (case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_try") 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
@@ -2994,12 +3537,14 @@ sed 's/^/| /' conftest.$ac_ext >&5
( exit $ac_status )
ac_cv_header_stdc=no
fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
fi
+
+
fi
fi
-echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
-echo "${ECHO_T}$ac_cv_header_stdc" >&6
+{ echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
+echo "${ECHO_T}$ac_cv_header_stdc" >&6; }
if test $ac_cv_header_stdc = yes; then
cat >>confdefs.h <<\_ACEOF
@@ -3022,9 +3567,9 @@ for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
inttypes.h stdint.h unistd.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
+{ echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; }
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
@@ -3038,37 +3583,35 @@ $ac_includes_default
#include <$ac_header>
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
eval "$as_ac_Header=yes"
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-eval "$as_ac_Header=no"
+ eval "$as_ac_Header=no"
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+ac_res=`eval echo '${'$as_ac_Header'}'`
+ { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
if test `eval echo '${'$as_ac_Header'}'` = yes; then
cat >>confdefs.h <<_ACEOF
#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
@@ -3083,18 +3626,19 @@ done
for ac_header in ieeefp.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
+ { echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; }
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
echo $ECHO_N "(cached) $ECHO_C" >&6
fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+ac_res=`eval echo '${'$as_ac_Header'}'`
+ { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
else
# Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking $ac_header usability" >&5
+echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; }
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
@@ -3105,40 +3649,37 @@ $ac_includes_default
#include <$ac_header>
_ACEOF
rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_compile") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then
ac_header_compiler=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-ac_header_compiler=no
+ ac_header_compiler=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6; }
# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
+{ echo "$as_me:$LINENO: checking $ac_header presence" >&5
+echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; }
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
@@ -3147,24 +3688,22 @@ cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <$ac_header>
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+ (exit $ac_status); } >/dev/null && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ }; then
ac_header_preproc=yes
else
echo "$as_me: failed program was:" >&5
@@ -3172,9 +3711,10 @@ sed 's/^/| /' conftest.$ac_ext >&5
ac_header_preproc=no
fi
+
rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
+{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6; }
# So? What about this header?
case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
@@ -3198,25 +3738,19 @@ echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\
echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
{ echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------------------ ##
-## Report this to the AC_PACKAGE_NAME lists. ##
-## ------------------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
+
;;
esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
+{ echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; }
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
eval "$as_ac_Header=\$ac_header_preproc"
fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+ac_res=`eval echo '${'$as_ac_Header'}'`
+ { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
fi
if test `eval echo '${'$as_ac_Header'}'` = yes; then
@@ -3234,9 +3768,9 @@ done
for ac_func in trunc
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
+{ echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; }
+if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
@@ -3262,67 +3796,60 @@ cat >>conftest.$ac_ext <<_ACEOF
#undef $ac_func
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
-{
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char $ac_func ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+#if defined __stub_$ac_func || defined __stub___$ac_func
choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
#endif
int
main ()
{
-return f != $ac_func;
+return $ac_func ();
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+ (eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+ (exit $ac_status); } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest$ac_exeext &&
+ $as_test_x conftest$ac_exeext; then
eval "$as_ac_var=yes"
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-eval "$as_ac_var=no"
+ eval "$as_ac_var=no"
fi
-rm -f conftest.err conftest.$ac_objext \
+
+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+ac_res=`eval echo '${'$as_ac_var'}'`
+ { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
if test `eval echo '${'$as_ac_var'}'` = yes; then
cat >>confdefs.h <<_ACEOF
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
@@ -3335,7 +3862,7 @@ done
- ac_config_files="$ac_config_files src/Makevars"
+ac_config_files="$ac_config_files src/Makevars"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@@ -3355,39 +3882,58 @@ _ACEOF
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
-# So, don't put newlines in cache variables' values.
+# So, we kill variables containing newlines.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
-{
+(
+ for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+ eval ac_val=\$$ac_var
+ case $ac_val in #(
+ *${as_nl}*)
+ case $ac_var in #(
+ *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5
+echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;;
+ esac
+ case $ac_var in #(
+ _ | IFS | as_nl) ;; #(
+ *) $as_unset $ac_var ;;
+ esac ;;
+ esac
+ done
+
(set) 2>&1 |
- case `(ac_space=' '; set | grep ac_space) 2>&1` in
- *ac_space=\ *)
+ case $as_nl`(ac_space=' '; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
# `set' does not quote correctly, so add quotes (double-quote
# substitution turns \\\\ into \\, and sed turns \\ into \).
sed -n \
"s/'/'\\\\''/g;
s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
- ;;
+ ;; #(
*)
# `set' quotes correctly as required by POSIX, so do not add quotes.
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
- esac;
-} |
+ esac |
+ sort
+) |
sed '
+ /^ac_cv_env_/b end
t clear
- : clear
+ :clear
s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
t end
- /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
- : end' >>confcache
-if diff $cache_file confcache >/dev/null 2>&1; then :; else
- if test -w $cache_file; then
- test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
+ s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+ if test -w "$cache_file"; then
+ test "x$cache_file" != "x/dev/null" &&
+ { echo "$as_me:$LINENO: updating cache $cache_file" >&5
+echo "$as_me: updating cache $cache_file" >&6;}
cat confcache >$cache_file
else
- echo "not updating unwritable cache $cache_file"
+ { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5
+echo "$as_me: not updating unwritable cache $cache_file" >&6;}
fi
fi
rm -f confcache
@@ -3396,63 +3942,48 @@ test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-# VPATH may cause trouble with some makes, so we remove $(srcdir),
-# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
-# trailing colons and then remove the whole line if VPATH becomes empty
-# (actually we leave an empty line to preserve line numbers).
-if test "x$srcdir" = x.; then
- ac_vpsub='/^[ ]*VPATH[ ]*=/{
-s/:*\$(srcdir):*/:/;
-s/:*\${srcdir}:*/:/;
-s/:*@srcdir@:*/:/;
-s/^\([^=]*=[ ]*\):*/\1/;
-s/:*$//;
-s/^[^=]*=[ ]*$//;
-}'
-fi
-
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
-# take arguments), then we branch to the quote section. Otherwise,
+# take arguments), then branch to the quote section. Otherwise,
# look for a macro that doesn't take arguments.
-cat >confdef2opt.sed <<\_ACEOF
+ac_script='
t clear
-: clear
-s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
+:clear
+s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g
t quote
-s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g
+s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g
t quote
-d
-: quote
-s,[ `~#$^&*(){}\\|;'"<>?],\\&,g
-s,\[,\\&,g
-s,\],\\&,g
-s,\$,$$,g
-p
-_ACEOF
-# We use echo to avoid assuming a particular line-breaking character.
-# The extra dot is to prevent the shell from consuming trailing
-# line-breaks from the sub-command output. A line-break within
-# single-quotes doesn't work because, if this script is created in a
-# platform that uses two characters for line-breaks (e.g., DOS), tr
-# would break.
-ac_LF_and_DOT=`echo; echo .`
-DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
-rm -f confdef2opt.sed
+b any
+:quote
+s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g
+s/\[/\\&/g
+s/\]/\\&/g
+s/\$/$$/g
+H
+:any
+${
+ g
+ s/^\n//
+ s/\n/ /g
+ p
+}
+'
+DEFS=`sed -n "$ac_script" confdefs.h`
ac_libobjs=
ac_ltlibobjs=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
# 1. Remove the extension, and $U if already installed.
- ac_i=`echo "$ac_i" |
- sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
- # 2. Add them.
- ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
- ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+ ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+ ac_i=`echo "$ac_i" | sed "$ac_script"`
+ # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR
+ # will be set to the directory where LIBOBJS objects are built.
+ ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+ ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs
@@ -3483,17 +4014,45 @@ cat >>$CONFIG_STATUS <<\_ACEOF
## M4sh Initialization. ##
## --------------------- ##
-# Be Bourne compatible
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
emulate sh
NULLCMD=:
# Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in
+ *posix*) set -o posix ;;
+esac
+
+fi
+
+
+
+
+# PATH needs CR
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
fi
-DUALCASE=1; export DUALCASE # for MKS sh
# Support unset when possible.
if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
@@ -3503,8 +4062,43 @@ else
fi
+# IFS
+# We need space, tab and new line, in precisely that order. Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+as_nl='
+'
+IFS=" "" $as_nl"
+
+# Find who we are. Look in the path if we contain no directory separator.
+case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+IFS=$as_save_IFS
+
+ ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+ as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+ echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ { (exit 1); exit 1; }
+fi
+
# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
+for as_var in ENV MAIL MAILPATH
+do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+done
PS1='$ '
PS2='> '
PS4='+ '
@@ -3518,18 +4112,19 @@ do
if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
eval $as_var=C; export $as_var
else
- $as_unset $as_var
+ ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
fi
done
# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
@@ -3537,159 +4132,120 @@ fi
# Name of the executable.
-as_me=`$as_basename "$0" ||
+as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
-
-
-# PATH needs CR, and LINENO needs CR and PATH.
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
+# CDPATH.
+$as_unset CDPATH
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
-echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
as_lineno_1=$LINENO
as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
+ test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {
# Create $as_me.lineno as a copy of $as_myself, but with $LINENO
# uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
+ # line-number line after each line using $LINENO; the second 'sed'
+ # does the real work. The second script uses 'N' to pair each
+ # line-number line with the line containing $LINENO, and appends
+ # trailing '-' during substitution so that $LINENO is not a special
+ # case at line end.
# (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
+ # scripts with optimization help from Paolo Bonzini. Blame Lee
+ # E. McMahon (1931-1989) for sed's syntax. :-)
+ sed -n '
+ p
+ /[$]LINENO/=
+ ' <$as_myself |
sed '
+ s/[$]LINENO.*/&-/
+ t lineno
+ b
+ :lineno
N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ :loop
+ s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
+ s/-\n.*//
' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
-echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
+ chmod +x "$as_me.lineno" ||
+ { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
{ (exit 1); exit 1; }; }
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
+ # original and so on. Autoconf is especially sensitive to this).
+ . "./$as_me.lineno"
# Exit status is that of the last command.
exit
}
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in
+-n*)
+ case `echo 'x\c'` in
+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.
+ *) ECHO_C='\c';;
+ esac;;
+*)
+ ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1; then
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+ rm -f conf$$.dir/conf$$.file
+else
+ rm -f conf$$.dir
+ mkdir conf$$.dir
+fi
echo >conf$$.file
if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
+ as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -p'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
as_ln_s='cp -p'
- else
- as_ln_s='ln -s'
- fi
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
as_ln_s='cp -p'
fi
-rm -f conf$$ conf$$.exe conf$$.file
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
if mkdir -p . 2>/dev/null; then
as_mkdir_p=:
@@ -3698,7 +4254,28 @@ else
as_mkdir_p=false
fi
-as_executable_p="test -f"
+if test -x / >/dev/null 2>&1; then
+ as_test_x='test -x'
+else
+ if ls -dL / >/dev/null 2>&1; then
+ as_ls_L_option=L
+ else
+ as_ls_L_option=
+ fi
+ as_test_x='
+ eval sh -c '\''
+ if test -d "$1"; then
+ test -d "$1/.";
+ else
+ case $1 in
+ -*)set "./$1";;
+ esac;
+ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in
+ ???[sx]*):;;*)false;;esac;fi
+ '\'' sh
+ '
+fi
+as_executable_p=$as_test_x
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -3707,31 +4284,14 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
exec 6>&1
-# Open the log real soon, to keep \$[0] and so on meaningful, and to
+# Save the log message, to keep $[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling. Logging --version etc. is OK.
-exec 5>>config.log
-{
- echo
- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
-} >&5
-cat >&5 <<_CSEOF
-
+# values after options handling.
+ac_log="
This file was extended by $as_me, which was
-generated by GNU Autoconf 2.59. Invocation command line was
+generated by GNU Autoconf 2.61. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -3739,30 +4299,18 @@ generated by GNU Autoconf 2.59. Invocation command line was
CONFIG_COMMANDS = $CONFIG_COMMANDS
$ $0 $@
-_CSEOF
-echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
-echo >&5
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
# Files that config.status was made for.
-if test -n "$ac_config_files"; then
- echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
-fi
-
-if test -n "$ac_config_headers"; then
- echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
-fi
-
-if test -n "$ac_config_links"; then
- echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
-fi
+config_files="$ac_config_files"
-if test -n "$ac_config_commands"; then
- echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
-fi
+_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF
-
ac_cs_usage="\
\`$as_me' instantiates files from templates according to the
current configuration.
@@ -3770,7 +4318,7 @@ current configuration.
Usage: $0 [OPTIONS] [FILE]...
-h, --help print this help, then exit
- -V, --version print version number, then exit
+ -V, --version print version number and configuration settings, then exit
-q, --quiet do not print progress messages
-d, --debug don't remove temporary files
--recheck update $as_me by reconfiguring in the same conditions
@@ -3781,18 +4329,20 @@ Configuration files:
$config_files
Report bugs to <bug-autoconf at gnu.org>."
-_ACEOF
+_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
config.status
-configured by $0, generated by GNU Autoconf 2.59,
- with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+configured by $0, generated by GNU Autoconf 2.61,
+ with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
-Copyright (C) 2003 Free Software Foundation, Inc.
+Copyright (C) 2006 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
-srcdir=$srcdir
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF
@@ -3803,60 +4353,42 @@ while test $# != 0
do
case $1 in
--*=*)
- ac_option=`expr "x$1" : 'x\([^=]*\)='`
- ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ ac_option=`expr "X$1" : 'X\([^=]*\)='`
+ ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
ac_shift=:
;;
- -*)
+ *)
ac_option=$1
ac_optarg=$2
ac_shift=shift
;;
- *) # This is not an option, so the user has probably given explicit
- # arguments.
- ac_option=$1
- ac_need_defaults=false;;
esac
case $ac_option in
# Handling of the options.
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
ac_cs_recheck=: ;;
- --version | --vers* | -V )
- echo "$ac_cs_version"; exit 0 ;;
- --he | --h)
- # Conflict between --help and --header
- { { echo "$as_me:$LINENO: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; };;
- --help | --hel | -h )
- echo "$ac_cs_usage"; exit 0 ;;
- --debug | --d* | -d )
+ --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+ echo "$ac_cs_version"; exit ;;
+ --debug | --debu | --deb | --de | --d | -d )
debug=: ;;
--file | --fil | --fi | --f )
$ac_shift
CONFIG_FILES="$CONFIG_FILES $ac_optarg"
ac_need_defaults=false;;
- --header | --heade | --head | --hea )
- $ac_shift
- CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
- ac_need_defaults=false;;
+ --he | --h | --help | --hel | -h )
+ echo "$ac_cs_usage"; exit ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil | --si | --s)
ac_cs_silent=: ;;
# This is an error.
- -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&2;}
+ -*) { echo "$as_me: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&2
{ (exit 1); exit 1; }; } ;;
- *) ac_config_targets="$ac_config_targets $1" ;;
+ *) ac_config_targets="$ac_config_targets $1"
+ ac_need_defaults=false ;;
esac
shift
@@ -3872,28 +4404,42 @@ fi
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF
if \$ac_cs_recheck; then
- echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
- exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
+ CONFIG_SHELL=$SHELL
+ export CONFIG_SHELL
+ exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
fi
_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+ echo "$ac_log"
+} >&5
-
-
-
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF
+
+# Handling of arguments.
for ac_config_target in $ac_config_targets
do
- case "$ac_config_target" in
- # Handling of arguments.
- "src/Makevars" ) CONFIG_FILES="$CONFIG_FILES src/Makevars" ;;
+ case $ac_config_target in
+ "src/Makevars") CONFIG_FILES="$CONFIG_FILES src/Makevars" ;;
+
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
{ (exit 1); exit 1; }; };;
esac
done
+
# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used. Set only those that are not.
# We use the long form for the default assignment because of an extremely
@@ -3903,326 +4449,404 @@ if $ac_need_defaults; then
fi
# Have a temporary directory for convenience. Make it in the build tree
-# simply because there is no reason to put it here, and in addition,
+# simply because there is no reason against having it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
-# Create a temporary directory, and hook for its removal unless debugging.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
$debug ||
{
- trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
+ tmp=
+ trap 'exit_status=$?
+ { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status
+' 0
trap '{ (exit 1); exit 1; }' 1 2 13 15
}
-
# Create a (secure) tmp directory for tmp files.
{
- tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
+ tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
test -n "$tmp" && test -d "$tmp"
} ||
{
- tmp=./confstat$$-$RANDOM
- (umask 077 && mkdir $tmp)
+ tmp=./conf$$-$RANDOM
+ (umask 077 && mkdir "$tmp")
} ||
{
echo "$me: cannot create a temporary directory in ." >&2
{ (exit 1); exit 1; }
}
-_ACEOF
-
-cat >>$CONFIG_STATUS <<_ACEOF
-
#
-# CONFIG_FILES section.
+# Set up the sed scripts for CONFIG_FILES section.
#
# No need to generate the scripts if there are no CONFIG_FILES.
# This happens for instance when ./config.status config.h
-if test -n "\$CONFIG_FILES"; then
- # Protect against being on the right side of a sed subst in config.status.
- sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
- s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
-s, at SHELL@,$SHELL,;t t
-s, at PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
-s, at PACKAGE_NAME@,$PACKAGE_NAME,;t t
-s, at PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
-s, at PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
-s, at PACKAGE_STRING@,$PACKAGE_STRING,;t t
-s, at PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
-s, at exec_prefix@,$exec_prefix,;t t
-s, at prefix@,$prefix,;t t
-s, at program_transform_name@,$program_transform_name,;t t
-s, at bindir@,$bindir,;t t
-s, at sbindir@,$sbindir,;t t
-s, at libexecdir@,$libexecdir,;t t
-s, at datadir@,$datadir,;t t
-s, at sysconfdir@,$sysconfdir,;t t
-s, at sharedstatedir@,$sharedstatedir,;t t
-s, at localstatedir@,$localstatedir,;t t
-s, at libdir@,$libdir,;t t
-s, at includedir@,$includedir,;t t
-s, at oldincludedir@,$oldincludedir,;t t
-s, at infodir@,$infodir,;t t
-s, at mandir@,$mandir,;t t
-s, at build_alias@,$build_alias,;t t
-s, at host_alias@,$host_alias,;t t
-s, at target_alias@,$target_alias,;t t
-s, at DEFS@,$DEFS,;t t
-s, at ECHO_C@,$ECHO_C,;t t
-s, at ECHO_N@,$ECHO_N,;t t
-s, at ECHO_T@,$ECHO_T,;t t
-s, at LIBS@,$LIBS,;t t
-s, at CXX@,$CXX,;t t
-s, at CXXFLAGS@,$CXXFLAGS,;t t
-s, at LDFLAGS@,$LDFLAGS,;t t
-s, at CPPFLAGS@,$CPPFLAGS,;t t
-s, at ac_ct_CXX@,$ac_ct_CXX,;t t
-s, at EXEEXT@,$EXEEXT,;t t
-s, at OBJEXT@,$OBJEXT,;t t
-s, at CC@,$CC,;t t
-s, at CFLAGS@,$CFLAGS,;t t
-s, at ac_ct_CC@,$ac_ct_CC,;t t
-s, at CPP@,$CPP,;t t
-s, at EGREP@,$EGREP,;t t
-s, at MV_HAVE_IEEEFP_H@,$MV_HAVE_IEEEFP_H,;t t
-s, at MV_HAVE_TRUNC@,$MV_HAVE_TRUNC,;t t
-s, at LIBOBJS@,$LIBOBJS,;t t
-s, at LTLIBOBJS@,$LTLIBOBJS,;t t
-CEOF
+if test -n "$CONFIG_FILES"; then
_ACEOF
- cat >>$CONFIG_STATUS <<\_ACEOF
- # Split the substitutions into bite-sized pieces for seds with
- # small command number limits, like on Digital OSF/1 and HP-UX.
- ac_max_sed_lines=48
- ac_sed_frag=1 # Number of current file.
- ac_beg=1 # First line for current file.
- ac_end=$ac_max_sed_lines # Line after last line for current file.
- ac_more_lines=:
- ac_sed_cmds=
- while $ac_more_lines; do
- if test $ac_beg -gt 1; then
- sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- else
- sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- fi
- if test ! -s $tmp/subs.frag; then
- ac_more_lines=false
- else
- # The purpose of the label and of the branching condition is to
- # speed up the sed processing (if there are no `@' at all, there
- # is no need to browse any of the substitutions).
- # These are the two extra sed commands mentioned above.
- (echo ':t
- /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
- else
- ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
- fi
- ac_sed_frag=`expr $ac_sed_frag + 1`
- ac_beg=$ac_end
- ac_end=`expr $ac_end + $ac_max_sed_lines`
- fi
- done
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds=cat
+
+
+ac_delim='%!_!# '
+for ac_last_try in false false false false false :; do
+ cat >conf$$subs.sed <<_ACEOF
+SHELL!$SHELL$ac_delim
+PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim
+PACKAGE_NAME!$PACKAGE_NAME$ac_delim
+PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim
+PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim
+PACKAGE_STRING!$PACKAGE_STRING$ac_delim
+PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim
+exec_prefix!$exec_prefix$ac_delim
+prefix!$prefix$ac_delim
+program_transform_name!$program_transform_name$ac_delim
+bindir!$bindir$ac_delim
+sbindir!$sbindir$ac_delim
+libexecdir!$libexecdir$ac_delim
+datarootdir!$datarootdir$ac_delim
+datadir!$datadir$ac_delim
+sysconfdir!$sysconfdir$ac_delim
+sharedstatedir!$sharedstatedir$ac_delim
+localstatedir!$localstatedir$ac_delim
+includedir!$includedir$ac_delim
+oldincludedir!$oldincludedir$ac_delim
+docdir!$docdir$ac_delim
+infodir!$infodir$ac_delim
+htmldir!$htmldir$ac_delim
+dvidir!$dvidir$ac_delim
+pdfdir!$pdfdir$ac_delim
+psdir!$psdir$ac_delim
+libdir!$libdir$ac_delim
+localedir!$localedir$ac_delim
+mandir!$mandir$ac_delim
+DEFS!$DEFS$ac_delim
+ECHO_C!$ECHO_C$ac_delim
+ECHO_N!$ECHO_N$ac_delim
+ECHO_T!$ECHO_T$ac_delim
+LIBS!$LIBS$ac_delim
+build_alias!$build_alias$ac_delim
+host_alias!$host_alias$ac_delim
+target_alias!$target_alias$ac_delim
+CXX!$CXX$ac_delim
+CXXFLAGS!$CXXFLAGS$ac_delim
+LDFLAGS!$LDFLAGS$ac_delim
+CPPFLAGS!$CPPFLAGS$ac_delim
+ac_ct_CXX!$ac_ct_CXX$ac_delim
+EXEEXT!$EXEEXT$ac_delim
+OBJEXT!$OBJEXT$ac_delim
+CC!$CC$ac_delim
+CFLAGS!$CFLAGS$ac_delim
+ac_ct_CC!$ac_ct_CC$ac_delim
+CPP!$CPP$ac_delim
+GREP!$GREP$ac_delim
+EGREP!$EGREP$ac_delim
+MV_HAVE_IEEEFP_H!$MV_HAVE_IEEEFP_H$ac_delim
+MV_HAVE_TRUNC!$MV_HAVE_TRUNC$ac_delim
+LIBOBJS!$LIBOBJS$ac_delim
+LTLIBOBJS!$LTLIBOBJS$ac_delim
+_ACEOF
+
+ if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 54; then
+ break
+ elif $ac_last_try; then
+ { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5
+echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}
+ { (exit 1); exit 1; }; }
+ else
+ ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
fi
-fi # test -n "$CONFIG_FILES"
+done
+
+ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed`
+if test -n "$ac_eof"; then
+ ac_eof=`echo "$ac_eof" | sort -nru | sed 1q`
+ ac_eof=`expr $ac_eof + 1`
+fi
+cat >>$CONFIG_STATUS <<_ACEOF
+cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b end
+_ACEOF
+sed '
+s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g
+s/^/s,@/; s/!/@,|#_!!_#|/
+:n
+t n
+s/'"$ac_delim"'$/,g/; t
+s/$/\\/; p
+N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n
+' >>$CONFIG_STATUS <conf$$subs.sed
+rm -f conf$$subs.sed
+cat >>$CONFIG_STATUS <<_ACEOF
+:end
+s/|#_!!_#|//g
+CEOF$ac_eof
_ACEOF
+
+
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=/{
+s/:*\$(srcdir):*/:/
+s/:*\${srcdir}:*/:/
+s/:*@srcdir@:*/:/
+s/^\([^=]*=[ ]*\):*/\1/
+s/:*$//
+s/^[^=]*=[ ]*$//
+}'
+fi
+
cat >>$CONFIG_STATUS <<\_ACEOF
-for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
- case $ac_file in
- - | *:- | *:-:* ) # input from stdin
- cat >$tmp/stdin
- ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- * ) ac_file_in=$ac_file.in ;;
+fi # test -n "$CONFIG_FILES"
+
+
+for ac_tag in :F $CONFIG_FILES
+do
+ case $ac_tag in
+ :[FHLC]) ac_mode=$ac_tag; continue;;
+ esac
+ case $ac_mode$ac_tag in
+ :[FHL]*:*);;
+ :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5
+echo "$as_me: error: Invalid tag $ac_tag." >&2;}
+ { (exit 1); exit 1; }; };;
+ :[FH]-) ac_tag=-:-;;
+ :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
esac
+ ac_save_IFS=$IFS
+ IFS=:
+ set x $ac_tag
+ IFS=$ac_save_IFS
+ shift
+ ac_file=$1
+ shift
+
+ case $ac_mode in
+ :L) ac_source=$1;;
+ :[FH])
+ ac_file_inputs=
+ for ac_f
+ do
+ case $ac_f in
+ -) ac_f="$tmp/stdin";;
+ *) # Look for the file first in the build tree, then in the source tree
+ # (if the path is not absolute). The absolute path cannot be DOS-style,
+ # because $ac_f cannot contain `:'.
+ test -f "$ac_f" ||
+ case $ac_f in
+ [\\/$]*) false;;
+ *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+ esac ||
+ { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5
+echo "$as_me: error: cannot find input file: $ac_f" >&2;}
+ { (exit 1); exit 1; }; };;
+ esac
+ ac_file_inputs="$ac_file_inputs $ac_f"
+ done
+
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ configure_input="Generated from "`IFS=:
+ echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure."
+ if test x"$ac_file" != x-; then
+ configure_input="$ac_file. $configure_input"
+ { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+ fi
- # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
- ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+ case $ac_tag in
+ *:-:* | *:-) cat >"$tmp/stdin";;
+ esac
+ ;;
+ esac
+
+ ac_dir=`$as_dirname -- "$ac_file" ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$ac_file" : 'X\(//\)[^/]' \| \
X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
+ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ { as_dir="$ac_dir"
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || {
as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$as_dir" : 'X\(//\)[^/]' \| \
X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5
+echo "$as_me: error: cannot create directory $as_dir" >&2;}
{ (exit 1); exit 1; }; }; }
-
ac_builddir=.
-if test "$ac_dir" != .; then
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
+ # A ".." for each directory in $ac_dir_suffix.
+ ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'`
+ case $ac_top_builddir_sub in
+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+ esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
case $srcdir in
- .) # No --srcdir option. We are building in place.
+ .) # We are building in place.
ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_top_srcdir=$ac_top_builddir_sub
+ ac_abs_top_srcdir=$ac_pwd ;;
+ [\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
+ ac_top_srcdir=$srcdir
+ ac_abs_top_srcdir=$srcdir ;;
+ *) # Relative name.
+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_build_prefix$srcdir
+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
+ case $ac_mode in
+ :F)
+ #
+ # CONFIG_FILE
+ #
+_ACEOF
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- if test x"$ac_file" = x-; then
- configure_input=
- else
- configure_input="$ac_file. "
- fi
- configure_input=$configure_input"Generated from `echo $ac_file_in |
- sed 's,.*/,,'` by configure."
-
- # First look for the input files in the build tree, otherwise in the
- # src tree.
- ac_file_inputs=`IFS=:
- for f in $ac_file_in; do
- case $f in
- -) echo $tmp/stdin ;;
- [\\/$]*)
- # Absolute (can't be DOS-style, as IFS=:)
- test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- echo "$f";;
- *) # Relative
- if test -f "$f"; then
- # Build tree
- echo "$f"
- elif test -f "$srcdir/$f"; then
- # Source tree
- echo "$srcdir/$f"
- else
- # /dev/null tree
- { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- fi;;
- esac
- done` || { (exit 1); exit 1; }
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If the template does not know about datarootdir, expand it.
+# FIXME: This hack should be removed a few years after 2.60.
+ac_datarootdir_hack=; ac_datarootdir_seen=
- if test x"$ac_file" != x-; then
- { echo "$as_me:$LINENO: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
- rm -f "$ac_file"
- fi
+case `sed -n '/datarootdir/ {
+ p
+ q
+}
+/@datadir@/p
+/@docdir@/p
+/@infodir@/p
+/@localedir@/p
+/@mandir@/p
+' $ac_file_inputs` in
+*datarootdir*) ac_datarootdir_seen=yes;;
+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
+ { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF
+ ac_datarootdir_hack='
+ s&@datadir@&$datadir&g
+ s&@docdir@&$docdir&g
+ s&@infodir@&$infodir&g
+ s&@localedir@&$localedir&g
+ s&@mandir@&$mandir&g
+ s&\\\${datarootdir}&$datarootdir&g' ;;
+esac
+_ACEOF
+
+# Neutralize VPATH when `$srcdir' = `.'.
+# Shell code in configure.ac might set extrasub.
+# FIXME: do we really want to maintain this feature?
+cat >>$CONFIG_STATUS <<_ACEOF
sed "$ac_vpsub
$extrasub
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s, at configure_input@,$configure_input,;t t
-s, at srcdir@,$ac_srcdir,;t t
-s, at abs_srcdir@,$ac_abs_srcdir,;t t
-s, at top_srcdir@,$ac_top_srcdir,;t t
-s, at abs_top_srcdir@,$ac_abs_top_srcdir,;t t
-s, at builddir@,$ac_builddir,;t t
-s, at abs_builddir@,$ac_abs_builddir,;t t
-s, at top_builddir@,$ac_top_builddir,;t t
-s, at abs_top_builddir@,$ac_abs_top_builddir,;t t
-" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
- rm -f $tmp/stdin
- if test x"$ac_file" != x-; then
- mv $tmp/out $ac_file
- else
- cat $tmp/out
- rm -f $tmp/out
- fi
+s&@configure_input@&$configure_input&;t t
+s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@srcdir@&$ac_srcdir&;t t
+s&@abs_srcdir@&$ac_abs_srcdir&;t t
+s&@top_srcdir@&$ac_top_srcdir&;t t
+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
+s&@builddir@&$ac_builddir&;t t
+s&@abs_builddir@&$ac_abs_builddir&;t t
+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
+$ac_datarootdir_hack
+" $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out
+
+test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
+ { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&
+ { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&
+ { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined. Please make sure it is defined." >&5
+echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined. Please make sure it is defined." >&2;}
+
+ rm -f "$tmp/stdin"
+ case $ac_file in
+ -) cat "$tmp/out"; rm -f "$tmp/out";;
+ *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;;
+ esac
+ ;;
-done
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+
+ esac
+
+done # for ac_tag
+
{ (exit 0); exit 0; }
_ACEOF
diff --git a/man/MCMCpanel.Rd b/man/MCMCpanel.Rd
deleted file mode 100644
index 61dcecc..0000000
--- a/man/MCMCpanel.Rd
+++ /dev/null
@@ -1,158 +0,0 @@
-\name{MCMCpanel}
-\alias{MCMCpanel}
-\title{Markov Chain Monte Carlo for the General Linear Panel Model}
-\description{
- MCMCpanel generates a sample from the posterior distribution of a General
- Linear Panel Model using Algorithm 2 of Chib and Carlin (1999).
- This model uses a multivariate Normal prior for the fixed
- effects parameters, a Wishart prior on the random effects
- precision matrix, and a Gamma prior on the conditional error
- precision. The user supplies data and priors, and a sample from
- the posterior distribution is returned as an mcmc object,
- which can be subsequently analyzed with functions provided in
- the coda package.
- }
-
-\usage{
-MCMCpanel(obs, Y, X, W, burnin = 1000, mcmc = 10000, thin = 5,
- verbose = 0, seed = NA, sigma2.start = NA,
- D.start = NA, b0 = 0, B0 = 1, eta0, R0, nu0 = 0.001,
- delta0 = 0.001, ...)
- }
-
-\arguments{
- \item{obs}{An \eqn{(nk \times 1)}{(nk * 1)} vector that contains unique
- observation numbers for each subject.}
-
- \item{Y}{An \eqn{(nk \times 1)}{(nk * 1)} vector of response variables,
- stacked across all subjects.}
-
- \item{X}{An \eqn{(nk \times p)}{(nk * p)} matrix of fixed effects
- covariates, stacked across all subjects.}
-
- \item{W}{An \eqn{(nk \times q)}{(nk * q)} matrix of random effects
- covariates, stacked across all subjects.}
-
- \item{burnin}{The number of burnin iterations for the sampler.}
-
- \item{mcmc}{The number of Gibbs iterations for the sampler.}
-
- \item{thin}{The thinning interval used in the simulation. The number of
- mcmc iterations must be divisible by this value.}
-
- \item{seed}{The seed for the random number generator. If NA, the Mersenne
- Twister generator is used with default seed 12345; if an integer is
- passed it is used to seed the Mersenne twister. The user can also
- pass a list of length two to use the L'Ecuyer random number generator,
- which is suitable for parallel computation. The first element of the
- list is the L'Ecuyer seed, which is a vector of length six or NA (if NA
- a default seed of \code{rep(12345,6)} is used). The second element of
- list is a positive substream number. See the MCMCpack
- specification for more details.}
-
-
- \item{verbose}{A switch which determines whether or not the progress of
- the sampler is printed to the screen. If \code{verbose} is greater
- than 0 the iteration number
- and parameters are printed to the screen every \code{verbose}th iteration.}
-
- \item{sigma2.start}{The starting value for the conditional error
- variance. Default value of NA uses the least squares estimates.}
-
- \item{D.start}{The starting value for precision matrix of the random
- effects. This can either be a scalar or square matrix with dimension
- equal to the number of random effects. If this takes a scalar value, then
- that value multiplied by an identity matrix will be the starting
- value. Default value of NA uses an identity matrix multiplied by 0.5
- the OLS \eqn{\sigma^2}{sigma2} estimate. }
-
- \item{b0}{The prior mean of \eqn{\beta}{beta}. This can either be a
- scalar or a
- column vector with dimension equal to the number of betas. If this takes
- a scalar value, then that value will serve as the prior mean for all
- of the betas.}
-
- \item{B0}{The prior precision of \eqn{\beta}{beta}.
- This can either be a scalar
- or a square matrix with dimensions equal to the number of betas. If
- this takes a scalar value, then that value times an identity matrix
- serves as the prior precision of beta. Default value of 0 is equivalent
- to an improper uniform prior for beta.}
-
- \item{eta0}{The shape parameter for the Wishart prior on
- precision matrix for the random effects.}
-
- \item{R0}{The scale matrix for the Wishart prior on precision matrix for
- the random effects.}
-
- \item{nu0}{The shape parameter for the Gamma prior on the
- conditional error precision.}
-
- \item{delta0}{The scale parameter for the Gamma prior on
- the conditional error precision.}
-
- \item{...}{further arguments to be passed}
-}
-
-\value{
- An mcmc object that contains the posterior sample. This
- object can be summarized by functions provided by the coda package.
-}
-
-\details{
- \code{MCMCpanel} simulates from the posterior distribution sample using
- the blocked Gibbs sampler of Chib and Carlin (1999), Algorithm 2.
- The simulation proper
- is done in compiled C++ code to maximize efficiency. Please consult
- the coda documentation for a comprehensive list of functions that can be
- used to analyze the posterior sample.
-
- The model takes the following form:
- \deqn{y_i = X_i \beta + W_i b_i + \varepsilon_i}{y_i = X_i * beta + W_i *
- b_i + epsilon_i}
- Where the random effects:
- \deqn{b_i \sim \mathcal{N}_q(0,D)}{b_i ~ N_q(0,D)}
- And the errors:
- \deqn{\varepsilon_i \sim \mathcal{N}(0, \sigma^2 I_k)}{epsilon_i ~ N(0,
- sigma^2 I_k)}
- We assume standard, conjugate priors:
- \deqn{\beta \sim \mathcal{N}(b0,B0^{-1})}{beta ~ N(b0,B0^(-1))}
- And:
- \deqn{\sigma^{-2} \sim \mathcal{G}amma(\nu_0/2, \delta_0/2)}{sigma^(-2) ~
- Gamma(nu0/2, delta0/2)}
- And:
- \deqn{D^{-1} \sim \mathcal{W}ishart(\eta_0, R_0^{-1})}{D^-1 ~ Wishart(eta0,
- R0^-1)}
- See Chib and Carlin (1999) or Martin and Saunders (2002) for more details.
-
- \emph{NOTE: Unlike most models in MCMCpack, we do not provide default
- parameters for the priors on the precision matrix for the random effects.}
- When fitting one of these models, it is of utmost importance to choose a
- prior that reflects your prior beliefs about the random effects. Using the
- \code{dwish} and \code{rwish} functions might be useful in choosing these
- values. Also, the user is not allowed to specify a starting value
- for the \eqn{\beta}{beta} parameters, as they are simulated in the
- first block of the sampler.
- }
-
-\references{
- Siddhartha Chib and Bradley P. Carlin. 1999. ``On MCMC Sampling in
- Hierarchical Longitudinal Models." \emph{Statistics and Computing.} 9:
- 17-26.
-
- Daniel Pemstein, Kevin M. Quinn, and Andrew D. Martin. 2007.
- \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
-
- Andrew D. Martin and Kyle L. Saunders. 2002. ``Bayesian Inference for
- Political Science Panel Data.'' Paper presented at the 2002 Annual Meeting
- of the American Political Science Association.
-
- Martyn Plummer, Nicky Best, Kate Cowles, and Karen Vines. 2002.
- \emph{Output Analysis and Diagnostics for MCMC (CODA)}.
- \url{http://www-fis.iarc.fr/coda/}.
-}
-
-\keyword{models}
-
-\seealso{\code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}}}
-
diff --git a/src/MCMCSVDreg.cc b/src/MCMCSVDreg.cc
index 1531571..dec6279 100644
--- a/src/MCMCSVDreg.cc
+++ b/src/MCMCSVDreg.cc
@@ -23,65 +23,73 @@
// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
//
// KQ 9/9/2005
-//
+// KQ 8/1/2007 ported to Scythe 1.0.2
+
+
+#ifndef MCMCSVDREG_CC
+#define MCMCSVDREG_CC
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-
-#include <iostream>
+#include "rng.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
+using namespace scythe;
+
+
+
+template<typename RNGTYPE>
+void MCMCSVDreg_impl(rng<RNGTYPE>& stream,
+ double *sampledata, const int *samplerow,
+ const int *samplecol,
+ const double *Ydata, const int *Yrow, const int *Ycol,
+ const int *Ymiss,
+ const double *Adata, const int *Arow, const int *Acol,
+ const double *Ddata, const int *Drow, const int *Dcol,
+ const double *Fdata, const int *Frow, const int *Fcol,
+ const int *burnin, const int *mcmc,
+ const int *thin, const int *uselecuyer,
+ const int *seedarray,
+ const int *lecuyerstream, const int *verbose,
+ const double *taustartdata, const int *taustartrow,
+ const int *taustartcol,
+ const double *g0data,
+ const int *g0row, const int *g0col,
+ const double *a0, const double *b0,
+ const double* c0, const double* d0,
+ const double* w0,
+ const int* betasamp
+ ){
-extern "C" {
-
- // simulate from posterior distribution and return an mcmc by parameters
- // matrix of the posterior sample
- void MCMCSVDreg(double *sampledata, const int *samplerow,
- const int *samplecol,
- const double *Ydata, const int *Yrow, const int *Ycol,
- const int *Ymiss,
- const double *Adata, const int *Arow, const int *Acol,
- const double *Ddata, const int *Drow, const int *Dcol,
- const double *Fdata, const int *Frow, const int *Fcol,
- const int *burnin, const int *mcmc,
- const int *thin, const int *lecuyer,
- const int *seedarray,
- const int *lecuyerstream, const int *verbose,
- const double *taustartdata, const int *taustartrow,
- const int *taustartcol,
- const double *g0data,
- const int *g0row, const int *g0col,
- const double *a0, const double *b0,
- const double* c0, const double* d0,
- const double* w0,
- const int* betasamp) {
-
// pull together Matrix objects
- Matrix <double> y = r2scythe(*Yrow, *Ycol, Ydata);
- Matrix <double> A = r2scythe(*Arow, *Acol, Adata);
- Matrix <double> D = r2scythe(*Drow, *Dcol, Ddata);
- Matrix <double> F = r2scythe(*Frow, *Fcol, Fdata);
- Matrix <double> g0 = r2scythe(*g0row, *g0col, g0data);
+ Matrix <> y(*Yrow, *Ycol, Ydata);
+ Matrix <> A(*Arow, *Acol, Adata);
+ Matrix <> D(*Drow, *Dcol, Ddata);
+ Matrix <> F(*Frow, *Fcol, Fdata);
+ Matrix <> g0(*g0row, *g0col, g0data);
// define constants
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
+ const int tot_iter = *burnin + *mcmc;
+ // total number of mcmc iterations
const int nstore = *mcmc / *thin; // number of draws to store
const int k = *Arow;
const int n = *Yrow;
- Matrix <double> FtD = t(F) * D;
- Matrix <double> DinvF = invpd(D) * F;
- Matrix <double> Dg0 = D * g0;
- double dsquared[n];
+ Matrix<> FtD = t(F) * D;
+ Matrix<> DinvF = invpd(D) * F;
+ Matrix<> Dg0 = D * g0;
+ //double dsquared[n]; OLD (NEW BELOW)
+ double* dsquared = new double[n];
+
for (int i=0; i<n; ++i){
dsquared[i] = std::pow(D(i,i), 2);
}
@@ -94,25 +102,24 @@ extern "C" {
const int nYmiss = holder;
// storage matrices
- Matrix<double> beta_store;
+ Matrix<> beta_store;
if (*betasamp == 1){
beta_store = Matrix<double>(k, nstore);
}
- Matrix<double> gamma_store(n, nstore);
- Matrix<double> Y_store(nYmiss, nstore);
- Matrix<double> sigma2_store(1, nstore);
- Matrix<double> tau2_store(n, nstore);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
+ Matrix<> gamma_store(n, nstore);
+ Matrix<> Y_store(nYmiss, nstore);
+ Matrix<> sigma2_store(1, nstore);
+ Matrix<> tau2_store(n, nstore);
// set starting values
- double tau2[n];
+ // double tau2[n]; OLD WAY (NEW BELOW)
+ double* tau2 = new double[n];
+
for (int i=0; i<n; ++i){
tau2[i] = taustartdata[i];
}
- Matrix <double> gamma(n, 1);
+ Matrix <> gamma(n, 1);
double sigma2 = 1;
Matrix <double> beta;
if (*betasamp == 1){
@@ -132,24 +139,24 @@ extern "C" {
for (int i=0; i<n; ++i){
q += (std::pow(Fy[i], 2) / (1 + tau2[i]));
}
- sigma2 = stream->rigamma((*a0+n)*0.5, (*b0 + q)*0.5);
+ sigma2 = stream.rigamma((*a0+n)*0.5, (*b0 + q)*0.5);
// sample [gamma | Y, A, D, F, sigma2, tau2]
// w0[i] is assumed to be the prior prob that gamma[i] == 0
- Matrix <double> gammahat = DinvF * y;
+ Matrix <> gammahat = DinvF * y;
for (int i=0; i<n; ++i){
double mstar = (g0[i] + tau2[i]*gammahat[i]) / (1 + tau2[i]);
double vstar = (sigma2 * tau2[i]) / (dsquared[i] * (tau2[i] + 1));
//double wstar = 1.0 - (1.0 - w0[i]) /
// (1.0 - w0[i] + w0[i] * dnorm(0.0, mstar, std::sqrt(vstar)));
- Matrix<double> gammanoti = gamma;
+ Matrix<> gammanoti = gamma;
gammanoti[i] = 0.0;
- Matrix<double> residvec = y - FtD * gammanoti;
- Matrix<double> margmeanvec = FtD(_,i) * g0[i];
- Matrix<double> margVarmat = FtD(_,i) * t(FtD(_,i)) *
+ Matrix<> residvec = y - FtD * gammanoti;
+ Matrix<> margmeanvec = FtD(_,i) * g0[i];
+ Matrix<> margVarmat = FtD(_,i) * t(FtD(_,i)) *
(sigma2 * tau2[i]) / (dsquared[i]) + eye<double>(n) * sigma2;
double logw0 = std::log(w0[i]);
@@ -163,24 +170,24 @@ extern "C" {
double logdenom;
if ( (logw0 + logf0) > (log1minusw0 + logfnot0)){
logdenom = logw0 + logf0 + std::log(1.0 +
- std::exp(log1minusw0 -
- logw0 + logfnot0 -
- logf0));
+ std::exp(log1minusw0 -
+ logw0 + logfnot0 -
+ logf0));
}
else{
logdenom = log1minusw0 + logfnot0 + std::log(1.0 +
- std::exp(logw0 -
- log1minusw0 + logf0 -
- logfnot0));
+ std::exp(logw0 -
+ log1minusw0 + logf0 -
+ logfnot0));
}
double wstar = std::exp(logw0 + logf0 - logdenom);
- if (stream->runif() < wstar){
+ if (stream.runif() < wstar){
gamma[i] = 0.0;
}
else {
- gamma[i] = stream->rnorm(mstar, std::sqrt(vstar));
+ gamma[i] = stream.rnorm(mstar, std::sqrt(vstar));
}
}
@@ -188,17 +195,17 @@ extern "C" {
// sample [tau2 | Y, A, D, F, gamma, sigma2]
for (int i=0; i<n; ++i){
double gamg2 = std::pow((gamma[i] - g0[i]), 2);
- tau2[i] = stream->rigamma((1+c0[i])*0.5,
+ tau2[i] = stream.rigamma((1+c0[i])*0.5,
(gamg2 * (dsquared[i] / sigma2) + d0[i])
*0.5);
}
// sample [y[miss] | Y[obs], A, D, F, gamma, sigma2, tau2]
- Matrix <double> eta = FtD * gamma;
+ Matrix <> eta = FtD * gamma;
for (int i=0; i<n; ++i){
if (Ymiss[i] == 1){
- y[i] = stream->rnorm(eta[i], std::sqrt(sigma2));
+ y[i] = stream.rnorm(eta[i], std::sqrt(sigma2));
}
}
@@ -250,10 +257,14 @@ extern "C" {
} // end MCMC loop
- delete stream; // clean up random number stream
+
+ // cleanup
+ delete [] dsquared;
+ delete [] tau2;
+
// load draws into sample array
- Matrix <double> storagematrix = cbind(t(Y_store), t(gamma_store));
+ Matrix <> storagematrix = cbind(t(Y_store), t(gamma_store));
storagematrix = cbind(storagematrix, t(tau2_store));
storagematrix = cbind(storagematrix, t(sigma2_store));
if (*betasamp == 1){
@@ -264,5 +275,56 @@ extern "C" {
for(int i = 0; i < size; ++i)
sampledata[i] = storagematrix[i];
- } // end MCMCregress
+
+
+}
+
+
+
+extern "C" {
+
+ // simulate from posterior distribution and return an mcmc by parameters
+ // matrix of the posterior sample
+ void MCMCSVDreg(double *sampledata, const int *samplerow,
+ const int *samplecol,
+ const double *Ydata, const int *Yrow, const int *Ycol,
+ const int *Ymiss,
+ const double *Adata, const int *Arow, const int *Acol,
+ const double *Ddata, const int *Drow, const int *Dcol,
+ const double *Fdata, const int *Frow, const int *Fcol,
+ const int *burnin, const int *mcmc,
+ const int *thin, const int *uselecuyer,
+ const int *seedarray,
+ const int *lecuyerstream, const int *verbose,
+ const double *taustartdata, const int *taustartrow,
+ const int *taustartcol,
+ const double *g0data,
+ const int *g0row, const int *g0col,
+ const double *a0, const double *b0,
+ const double* c0, const double* d0,
+ const double* w0,
+ const int* betasamp) {
+
+
+
+ MCMCPACK_PASSRNG2MODEL(MCMCSVDreg_impl,
+ sampledata, samplerow, samplecol,
+ Ydata, Yrow, Ycol,
+ Ymiss,
+ Adata, Arow, Acol,
+ Ddata, Drow, Dcol,
+ Fdata, Frow, Fcol,
+ burnin, mcmc, thin,
+ uselecuyer, seedarray, lecuyerstream, verbose,
+ taustartdata, taustartrow, taustartcol,
+ g0data, g0row, g0col,
+ a0, b0, c0, d0, w0,
+ betasamp);
+
+
+ } // end MCMCSVDreg
} // end extern "C"
+
+
+
+#endif
diff --git a/src/MCMCdistn.cc b/src/MCMCdistn.cc
deleted file mode 100644
index 062938b..0000000
--- a/src/MCMCdistn.cc
+++ /dev/null
@@ -1,466 +0,0 @@
-// MCMCdistn.cc contains a number of functions that interface the scythe
-// random number generators, density functions, and distribution functions
-// with the MCMCpack R package so that these functions can be called
-// directly from R.
-//
-// Andrew D. Martin
-// Dept. of Political Science
-// Washington University in St. Louis
-// admartin at wustl.edu
-//
-// Kevin M. Quinn
-// Dept. of Government
-// Harvard University
-// kevin_quinn at harvard.edu
-//
-// This software is distributed under the terms of the GNU GENERAL
-// PUBLIC LICENSE Version 2, June 1991. See the package LICENSE
-// file for more information.
-//
-// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
-//
-
-#include "matrix.h"
-#include "distributions.h"
-#include "stat.h"
-#include "la.h"
-#include "ide.h"
-#include "smath.h"
-#include "MCMCrng.h"
-
-
-#include <R.h> // needed to use Rprintf()
-#include <R_ext/Utils.h> // needed to allow user interrupts
-
-using namespace SCYTHE;
-using namespace std;
-
-extern "C"{
-
- void rtnormFromR(double* sampledata, const int* samplesize,
- const double* mean, const int* meanlength,
- const double* var, const int* varlength,
- const double* below, const int* belowlength,
- const double* above, const int* abovelength,
- const int *lecuyer, const int *seedarray,
- const int *lecuyerstream){
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // individual indexing to do R-style index recycling
- int m_index = -1;
- int v_index = -1;
- int b_index = -1;
- int a_index = -1;
-
- // the loop where the random number draws take place
- for (int i=0; i<*samplesize; ++i){
-
- // do the R-style index recycling
- ++m_index;
- if (m_index==*meanlength){
- m_index = 0;
- }
- ++v_index;
- if (v_index==*varlength){
- v_index = 0;
- }
- ++b_index;
- if (b_index==*belowlength){
- b_index = 0;
- }
- ++a_index;
- if (a_index==*abovelength){
- a_index = 0;
- }
-
- sampledata[i] = stream->rtnorm(mean[m_index], var[v_index],
- below[b_index], above[a_index]);
-
- }
-
- } // end rtnormFromR
-
- //This next function implements the algorithm for rnchypgeom for a
- //list of data by calling double rng::rnchypgeom() for each element.
- void rnchypgeomFromR(const int * number,
- const double* m1, const double* n1,
- const double* n2, const double* psi,
- const double* delta, const int * listLengths,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we create some indices for wrap-around. Note that we will
- //be assuming that the listLenths array has five elements, which it
- //should if it was called from the R code.
- int count[5]={-1,-1,-1,-1,-1};
-
- //Third, we use the function to calculate the return values, while
- //being sure to use R-like vector wraparound for all of our parameters.
- for(int i=0; i < *number; ++i) {
-
- for(int j=0; j < 5; ++j) {
- count[j] = (count[j] + 1) % listLengths[j];
- }
-
- result[i] = stream->rnchypgeom(m1[count[0]], n1[count[1]], n2[count[2]],
- psi[count[3]], delta[count[4]]);
- }
-
- //Finally, we're done, so we just end.
- }
-
- //This next function fills the given list from rng::richisq() from the
- //given value of the nu (degrees of freedom).
- void richisqFromR(const int * number, const double * nu,
- const int * listLength, double * result,
- const int *lecuyer, const int *seedarray,
- const int *lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //We create an index for the wrap-around.
- int count = -1;
-
- //We fill our array now from our function.
- for(int i = 0; i < *number; ++i) {
- count = (count + 1)%(*listLength);
-
- result[i] = stream->richisq(nu[count]);
- }
-
- //Now, we're done, so get out of here.
- }
-
- //This next function fills the given list from rng::rigamma() from the
- //given value of the alpha and beta.
- void rigammaFromR(const int * number, const double * alpha,
- const double * beta, const int * listLengths,
- double * result, const int *lecuyer,
- const int *seedarray, const int *lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //We create an index for the wrap-around.
- int count[2] = {-1,-1};
-
- //We fill our array now from our function.
- for(int i = 0; i < *number; ++i) {
-
- for(int j = 0; j < 2; ++j) {
- count[j] = (count[j] + 1)%(listLengths[j]);
- }
-
- result[i] = stream->rigamma(alpha[count[0]], beta[count[1]]);
- }
-
- //Now, we're done, so get out of here.
- }
-
- //This next function fills the given list from rng::rbern() from the
- //given value of the p parameter.
- void rbernFromR(const int * number, const double * p,
- const int * listLength, double * result,
- const int *lecuyer, const int *seedarray,
- const int *lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //We create an index for the wrap-around.
- int count = -1;
-
- //We fill our array now from our function.
- for(int i = 0; i < *number; ++i) {
- count = (count + 1)%(*listLength);
-
- result[i] = stream->rbern(p[count]);
- }
-
- //Now, we're done, so get out of here.
- }
-
- //This next function implements the algorithm for rtnormcombo for a
- //list of data by calling double rng::rtnorm_combo() for each element.
- void rtnormcomboFromR(const int * number,
- const double* m, const double* v,
- const double* below, const double* above,
- const int * listLengths,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we create some indices for wrap-around. Note that we will
- //be assuming that the listLenths array has four elements, which it
- //should if it was called from the R code.
- int count[4]={-1,-1,-1,-1};
-
- //Third, we use the function to calculate the return values, while
- //being sure to use R-like vector wraparound for all of our parameters.
- for(int i=0; i < *number; ++i) {
-
- for(int j=0; j < 4; ++j) {
- count[j] = (count[j] + 1) % listLengths[j];
- }
-
- result[i] = stream->rtnorm_combo(m[count[0]], v[count[1]], below[count[2]],
- above[count[3]]);
- }
-
- //Finally, we're done, so we just end.
- }
-
- //This next function implements the algorithm for rtbnormslice for a
- //list of data by calling double rng::rtbnorm_slice() for each element.
- void rtbnormsliceFromR(const int * number,
- const double* m, const double* v,
- const double* below, const int* iter,
- const int * listLengths,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we create some indices for wrap-around. Note that we will
- //be assuming that the listLenths array has four elements, which it
- //should if it was called from the R code.
- int count[4]={-1,-1,-1,-1};
-
- //Third, we use the function to calculate the return values, while
- //being sure to use R-like vector wraparound for all of our parameters.
- for(int i=0; i < *number; ++i) {
-
- for(int j=0; j < 4; ++j) {
- count[j] = (count[j] + 1) % listLengths[j];
- }
-
- result[i] = stream->rtbnorm_slice(m[count[0]], v[count[1]], below[count[2]],
- iter[count[3]]);
- }
-
- //Finally, we're done, so we just end.
- }
-
- //This next function implements the algorithm for rtanormslice for a
- //list of data by calling double rng::rtanorm_slice() for each element.
- void rtanormsliceFromR(const int * number,
- const double* m, const double* v,
- const double* above, const int* iter,
- const int * listLengths,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we create some indices for wrap-around. Note that we will
- //be assuming that the listLenths array has four elements, which it
- //should if it was called from the R code.
- int count[4]={-1,-1,-1,-1};
-
- //Third, we use the function to calculate the return values, while
- //being sure to use R-like vector wraparound for all of our parameters.
- for(int i=0; i < *number; ++i) {
-
- for(int j=0; j < 4; ++j) {
- count[j] = (count[j] + 1) % listLengths[j];
- }
-
- result[i] = stream->rtanorm_slice(m[count[0]], v[count[1]], above[count[2]],
- iter[count[3]]);
- }
-
- //Finally, we're done, so we just end.
- }
-
- //This next function implements the algorithm for rtbnormcombo for a
- //list of data by calling double rng::rtbnorm_combo() for each element.
- void rtbnormcomboFromR(const int * number,
- const double* m, const double* v,
- const double* below, const int* iter,
- const int * listLengths,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we create some indices for wrap-around. Note that we will
- //be assuming that the listLenths array has four elements, which it
- //should if it was called from the R code.
- int count[4]={-1,-1,-1,-1};
-
- //Third, we use the function to calculate the return values, while
- //being sure to use R-like vector wraparound for all of our parameters.
- for(int i=0; i < *number; ++i) {
-
- for(int j=0; j < 4; ++j) {
- count[j] = (count[j] + 1) % listLengths[j];
- }
-
- result[i] = stream->rtbnorm_combo(m[count[0]], v[count[1]], below[count[2]],
- iter[count[3]]);
- }
-
- //Finally, we're done, so we just end.
- }
-
- //This next function implements the algorithm for rtanormcombo for a
- //list of data by calling double rng::rtanorm_combo() for each element.
- void rtanormcomboFromR(const int * number,
- const double* m, const double* v,
- const double* above, const int* iter,
- const int * listLengths,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we create some indices for wrap-around. Note that we will
- //be assuming that the listLenths array has four elements, which it
- //should if it was called from the R code.
- int count[4]={-1,-1,-1,-1};
-
- //Third, we use the function to calculate the return values, while
- //being sure to use R-like vector wraparound for all of our parameters.
- for(int i=0; i < *number; ++i) {
-
- for(int j=0; j < 4; ++j) {
- count[j] = (count[j] + 1) % listLengths[j];
- }
-
- result[i] = stream->rtanorm_combo(m[count[0]], v[count[1]], above[count[2]],
- iter[count[3]]);
- }
-
- //Finally, we're done, so we just end.
- }
-
- //This next function implements the algorithm for rwish for a
- //by calling double rng::rwish() for the whole matrix.
- void rwishFromR(const int * v, const double* s,
- const int * dimension,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream, being sure to store the parameters
- //so that we can check for them the next time this is run.
- static rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
- static int store_lecuyer = *lecuyer;
- static int store_seedarray[6] = {0,0,0,0,0,0};
- static int store_lecuyerstream = *lecuyerstream;
- if((*lecuyer!=store_lecuyer)||(*lecuyerstream!=store_lecuyerstream)||
- (store_seedarray[0]!=seedarray[0])||(store_seedarray[1]!=seedarray[1])||
- (store_seedarray[2]!=seedarray[2])||(store_seedarray[3]!=seedarray[3])||
- (store_seedarray[4]!=seedarray[4])||(store_seedarray[5]!=seedarray[5])) {
- for(int i = 0; i < 6; ++i) store_seedarray[i] = seedarray[i];
- store_lecuyer = *lecuyer;
- store_lecuyerstream = *lecuyerstream;
- delete stream;
- stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
- }
-
- //Second, we run our rng::rwish() function to get the result
- Matrix<double> * myMat = new Matrix<double>(*dimension,*dimension,s);
- Matrix<double> myMatrix2 = stream->rwish(*v,*myMat);
-
- for(int i = 0; i < (*dimension)*(*dimension); ++i) {
- result[i] = myMatrix2[i];
- }
-
- //So that we don't have any memory leaks:
- delete myMat;
-
- //Finally, we're done, so we just end.
- }
-
- //This next function implements the algorithm for rdirich for a
- //by calling double rng::rdirich() for each element.
- void rdirichFromR(const int * n, const double* alpha,
- const int * vsize, const int * hsize,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we run our rng::rdirich() function to get the result
- Matrix<double> alphaMatrix(*hsize,*vsize,alpha);
- Matrix<double> temp, tempVector;
-
- for(int i=0; i < *n; ++i) {
- tempVector = alphaMatrix(i%(*hsize), _);
- tempVector.resize(*vsize, 1);
- temp = stream->rdirich(tempVector);
- for(int j = 0; j < *vsize; ++j)
- result[i*(*vsize)+j] = temp[j];
- }
-
- //Finally, we're done, so we just end.
- }
-
- //This next function implements the algorithm for rmvnorm for a
- //by calling double rng::rmvnorm() for each element.
- void rmvnormFromR(const int * n, const double* mu,
- const int * vsize, const int * hsize,
- const double * sigma,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we run our rng::rdirich() function to get the result
- Matrix<double> muMatrix(*hsize,*vsize,mu);
- Matrix<double> sigmaMatrix(*vsize,*vsize,sigma);
- Matrix<double> temp, tempVector;
-
- for(int i=0; i < *n; ++i) {
- tempVector = muMatrix(i%(*hsize), _);
- tempVector.resize(*vsize, 1);
- temp = stream->rmvnorm(tempVector, sigmaMatrix);
- for(int j = 0; j < *vsize; ++j)
- result[i*(*vsize)+j] = temp[j];
- }
-
- //Finally, we're done, so we just end.
- }
-
- //This next function implements the algorithm for rmvt for a
- //by calling double rng::rmvt() for each element.
- void rmvtFromR(const int * n, const double* sigma,
- const int * size, const double * nu, const int * sizeNu,
- double* result, const int* lecuyer,
- const int* seedarray, const int* lecuyerstream) {
-
- //First, we initialize our rng stream.
- rng * stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- //Second, we run our rng::rdirich() function to get the result
- Matrix<double> sigmaMatrix(*size,*size,sigma);
- Matrix<double> temp;
-
- for(int i=0; i < *n; ++i) {
- temp = stream->rmvt(sigmaMatrix, nu[(i%(*sizeNu))]);
- for(int j = 0; j < *size; ++j)
- result[i*(*size)+j] = temp[j];
- }
-
- //Finally, we're done, so we just end.
- }
-
- // other *FromR functions should be added here
-
-
-
-} // end extern "C"
diff --git a/src/MCMCdynamicEI.cc b/src/MCMCdynamicEI.cc
index adb4bc7..5d604e1 100644
--- a/src/MCMCdynamicEI.cc
+++ b/src/MCMCdynamicEI.cc
@@ -10,6 +10,12 @@
// KQ 10/25/2002 [ported to Scythe0.3 and written for an R interface]
// KQ 7/20/2004 [minor changes regarding output and user interrupts]
// ADM 7/24/2004 [updated to new Scythe version]
+// KQ 7/30/2007 [updated to Scythe 1.0.X]
+
+
+#ifndef MCMCDYNAMICEI_CC
+#define MCMCDYNAMICEI_CC
+
#include "matrix.h"
#include "distributions.h"
@@ -23,12 +29,16 @@
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
+
+using namespace scythe;
using namespace std;
-static double Lev1thetaPost(double theta[], const double& r0, const double& r1,
- const double& c0, const double& mu0, const double& mu1,
- const double& sigma0, const double& sigma1){
+
+static double Lev1thetaPost(double theta[], const double& r0,
+ const double& r1,
+ const double& c0, const double& mu0,
+ const double& mu1,
+ const double& sigma0, const double& sigma1){
const double theta0 = theta[0];
const double theta1 = theta[1];
const double p0 = 1.0/(1.0 + exp(-1*theta0));
@@ -47,16 +57,19 @@ static double Lev1thetaPost(double theta[], const double& r0, const double& r1,
// general and put in MCMCfcds.{h cc}
//
// Radford Neal's (2000) doubling procedure coded for a logdensity
+template <typename RNGTYPE>
static void doubling(double (*logfun)(double[], const double&, const double&,
- const double&, const double&, const double&,
- const double&, const double&),
- double theta[], const int& index, const double& z,
- const double& w, const int& p, const double& r0,
- const double& r1, const double& c0, const double& mu0,
- const double& mu1, const double& sigma0, const double& sigma1,
- rng* stream, double& L, double& R){
-
- const double U = stream->runif();
+ const double&, const double&,
+ const double&,
+ const double&, const double&),
+ double theta[], const int& index, const double& z,
+ const double& w, const int& p, const double& r0,
+ const double& r1, const double& c0, const double& mu0,
+ const double& mu1, const double& sigma0,
+ const double& sigma1,
+ rng<RNGTYPE>& stream, double& L, double& R){
+
+ const double U = stream.runif();
const double x0 = theta[index];
double theta_L[2];
double theta_R[2];
@@ -70,7 +83,7 @@ static void doubling(double (*logfun)(double[], const double&, const double&,
while (K > 0 &&
(z < logfun(theta_L, r0, r1, c0, mu0, mu1, sigma0, sigma1) ||
z < logfun(theta_R, r0, r1, c0, mu0, mu1, sigma0, sigma1))){
- double V = stream->runif();
+ double V = stream.runif();
if (V < 0.5){
L = L - (R - L);
theta_L[index] = L;
@@ -83,6 +96,7 @@ static void doubling(double (*logfun)(double[], const double&, const double&,
}
}
+
// Radford Neal's (2000) Accept procedure coded for a logdensity
static const bool Accept(double (*logfun)(double[], const double&,
const double&,
@@ -132,6 +146,7 @@ static const bool Accept(double (*logfun)(double[], const double&,
// Radford Neal's (2000) shrinkage procedure coded for a log density
+template <typename RNGTYPE>
static double shrinkage(double (*logfun)(double[], const double&,
const double&,
const double&, const double&,
@@ -141,8 +156,8 @@ static double shrinkage(double (*logfun)(double[], const double&,
const double& w, const double& r0,
const double& r1, const double& c0, const double& mu0,
const double& mu1, const double& sigma0,
- const double& sigma1, rng*
- stream, const double& L, const double& R){
+ const double& sigma1, rng<RNGTYPE>& stream,
+ const double& L, const double& R){
double Lbar = L;
double Rbar = R;
@@ -158,7 +173,7 @@ static double shrinkage(double (*logfun)(double[], const double&,
theta_x1[1] = theta[1];
const double x0 = theta[index];
for (;;){
- const double U = stream->runif();
+ const double U = stream.runif();
const double x1 = Lbar + U*(Rbar - Lbar);
theta_x1[index] = x1;
if (z <= logfun(theta_x1, r0, r1, c0, mu0, mu1, sigma0, sigma1) &&
@@ -178,244 +193,272 @@ static double shrinkage(double (*logfun)(double[], const double&,
-extern "C"{
-
- void dynamicEI(double* sample, const int* samrow, const int* samcol,
- const double* Rr0, const double* Rr1, const double* Rc0,
- const double* Rc1, const int* Rntables, const int* Rburnin,
- const int* Rmcmc, const int* Rthin,
- const double* RW, const double* Rnu0,
- const double* Rdelta0, const double* Rnu1,
- const double* Rdelta1, const int* Rverbose,
- const int *lecuyer, const int *seedarray,
- const int *lecuyerstream){
-
- // load data
- // table notation is:
- // --------------------
- // Y0 | | r0
- // --------------------
- // Y1 | | r1
- // --------------------
- // c0 | c1 | N
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
+template <typename RNGTYPE>
+void MCMCdynamicEI_impl(rng<RNGTYPE>& stream,
+ const Matrix<>& r0,
+ const Matrix<>& r1, const Matrix<>& c0,
+ const Matrix<>& c1, const Matrix<>& W,
+ double nu0, double delta0,
+ double nu1, double delta1, unsigned int ntables,
+ unsigned int burnin, unsigned int mcmc,
+ unsigned int thin, unsigned int verbose,
+ Matrix<double,Row>& result
+ ){
- const int ntables = *Rntables;
- const int verbose = *Rverbose;
- Matrix<double> r0(ntables, 1, Rr0);
- Matrix<double> r1(ntables, 1, Rr1);
- Matrix<double> c0(ntables, 1, Rc0);
- Matrix<double> c1(ntables, 1, Rc1);
- Matrix<double> N = c0 + c1;
-
- Matrix<double> W(ntables, ntables, RW);
-
- // MCMC-related quantities
- int burnin = *Rburnin;
- int mcmc = *Rmcmc;
- int thin = *Rthin;
- int tot_iter = burnin + mcmc;
-
+ unsigned int tot_iter = burnin + mcmc;
+
+ Matrix<> N = c0 + c1;
+
- // sum of weights across each row
- Matrix<double> W_sum = sumc(t(W));
+ // sum of weights across each row
+ Matrix<> W_sum = sumc(t(W));
- // precision matrix (not the weight matrix) for theta0 and theta1
- Matrix<double> P = -1*W;
- for (int i=0; i<ntables; ++i)
- P(i,i) = W_sum[i];
+ // precision matrix (not the weight matrix) for theta0 and theta1
+ Matrix<> P = -1*W;
+ for (unsigned int i=0; i<ntables; ++i)
+ P(i,i) = W_sum[i];
- // sigma_theta0 ~ IG(nu0/2, delta0/2)
- double nu0 = *Rnu0;
- double delta0 = *Rdelta0;
-
- // sigma_theta1 ~ IG(nu1/2, delta1/2)
- double nu1 = *Rnu1;
- double delta1 = *Rdelta1;
-
-
- // storage matrices
- Matrix<double> p0mat(mcmc/thin, ntables);
- Matrix<double> p1mat(mcmc/thin, ntables);
- Matrix<double> sig0mat(mcmc/thin, 1);
- Matrix<double> sig1mat(mcmc/thin, 1);
-
- int count = 0;
-
- // starting values
- Matrix<double> p0 = stream->runif(ntables,1)*0.5 + 0.25;
- Matrix<double> p1 = stream->runif(ntables,1)*0.5 + 0.25;
- Matrix<double> theta0 = log(p0/(1.0 - p0));
- Matrix<double> theta1 = log(p1/(1.0 - p1));
- // evolution variance for theta0
- double sigma_theta0 = ::pow(0.25, 2);
- // evolution variance for theta1
- double sigma_theta1 = ::pow(0.25, 2);
- double L = -2.0;
- double R = 2.0;
-
-
- // sampling constants
- const int warmup_iter = 4000;
- const int warmup_burnin = 2000;
- const double w_init = .000000001;
- const int p_init = 50;
- const Matrix<double> widthmat(warmup_iter - warmup_burnin, 2);
-
- // warm up sampling to chose slice sampling parameters adaptively
- for (int iter=0; iter<warmup_iter; ++iter){
- // loop over tables
- for (int i=0; i<ntables; ++i){
- const double mu0 = ((W(i,_) * theta0) / W_sum[i])[0];
- const double mu1 = ((W(i,_) * theta1) / W_sum[i])[0];
- const double sigma0 = sigma_theta0/W_sum[i];
- const double sigma1 = sigma_theta1/W_sum[i];
+ // sigma_theta0 ~ IG(nu0/2, delta0/2)
+ //double nu0 = *Rnu0;
+ //double delta0 = *Rdelta0;
+
+ // sigma_theta1 ~ IG(nu1/2, delta1/2)
+ //double nu1 = *Rnu1;
+ //double delta1 = *Rdelta1;
+
+
+ // storage matrices
+ Matrix<double> p0mat(mcmc/thin, ntables);
+ Matrix<double> p1mat(mcmc/thin, ntables);
+ Matrix<double> sig0mat(mcmc/thin, 1);
+ Matrix<double> sig1mat(mcmc/thin, 1);
+
+ int count = 0;
+
+ // starting values
+ Matrix<double> p0 = stream.runif(ntables,1)*0.5 + 0.25;
+ Matrix<double> p1 = stream.runif(ntables,1)*0.5 + 0.25;
+ Matrix<double> theta0 = log(p0/(1.0 - p0));
+ Matrix<double> theta1 = log(p1/(1.0 - p1));
+ // evolution variance for theta0
+ double sigma_theta0 = ::pow(0.25, 2);
+ // evolution variance for theta1
+ double sigma_theta1 = ::pow(0.25, 2);
+ double L = -2.0;
+ double R = 2.0;
+
+
+ // sampling constants
+ const unsigned int warmup_iter = 4000;
+ const unsigned int warmup_burnin = 2000;
+ const double w_init = .000000001;
+ const int p_init = 50;
+ const Matrix<double> widthmat(warmup_iter - warmup_burnin, 2);
+
+ // warm up sampling to chose slice sampling parameters adaptively
+ for (unsigned int iter=0; iter<warmup_iter; ++iter){
+ // loop over tables
+ for (unsigned int i=0; i<ntables; ++i){
+ const double mu0 = ((W(i,_) * theta0) / W_sum[i])[0];
+ const double mu1 = ((W(i,_) * theta1) / W_sum[i])[0];
+ const double sigma0 = sigma_theta0/W_sum[i];
+ const double sigma1 = sigma_theta1/W_sum[i];
- // sample theta0, theta1 using slice sampling
- for (int index = 0; index<2; ++index){
- double theta_i[2];
- theta_i[0] = theta0[i];
- theta_i[1] = theta1[i];
- double funval = Lev1thetaPost(theta_i, r0[i], r1[i], c0[i],
- mu0, mu1, sigma0, sigma1);
+ // sample theta0, theta1 using slice sampling
+ for (int index = 0; index<2; ++index){
+ double theta_i[2];
+ theta_i[0] = theta0[i];
+ theta_i[1] = theta1[i];
+ double funval = Lev1thetaPost(theta_i, r0[i], r1[i], c0[i],
+ mu0, mu1, sigma0, sigma1);
- double z = funval - stream->rexp(1.0);
- doubling(&Lev1thetaPost, theta_i, index, z, w_init, p_init, r0[i],
- r1[i], c0[i], mu0, mu1, sigma0, sigma1, stream, L, R);
+ double z = funval - stream.rexp(1.0);
+ doubling(&Lev1thetaPost, theta_i, index, z, w_init, p_init, r0[i],
+ r1[i], c0[i], mu0, mu1, sigma0, sigma1, stream, L, R);
- //Rprintf("L = %10.5f R = %10.5f\n", L, R);
+ //Rprintf("L = %10.5f R = %10.5f\n", L, R);
- theta_i[index] = shrinkage(&Lev1thetaPost, theta_i, index, z,
- w_init, r0[i], r1[i], c0[i], mu0, mu1,
- sigma0, sigma1, stream, L, R);
+ theta_i[index] = shrinkage(&Lev1thetaPost, theta_i, index, z,
+ w_init, r0[i], r1[i], c0[i], mu0, mu1,
+ sigma0, sigma1, stream, L, R);
- if (iter >= warmup_burnin){
- widthmat(iter- warmup_burnin, index) = R - L;
- }
+ if (iter >= warmup_burnin){
+ widthmat(iter- warmup_burnin, index) = R - L;
+ }
- theta0[i] = theta_i[0];
- theta1[i] = theta_i[1];
- } // end index loop
+ theta0[i] = theta_i[0];
+ theta1[i] = theta_i[1];
+ } // end index loop
// if after burnin store samples
- if ((iter >= burnin) && ((iter%thin)==0)){
- p0mat(count,i) = 1.0/(1.0 + exp(-1*theta0[i]));;
- p1mat(count,i) = 1.0/(1.0 + exp(-1*theta1[i]));;
+ if ((iter >= burnin) && ((iter%thin)==0)){
+ p0mat(count,i) = 1.0/(1.0 + exp(-1*theta0[i]));;
+ p1mat(count,i) = 1.0/(1.0 + exp(-1*theta1[i]));;
- }
- } // end tables loop
+ }
+ } // end tables loop
// sample sigma_theta0 and sigma_theta1
- Matrix<double> SSE = t(theta0-meanc(theta0)) * P *
- (theta0 - meanc(theta0));
- double nu2 = (nu0 + ntables)*0.5;
- double delta2 = (delta0 + SSE[0])*0.5;
- sigma_theta0 = stream->rigamma(nu2, delta2);
+ Matrix<double> SSE = t(theta0-meanc(theta0)) * P *
+ (theta0 - meanc(theta0));
+ double nu2 = (nu0 + ntables)*0.5;
+ double delta2 = (delta0 + SSE[0])*0.5;
+ sigma_theta0 = stream.rigamma(nu2, delta2);
- SSE = t(theta1-meanc(theta1)) * P * (theta1 - meanc(theta1));
- nu2 = (nu1 + ntables)*0.5;
- delta2 = (delta1 + SSE[0])*0.5;
- sigma_theta1 = stream->rigamma(nu2, delta2);
- }
+ SSE = t(theta1-meanc(theta1)) * P * (theta1 - meanc(theta1));
+ nu2 = (nu1 + ntables)*0.5;
+ delta2 = (delta1 + SSE[0])*0.5;
+ sigma_theta1 = stream.rigamma(nu2, delta2);
+ }
- // allow user interrupts
- R_CheckUserInterrupt();
- // @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+ // allow user interrupts
+ R_CheckUserInterrupt();
+ // @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
- // sampling constants
- const double w = mean(widthmat);
- int p_temp = 2;
- while ((w * pow(2.0, p_temp) ) < max(widthmat)){
- ++p_temp;
- }
- const int p = p_temp + 1;
+ // sampling constants
+ const double w = mean(widthmat);
+ int p_temp = 2;
+ while ((w * pow(2.0, p_temp) ) < max(widthmat)){
+ ++p_temp;
+ }
+ const int p = p_temp + 1;
- // @@@@@@@@@@ the real sampling takes place here @@@@@@@@@@@@@@
- for (int iter=0; iter<tot_iter; ++iter){
- // loop over tables
- for (int i=0; i<ntables; ++i){
- const double mu0 = ((W(i,_) * theta0) / W_sum[i])[0];
- const double mu1 = ((W(i,_) * theta1) / W_sum[i])[0];
- const double sigma0 = sigma_theta0/W_sum[i];
- const double sigma1 = sigma_theta1/W_sum[i];
+ // @@@@@@@@@@ the real sampling takes place here @@@@@@@@@@@@@@
+ for (unsigned int iter=0; iter<tot_iter; ++iter){
+ // loop over tables
+ for (unsigned int i=0; i<ntables; ++i){
+ const double mu0 = ((W(i,_) * theta0) / W_sum[i])[0];
+ const double mu1 = ((W(i,_) * theta1) / W_sum[i])[0];
+ const double sigma0 = sigma_theta0/W_sum[i];
+ const double sigma1 = sigma_theta1/W_sum[i];
- // sample theta0, theta1 using slice sampling
- for (int index = 0; index<2; ++index){
- double theta_i[2];
- theta_i[0] = theta0[i];
- theta_i[1] = theta1[i];
- double funval = Lev1thetaPost(theta_i, r0[i], r1[i], c0[i],
- mu0, mu1, sigma0, sigma1);
+ // sample theta0, theta1 using slice sampling
+ for (unsigned int index = 0; index<2; ++index){
+ double theta_i[2];
+ theta_i[0] = theta0[i];
+ theta_i[1] = theta1[i];
+ double funval = Lev1thetaPost(theta_i, r0[i], r1[i], c0[i],
+ mu0, mu1, sigma0, sigma1);
- double z = funval - stream->rexp(1.0);
- doubling(&Lev1thetaPost, theta_i, index, z, w, p, r0[i],
- r1[i], c0[i], mu0, mu1, sigma0, sigma1, stream, L, R);
+ double z = funval - stream.rexp(1.0);
+ doubling(&Lev1thetaPost, theta_i, index, z, w, p, r0[i],
+ r1[i], c0[i], mu0, mu1, sigma0, sigma1, stream, L, R);
- //Rprintf("L = %10.5f R = %10.5f\n", L, R);
+ //Rprintf("L = %10.5f R = %10.5f\n", L, R);
- theta_i[index] = shrinkage(&Lev1thetaPost, theta_i, index, z, w,
- r0[i], r1[i], c0[i], mu0, mu1,
- sigma0, sigma1, stream, L, R);
+ theta_i[index] = shrinkage(&Lev1thetaPost, theta_i, index, z, w,
+ r0[i], r1[i], c0[i], mu0, mu1,
+ sigma0, sigma1, stream, L, R);
- theta0[i] = theta_i[0];
- theta1[i] = theta_i[1];
- } // end index loop
+ theta0[i] = theta_i[0];
+ theta1[i] = theta_i[1];
+ } // end index loop
// if after burnin store samples
- if ((iter >= burnin) && ((iter%thin)==0)){
- p0mat(count,i) = 1.0/(1.0 + exp(-1*theta0[i]));
- p1mat(count,i) = 1.0/(1.0 + exp(-1*theta1[i]));
- }
- } // end tables loop
+ if ((iter >= burnin) && ((iter%thin)==0)){
+ p0mat(count,i) = 1.0/(1.0 + exp(-1*theta0[i]));
+ p1mat(count,i) = 1.0/(1.0 + exp(-1*theta1[i]));
+ }
+ } // end tables loop
// sample sigma_theta0 and sigma_theta1
- Matrix<double> SSE = t(theta0-meanc(theta0)) * P *
- (theta0 - meanc(theta0));
- double nu2 = (nu0 + ntables)*0.5;
- double delta2 = (delta0 + SSE[0])*0.5;
- sigma_theta0 = stream->rigamma(nu2, delta2);
+ Matrix<double> SSE = t(theta0-meanc(theta0)) * P *
+ (theta0 - meanc(theta0));
+ double nu2 = (nu0 + ntables)*0.5;
+ double delta2 = (delta0 + SSE[0])*0.5;
+ sigma_theta0 = stream.rigamma(nu2, delta2);
- SSE = t(theta1-meanc(theta1)) * P * (theta1 - meanc(theta1));
- nu2 = (nu1 + ntables)*0.5;
- delta2 = (delta1 + SSE[0])*0.5;
- sigma_theta1 = stream->rigamma(nu2, delta2);
+ SSE = t(theta1-meanc(theta1)) * P * (theta1 - meanc(theta1));
+ nu2 = (nu1 + ntables)*0.5;
+ delta2 = (delta1 + SSE[0])*0.5;
+ sigma_theta1 = stream.rigamma(nu2, delta2);
- if ((iter >= burnin) && ((iter%thin)==0)){
- sig0mat(count,0) = sigma_theta0;
- sig1mat(count,0) = sigma_theta1;
- ++count;
- }
+ if ((iter >= burnin) && ((iter%thin)==0)){
+ sig0mat(count,0) = sigma_theta0;
+ sig1mat(count,0) = sigma_theta1;
+ ++count;
+ }
- // print output to screen
- if (verbose>0 && (iter%verbose)==0){
- Rprintf("\nMCMCdynamicEI iteration %i of %i \n", (iter+1),
- tot_iter);
- }
-
- // allow user interrupts
- R_CheckUserInterrupt();
+ // print output to screen
+ if (verbose>0 && (iter%verbose)==0){
+ Rprintf("\nMCMCdynamicEI iteration %i of %i \n", (iter+1),
+ tot_iter);
}
- delete stream; // clean up random number stream
- // return sample
- Matrix<double> storeagem = cbind(p0mat, p1mat);
- storeagem = cbind(storeagem, sig0mat);
- storeagem = cbind(storeagem, sig1mat);
- int mat_size = samrow[0] * samcol[0];
- for (int i=0; i<mat_size; ++i)
- sample[i] = storeagem[i];
+ // allow user interrupts
+ R_CheckUserInterrupt();
+ }
+
+
+ // return sample
+ result = cbind(p0mat, p1mat);
+ result = cbind(result, sig0mat);
+ result = cbind(result, sig1mat);
+
+
+}
+
+
+
+
+
+
+
+extern "C"{
+
+ void dynamicEI(double* sample, const int* samrow, const int* samcol,
+ const double* Rr0, const double* Rr1, const double* Rc0,
+ const double* Rc1, const int* Rntables, const int* Rburnin,
+ const int* Rmcmc, const int* Rthin,
+ const double* RW, const double* Rnu0,
+ const double* Rdelta0, const double* Rnu1,
+ const double* Rdelta1, const int* Rverbose,
+ const int *uselecuyer, const int *seedarray,
+ const int *lecuyerstream){
+
+
+ // load data
+ // table notation is:
+ // --------------------
+ // Y0 | | r0
+ // --------------------
+ // Y1 | | r1
+ // --------------------
+ // c0 | c1 | N
+
+
+ const int ntables = *Rntables;
+
+ const Matrix<> r0(ntables, 1, Rr0);
+ const Matrix<> r1(ntables, 1, Rr1);
+ const Matrix<> c0(ntables, 1, Rc0);
+ const Matrix<> c1(ntables, 1, Rc1);
+
+ const Matrix<double> W(ntables, ntables, RW);
+
+ Matrix<double,Row> result(*samrow, *samcol, false);
+ MCMCPACK_PASSRNG2MODEL(MCMCdynamicEI_impl, r0, r1, c0, c1, W,
+ *Rnu0, *Rdelta0,
+ *Rnu1, *Rdelta1,
+ ntables, *Rburnin, *Rmcmc,
+ *Rthin, *Rverbose, result);
+
+ for (unsigned int i = 0; i < result.size(); ++i)
+ sample[i] = result[i];
+
}
} // extern "C"
+
+
+#endif
diff --git a/src/MCMCfactanal.cc b/src/MCMCfactanal.cc
index 386018e..723e5ba 100644
--- a/src/MCMCfactanal.cc
+++ b/src/MCMCfactanal.cc
@@ -18,9 +18,15 @@
//
// revised version of older MCMCfactanal 5/11/2004 KQ
// updated to new verion of scythe 7/25/2004 ADM
+// updated to Scythe 1.0.X 7/10/2007 ADM
+// finished update to Scythe 1.0.X 7/30/2007 KQ
+//
+#ifndef MCMCFACTANAL_CC
+#define MCMCFACTANAL_CC
#include "matrix.h"
+#include "algorithm.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
@@ -32,18 +38,137 @@
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
+typedef Matrix<double,Row,View> rmview;
+
using namespace std;
+using namespace scythe;
+
+template <typename RNGTYPE>
+void MCMCfactanal_impl (rng<RNGTYPE>& stream, const Matrix<>& X,
+ Matrix<>& Lambda,
+ Matrix<>& Psi, Matrix<>& Psi_inv,
+ const Matrix<>& Lambda_eq,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& a0, const Matrix<>& b0,
+ unsigned int burnin, unsigned int mcmc,
+ unsigned int thin,
+ unsigned int verbose,
+ unsigned int storescores, Matrix<>& result) {
+
+ // constants
+ const unsigned int K = X.cols(); // number of manifest variables
+ const unsigned int N = X.rows(); // number of observations
+ const unsigned int D = Lambda.cols(); // number of factors
+ const unsigned int tot_iter = burnin + mcmc;
+ const unsigned int nsamp = mcmc / thin;
+ const Matrix<> I = eye(D);
+ const Matrix<> Lambda_free_indic = Matrix<>(K, D);
+ for (unsigned int i=0; i<(K*D); ++i){
+ if (Lambda_eq[i] == -999) Lambda_free_indic[i] = 1.0;
+ }
+
+
+ // starting value for phi
+ Matrix<> phi = Matrix<>(N,D);
+
+ // storage matrices (row major order)
+ Matrix<> Lambda_store = Matrix<>(nsamp, K*D);
+ Matrix<> Psi_store = Matrix<>(nsamp, K);
+ Matrix<> phi_store;
+ if (storescores==1){
+ phi_store = Matrix<double>(nsamp, N*D);
+ }
+
-// ADD USER-DEFINED FUNCTIONS HERE
+ unsigned int count = 0;
+ // sampling begins here
+ for (unsigned int iter=0; iter < tot_iter; ++iter){
+
+ // sample phi
+ NormNormfactanal_phi_draw(phi, I, Lambda, Psi_inv,
+ X, N, D, stream);
-extern "C" {
+
+ // sample Lambda
+ NormNormfactanal_Lambda_draw(Lambda, Lambda_free_indic,
+ Lambda_prior_mean,
+ Lambda_prior_prec,
+ phi, X, Psi_inv,
+ Lambda_ineq,
+ D, K, stream);
+
+
+ // sample Psi
+ NormIGfactanal_Psi_draw(Psi, X, phi, Lambda,
+ a0, b0, K, N, stream);
+
+
+ for (unsigned int i=0; i<K; ++i)
+ Psi_inv(i,i) = 1.0 / Psi(i,i);
+
+
+
+ // print results to screen
+ if (verbose > 0 && iter % verbose == 0){
+ Rprintf("\n\nMCMCfactanal iteration %i of %i \n", (iter+1), tot_iter);
+ Rprintf("Lambda = \n");
+ for (unsigned int i=0; i<K; ++i){
+ for (unsigned int j=0; j<D; ++j){
+ Rprintf("%10.5f", Lambda(i,j));
+ }
+ Rprintf("\n");
+ }
+ Rprintf("diag(Psi) = \n");
+ for (unsigned int i=0; i<K; ++i){
+ Rprintf("%10.5f", Psi(i,i));
+ }
+ Rprintf("\n");
+ }
+
+ // store results
+ if ((iter % thin)==0 && iter >= burnin ) {
+ // store Lambda
+ //Matrix<> Lambda_store_vec = Lambda.resize(1, K*D, true);
+ //for (int l=0; l<K*D; ++l)
+ //Lambda_store(count, l) = Lambda(l);
+ rmview(Lambda_store(count, _)) = Lambda;
+
+ // store Psi
+ for (unsigned int i=0; i<K; ++i)
+ Psi_store(count, i) = Psi(i,i);
+ // stop phi
+ if (storescores==1){
+ //Matrix<> phi_store_vec = phi.resize(1, N*D, true);
+ //for (int l=0; l<N*D; ++l)
+ // phi_store(count, l) = phi(l);
+ rmview(phi_store(count, _)) = phi;
+ }
+ count++;
+ }
+
+ // allow user interrupts
+ R_CheckUserInterrupt();
+
+ } // end Gibbs loop
+
+ // return output
+ //Matrix<double> result;
+ result = cbind(Lambda_store, Psi_store);
+ if(storescores == 1) {
+ result = cbind(result, phi_store);
+ }
- // BRIEF FUNCTION DESCRIPTION
+}
+
+
+extern "C" {
+
void MCMCfactanal(double *sampledata, const int *samplerow,
const int *samplecol, const double *Xdata,
const int *Xrow, const int *Xcol, const int *burnin,
- const int *mcmc, const int *thin, const int *lecuyer,
+ const int *mcmc, const int *thin, const int *uselecuyer,
const int *seedarray, const int *lecuyerstream,
const int *verbose, const double *Lambdadata,
const int *Lambdarow, const int *Lambdacol,
@@ -60,129 +185,36 @@ extern "C" {
const int *b0col, const int *storescores) {
// pull together Matrix objects
- const Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix <double> Lambda = r2scythe(*Lambdarow, *Lambdacol, Lambdadata);
- Matrix <double> Psi = r2scythe(*Psirow, *Psicol, Psidata);
- Matrix <double> Psi_inv = invpd(Psi);
- const Matrix <double> Lambda_eq = r2scythe(*Lameqrow, *Lameqcol,
- Lameqdata);
- const Matrix <double> Lambda_ineq = r2scythe(*Lamineqrow, *Lamineqcol,
- Lamineqdata);
- const Matrix <double> Lambda_prior_mean = r2scythe(*Lampmeanrow,
- *Lampmeancol,
- Lampmeandata);
- const Matrix <double> Lambda_prior_prec = r2scythe(*Lampprecrow,
- *Lamppreccol,
- Lampprecdata);
- const Matrix <double> a0 = r2scythe(*a0row, *a0col, a0data);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // constants
- const int K = X.cols(); // number of manifest variables
- const int N = X.rows(); // number of observations
- const int D = Lambda.cols(); // number of factors
- const int tot_iter = *burnin + *mcmc;
- const int nsamp = *mcmc / *thin;
- const Matrix<double> I = eye<double>(D);
- const Matrix<double> Lambda_free_indic = Matrix<double>(K, D);
- for (int i=0; i<(K*D); ++i){
- if (Lambda_eq[i] == -999) Lambda_free_indic[i] = 1.0;
- }
-
- // starting value for phi
- Matrix<double> phi = Matrix<double>(N,D);
-
- // storage matrices (row major order)
- Matrix<double> Lambda_store = Matrix<double>(nsamp, K*D);
- Matrix<double> Psi_store = Matrix<double>(nsamp, K);
- Matrix<double> phi_store;
- if (*storescores==1){
- phi_store = Matrix<double>(nsamp, N*D);
- }
+ const Matrix <> X(*Xrow, *Xcol, Xdata);
+ Matrix <> Lambda(*Lambdarow, *Lambdacol, Lambdadata);
+ Matrix <> Psi(*Psirow, *Psicol, Psidata);
+ Matrix <> Psi_inv = invpd(Psi);
+ const Matrix <> Lambda_eq(*Lameqrow, *Lameqcol,
+ Lameqdata);
+ const Matrix <> Lambda_ineq(*Lamineqrow, *Lamineqcol,
+ Lamineqdata);
+ const Matrix <> Lambda_prior_mean(*Lampmeanrow,
+ *Lampmeancol,
+ Lampmeandata);
+ const Matrix <> Lambda_prior_prec(*Lampprecrow,
+ *Lamppreccol,
+ Lampprecdata);
+ const Matrix <> a0(*a0row, *a0col, a0data);
+ const Matrix <> b0(*b0row, *b0col, b0data);
+ Matrix<> storagematrix;
- int count = 0;
- // sampling begins here
- for (int iter=0; iter < tot_iter; ++iter){
-
- // sample phi
- NormNormfactanal_phi_draw(phi, I, Lambda, Psi_inv, X, N, D, stream);
-
- // sample Lambda
- NormNormfactanal_Lambda_draw(Lambda, Lambda_free_indic,
- Lambda_prior_mean,
- Lambda_prior_prec,
- phi, X, Psi_inv, Lambda_ineq,
- D, K, stream);
- // sample Psi
- NormIGfactanal_Psi_draw(Psi, X, phi, Lambda, a0, b0, K, N, stream);
- for (int i=0; i<K; ++i)
- Psi_inv(i,i) = 1.0 / Psi(i,i);
-
-
- // print results to screen
- if (verbose[0] > 0 && iter % verbose[0] == 0){
- Rprintf("\n\nMCMCfactanal iteration %i of %i \n", (iter+1), tot_iter);
- Rprintf("Lambda = \n");
- for (int i=0; i<K; ++i){
- for (int j=0; j<D; ++j){
- Rprintf("%10.5f", Lambda(i,j));
- }
- Rprintf("\n");
- }
- Rprintf("diag(Psi) = \n");
- for (int i=0; i<K; ++i){
- Rprintf("%10.5f", Psi(i,i));
- }
- Rprintf("\n");
- }
-
- // store results
- if ((iter % thin[0])==0 && iter >= burnin[0] ) {
- // store Lambda
- Matrix<double> Lambda_store_vec = reshape(Lambda,1,K*D);
- for (int l=0; l<K*D; ++l)
- Lambda_store(count, l) = Lambda_store_vec[l];
- // store Psi
- for (int i=0; i<K; ++i)
- Psi_store(count, i) = Psi(i,i);
- // stop phi
- if (*storescores==1){
- Matrix<double> phi_store_vec = reshape(phi, 1, N*D);
- for (int l=0; l<N*D; ++l)
- phi_store(count, l) = phi_store_vec[l];
- }
- count++;
- }
-
- // allow user interrupts
- R_CheckUserInterrupt();
-
- } // end Gibbs loop
-
- delete stream; // clean up random number stream
-
- // return output
-
- Matrix<double> output = cbind(Lambda_store, Psi_store);
- if(*storescores == 1) {
- output = cbind(output, phi_store);
- }
-
- const int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = output[i];
+ MCMCPACK_PASSRNG2MODEL(MCMCfactanal_impl, X, Lambda, Psi, Psi_inv,
+ Lambda_eq, Lambda_ineq, Lambda_prior_mean,
+ Lambda_prior_prec,
+ a0, b0, *burnin, *mcmc, *thin,
+ *verbose, *storescores, storagematrix);
+ const unsigned int size = *samplerow * *samplecol;
+ for (unsigned int i = 0; i < size; ++i)
+ sampledata[i] = storagematrix(i);
}
-
}
-
-
-
-
-
+#endif
diff --git a/src/MCMCfcds.cc b/src/MCMCfcds.cc
deleted file mode 100644
index ccb2349..0000000
--- a/src/MCMCfcds.cc
+++ /dev/null
@@ -1,400 +0,0 @@
-// MCMCfcds.cc contains definitions for a number of functions that
-// produce draws from full conditional distributions.
-//
-// Andrew D. Martin
-// Dept. of Political Science
-// Washington University in St. Louis
-// admartin at wustl.edu
-//
-// Kevin M. Quinn
-// Dept. of Government
-// Harvard University
-// kevin_quinn at harvard.edu
-//
-// This software is distributed under the terms of the GNU GENERAL
-// PUBLIC LICENSE Version 2, June 1991. See the package LICENSE
-// file for more information.
-//
-// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
-//
-// KQ 6/10/2004
-// modified to meet the new developer spec KQ 6/18/2004
-// update to new Scythe version ADM 7/24/2004
-
-#ifndef MCMCFCDS_CC
-#define MCMCFCDS_CC
-
-#include "rng.h"
-#include "distributions.h"
-#include "stat.h"
-#include "smath.h"
-#include "la.h"
-#include "ide.h"
-#include "error.h"
-#include "smath.h"
-
-namespace SCYTHE {
-
- // linear regression with Gaussian errors beta draw
- // (multivariate Normal prior)
- // regression model is y = X * beta + epsilon, epsilon ~ N(0,sigma2)
- // XpX is X'X
- // XpY is X'y
- // b0 is the prior mean of beta
- // B0 is the prior precision (the inverse variance) of beta
- Matrix<double>
- NormNormregress_beta_draw (const Matrix <double> &XpX,
- const Matrix <double> &XpY,
- const Matrix <double> &b0,
- const Matrix <double> &B0,
- const double &sigma2,
- rng *stream){
-
- // this function gets the cross-product matrix X'X and the matrix X'Y
- // to minimize the amount of computation within the function
- const int k = XpX.cols ();
- const double sig2_inv = 1.0 / sigma2;
- const Matrix <double> sig_beta = invpd (B0 + XpX * sig2_inv);
- const Matrix <double> C = cholesky (sig_beta);
- const Matrix <double> betahat = sig_beta *
- gaxpy(B0, b0, XpY*sig2_inv);
-
- return( gaxpy(C, stream->rnorm(k,1), betahat) );
- }
-
- // linear regression with Gaussian errors sigma2 draw
- // (inverse-Gamma prior)
- // regression model is y = X * beta + epsilon, epsilon ~ N(0,sigma2)
- // c0/2 is the prior shape parameter for sigma2
- // d0/2 is the prior scale parameter for sigma2
- double
- NormIGregress_sigma2_draw (const Matrix <double> &X,
- const Matrix <double> &Y,
- const Matrix <double> &beta,
- const double& c0,
- const double& d0,
- rng *stream){
-
- const Matrix <double> e = gaxpy(X, (-1*beta), Y);
- const Matrix <double> SSE = crossprod (e);
- const double c_post = (c0 + X.rows ()) * 0.5;
- const double d_post = (d0 + SSE[0]) * 0.5;
-
- return stream->rigamma (c_post, d_post);
- }
-
- // factor analysis model with normal mean 0, precision F0 prior on
- // factor scores
- // X follows a multivariate normal distribution
- // Lambda is the matrix of factor loadings
- // Psi_inv is the inverse of the uniqueness matrix
- // N is number of observations
- // D is the number of factors
- // this function draws the factor scores
- //
- // IMPORTANT
- // ***********Psi_inv IS ASSUMED TO DIAGONAL ***********
- void
- NormNormfactanal_phi_draw(Matrix<double> &phi,
- const Matrix<double> &F0,
- const Matrix<double> &Lambda,
- const Matrix<double> &Psi_inv,
- const Matrix<double> &X,
- const int& N, const int& D,
- rng *stream){
- // If Psi_inv is *not* diagonal then use:
- // Matrix<double> phi_post_var = invpd(F0 + t(Lambda) * Psi_inv *
- // Lambda);
- //Instead of the following 2 lines:
- const Matrix<double> AAA = SCYTHE::sqrt(Psi_inv) * Lambda;
- const Matrix<double> phi_post_var = invpd(F0 + crossprod(AAA));
-
- const Matrix<double> phi_post_C = cholesky(phi_post_var);
- for (int i=0; i<N; ++i){
- const Matrix<double> phi_post_mean = phi_post_var *
- (t(Lambda) * Psi_inv * t(X(i,_)));
- const Matrix<double> phi_samp = gaxpy(phi_post_C, stream->rnorm(D, 1),
- phi_post_mean);
- for (int j=0; j<D; ++j)
- phi(i,j) = phi_samp[j];
- }
- }
-
- // Psi_inv assumed diagnonal
- // this function draws the factor loading matrix
- void
- NormNormfactanal_Lambda_draw(Matrix<double>& Lambda,
- const Matrix<double> &Lambda_free_indic,
- const Matrix<double> &Lambda_prior_mean,
- const Matrix<double> &Lambda_prior_prec,
- const Matrix<double> &phi,
- const Matrix<double> &X,
- const Matrix<double> &Psi_inv,
- const Matrix<double> &Lambda_ineq,
- const int& D, const int& K,
- rng *stream) {
-
- for (int i=0; i<K; ++i){
- const Matrix<double> free_indic = t(Lambda_free_indic(i,_));
- const Matrix<double> not_free_indic = (free_indic-1)*-1;
- if (sumc(free_indic)[0] > 0 &&
- sumc(not_free_indic)[0] > 0){ // both constrnd & unconstrnd
- const Matrix<double> phifree_i = t(selif(t(phi), free_indic));
- const Matrix<double> mulamfree_i = selif(t(Lambda_prior_mean(i,_)),
- free_indic); // prior mean
- const Matrix<double> hold = selif(t(Lambda_prior_prec(i,_)),
- free_indic);
- Matrix<double> sig2lamfree_inv_i =
- eye<double>(hold.rows()); // prior prec
- for (int j=0; j<(hold.rows()); ++j)
- sig2lamfree_inv_i(j,j) = hold[j];
- const Matrix<double> Lambdacon_i =
- selif(t(Lambda(i,_)), not_free_indic);
- const Matrix<double> phicon_i = t(selif(t(phi), not_free_indic));
- const Matrix<double> newX_i = gaxpy((-1.0*phicon_i), Lambdacon_i,
- X(_,i));
- const Matrix<double> Lam_post_var = invpd(sig2lamfree_inv_i +
- Psi_inv(i,i) *
- crossprod(phifree_i));
- const Matrix<double> Lam_post_C = cholesky(Lam_post_var);
- const Matrix<double> Lam_post_mean = Lam_post_var *
- (sig2lamfree_inv_i * mulamfree_i + Psi_inv(i,i) *
- t(phifree_i) * newX_i);
-
- Matrix<double> Lambdafree_i =
- gaxpy(Lam_post_C, stream->rnorm(hold.rows(), 1), Lam_post_mean);
-
- // check to see if inequality constraints hold
- const Matrix<double> Lambda_ineq_vec = Lambda_ineq(i,_);
- double ineq_holds = 0;
- int Lam_count = 0;
- for (int j=0; j<D; ++j){
- if (free_indic[j]==1)
- ineq_holds = std::min(ineq_holds,
- Lambda_ineq_vec[j] *
- Lambdafree_i[Lam_count]);
- ++Lam_count;
- }
- while (ineq_holds < 0){
- Lambdafree_i =
- gaxpy(Lam_post_C, stream->rnorm(hold.rows(), 1), Lam_post_mean);
- Lam_count = 0;
- double test = 0;
- for (int j=0; j<D; ++j){
- if (free_indic[j]==1){
- Matrix<double> prodcheck =
- Lambda_ineq_vec[j]*Lambdafree_i[Lam_count];
- test = std::min(test, prodcheck[0]);
- ++Lam_count;
- }
- }
- ineq_holds = test;
- }
-
- // put draw into Lambda
- Lam_count = 0;
- for (int j=0; j<D; ++j){
- if (free_indic[j] == 1){
- Lambda(i,j) = Lambdafree_i[Lam_count];
- ++Lam_count;
- }
- }
- }
- else if (sumc(free_indic)[0] > 0){ // just unconstrained
- const Matrix<double> phifree_i = t(selif(t(phi), free_indic));
- const Matrix<double> mulamfree_i = selif(t(Lambda_prior_mean(i,_)),
- free_indic); // prior mean
- const Matrix<double> hold = selif(t(Lambda_prior_prec(i,_)),
- free_indic);
- Matrix<double> sig2lamfree_inv_i =
- eye<double>(hold.rows()); // prior prec
- for (int j=0; j<hold.rows(); ++j)
- sig2lamfree_inv_i(j,j) = hold[j];
- const Matrix<double> Lam_post_var = invpd(sig2lamfree_inv_i +
- Psi_inv(i,i) *
- crossprod(phifree_i));
- const Matrix<double> Lam_post_C = cholesky(Lam_post_var);
- const Matrix<double> Lam_post_mean = Lam_post_var *
- (sig2lamfree_inv_i * mulamfree_i + Psi_inv(i,i) *
- t(phifree_i) * X(_,i));
- Matrix<double> Lambdafree_i =
- gaxpy(Lam_post_C, stream->rnorm(hold.rows(), 1), Lam_post_mean);
-
- // check to see if inequality constraints hold
- Matrix<double> Lambda_ineq_vec = Lambda_ineq(i,_);
- double ineq_holds = 0;
- for (int j=0; j<D; ++j){
- ineq_holds =
- std::min(ineq_holds, Lambda_ineq_vec[j]*Lambdafree_i[j]);
- }
- while (ineq_holds < 0){
- Lambdafree_i =
- gaxpy(Lam_post_C, stream->rnorm(hold.rows(), 1), Lam_post_mean);
- double test = 0;
- for (int j=0; j<D; ++j){
- //if (free_indic[j]==1)
- double prodcheck = Lambda_ineq_vec[j]*Lambdafree_i[j];
- test = std::min(test, prodcheck);
- }
- ineq_holds = test;
- }
-
- // put draw into Lambda
- for (int j=0; j<D; ++j){
- Lambda(i,j) = Lambdafree_i[j];
- }
- }
- }
-
- // return(Lambda);
- }
-
-
- // samples the Psi matrix for a Normal theory factor model with IG
- // prior on diag elements of Psi
- void
- NormIGfactanal_Psi_draw(Matrix<double> &Psi, const Matrix<double> &X,
- const Matrix<double> &phi,
- const Matrix<double> &Lambda,
- const Matrix<double> &a0,
- const Matrix<double> &b0,
- const int& K, const int&N,
- rng *stream){
- for (int i=0; i<K; ++i){
- const Matrix<double> epsilon = gaxpy(phi, -1*(t(Lambda(i,_))), X(_,i));
- const Matrix<double> SSE = crossprod(epsilon);
- const double a1 = (a0[i] + N)*0.5;
- const double b1 = (b0[i] + SSE[0])*0.5;
- Psi(i,i) = stream->rigamma(a1, b1);
- }
- }
-
-
- // update latent data for standard item response models
- // only works for 1 dimensional case
- void irt_Z_update1 (Matrix<double> &Z, const Matrix<int>& X,
- const Matrix<double> &theta,
- const Matrix<double> &eta, rng *stream) {
- // define constants
- const int J = theta.rows();
- const int K = eta.rows();
-
- // perform update from truncated Normal / standard Normals
- for (int i=0; i<J; ++i) {
- for (int j=0; j<K; ++j){
- const double Z_mean = -eta(j,0) + theta[i] * eta(j,1);
- if (X(i,j) == 1){
- Z(i,j) = stream->rtbnorm_combo(Z_mean, 1.0, 0);
- }
- else if (X(i,j) == 0){
- Z(i,j) = stream->rtanorm_combo(Z_mean, 1.0, 0);
- }
- else {
- Z(i,j) = stream->rnorm(Z_mean, 1.0);
- }
- }
- }
- }
-
- // update item (case, roll call) parameters for item response model
- // note: works only for one-dimensional case
- void
- irt_eta_update1 (Matrix<double> & eta, const Matrix<double> & Z,
- const Matrix<double> & theta,
- const Matrix<double> & ab0,
- const Matrix<double> & AB0,
- rng *stream) {
-
- // define constants
- const int J = theta.rows();
- const int K = Z.cols();
- const Matrix<double> AB0ab0 = AB0 * ab0;
-
- // perform update
- //const Matrix<double> Ttheta_star = t(cbind(-1.0*ones<double>(J,1),theta)); // only needed for option 2
- const Matrix<double> tpt(2,2);
- for (int i=0; i<J; ++i){
- const double theta_i = theta[i];
- tpt(0,1) -= theta_i;
- tpt(1,1) += std::pow(theta_i, 2.0);
- }
- tpt(1,0) = tpt(0,1);
- tpt(0,0) = J;
- const Matrix<double> eta_post_var = invpd(tpt + AB0);
- const Matrix<double> eta_post_C = cholesky(eta_post_var);
-
- for (int k=0; k<K; ++k){
- const Matrix<double> TZ(2, 1);
- for (int j=0; j<J; ++j){
- TZ[0] -= Z(j,k);
- TZ[1] += Z(j,k) * theta[j];
- }
- const Matrix<double> eta_post_mean = eta_post_var *
- (TZ + AB0ab0);
- const Matrix<double> new_eta = gaxpy(eta_post_C,
- stream->rnorm(2, 1),
- eta_post_mean);
- eta(k,0) = new_eta[0];
- eta(k,1) = new_eta[1];
- }
- }
-
- // update ability parameters (ideal points) for one dimensional
- // item response model
- // note: works only for one-dimensional case
- void
- irt_theta_update1 (Matrix<double>& theta, const Matrix<double> & Z,
- const Matrix<double> & eta,
- const double& t0, const double& T0,
- const Matrix<double>& theta_eq,
- const Matrix<double>& theta_ineq,
- rng *stream) {
-
- const int J = Z.rows();
- const int K = Z.cols();
-
- // perform update from multivariate Normal
- const double T0t0 = T0*t0;
- const Matrix<double> alpha = eta(_, 0);
- const Matrix<double> beta = eta(_, 1);
- //const Matrix<double> tbeta = t(beta); // only neede for option 2
- //const Matrix<double> talpha = t(alpha); // only needed for option 2
-
- // calculate the posterior variance outside the justice specific loop
- double theta_post_var = T0;
- for (int i=0; i<K; ++i)
- theta_post_var += std::pow(beta[i], 2.0);
- theta_post_var = 1.0/theta_post_var;
- const double theta_post_sd = std::sqrt(theta_post_var);
-
- // sample for each justice
- for (int j=0; j<J; ++j) {
- // no equality constraints
- if (theta_eq[j] == -999){
- double betaTZjalpha = 0;
- for (int k=0; k<K; ++k)
- betaTZjalpha += beta[k] * (Z(j,k) + alpha[k]);
- const double theta_post_mean = theta_post_var *
- (T0t0 + betaTZjalpha);
-
- if (theta_ineq[j] == 0){ // no inequality constraint
- theta[j] = theta_post_mean + stream->rnorm(0.0, theta_post_sd);
- }
- else if (theta_ineq[j] > 0){ // theta[j] > 0
- theta[j] = stream->rtbnorm_combo(theta_post_mean,
- theta_post_var, 0);
- }
- else { // theta[j] < 0
- theta[j] = stream->rtanorm_combo(theta_post_mean,
- theta_post_var, 0);
- }
- }
- else { // equality constraints
- theta[j] = theta_eq[j];
- }
- }
-
- }
-
-}// end namespace SCYTHE
-#endif
diff --git a/src/MCMCfcds.h b/src/MCMCfcds.h
index 013dbf4..e3df141 100644
--- a/src/MCMCfcds.h
+++ b/src/MCMCfcds.h
@@ -19,82 +19,405 @@
// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
//
// KQ 6/10/2004
+// DBP 7/01/2007 [ported to scythe 1.0.x (partial)]
#ifndef MCMCFCDS_H
#define MCMCFCDS_H
#include "matrix.h"
+#include "rng.h"
+#include "stat.h"
#include "smath.h"
-#include <cfloat>
-
-namespace SCYTHE {
-
- // linear regression with Gaussian errors beta draw (multivariate Normal
- // prior)
- Matrix<double>
- NormNormregress_beta_draw (const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const double &,
- rng *);
-
- // linear regression with Gaussian errors sigma2 draw (inverse-Gamma
- // prior)
- double
- NormIGregress_sigma2_draw (const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const double &,
- const double &,
- rng *);
- // factor scores with N(0, F0^-1) prior
- void
- NormNormfactanal_phi_draw (Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const int&, const int&,
- rng *);
+#include "ide.h"
+#include "la.h"
+#include "distributions.h"
+
+#include <iostream>
+using namespace std;
+
+using namespace scythe;
+
+// linear regression with Gaussian errors beta draw
+// (multivariate Normal prior)
+// regression model is y = X * beta + epsilon, epsilon ~ N(0,sigma2)
+// XpX is X'X
+// XpY is X'y
+// b0 is the prior mean of beta
+// B0 is the prior precision (the inverse variance) of beta
+template <typename RNGTYPE>
+Matrix<double>
+NormNormregress_beta_draw (const Matrix<>& XpX, const Matrix<>& XpY,
+ const Matrix<>& b0, const Matrix<>& B0, double sigma2,
+ rng<RNGTYPE>& stream)
+{
+ // this function gets the cross-product matrix X'X and the matrix X'Y
+ // to minimize the amount of computation within the function
+ const unsigned int k = XpX.cols ();
+ const double sig2_inv = 1.0 / sigma2;
+ const Matrix<> sig_beta = invpd (B0 + XpX * sig2_inv);
+ const Matrix<> C = cholesky (sig_beta);
+ const Matrix<> betahat = sig_beta * gaxpy(B0, b0, XpY*sig2_inv);
+
+ return( gaxpy(C, stream.rnorm(k,1, 0, 1), betahat) );
+}
+
+// linear regression with Gaussian errors sigma2 draw
+// (inverse-Gamma prior)
+// regression model is y = X * beta + epsilon, epsilon ~ N(0,sigma2)
+// c0/2 is the prior shape parameter for sigma2
+// d0/2 is the prior scale parameter for sigma2
+template <typename RNGTYPE>
+double
+NormIGregress_sigma2_draw (const Matrix <> &X, const Matrix <> &Y,
+ const Matrix <> &beta, double c0, double d0,
+ rng<RNGTYPE>& stream)
+{
- // factor loading matrix
- void
- NormNormfactanal_Lambda_draw(Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const int&, const int&,
- rng *);
-
- // samples the Psi matrix for a Normal theory factor model with IG
- // prior on diag elements of Psi
- void
- NormIGfactanal_Psi_draw(Matrix<double> &, const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const Matrix<double> &,
- const int&, const int&,
- rng *);
-
- // updates for MCMCirt1d
- void irt_Z_update1(Matrix<double> &, const Matrix<int> &,
- const Matrix<double> &, const Matrix<double> &,
- rng *);
+ const Matrix <> e = gaxpy(X, (-1*beta), Y);
+ const Matrix <> SSE = crossprod (e);
+ const double c_post = (c0 + X.rows ()) * 0.5;
+ const double d_post = (d0 + SSE[0]) * 0.5;
+
+ return stream.rigamma (c_post, d_post);
+}
+
+// update latent data for standard item response models
+// only works for 1 dimensional case
+template <typename RNGTYPE>
+void irt_Z_update1 (Matrix<>& Z, const Matrix<int>& X,
+ const Matrix<>& theta, const Matrix<>& eta, rng<RNGTYPE>& stream)
+{
+ // define constants
+ const unsigned int J = theta.rows();
+ const unsigned int K = eta.rows();
- void irt_eta_update1(Matrix<double> &, const Matrix<double> &,
- const Matrix<double> &, const Matrix<double> &,
- const Matrix<double> &, rng *);
+ // perform update from truncated Normal / standard Normals
+ for (unsigned int i = 0; i < J; ++i) {
+ for (unsigned int j = 0; j < K; ++j){
+ const double Z_mean = -eta(j,0) + theta(i) * eta(j,1);
+ if (X(i,j) == 1) {
+ Z(i,j) = stream.rtbnorm_combo(Z_mean, 1.0, 0);
+ } else if (X(i,j) == 0) {
+ Z(i,j) = stream.rtanorm_combo(Z_mean, 1.0, 0);
+ } else {
+ Z(i,j) = stream.rnorm(Z_mean, 1.0);
+ }
+ }
+ }
+}
+
+// update item (case, roll call) parameters for item response model
+// note: works only for one-dimensional case
+template <typename RNGTYPE>
+void irt_eta_update1 (Matrix<>& eta, const Matrix<>& Z,
+ const Matrix<>& theta, const Matrix<>& AB0, const Matrix<>& AB0ab0,
+ rng<RNGTYPE>& stream)
+{
+
+ // define constants
+ const unsigned int J = theta.rows();
+ const unsigned int K = Z.cols();
+
+ // perform update
+ //const Matrix<double> Ttheta_star = t(cbind(-1.0*ones<double>(J,1),theta)); // only needed for option 2
+ const Matrix<> tpt(2,2);
+ for (unsigned int i = 0; i < J; ++i) {
+ const double theta_i = theta(i);
+ tpt(0,1) -= theta_i;
+ tpt(1,1) += std::pow(theta_i, 2.0);
+ }
+ tpt(1,0) = tpt(0,1);
+ tpt(0,0) = J;
+ const Matrix<> eta_post_var = invpd(tpt + AB0);
+ const Matrix<> eta_post_C = cholesky(eta_post_var);
- void irt_theta_update1(Matrix<double>&, const Matrix<double>&,
- const Matrix<double>&, const double&,
- const double&, const Matrix<double>&,
- const Matrix<double>&, rng *);
+ for (unsigned int k = 0; k < K; ++k) {
+ const Matrix<> TZ(2, 1);
+ for (unsigned int j = 0; j < J; ++j) {
+ TZ[0] -= Z(j,k);
+ TZ[1] += Z(j,k) * theta[j];
+ }
+ const Matrix<> eta_post_mean = eta_post_var * (TZ + AB0ab0);
+ const Matrix<> new_eta = gaxpy(eta_post_C, stream.rnorm(2, 1, 0, 1),
+ eta_post_mean);
+ eta(k,0) = new_eta(0);
+ eta(k,1) = new_eta(1);
+ }
+}
+
+// update ability parameters (ideal points) for one dimensional
+// item response model
+// note: works only for one-dimensional case
+template <typename RNGTYPE>
+void irt_theta_update1 (Matrix<>& theta, const Matrix<>& Z,
+ const Matrix<>& eta, double t0, double T0, const Matrix<>& theta_eq,
+ const Matrix<>& theta_ineq, rng<RNGTYPE>& stream)
+{
+
+ const unsigned int J = Z.rows();
+ const unsigned int K = Z.cols();
+
+ // perform update from multivariate Normal
+ const double T0t0 = T0*t0;
+ const Matrix<> alpha = eta(_, 0);
+ const Matrix<> beta = eta(_, 1);
+ //const Matrix<double> tbeta = t(beta); // only neede for option 2
+ //const Matrix<double> talpha = t(alpha); // only needed for option 2
+
+ // calculate the posterior variance outside the justice specific loop
+ double theta_post_var = T0;
+ for (unsigned int i = 0; i < K; ++i)
+ theta_post_var += std::pow(beta(i), 2.0);
+ theta_post_var = 1.0 / theta_post_var;
+ const double theta_post_sd = std::sqrt(theta_post_var);
+
+ // sample for each justice
+ for (unsigned int j = 0; j < J; ++j) {
+ // no equality constraints
+ if (theta_eq(j) == -999) {
+ double betaTZjalpha = 0;
+ for (unsigned int k = 0; k < K; ++k)
+ betaTZjalpha += beta(k) * (Z(j,k) + alpha(k));
+ const double theta_post_mean = theta_post_var
+ * (T0t0 + betaTZjalpha);
+
+ if (theta_ineq(j) == 0) { // no inequality constraint
+ theta(j) = theta_post_mean + stream.rnorm(0.0, theta_post_sd);
+ } else if (theta_ineq(j) > 0) { // theta[j] > 0
+ theta(j) = stream.rtbnorm_combo(theta_post_mean, theta_post_var,
+ 0);
+ } else { // theta[j] < 0
+ theta(j) = stream.rtanorm_combo(theta_post_mean, theta_post_var,
+ 0);
+ }
+ } else { // equality constraints
+ theta(j) = theta_eq(j);
+ }
+ }
+}
+
+
+
+
+
+
+// factor analysis model with normal mean 0, precision F0 prior on
+// factor scores
+// X follows a multivariate normal distribution
+// Lambda is the matrix of factor loadings
+// Psi_inv is the inverse of the uniqueness matrix
+// N is number of observations
+// D is the number of factors
+// this function draws the factor scores
+//
+// IMPORTANT
+// ***********Psi_inv IS ASSUMED TO DIAGONAL ***********
+template <typename RNGTYPE>
+void
+NormNormfactanal_phi_draw(Matrix<> &phi,
+ const Matrix<> &F0,
+ const Matrix<> &Lambda,
+ const Matrix<> &Psi_inv,
+ const Matrix<> &X,
+ const int& N, const int& D,
+ rng <RNGTYPE>& stream){
+ // If Psi_inv is *not* diagonal then use:
+ // Matrix<double> phi_post_var = invpd(F0 + t(Lambda) * Psi_inv *
+ // Lambda);
+ //Instead of the following 2 lines:
+ const Matrix<> AAA = scythe::sqrt(Psi_inv) * Lambda;
+ const Matrix<> phi_post_var = invpd(F0 + crossprod(AAA));
+ const Matrix<> phi_post_C = cholesky(phi_post_var);
+ for (int i=0; i<N; ++i){
+ const Matrix<> phi_post_mean = phi_post_var *
+ (t(Lambda) * Psi_inv * t(X(i,_)));
+ const Matrix<> phi_samp = gaxpy(phi_post_C, stream.rnorm(D, 1, 0.0, 1.0),
+ phi_post_mean);
+ for (int j=0; j<D; ++j)
+ phi(i,j) = phi_samp(j);
+ }
+}
+
+
+// samples the Psi matrix for a Normal theory factor model with IG
+// prior on diag elements of Psi
+template <typename RNGTYPE>
+void
+NormIGfactanal_Psi_draw(Matrix<> &Psi, const Matrix<> &X,
+ const Matrix<> &phi,
+ const Matrix<> &Lambda,
+ const Matrix<> &a0,
+ const Matrix<> &b0,
+ const int& K, const int& N,
+ rng<RNGTYPE>& stream){
+ for (int i=0; i<K; ++i){
+ const Matrix<double> epsilon = gaxpy(phi, -1*(t(Lambda(i,_))), X(_,i));
+ const Matrix<double> SSE = crossprod(epsilon);
+ const double a1 = (a0[i] + N)*0.5;
+ const double b1 = (b0[i] + SSE[0])*0.5;
+ Psi(i,i) = stream.rigamma(a1, b1);
+ }
+}
+
+
+
+// Psi_inv assumed diagnonal
+// this function draws the factor loading matrix
+template <typename RNGTYPE>
+void
+NormNormfactanal_Lambda_draw(Matrix<>& Lambda,
+ const Matrix<bool> &Lambda_free_indic,
+ const Matrix<> &Lambda_prior_mean,
+ const Matrix<> &Lambda_prior_prec,
+ const Matrix<> &phi,
+ const Matrix<> &X,
+ const Matrix<> &Psi_inv,
+ const Matrix<> &Lambda_ineq,
+ const unsigned int D, const unsigned int K,
+ rng<RNGTYPE>& stream)
+{
+
+ for (unsigned int i = 0; i < K; ++i) {
+ const Matrix<bool> free_indic = t(Lambda_free_indic(i,_));
+ // end replacement
+
+ if (sumc(free_indic)(0) > 0 && sumc(! free_indic)(0) > 0) {
+ // both constrnd & unconstrnd
+ const Matrix<> phifree_i = t(selif(t(phi), free_indic));
+ const Matrix<> mulamfree_i = selif(t(Lambda_prior_mean(i,_)),
+ free_indic); // prior mean
+ const Matrix<> hold = selif(t(Lambda_prior_prec(i,_)),
+ free_indic);
+ Matrix<> sig2lamfree_inv_i
+ = eye<double>(hold.rows()); // prior prec
+
+ for (unsigned int j = 0; j < (hold.rows()); ++j)
+ sig2lamfree_inv_i(j,j) = hold[j];
+
+ const Matrix<> Lambdacon_i = selif(t(Lambda(i,_)), ! free_indic);
+ const Matrix<> phicon_i = t(selif(t(phi), ! free_indic));
+ const Matrix<> newX_i = gaxpy((-1.0*phicon_i), Lambdacon_i,
+ X(_,i));
+ const Matrix<> Lam_post_var = invpd(sig2lamfree_inv_i +
+ Psi_inv(i,i) * crossprod(phifree_i));
+ const Matrix<> Lam_post_C = cholesky(Lam_post_var);
+ const Matrix<> Lam_post_mean = Lam_post_var *
+ (sig2lamfree_inv_i * mulamfree_i + Psi_inv(i,i) *
+ t(phifree_i) * newX_i);
+
+
+ Matrix<> Lambdafree_i =
+ gaxpy(Lam_post_C, stream.rnorm(hold.rows(), 1, 0, 1),Lam_post_mean);
+
+
+
+ // check to see if inequality constraints hold
+ const Matrix<> Lambda_ineq_vec = Lambda_ineq(i,_);
+
+ double ineq_holds = 0;
+ int Lam_count = 0;
+ for (unsigned int j = 0; j < D; ++j) {
+ if (free_indic(j)){
+ ineq_holds = std::min(ineq_holds, Lambda_ineq_vec(j) *
+ Lambdafree_i(Lam_count));
+ ++Lam_count;
+ }
+ }
+
+ while (ineq_holds < 0) {
+ Lambdafree_i = gaxpy(Lam_post_C, stream.rnorm(hold.rows(), 1, 0, 1),
+ Lam_post_mean);
+ Lam_count = 0;
+ double test = 0;
+ for (unsigned int j = 0; j < D; ++j) {
+ if (free_indic(j) == 1) {
+ Matrix<> prodcheck = Lambda_ineq_vec(j)
+ * Lambdafree_i(Lam_count);
+ test = std::min(test, prodcheck(0));
+ ++Lam_count;
+ }
+ }
+ ineq_holds = test;
+ }
+
+ // put draw into Lambda
+ Lam_count = 0;
+ for (unsigned int j = 0; j < D; ++j) {
+ if (free_indic(j) == 1) {
+ Lambda(i,j) = Lambdafree_i(Lam_count);
+ ++Lam_count;
+ }
+ }
+ } else if (sumc(free_indic)(0) > 0) { // just unconstrained
+ const Matrix<> phifree_i = t(selif(t(phi), free_indic));
+ const Matrix<> mulamfree_i = selif(t(Lambda_prior_mean(i,_)),
+ free_indic); // prior mean
+ const Matrix<> hold = selif(t(Lambda_prior_prec(i,_)), free_indic);
+ Matrix<> sig2lamfree_inv_i = eye<double>(hold.rows()); // prior prec
+
+ for (unsigned int j = 0; j < hold.rows(); ++j)
+ sig2lamfree_inv_i(j,j) = hold(j);
+
+ const Matrix<> Lam_post_var = invpd(sig2lamfree_inv_i +
+ Psi_inv(i,i) * crossprod(phifree_i));
+ const Matrix<> Lam_post_C = cholesky(Lam_post_var);
+ const Matrix<> Lam_post_mean = Lam_post_var * (sig2lamfree_inv_i
+ * mulamfree_i +
+ Psi_inv(i,i) *
+ t(phifree_i) * X(_,i));
+ Matrix<> Lambdafree_i = gaxpy(Lam_post_C,
+ stream.rnorm(hold.rows(), 1, 0, 1),
+ Lam_post_mean);
+
+
+ // check to see if inequality constraints hold
+ Matrix<> Lambda_ineq_vec = Lambda_ineq(i,_);
+ double ineq_holds = 0;
+ for (unsigned int j = 0; j < D; ++j) {
+ ineq_holds = std::min(ineq_holds, Lambda_ineq_vec(j)
+ * Lambdafree_i(j));
+ }
+
+ while (ineq_holds < 0) {
+ Lambdafree_i = gaxpy(Lam_post_C, stream.rnorm(hold.rows(), 1, 0, 1),
+ Lam_post_mean);
+ double test = 0;
+ for (unsigned int j = 0; j < D; ++j) {
+ //if (free_indic[j]==1)
+ double prodcheck = Lambda_ineq_vec[j]*Lambdafree_i[j];
+ test = std::min(test, prodcheck);
+ }
+
+ ineq_holds = test;
+ }
+
+ // put draw into Lambda
+ for (unsigned int j = 0; j < D; ++j) {
+ Lambda(i,j) = Lambdafree_i(j);
+ }
+ }
+ }
+ // return(Lambda);
}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#endif
+
+
+
diff --git a/src/MCMChierEI.cc b/src/MCMChierEI.cc
index 16b5963..f290920 100644
--- a/src/MCMChierEI.cc
+++ b/src/MCMChierEI.cc
@@ -7,8 +7,13 @@
// KQ 7/20/2004 [minor changes regarding output and user interrupts]
// ADM 7/24/2004 [updated to new Scythe version]
// KQ 8/10/2004 bug fix and major overhaul of sampling scheme
+// ADM 7/??/2007 ported to Scythe 1.0.X
+// KQ 7/29/2007 some minor fixes (still not fully tested)
+
+
+#ifndef MCMCHIEREI_CC
+#define MCMCHIEREI_CC
-#include <iostream>
#include "matrix.h"
#include "distributions.h"
@@ -23,40 +28,42 @@
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
+using namespace scythe;
using namespace std;
-static double Lev1thetaPost(double theta[], const double& r0, const double& r1,
+static
+double Lev1thetaPost(double theta[], const double& r0, const double& r1,
const double& c0, const double& mu0, const double& mu1,
- const double& sigma0, const double& sigma1){
+ const double& sigma0, const double& sigma1)
+{
const double theta0 = theta[0];
const double theta1 = theta[1];
const double p0 = 1.0/(1.0 + exp(-1*theta0));
const double p1 = 1.0/(1.0 + exp(-1*theta1));
const double logprior = lndnorm(theta0, mu0, sqrt(sigma0)) +
lndnorm(theta1, mu1, sqrt(sigma1));
- const double loglike = lndnorm(c0, r0*p0 + r1*p1,
- sqrt(r0*p0*(1.0-p0) +
- r1*p1*(1.0-p1)));
+ const double loglike = lndnorm(c0, r0*p0 + r1*p1, sqrt(r0*p0*(1.0-p0) +
+ r1*p1*(1.0-p1)));
return(loglike + logprior);
}
-
-
// eventually all of the slice sampling functions should be made more
// general and put in MCMCfcds.{h cc}
//
// Radford Neal's (2000) doubling procedure coded for a logdensity
-static void doubling(double (*logfun)(double[], const double&, const double&,
+template <typename RNGTYPE>
+static
+void doubling(double (*logfun)(double[], const double&, const double&,
const double&, const double&, const double&,
const double&, const double&),
double theta[], const int& index, const double& z,
const double& w, const int& p, const double& r0,
const double& r1, const double& c0, const double& mu0,
- const double& mu1, const double& sigma0, const double& sigma1,
- rng* stream, double& L, double& R){
-
- const double U = stream->runif();
+ const double& mu1, const double& sigma0, const double& sigma1,
+ rng<RNGTYPE>& stream, double& L, double& R)
+{
+
+ const double U = stream.runif();
const double x0 = theta[index];
double theta_L[2];
double theta_R[2];
@@ -70,7 +77,7 @@ static void doubling(double (*logfun)(double[], const double&, const double&,
while (K > 0 &&
(z < logfun(theta_L, r0, r1, c0, mu0, mu1, sigma0, sigma1) ||
z < logfun(theta_R, r0, r1, c0, mu0, mu1, sigma0, sigma1))){
- double V = stream->runif();
+ double V = stream.runif();
if (V < 0.5){
L = L - (R - L);
theta_L[index] = L;
@@ -84,18 +91,17 @@ static void doubling(double (*logfun)(double[], const double&, const double&,
}
// Radford Neal's (2000) Accept procedure coded for a logdensity
-static const bool Accept(double (*logfun)(double[], const double&,
- const double&,
- const double&, const double&,
- const double&,
- const double&, const double&),
- double theta[], const int& index, const double x0,
- const double& z, const double& w, const double& r0,
- const double& r1, const double& c0,
- const double& mu0, const double& mu1,
- const double& sigma0, const double& sigma1,
- const double& L, const double& R){
-
+static const
+bool Accept(double (*logfun)(double[], const double&,
+ const double&, const double&, const double&,
+ const double&, const double&, const double&),
+ double theta[], const int& index, const double x0,
+ const double& z, const double& w, const double& r0,
+ const double& r1, const double& c0,
+ const double& mu0, const double& mu1,
+ const double& sigma0, const double& sigma1,
+ const double& L, const double& R)
+{
double Lhat = L;
double Rhat = R;
bool D = false;
@@ -132,18 +138,20 @@ static const bool Accept(double (*logfun)(double[], const double&,
// Radford Neal's (2000) shrinkage procedure coded for a log density
-static double shrinkage(double (*logfun)(double[], const double&,
- const double&,
- const double&, const double&,
- const double&,
- const double&, const double&),
- double theta[], const int& index, const double& z,
- const double& w, const double& r0,
- const double& r1, const double& c0, const double& mu0,
- const double& mu1, const double& sigma0,
- const double& sigma1, rng*
- stream, const double& L, const double& R){
-
+template <typename RNGTYPE>
+static
+double shrinkage(double (*logfun)(double[], const double&,
+ const double&, const double&,
+ const double&, const double&,
+ const double&, const double&),
+ double theta[], const int& index, const double& z,
+ const double& w, const double& r0,
+ const double& r1, const double& c0, const double& mu0,
+ const double& mu1, const double& sigma0,
+ const double& sigma1, rng<RNGTYPE>& stream,
+ const double& L, const double& R)
+{
+
double Lbar = L;
double Rbar = R;
// int ind0;
@@ -158,7 +166,7 @@ static double shrinkage(double (*logfun)(double[], const double&,
theta_x1[1] = theta[1];
const double x0 = theta[index];
for (;;){
- const double U = stream->runif();
+ const double U = stream.runif();
const double x1 = Lbar + U*(Rbar - Lbar);
theta_x1[index] = x1;
if (z <= logfun(theta_x1, r0, r1, c0, mu0, mu1, sigma0, sigma1) &&
@@ -176,12 +184,218 @@ static double shrinkage(double (*logfun)(double[], const double&,
} // end infinite loop
}
-
-
+template <typename RNGTYPE>
+void MCMChierEI_impl(rng<RNGTYPE>& stream,
+ const Matrix<>& r0,
+ const Matrix<>& r1, const Matrix<>& c0,
+ const Matrix<>& c1, double mu0_prior_mean,
+ double mu0_prior_var, double mu1_prior_mean,
+ double mu1_prior_var, double nu0, double delta0,
+ double nu1, double delta1, unsigned int ntables,
+ unsigned int burnin, unsigned int mcmc,
+ unsigned int thin, unsigned int verbose,
+ Matrix<double,Row>& result)
+{
+
+ // MCMC-related quantities
+ unsigned int tot_iter = burnin + mcmc;
+
+ // storage matrices
+ Matrix<> p0mat(mcmc/thin, ntables, false);
+ Matrix<> p1mat(mcmc/thin, ntables, false);
+ Matrix<> mu0mat(mcmc/thin, 1, false);
+ Matrix<> mu1mat(mcmc/thin, 1, false);
+ Matrix<> sig0mat(mcmc/thin, 1, false);
+ Matrix<> sig1mat(mcmc/thin, 1, false);
+ unsigned int count = 0;
+
+ // starting values
+ Matrix<> p0 = stream.runif(ntables, 1)*0.5 + 0.25;
+ Matrix<> p1 = stream.runif(ntables, 1)*0.5 + 0.25;
+ Matrix<> theta0 = log(p0/(1.0 - p0));
+ Matrix<> theta1 = log(p1/(1.0 - p1));
+ double mu0 = 0.0;
+ double mu1 = 0.0;
+ double sigma0 = 1.0;
+ double sigma1 = 1.0;
+ double L = -2.0;
+ double R = 2.0;
+
+ // sampling constants
+ const unsigned int warmup_iter = 4000;
+ const unsigned int warmup_burnin = 2000;
+ const double w_init = .000000001;
+ const unsigned int p_init = 50;
+ const Matrix<> widthmat(warmup_iter - warmup_burnin, 2);
+
+ // warm up sampling to choose slice sampling parameters adaptively
+ for (unsigned int iter = 0; iter < warmup_iter; ++iter) {
+
+ // loop over tables
+ for (unsigned int i = 0; i < ntables; ++i) {
+
+ // sample theta0, theta1 using slice sampling
+ for (int index = 0; index<2; ++index){
+ double theta_i[2];
+ theta_i[0] = theta0(i);
+ theta_i[1] = theta1(i);
+ double funval = Lev1thetaPost(theta_i, r0[i], r1[i], c0[i],
+ mu0, mu1, sigma0, sigma1);
+
+ double z = funval - stream.rexp(1.0);
+ doubling(&Lev1thetaPost, theta_i, index, z, w_init, p_init, r0[i],
+ r1[i], c0[i], mu0, mu1, sigma0, sigma1, stream, L, R);
+
+ theta_i[index] = shrinkage(&Lev1thetaPost, theta_i, index, z,
+ w_init, r0[i], r1[i], c0[i], mu0, mu1,
+ sigma0, sigma1, stream, L, R);
+ if (iter >= warmup_burnin) {
+ widthmat(iter-warmup_burnin, index) = R - L;
+ }
+ theta0(i) = theta_i[0];
+ theta1(i) = theta_i[1];
+ } // end index loop
+
+ } // end tables loop
+
+ // sample mu0 and mu1
+ // mu0
+ double post_var = 1.0/(1.0/mu0_prior_var + ntables*(1.0/sigma0));
+ double post_mean = post_var*(sumc(theta0)[0]*(1.0/sigma0) +
+ (1.0/mu0_prior_var)*mu0_prior_mean);
+ mu0 = stream.rnorm(post_mean, sqrt(post_var));
+
+ // mu1
+ post_var = 1.0/(1.0/mu1_prior_var + ntables*(1.0/sigma1));
+ post_mean = post_var*(sumc(theta1)[0]*(1.0/sigma1) +
+ (1.0/mu1_prior_var)*mu1_prior_mean);
+ mu1 = stream.rnorm(post_mean, sqrt(post_var));
+
+ // sample sigma0 and sigma1
+ // sigma0
+ Matrix<> e = theta0 - mu0;
+ Matrix<> SSE = crossprod(e);
+ double nu2 = (nu0 + ntables)*0.5;
+ double delta2 = (delta0 + SSE[0])*0.5;
+ sigma0 = stream.rigamma(nu2, delta2);
+
+ // sigma1
+ e = theta1 - mu1;
+ SSE = crossprod(e);
+ nu2 = (nu1 + ntables)*0.5;
+ delta2 = (delta1 + SSE[0])*0.5;
+ sigma1 = stream.rigamma(nu2, delta2);
+
+ // allow user interrupts
+ R_CheckUserInterrupt();
+ }
+ // @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+
+
+ // sampling constants
+ double w = mean(widthmat);
+ int p_temp = 2;
+ while ((w * pow(2.0, p_temp) ) < max(widthmat)){
+ ++p_temp;
+ }
+ const int p = p_temp + 1;
+
+
+ // @@@@@@@@@@@@@@ The real sampling @@@@@@@@@@@@@@@
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
+
+ // loop over tables
+ for (unsigned int i = 0; i < ntables; ++i) {
+
+ // sample theta0, theta1 using slice sampling
+ for (unsigned int index = 0; index < 2; ++index) {
+ double theta_i[2];
+ theta_i[0] = theta0(i);
+ theta_i[1] = theta1(i);
+ double funval = Lev1thetaPost(theta_i, r0[i], r1[i], c0[i],
+ mu0, mu1, sigma0, sigma1);
+
+ double z = funval - stream.rexp(1.0);
+ doubling(&Lev1thetaPost, theta_i, index, z, w, p, r0[i],
+ r1[i], c0[i], mu0, mu1, sigma0, sigma1, stream, L, R);
+
+ //Rprintf("L = %10.5f R = %10.5f\n", L, R);
+
+ theta_i[index] = shrinkage(&Lev1thetaPost, theta_i, index, z, w,
+ r0[i], r1[i], c0[i], mu0, mu1,
+ sigma0, sigma1, stream, L, R);
+
+
+ theta0[i] = theta_i[0];
+ theta1[i] = theta_i[1];
+ } // end index loop
+
+ // if after burnin store samples
+ if ((iter >= burnin) && ((iter % thin)==0)){
+ p0mat(count,i) = 1.0/(1.0 + exp(-1*theta0[i]));
+ p1mat(count,i) = 1.0/(1.0 + exp(-1*theta1[i]));
+ }
+ } // end tables loop
+
+
+ // sample mu0 and mu1
+ // mu0
+ double post_var = 1.0/(1.0/mu0_prior_var + ntables*(1.0/sigma0));
+ double post_mean = post_var*(sumc(theta0)[0]*(1.0/sigma0) +
+ (1.0/mu0_prior_var)*mu0_prior_mean);
+ mu0 = stream.rnorm(post_mean, sqrt(post_var));
+
+ // mu1
+ post_var = 1.0/(1.0/mu1_prior_var + ntables*(1.0/sigma1));
+ post_mean = post_var*(sumc(theta1)[0]*(1.0/sigma1) +
+ (1.0/mu1_prior_var)*mu1_prior_mean);
+ mu1 = stream.rnorm(post_mean, sqrt(post_var));
+
+
+ // sample sigma0 and sigma1
+ // sigma0
+ Matrix<double> e = theta0 - mu0;
+ Matrix<double> SSE = crossprod(e);
+ double nu2 = (nu0 + ntables)*0.5;
+ double delta2 = (delta0 + SSE[0])*0.5;
+ sigma0 = stream.rigamma(nu2,delta2);
+
+ // sigma1
+ e = theta1 - mu1;
+ SSE = crossprod(e);
+ nu2 = (nu1 + ntables)*0.5;
+ delta2 = (delta1 + SSE[0])*0.5;
+ sigma1 = stream.rigamma(nu2,delta2);
+
+
+ // if after burnin store samples
+ if ((iter >= burnin) && ((iter % thin)==0)){
+ mu0mat(count,0) = mu0;
+ mu1mat(count,0) = mu1;
+ sig0mat(count,0) = sigma0;
+ sig1mat(count,0) = sigma1;
+ ++ count;
+ }
+
+ // print output to screen
+ if (verbose>0 && (iter%verbose)==0)
+ Rprintf("\nMCMChierEI iteration %i of %i \n", (iter+1), tot_iter);
+
+ // allow user interrupts
+ R_CheckUserInterrupt();
+ }
+
+
+ // return sample
+ result = cbind(p0mat, p1mat);
+ result = cbind(result, mu0mat);
+ result = cbind(result, mu1mat);
+ result = cbind(result, sig0mat);
+ result = cbind(result, sig1mat);
+}
extern "C"{
-
void hierEI(double* sample, const int* samrow, const int* samcol,
const double* Rr0, const double* Rr1, const double* Rc0,
const double* Rc1, const int* Rntables, const int* Rburnin,
@@ -190,11 +404,9 @@ extern "C"{
const double* Rmu1pm, const double* Rmu1pv,
const double* Rnu0, const double* Rdelta0,
const double* Rnu1, const double* Rdelta1,
- const int* Rverbose,
- const int *lecuyer, const int *seedarray,
- const int *lecuyerstream){
-
-
+ const int* Rverbose, const int *uselecuyer,
+ const int *seedarray, const int *lecuyerstream)
+ {
// load data
// table notation is:
// --------------------
@@ -203,244 +415,25 @@ extern "C"{
// Y1 | | r1
// --------------------
// c0 | c1 | N
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- const int ntables = *Rntables;
- const int verbose = *Rverbose;
-
- Matrix<double> r0(ntables, 1, Rr0);
- Matrix<double> r1(ntables, 1, Rr1);
- Matrix<double> c0(ntables, 1, Rc0);
- Matrix<double> c1(ntables, 1, Rc1);
- Matrix<double> N = c0 + c1;
-
-
- // MCMC-related quantities
- int burnin = *Rburnin;
- int mcmc = *Rmcmc;
- int thin = *Rthin;
- int tot_iter = burnin + mcmc;
-
-
- // prior for mu0 ~ N(mu0_prior_mean, mu0_prior_var)
- double mu0_prior_mean = *Rmu0pm;
- double mu0_prior_var = *Rmu0pv;
-
- // prior for mu1 ~ N(mu1_prior_mean, mu1_prior_var)
- double mu1_prior_mean = *Rmu1pm;
- double mu1_prior_var = *Rmu1pv;
-
- // prior for sigma0 ~ IG(nu0/2, delta0/2)
- double nu0 = *Rnu0;
- double delta0 = *Rdelta0;
-
- // prior for sigma1 ~ IG(nu1/2, delta1/2)
- double nu1 = *Rnu1;
- double delta1 = *Rdelta1;
-
- // storage matrices
- Matrix<double> p0mat(mcmc/thin, ntables);
- Matrix<double> p1mat(mcmc/thin, ntables);
- Matrix<double> mu0mat(mcmc/thin, 1);
- Matrix<double> mu1mat(mcmc/thin, 1);
- Matrix<double> sig0mat(mcmc/thin, 1);
- Matrix<double> sig1mat(mcmc/thin, 1);
- int count = 0;
-
- // starting values
- Matrix<double> p0 = stream->runif(ntables,1)*0.5 + 0.25;
- Matrix<double> p1 = stream->runif(ntables,1)*0.5 + 0.25;
- Matrix<double> theta0 = log(p0/(1.0 - p0));
- Matrix<double> theta1 = log(p1/(1.0 - p1));
- double mu0 = 0.0;
- double mu1 = 0.0;
- double sigma0 = 1.0;
- double sigma1 = 1.0;
- double L = -2.0;
- double R = 2.0;
+ unsigned int ntables = *Rntables;
+ Matrix<> r0(ntables, 1, Rr0);
+ Matrix<> r1(ntables, 1, Rr1);
+ Matrix<> c0(ntables, 1, Rc0);
+ Matrix<> c1(ntables, 1, Rc1);
+
+ Matrix<double,Row> result(*samrow, *samcol, false);
+ MCMCPACK_PASSRNG2MODEL(MCMChierEI_impl, r0, r1, c0, c1, *Rmu0pm,
+ *Rmu0pv, *Rmu1pm, *Rmu1pv, *Rnu0, *Rdelta0,
+ *Rnu1, *Rdelta1,
+ ntables, *Rburnin, *Rmcmc,
+ *Rthin, *Rverbose, result);
- // sampling constants
- const int warmup_iter = 4000;
- const int warmup_burnin = 2000;
- const double w_init = .000000001;
- const int p_init = 50;
- const Matrix<double> widthmat(warmup_iter - warmup_burnin, 2);
-
- // warm up sampling to choose slice sampling parameters adaptively
- for (int iter=0; iter<warmup_iter; ++iter){
-
- // loop over tables
- for (int i=0; i<ntables; ++i){
-
- // sample theta0, theta1 using slice sampling
- for (int index = 0; index<2; ++index){
- double theta_i[2];
- theta_i[0] = theta0[i];
- theta_i[1] = theta1[i];
- double funval = Lev1thetaPost(theta_i, r0[i], r1[i], c0[i],
- mu0, mu1, sigma0, sigma1);
-
- double z = funval - stream->rexp(1.0);
- doubling(&Lev1thetaPost, theta_i, index, z, w_init, p_init, r0[i],
- r1[i], c0[i], mu0, mu1, sigma0, sigma1, stream, L, R);
-
- theta_i[index] = shrinkage(&Lev1thetaPost, theta_i, index, z,
- w_init, r0[i], r1[i], c0[i], mu0, mu1,
- sigma0, sigma1, stream, L, R);
- if (iter >= warmup_burnin){
- widthmat(iter-warmup_burnin, index) = R - L;
- }
- theta0[i] = theta_i[0];
- theta1[i] = theta_i[1];
- } // end index loop
-
- } // end tables loop
-
- // sample mu0 and mu1
- // mu0
- double post_var = 1.0/(1.0/mu0_prior_var + ntables*(1.0/sigma0));
- double post_mean = post_var*(sumc(theta0)[0]*(1.0/sigma0) +
- (1.0/mu0_prior_var)*mu0_prior_mean);
- mu0 = stream->rnorm(post_mean, sqrt(post_var));
-
- // mu1
- post_var = 1.0/(1.0/mu1_prior_var + ntables*(1.0/sigma1));
- post_mean = post_var*(sumc(theta1)[0]*(1.0/sigma1) +
- (1.0/mu1_prior_var)*mu1_prior_mean);
- mu1 = stream->rnorm(post_mean, sqrt(post_var));
-
- // sample sigma0 and sigma1
- // sigma0
- Matrix<double> e = theta0 - mu0;
- Matrix<double> SSE = crossprod(e);
- double nu2 = (nu0 + ntables)*0.5;
- double delta2 = (delta0 + SSE[0])*0.5;
- sigma0 = stream->rigamma(nu2,delta2);
-
- // sigma1
- e = theta1 - mu1;
- SSE = crossprod(e);
- nu2 = (nu1 + ntables)*0.5;
- delta2 = (delta1 + SSE[0])*0.5;
- sigma1 = stream->rigamma(nu2,delta2);
-
- // allow user interrupts
- R_CheckUserInterrupt();
- }
- // @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-
- // sampling constants
- double w = mean(widthmat);
- int p_temp = 2;
- while ((w * pow(2.0, p_temp) ) < max(widthmat)){
- ++p_temp;
- }
- const int p = p_temp + 1;
-
-
- // @@@@@@@@@@@@@@ The real sampling @@@@@@@@@@@@@@@
- for (int iter=0; iter<tot_iter; ++iter){
-
- // loop over tables
- for (int i=0; i<ntables; ++i){
-
- // sample theta0, theta1 using slice sampling
- for (int index = 0; index<2; ++index){
- double theta_i[2];
- theta_i[0] = theta0[i];
- theta_i[1] = theta1[i];
- double funval = Lev1thetaPost(theta_i, r0[i], r1[i], c0[i],
- mu0, mu1, sigma0, sigma1);
-
- double z = funval - stream->rexp(1.0);
- doubling(&Lev1thetaPost, theta_i, index, z, w, p, r0[i],
- r1[i], c0[i], mu0, mu1, sigma0, sigma1, stream, L, R);
-
- //Rprintf("L = %10.5f R = %10.5f\n", L, R);
-
- theta_i[index] = shrinkage(&Lev1thetaPost, theta_i, index, z, w,
- r0[i], r1[i], c0[i], mu0, mu1,
- sigma0, sigma1, stream, L, R);
-
-
- theta0[i] = theta_i[0];
- theta1[i] = theta_i[1];
- } // end index loop
-
- // if after burnin store samples
- if ((iter >= burnin) && ((iter%thin)==0)){
- p0mat(count,i) = 1.0/(1.0 + exp(-1*theta0[i]));
- p1mat(count,i) = 1.0/(1.0 + exp(-1*theta1[i]));
-
- }
- } // end tables loop
-
-
- // sample mu0 and mu1
- // mu0
- double post_var = 1.0/(1.0/mu0_prior_var + ntables*(1.0/sigma0));
- double post_mean = post_var*(sumc(theta0)[0]*(1.0/sigma0) +
- (1.0/mu0_prior_var)*mu0_prior_mean);
- mu0 = stream->rnorm(post_mean, sqrt(post_var));
-
- // mu1
- post_var = 1.0/(1.0/mu1_prior_var + ntables*(1.0/sigma1));
- post_mean = post_var*(sumc(theta1)[0]*(1.0/sigma1) +
- (1.0/mu1_prior_var)*mu1_prior_mean);
- mu1 = stream->rnorm(post_mean, sqrt(post_var));
-
-
- // sample sigma0 and sigma1
- // sigma0
- Matrix<double> e = theta0 - mu0;
- Matrix<double> SSE = crossprod(e);
- double nu2 = (nu0 + ntables)*0.5;
- double delta2 = (delta0 + SSE[0])*0.5;
- sigma0 = stream->rigamma(nu2,delta2);
-
- // sigma1
- e = theta1 - mu1;
- SSE = crossprod(e);
- nu2 = (nu1 + ntables)*0.5;
- delta2 = (delta1 + SSE[0])*0.5;
- sigma1 = stream->rigamma(nu2,delta2);
-
-
- // if after burnin store samples
- if ((iter >= burnin) && ((iter%thin)==0)){
- mu0mat(count,0) = mu0;
- mu1mat(count,0) = mu1;
- sig0mat(count,0) = sigma0;
- sig1mat(count,0) = sigma1;
- ++ count;
- }
-
- // print output to screen
- if (verbose>0 && (iter%verbose)==0){
- Rprintf("\nMCMChierEI iteration %i of %i \n", (iter+1),
- tot_iter);
- }
-
- // allow user interrupts
- R_CheckUserInterrupt();
- }
-
- delete stream; // clean up random number stream
-
- // return sample
- Matrix<double> storeagem = cbind(p0mat, p1mat);
- storeagem = cbind(storeagem, mu0mat);
- storeagem = cbind(storeagem, mu1mat);
- storeagem = cbind(storeagem, sig0mat);
- storeagem = cbind(storeagem, sig1mat);
- int mat_size = samrow[0] * samcol[0];
- for (int i=0; i<mat_size; ++i)
- sample[i] = storeagem[i];
-
+ for (unsigned int i = 0; i < result.size(); ++i)
+ sample[i] = result[i];
}
-
+
+
+
} // extern "C"
+#endif
diff --git a/src/MCMCirt1d.cc b/src/MCMCirt1d.cc
index bd84d14..c7889ac 100644
--- a/src/MCMCirt1d.cc
+++ b/src/MCMCirt1d.cc
@@ -5,172 +5,147 @@
// ADM 7/28/2004 [updated to new Scythe version]
// completely rewritten and optimized for the 1-d case 8/2/2004 KQ
// storage changed to save memory KQ 1/27/2006
+// DBP 7/3/07 [ported to scythe 1.0.x]
+#ifndef MCMCIRT1D_CC
+#define MCMCIRT1D_CC
+
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
+#include "rng.h"
+#include "mersenne.h"
+#include "lecuyer.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
+using namespace scythe;
-extern "C"{
+/* MCMCirt1d implementation. */
+template <typename RNGTYPE>
+void MCMCirt1d_impl (rng<RNGTYPE>& stream, const Matrix<int>& X,
+ Matrix<>& theta, Matrix<>& eta, const Matrix<>& ab0,
+ const Matrix<>& AB0, const Matrix<>& theta_eq,
+ const Matrix<>& theta_ineq, double t0, double T0, unsigned int burnin,
+ unsigned int mcmc, unsigned int thin, unsigned int verbose,
+ bool storea, bool storei, double* sampledata, unsigned int samplesize)
+{
+ // constants
+ const unsigned int J = X.rows(); // # subjects (justices, legislators)
+ const unsigned int K = X.cols(); // number of items (cases, roll calls)
+ const unsigned int tot_iter = burnin + mcmc;
+ const unsigned int nsamp = mcmc / thin;
-// function called by R to fit model
- void
- MCMCirt1d(double* sampledata,
- const int* samplerow,
- const int* samplecol,
- const int* Xdata,
- const int* Xrow,
- const int* Xcol,
- const int* burnin,
- const int* mcmc,
- const int* thin,
- const int *lecuyer,
- const int *seedarray,
- const int *lecuyerstream,
- const int* verbose,
- const double* thetastartdata,
- const int* thetastartrow,
- const int* thetastartcol,
- const double* astartdata,
- const int* astartrow,
- const int* astartcol,
- const double* bstartdata,
- const int* bstartrow,
- const int* bstartcol,
- const double* t0,
- const double* T0,
- const double* ab0data,
- const int* ab0row,
- const int* ab0col,
- const double* AB0data,
- const int* AB0row,
- const int* AB0col,
- const double* thetaeqdata,
- const int* thetaeqrow,
- const int* thetaeqcol,
- const double* thetaineqdata,
- const int* thetaineqrow,
- const int* thetaineqcol,
- const int* storei,
- const int* storea
- ) {
-
- using namespace SCYTHE; //Added by Matthew S. Fasman on 11/04/2004
-
- // put together matrices
- const Matrix<int> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix<double> theta = r2scythe(*thetastartrow, *thetastartcol,
- thetastartdata);
- Matrix<double> alpha = r2scythe(*astartrow, *astartcol,
- astartdata);
- Matrix<double> beta = r2scythe(*bstartrow, *bstartcol,
- bstartdata);
- const Matrix<double> ab0 = r2scythe(*ab0row, *ab0col, ab0data);
- const Matrix<double> AB0 = r2scythe(*AB0row, *AB0col, AB0data);
- const Matrix<double> theta_eq = r2scythe(*thetaeqrow,
- *thetaeqcol,
- thetaeqdata);
- const Matrix<double> theta_ineq = r2scythe(*thetaineqrow,
- *thetaineqcol,
- thetaineqdata);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // constants
- const int J = X.rows(); // number of subjects (justices, legislators)
- const int K = X.cols(); // number of items (cases, roll calls)
- const int tot_iter = *burnin + *mcmc;
- const int nsamp = *mcmc / *thin;
+ // storage matrices (col major order)
+ Matrix<> theta_store;
+ Matrix<> eta_store;
+ if (storea)
+ theta_store = Matrix<>(nsamp, J);
+ if (storei)
+ eta_store = Matrix<>(nsamp, K*2);
- // storage matrices (row major order)
- Matrix<double> theta_store;
- Matrix<double> eta_store;
- if (*storea == 1){
- theta_store = Matrix<double>(nsamp, J);
- }
- if (*storei == 1){
- eta_store = Matrix<double>(nsamp, K*2);
- }
+ // starting values
+ Matrix<> Z(J, K);
- // starting values
- Matrix<double> eta = cbind(alpha, beta);
- Matrix<double> Z = Matrix<double>(J,K);
+ // pre-compute
+ const Matrix<> AB0ab0 = AB0 * ab0;
- int count = 0;
- // MCMC sampling occurs in this for loop
- for (int iter=0; iter < tot_iter; ++iter){
-
- // sample latent utilities (Z)
- irt_Z_update1(Z, X, theta, eta, stream);
-
- // sample item (case, bill) parameters (eta)
- irt_eta_update1(eta, Z, theta, ab0, AB0, stream);
-
- // sample ability (ideal points) (theta)
- irt_theta_update1(theta, Z, eta, *t0, *T0, theta_eq,
- theta_ineq, stream);
-
- // print results to screen
- if (*verbose > 0 && iter % *verbose == 0){
- Rprintf("\n\nMCMCirt1d iteration %i of %i \n",
- (iter+1), tot_iter);
- //Rprintf("theta = \n");
- //for (int j=0; j<J; ++j)
- // Rprintf("%10.5f\n", theta[j]);
- }
-
- // store results
- if ((iter >= burnin[0]) && ((iter % thin[0]==0))) {
-
- // store ideal points
- if (*storea == 1){
- for (int l=0; l<J; ++l)
- theta_store(count, l) = theta[l];
- }
-
- // store bill parameters
- if (*storei == 1){
- for (int l=0; l<K*2; ++l)
- eta_store(count, l) = eta[l];
- }
- count++;
- }
-
- R_CheckUserInterrupt(); // allow user interrupts
-
- } // end Gibbs loop
+ unsigned int count = 0;
+ // MCMC sampling occurs in this for loop
+ for (unsigned int iter = 0; iter < tot_iter; ++iter){
- delete stream; // clean up random number stream
-
- // return output
- Matrix<double> output;
- if(*storei == 0 && *storea == 1) {
- output = theta_store;
- }
- else if (*storei == 1 && *storea == 0){
- output = eta_store;
+ // sample latent utilities (Z)
+ irt_Z_update1(Z, X, theta, eta, stream);
+
+ // sample item (case, bill) parameters (eta)
+ irt_eta_update1(eta, Z, theta, AB0, AB0ab0, stream);
+
+ // sample ability (ideal points) (theta)
+ irt_theta_update1(theta, Z, eta, t0, T0, theta_eq, theta_ineq, stream);
+
+ // print results to screen
+ if (verbose > 0 && iter % verbose == 0) {
+ Rprintf("\n\nMCMCirt1d iteration %i of %i \n", (iter+1), tot_iter);
+ //Rprintf("theta = \n");
+ //for (int j=0; j<J; ++j)
+ //Rprintf("%10.5f\n", theta[j]);
}
- else {
- output = cbind(theta_store, eta_store);
+
+ // store results
+ if ((iter >= burnin) && ((iter % thin == 0))) {
+
+ // store ideal points
+ if (storea)
+ theta_store(count, _) = theta;
+
+ // store bill parameters
+ if (storei)
+ eta_store(count, _) = t(eta);
+ count++;
}
- const int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = output[i];
+ R_CheckUserInterrupt(); // allow user interrupts
+
+ } // end Gibbs loop
+ // return output
+ Matrix<> output;
+ if(! storei && storea) {
+ output = theta_store;
+ } else if (storei && ! storea){
+ output = eta_store;
+ } else {
+ output = cbind(theta_store, eta_store);
}
+
+ for (unsigned int i = 0; i < samplesize; ++i)
+ sampledata[i] = output[i];
+
}
+extern "C" {
+
+ void
+ MCMCirt1d(double* sampledata, const int* samplerow, const int* samplecol,
+ const int* Xdata, const int* Xrow, const int* Xcol,
+ const int* burnin, const int* mcmc, const int* thin,
+ const int *uselecuyer, const int *seedarray,
+ const int *lecuyerstream,
+ const int* verbose, const double* thetastartdata,
+ const int* thetastartrow, const int* thetastartcol,
+ const double* astartdata, const int* astartrow, const int* astartcol,
+ const double* bstartdata, const int* bstartrow, const int* bstartcol,
+ const double* t0, const double* T0, const double* ab0data,
+ const int* ab0row, const int* ab0col, const double* AB0data,
+ const int* AB0row, const int* AB0col, const double* thetaeqdata,
+ const int* thetaeqrow, const int* thetaeqcol,
+ const double* thetaineqdata, const int* thetaineqrow,
+ const int* thetaineqcol, const int* storei, const int* storea)
+ {
+ // put together matrices
+ const Matrix<int> X(*Xrow, *Xcol, Xdata);
+ Matrix<> theta(*thetastartrow, *thetastartcol, thetastartdata);
+ Matrix<> alpha(*astartrow, *astartcol, astartdata);
+ Matrix<> beta(*bstartrow, *bstartcol, bstartdata);
+ const Matrix<> ab0(*ab0row, *ab0col, ab0data);
+ const Matrix<> AB0(*AB0row, *AB0col, AB0data);
+ const Matrix<> theta_eq(*thetaeqrow, *thetaeqcol, thetaeqdata);
+ const Matrix<> theta_ineq(*thetaineqrow, *thetaineqcol, thetaineqdata);
+ Matrix<> eta = cbind(alpha, beta);
+ const int samplesize = (*samplerow) * (*samplecol);
+
+ MCMCPACK_PASSRNG2MODEL(MCMCirt1d_impl, X, theta, eta, ab0,
+ AB0, theta_eq, theta_ineq, *t0, *T0, *burnin, *mcmc, *thin,
+ *verbose, *storea, *storei, sampledata, samplesize);
+ }
+}
+#endif
diff --git a/src/MCMCirtKdRob.cc b/src/MCMCirtKdRob.cc
index 05eb0ef..dc99bf5 100644
--- a/src/MCMCirtKdRob.cc
+++ b/src/MCMCirtKdRob.cc
@@ -18,9 +18,12 @@
// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
//
// 2/18/2005 KQ
+// 8/1/2007 ported to Scythe 1.0.2 KQ
//
-#include <iostream>
+
+#ifndef MCMCIRTKDROB_CC
+#define MCMCIRTKDROB_CC
#include "matrix.h"
#include "distributions.h"
@@ -30,12 +33,16 @@
#include "smath.h"
#include "MCMCrng.h"
#include "MCMCfcds.h"
+#include "MCMCmnl.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
+
+typedef Matrix<double,Row,View> rmview;
+
using namespace std;
+using namespace scythe;
/* Equal probability sampling; without-replacement case */
@@ -45,13 +52,14 @@ using namespace std;
// y: k array of samled indices
// k: length of y (must be <= n)
// n: length of x (must be >= k)
+template <typename RNGTYPE>
static void SampleNoReplace(const int k, int n, int *y, int *x,
- rng* stream){
+ rng<RNGTYPE>& stream){
for (int i = 0; i < n; i++)
x[i] = i;
for (int i = 0; i < k; i++) {
- int j = static_cast<int>(n * stream->runif());
+ int j = static_cast<int>(n * stream.runif());
y[i] = x[j];
x[j] = x[--n];
}
@@ -63,14 +71,14 @@ static void SampleNoReplace(const int k, int n, int *y, int *x,
// this single element is Lambda(rowindex, colindex)
static double Lambda_logfcd(const double& lam_ij,
const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
const double& delta0,
const double& delta1,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
const double& k0,
const double& k1,
const double& c0,
@@ -98,22 +106,22 @@ static double Lambda_logfcd(const double& lam_ij,
// prior is uniform on hypersphere with radius 10
/*
- if (Lambda_ineq(rowindex,colindex) * lam_ij < 0){
+ if (Lambda_ineq(rowindex,colindex) * lam_ij < 0){
return log(0.0);
- }
- double absqdist = 0.0;
- for (int i=0; i<D; ++i){
+ }
+ double absqdist = 0.0;
+ for (int i=0; i<D; ++i){
if (i==colindex){
- absqdist += ::pow(lam_ij, 2);
+ absqdist += ::pow(lam_ij, 2);
}
else{
- absqdist += ::pow(Lambda(rowindex,i), 2);
+ absqdist += ::pow(Lambda(rowindex,i), 2);
}
- }
- if (absqdist > 100.0){
+ }
+ if (absqdist > 100.0){
return log(0.0);
- }
- const double logprior = 0.0;
+ }
+ const double logprior = 0.0;
*/
// likelihood
@@ -145,14 +153,14 @@ static double Lambda_logfcd(const double& lam_ij,
// this single element is theta(rowindex, colindex)
static double theta_logfcd(const double& t_ij,
const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
const double& delta0,
const double& delta1,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
const double& k0,
const double& k1,
const double& c0,
@@ -171,22 +179,22 @@ static double theta_logfcd(const double& t_ij,
// prior is uniform on unit circle
/*
- if (theta_ineq(rowindex,colindex-1) * t_ij < 0){
+ if (theta_ineq(rowindex,colindex-1) * t_ij < 0){
return log(0.0);
- }
- double tsqdist = 0.0;
- for (int i=0; i<(D-1); ++i){
+ }
+ double tsqdist = 0.0;
+ for (int i=0; i<(D-1); ++i){
if (i==(colindex-1)){
- tsqdist += ::pow(t_ij, 2);
+ tsqdist += ::pow(t_ij, 2);
}
else{
- tsqdist += ::pow(theta(rowindex,(i-1)), 2);
+ tsqdist += ::pow(theta(rowindex,(i-1)), 2);
}
- }
- if (tsqdist > 1.0){
+ }
+ if (tsqdist > 1.0){
return log(0.0);
- }
- const double logprior = 1.0;
+ }
+ const double logprior = 1.0;
*/
// likelihood
@@ -217,14 +225,14 @@ static double theta_logfcd(const double& t_ij,
// full conditional for delta0
static double delta0_logfcd(const double& delta0,
const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
const double& junk,
const double& delta1,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
const double& k0,
const double& k1,
const double& c0,
@@ -267,14 +275,14 @@ static double delta0_logfcd(const double& delta0,
// full conditional for delta1
static double delta1_logfcd(const double& delta1,
const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
const double& delta0,
const double& junk,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
const double& k0,
const double& k1,
const double& c0,
@@ -313,17 +321,21 @@ static double delta1_logfcd(const double& delta1,
}
+
+
+
// Radford Neal's (2000) doubling procedure coded for a logdensity
+template<typename RNGTYPE>
static void doubling(double (*logfun)(const double&,
const Matrix<int>&,
- const Matrix<double>&,
- const Matrix<double>&,
+ const Matrix<>&,
+ const Matrix<>&,
const double&,
const double&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
const double&,
const double&,
const double&,
@@ -333,14 +345,14 @@ static void doubling(double (*logfun)(const double&,
const int&,
const int&),
const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
const double& delta0,
const double& delta1,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
const double& k0,
const double& k1,
const double& c0,
@@ -351,10 +363,10 @@ static void doubling(double (*logfun)(const double&,
const int& colindex,
const double& z,
const double& w, const int& p,
- rng* stream, double& L, double& R,
+ rng<RNGTYPE>& stream, double& L, double& R,
const int& param){
- const double U = stream->runif();
+ const double U = stream.runif();
double x0;
if (param==0){ // Lambda
x0 = Lambda(rowindex, colindex);
@@ -383,7 +395,7 @@ static void doubling(double (*logfun)(const double&,
z < logfun(R, X, Lambda, theta, delta0, delta1, Lambda_prior_mean,
Lambda_prior_prec, Lambda_ineq, theta_ineq,
k0, k1, c0, d0, c1, d1, rowindex, colindex))){
- double V = stream->runif();
+ double V = stream.runif();
if (V < 0.5){
L = L - (R - L);
}
@@ -397,47 +409,48 @@ static void doubling(double (*logfun)(const double&,
// Radford Neal's (2000) stepping out procedure coded for a logdensity
+template<typename RNGTYPE>
static void StepOut(double (*logfun)(const double&,
- const Matrix<int>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const double&,
- const double&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const double&,
- const double&,
- const double&,
- const double&,
- const double&,
- const double&,
- const int&,
- const int&),
- const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
- const double& delta0,
- const double& delta1,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
- const double& k0,
- const double& k1,
- const double& c0,
- const double& d0,
- const double& c1,
- const double& d1,
- const int& rowindex,
- const int& colindex,
- const double& z,
- const double& w, const int& m,
- rng* stream, double& L, double& R,
- const int& param){
+ const Matrix<int>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const double&,
+ const double&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const double&,
+ const double&,
+ const double&,
+ const double&,
+ const double&,
+ const double&,
+ const int&,
+ const int&),
+ const Matrix<int>& X,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
+ const double& delta0,
+ const double& delta1,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
+ const double& k0,
+ const double& k1,
+ const double& c0,
+ const double& d0,
+ const double& c1,
+ const double& d1,
+ const int& rowindex,
+ const int& colindex,
+ const double& z,
+ const double& w, const int& m,
+ rng<RNGTYPE>& stream, double& L, double& R,
+ const int& param){
- const double U = stream->runif();
+ const double U = stream.runif();
double x0;
if (param==0){ // Lambda
x0 = Lambda(rowindex, colindex);
@@ -459,7 +472,7 @@ static void StepOut(double (*logfun)(const double&,
L = x0 - w*U;
R = L + w;
- const double V = stream->runif();
+ const double V = stream.runif();
int J = static_cast<int>(m*V);
int K = (m-1) - J;
while (J > 0 &&
@@ -485,14 +498,14 @@ static void StepOut(double (*logfun)(const double&,
// Radford Neal's (2000) Accept procedure coded for a logdensity
static const bool Accept(double (*logfun)(const double&,
const Matrix<int>&,
- const Matrix<double>&,
- const Matrix<double>&,
+ const Matrix<>&,
+ const Matrix<>&,
const double&,
const double&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
const double&,
const double&,
const double&,
@@ -502,14 +515,14 @@ static const bool Accept(double (*logfun)(const double&,
const int&,
const int&),
const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
const double& delta0,
const double& delta1,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
const double& k0,
const double& k1,
const double& c0,
@@ -554,16 +567,17 @@ static const bool Accept(double (*logfun)(const double&,
// Radford Neal's (2000) shrinkage procedure coded for a log density
// assumes the doubling procedure has been used to find L and R
+template <typename RNGTYPE>
static double shrinkageDoubling(double (*logfun)(const double&,
const Matrix<int>&,
- const Matrix<double>&,
- const Matrix<double>&,
+ const Matrix<>&,
+ const Matrix<>&,
const double&,
const double&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
const double&,
const double&,
const double&,
@@ -573,14 +587,14 @@ static double shrinkageDoubling(double (*logfun)(const double&,
const int&,
const int&),
const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
const double& delta0,
const double& delta1,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
const double& k0,
const double& k1,
const double& c0,
@@ -590,7 +604,8 @@ static double shrinkageDoubling(double (*logfun)(const double&,
const int& rowindex,
const int& colindex,
const double& z, const double& w,
- rng* stream, const double& L, const double& R,
+ rng<RNGTYPE>& stream, const double& L,
+ const double& R,
const int& param){
double Lbar = L;
@@ -614,11 +629,11 @@ static double shrinkageDoubling(double (*logfun)(const double&,
}
for (;;){
- const double U = stream->runif();
+ const double U = stream.runif();
const double x1 = Lbar + U*(Rbar - Lbar);
if (z <= logfun(x1, X, Lambda, theta, delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq, theta_ineq,
- k0, k1, c0, d0, c1, d1, rowindex, colindex) &&
+ Lambda_prior_prec, Lambda_ineq, theta_ineq,
+ k0, k1, c0, d0, c1, d1, rowindex, colindex) &&
Accept(logfun, X, Lambda, theta, delta0, delta1, Lambda_prior_mean,
Lambda_prior_prec, Lambda_ineq, theta_ineq,
k0, k1, c0, d0, c1, d1, rowindex, colindex, z, w,
@@ -638,16 +653,17 @@ static double shrinkageDoubling(double (*logfun)(const double&,
// Radford Neal's (2000) shrinkage procedure coded for a log density
// assumes the stepping out procedure has been used to find L and R
+template <typename RNGTYPE>
static double shrinkageStep(double (*logfun)(const double&,
const Matrix<int>&,
- const Matrix<double>&,
- const Matrix<double>&,
+ const Matrix<>&,
+ const Matrix<>&,
const double&,
const double&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
+ const Matrix<>&,
const double&,
const double&,
const double&,
@@ -657,14 +673,14 @@ static double shrinkageStep(double (*logfun)(const double&,
const int&,
const int&),
const Matrix<int>& X,
- const Matrix<double>& Lambda,
- const Matrix<double>& theta,
+ const Matrix<>& Lambda,
+ const Matrix<>& theta,
const double& delta0,
const double& delta1,
- const Matrix<double>& Lambda_prior_mean,
- const Matrix<double>& Lambda_prior_prec,
- const Matrix<double>& Lambda_ineq,
- const Matrix<double>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_ineq,
const double& k0,
const double& k1,
const double& c0,
@@ -674,7 +690,8 @@ static double shrinkageStep(double (*logfun)(const double&,
const int& rowindex,
const int& colindex,
const double& z, const double& w,
- rng* stream, const double& L, const double& R,
+ rng<RNGTYPE>& stream, const double& L,
+ const double& R,
const int& param){
double Lbar = L;
@@ -698,11 +715,11 @@ static double shrinkageStep(double (*logfun)(const double&,
}
for (;;){
- const double U = stream->runif();
+ const double U = stream.runif();
const double x1 = Lbar + U*(Rbar - Lbar);
if (z <= logfun(x1, X, Lambda, theta, delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq, theta_ineq,
- k0, k1, c0, d0, c1, d1, rowindex, colindex) ){
+ Lambda_prior_prec, Lambda_ineq, theta_ineq,
+ k0, k1, c0, d0, c1, d1, rowindex, colindex) ){
return(x1);
}
if (x1 < x0){
@@ -717,15 +734,367 @@ static double shrinkageStep(double (*logfun)(const double&,
+
+
+
+
+
+
+
+
+
+template <typename RNGTYPE>
+void MCMCirtKdRob_impl(rng<RNGTYPE>& stream,
+ const Matrix<int>& X,
+ Matrix<>& Lambda,
+ Matrix<>& theta,
+ const Matrix<>& Lambda_eq, const Matrix<>& Lambda_ineq,
+ const Matrix<>& theta_eq, const Matrix<>& theta_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const int* burnin, const int* mcmc, const int* thin,
+ const int* verbose,
+ const int* method_step,
+ const double* theta_w, const int* theta_p,
+ const double* lambda_w, const int* lambda_p,
+ const double* delta0_w, const int* delta0_p,
+ const double* delta1_w, const int* delta1_p,
+ const double * delta0start, const double* delta1start,
+ const double* k0, const double* k1,
+ const double* c0, const double* c1,
+ const double* d0, const double* d1,
+ const int* storeitem,
+ const int* storeability,
+ double* sampledata, const int* samplerow,
+ const int* samplecol
+ ){
+
+
+
+ // constants
+ const int K = X.cols(); // number of items
+ const int N = X.rows(); // number of subjects
+ const int D = Lambda.cols(); // number of dimensions + 1
+ const int tot_iter = *burnin + *mcmc;
+ const int nsamp = *mcmc / *thin;
+ // const Matrix<double> Lambda_free_indic = Matrix<double>(K, D);
+ //for (int i=0; i<(K*D); ++i){
+ // if (Lambda_eq[i] == -999) Lambda_free_indic[i] = 1.0;
+ //}
+
+ // starting values
+ // Matrix<double> theta = Matrix<double>(N, D-1);
+ Matrix<> onesvec = ones<double>(N, 1);
+ onesvec = onesvec * -1.0;
+ theta = cbind(onesvec, theta);
+ double delta0 = *delta0start;
+ double delta1 = *delta1start;
+
+ // index arrays (used for the random order of the sampling)
+ // OLD
+ //int K_array[K];
+ //int N_array[N];
+ //int D_array[D];
+ //int Dm1_array[D-1];
+ //int K_inds_perm[K];
+ //int N_inds_perm[N];
+ //int D_inds_perm[D];
+ //int Dm1_inds_perm[D-1];
+ // NEW
+ int* K_array = new int[K];
+ int* N_array = new int[N];
+ int* D_array = new int[D];
+ int* Dm1_array = new int[D-1];
+ int* K_inds_perm = new int[K];
+ int* N_inds_perm = new int[N];
+ int* D_inds_perm = new int[D];
+ int* Dm1_inds_perm = new int[D-1];
+
+
+ // storage matrices (row major order)
+ Matrix<> Lambda_store;
+ if (storeitem[0]==1){
+ Lambda_store = Matrix<double>(nsamp, K*D);
+ }
+ Matrix<> theta_store;
+ if (*storeability==1){
+ theta_store = Matrix<double>(nsamp, N*D);
+ }
+ Matrix<> delta0_store(nsamp, 1);
+ Matrix<> delta1_store(nsamp, 1);
+
+ ///////////////////
+ // Slice Sampler //
+ ///////////////////
+ int count = 0;
+ for (int iter=0; iter < tot_iter; ++iter){
+
+ double L, R, w, funval, z;
+ int p;
+
+ // sample theta
+ int param = 1;
+ SampleNoReplace(N, N, N_inds_perm, N_array, stream);
+ for (int ii=0; ii<N; ++ii){
+ int i = N_inds_perm[ii];
+ SampleNoReplace(D-1, D-1, Dm1_inds_perm, Dm1_array, stream);
+ for (int jj=0; jj<(D-1); ++jj){
+ int j = Dm1_inds_perm[jj]+1;
+ if (theta_eq(i,j-1) == -999){
+ w = *theta_w;
+ p = *theta_p;
+ L = -1.0;
+ R = 1.0;
+ funval = theta_logfcd(theta(i,j), X, Lambda,
+ theta, delta0,
+ delta1, Lambda_prior_mean,
+ Lambda_prior_prec,
+ Lambda_ineq, theta_ineq,
+ *k0, *k1, *c0, *d0,
+ *c1, *d1, i, j);
+ z = funval - stream.rexp(1.0);
+
+ if (*method_step == 1){
+ StepOut(&theta_logfcd, X, Lambda, theta, delta0, delta1,
+ Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, i, j, z,
+ w, p, stream, L, R, param);
+
+ theta(i,j) = shrinkageStep(&theta_logfcd, X, Lambda, theta,
+ delta0, delta1, Lambda_prior_mean,
+ Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1,
+ *c0, *d0, *c1,
+ *d1, i, j, z, w, stream,
+ L, R, param);
+ }
+ else{
+ doubling(&theta_logfcd, X, Lambda, theta, delta0, delta1,
+ Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, i, j, z,
+ w, p, stream, L, R, param);
+ theta(i,j) = shrinkageDoubling(&theta_logfcd, X, Lambda, theta,
+ delta0, delta1, Lambda_prior_mean,
+ Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1,
+ *c0, *d0, *c1,
+ *d1, i, j, z, w, stream,
+ L, R, param);
+ }
+ }
+ }
+ }
+
+
+
+ // sample Lambda
+ param = 0;
+ SampleNoReplace(K, K, K_inds_perm, K_array, stream);
+ for (int ii=0; ii<K; ++ii){
+ int i = K_inds_perm[ii];
+ SampleNoReplace(D, D, D_inds_perm, D_array, stream);
+ for (int jj=0; jj<D; ++jj){
+ int j = D_inds_perm[jj];
+ if (Lambda_eq(i,j) == -999){
+ w = *lambda_w;
+ p = *lambda_p;
+ L = -1.0;
+ R = 1.0;
+ funval = Lambda_logfcd(Lambda(i,j), X, Lambda,
+ theta, delta0,
+ delta1, Lambda_prior_mean,
+ Lambda_prior_prec,
+ Lambda_ineq, theta_ineq, *k0, *k1, *c0, *d0,
+ *c1, *d1, i, j);
+ z = funval - stream.rexp(1.0);
+ if (*method_step == 1){
+ StepOut(&Lambda_logfcd, X, Lambda, theta, delta0, delta1,
+ Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, i, j, z,
+ w, p, stream, L, R, param);
+ Lambda(i,j) = shrinkageStep(&Lambda_logfcd, X, Lambda, theta,
+ delta0, delta1, Lambda_prior_mean,
+ Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0,
+ *c1, *d1, i, j, z, w, stream,
+ L, R, param);
+ }
+ else{
+ doubling(&Lambda_logfcd, X, Lambda, theta, delta0, delta1,
+ Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, i, j, z,
+ w, p, stream, L, R, param);
+ Lambda(i,j) = shrinkageDoubling(&Lambda_logfcd, X, Lambda, theta,
+ delta0, delta1, Lambda_prior_mean,
+ Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0,
+ *c1, *d1, i, j, z, w, stream,
+ L, R, param);
+ }
+ }
+ }
+ }
+
+
+
+ // sample delta0
+ param = 2;
+ w = *delta0_w;
+ p = *delta0_p;
+ L = -1.0;
+ R = 1.0;
+ funval = delta0_logfcd(delta0, X, Lambda,
+ theta, delta0,
+ delta1, Lambda_prior_mean,
+ Lambda_prior_prec,
+ Lambda_ineq, theta_ineq,
+ *k0, *k1, *c0, *d0,
+ *c1, *d1, 0, 0);
+ z = funval - stream.rexp(1.0);
+ if (*method_step == 1){
+ StepOut(&delta0_logfcd, X, Lambda, theta, delta0, delta1,
+ Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, 0, 0, z,
+ w, p, stream, L, R, param);
+ delta0 = shrinkageStep(&delta0_logfcd, X, Lambda, theta,
+ delta0, delta1, Lambda_prior_mean,
+ Lambda_prior_prec, Lambda_ineq, theta_ineq,
+ *k0, *k1, *c0, *d0, *c1, *d1, 0, 0,
+ z, w, stream, L, R, param);
+ }
+ else{
+ doubling(&delta0_logfcd, X, Lambda, theta, delta0, delta1,
+ Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, 0, 0, z,
+ w, p, stream, L, R, param);
+ delta0 = shrinkageDoubling(&delta0_logfcd, X, Lambda, theta,
+ delta0, delta1, Lambda_prior_mean,
+ Lambda_prior_prec, Lambda_ineq, theta_ineq,
+ *k0, *k1, *c0, *d0, *c1, *d1, 0, 0,
+ z, w, stream, L, R, param);
+ }
+
+
+
+ // sample delta1
+ param = 3;
+ w = *delta1_w;
+ p = *delta1_p;
+ L = -1.0;
+ R = 1.0;
+ funval = delta1_logfcd(delta1, X, Lambda,
+ theta, delta0,
+ delta1, Lambda_prior_mean,
+ Lambda_prior_prec,
+ Lambda_ineq, theta_ineq, *k0, *k1, *c0, *d0,
+ *c1, *d1, 0, 0);
+ z = funval - stream.rexp(1.0);
+ if (*method_step == 1){
+ StepOut(&delta1_logfcd, X, Lambda, theta, delta0, delta1,
+ Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, 0, 0, z,
+ w, p, stream, L, R, param);
+ delta1 = shrinkageStep(&delta1_logfcd, X, Lambda, theta,
+ delta0, delta1, Lambda_prior_mean,
+ Lambda_prior_prec, Lambda_ineq, theta_ineq,
+ *k0, *k1, *c0, *d0, *c1, *d1, 0, 0,
+ z, w, stream, L, R, param);
+ }
+ else{
+ doubling(&delta1_logfcd, X, Lambda, theta, delta0, delta1,
+ Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
+ theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, 0, 0, z,
+ w, p, stream, L, R, param);
+ delta1 = shrinkageDoubling(&delta1_logfcd, X, Lambda, theta,
+ delta0, delta1, Lambda_prior_mean,
+ Lambda_prior_prec, Lambda_ineq, theta_ineq,
+ *k0, *k1, *c0, *d0, *c1, *d1, 0, 0,
+ z, w, stream, L, R, param);
+ }
+
+ // print results to screen
+ if (verbose[0] > 0 && iter % verbose[0] == 0){
+ Rprintf("\n\nMCMCirtKdRob iteration %i of %i \n", (iter+1), tot_iter);
+ }
+
+ // store results
+ if ((iter >= burnin[0]) && ((iter % thin[0]==0))) {
+
+ // store Lambda
+ if (storeitem[0]==1){
+ //Matrix<double> Lambda_store_vec = reshape(Lambda,1,K*D);
+ //for (int l=0; l<K*D; ++l)
+ // Lambda_store(count, l) = Lambda_store_vec[l];
+ rmview(Lambda_store(count, _)) = Lambda;
+ }
+
+ // store theta
+ if (storeability[0]==1){
+ //Matrix<double> theta_store_vec = reshape(theta, 1, N*D);
+ //for (int l=0; l<N*D; ++l)
+ // theta_store(count, l) = theta_store_vec[l];
+ rmview(theta_store(count, _)) = theta;
+ }
+
+ // store delta0 and delta1
+ delta0_store[count] = delta0;
+ delta1_store[count] = delta1;
+
+ count++;
+ }
+
+ // allow user interrupts
+ R_CheckUserInterrupt();
+ } // end MCMC loop
+
+
+
+
+
+ delete [] K_array;
+ delete [] N_array;
+ delete [] D_array;
+ delete [] Dm1_array;
+ delete [] K_inds_perm;
+ delete [] N_inds_perm;
+ delete [] D_inds_perm;
+ delete [] Dm1_inds_perm;
+
+
+
+
+ // return output
+ Matrix<double> output = delta0_store;
+ output = cbind(output, delta1_store);
+ if (*storeitem == 1){
+ output = cbind(output, Lambda_store);
+ }
+ if(*storeability == 1) {
+ output = cbind(output, theta_store);
+ }
+
+ int size = *samplerow * *samplecol;
+ for (int i=0; i<size; ++i)
+ sampledata[i] = output[i];
+
+
+}
+
+
+
+
+
+
+
extern "C"{
-// function called by R to fit model
+ // function called by R to fit model
void
irtKdRobpost (double* sampledata, const int* samplerow,
const int* samplecol,
const int* Xdata, const int* Xrow, const int* Xcol,
const int* burnin, const int* mcmc, const int* thin,
- const int *lecuyer, const int *seedarray,
+ const int *uselecuyer, const int *seedarray,
const int *lecuyerstream, const int* verbose,
const int* method_step,
const double* theta_w, const int* theta_p,
@@ -756,308 +1125,49 @@ extern "C"{
const int* storeability
) {
- // put together matrices
- const Matrix<int> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix<double> Lambda = r2scythe(*Lamstartrow, *Lamstartcol, Lamstartdata);
- Matrix<double> theta = r2scythe(*thetstartrow, *thetstartcol, thetstartdata);
- const Matrix<double> Lambda_eq = r2scythe(*Lameqrow, *Lameqcol, Lameqdata);
- const Matrix<double> Lambda_ineq = r2scythe(*Lamineqrow, *Lamineqcol,
- Lamineqdata);
- const Matrix<double> theta_eq = r2scythe(*theteqrow, *theteqcol,
- theteqdata);
- const Matrix<double> theta_ineq = r2scythe(*thetineqrow, *thetineqcol,
- thetineqdata);
- const Matrix<double> Lambda_prior_mean = r2scythe(*Lampmeanrow,
- *Lampmeancol,
- Lampmeandata);
- const Matrix<double> Lambda_prior_prec = r2scythe(*Lampprecrow,
- *Lamppreccol,
- Lampprecdata);
-
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // constants
- const int K = X.cols(); // number of items
- const int N = X.rows(); // number of subjects
- const int D = Lambda.cols(); // number of dimensions + 1
- const int tot_iter = *burnin + *mcmc;
- const int nsamp = *mcmc / *thin;
- // const Matrix<double> Lambda_free_indic = Matrix<double>(K, D);
- //for (int i=0; i<(K*D); ++i){
- // if (Lambda_eq[i] == -999) Lambda_free_indic[i] = 1.0;
- //}
-
- // starting values
- // Matrix<double> theta = Matrix<double>(N, D-1);
- theta = cbind(-1*ones<double>(N,1), theta);
- double delta0 = *delta0start;
- double delta1 = *delta1start;
-
- // index arrays (used for the random order of the sampling)
- int K_array[K];
- int N_array[N];
- int D_array[D];
- int Dm1_array[D-1];
- int K_inds_perm[K];
- int N_inds_perm[N];
- int D_inds_perm[D];
- int Dm1_inds_perm[D-1];
-
-
- // storage matrices (row major order)
- Matrix<double> Lambda_store;
- if (storeitem[0]==1){
- Lambda_store = Matrix<double>(nsamp, K*D);
- }
- Matrix<double> theta_store;
- if (*storeability==1){
- theta_store = Matrix<double>(nsamp, N*D);
- }
- Matrix<double> delta0_store = Matrix<double>(nsamp, 1);
- Matrix<double> delta1_store = Matrix<double>(nsamp, 1);
-
- ///////////////////
- // Slice Sampler //
- ///////////////////
- int count = 0;
- for (int iter=0; iter < tot_iter; ++iter){
-
- double L, R, w, funval, z;
- int p;
-
- // sample theta
- int param = 1;
- SampleNoReplace(N, N, N_inds_perm, N_array, stream);
- for (int ii=0; ii<N; ++ii){
- int i = N_inds_perm[ii];
- SampleNoReplace(D-1, D-1, Dm1_inds_perm, Dm1_array, stream);
- for (int jj=0; jj<(D-1); ++jj){
- int j = Dm1_inds_perm[jj]+1;
- if (theta_eq(i,j-1) == -999){
- w = *theta_w;
- p = *theta_p;
- L = -1.0;
- R = 1.0;
- funval = theta_logfcd(theta(i,j), X, Lambda,
- theta, delta0,
- delta1, Lambda_prior_mean,
- Lambda_prior_prec,
- Lambda_ineq, theta_ineq,
- *k0, *k1, *c0, *d0,
- *c1, *d1, i, j);
- z = funval - stream->rexp(1.0);
-
- if (*method_step == 1){
- StepOut(&theta_logfcd, X, Lambda, theta, delta0, delta1,
- Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, i, j, z,
- w, p, stream, L, R, param);
-
- theta(i,j) = shrinkageStep(&theta_logfcd, X, Lambda, theta,
- delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1,
- *c0, *d0, *c1,
- *d1, i, j, z, w, stream,
- L, R, param);
- }
- else{
- doubling(&theta_logfcd, X, Lambda, theta, delta0, delta1,
- Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, i, j, z,
- w, p, stream, L, R, param);
- theta(i,j) = shrinkageDoubling(&theta_logfcd, X, Lambda, theta,
- delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1,
- *c0, *d0, *c1,
- *d1, i, j, z, w, stream,
- L, R, param);
- }
- }
- }
- }
-
-
-
- // sample Lambda
- param = 0;
- SampleNoReplace(K, K, K_inds_perm, K_array, stream);
- for (int ii=0; ii<K; ++ii){
- int i = K_inds_perm[ii];
- SampleNoReplace(D, D, D_inds_perm, D_array, stream);
- for (int jj=0; jj<D; ++jj){
- int j = D_inds_perm[jj];
- if (Lambda_eq(i,j) == -999){
- w = *lambda_w;
- p = *lambda_p;
- L = -1.0;
- R = 1.0;
- funval = Lambda_logfcd(Lambda(i,j), X, Lambda,
- theta, delta0,
- delta1, Lambda_prior_mean,
- Lambda_prior_prec,
- Lambda_ineq, theta_ineq, *k0, *k1, *c0, *d0,
- *c1, *d1, i, j);
- z = funval - stream->rexp(1.0);
- if (*method_step == 1){
- StepOut(&Lambda_logfcd, X, Lambda, theta, delta0, delta1,
- Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, i, j, z,
- w, p, stream, L, R, param);
- Lambda(i,j) = shrinkageStep(&Lambda_logfcd, X, Lambda, theta,
- delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0,
- *c1, *d1, i, j, z, w, stream,
- L, R, param);
- }
- else{
- doubling(&Lambda_logfcd, X, Lambda, theta, delta0, delta1,
- Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, i, j, z,
- w, p, stream, L, R, param);
- Lambda(i,j) = shrinkageDoubling(&Lambda_logfcd, X, Lambda, theta,
- delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0,
- *c1, *d1, i, j, z, w, stream,
- L, R, param);
- }
- }
- }
- }
-
-
+ // put together matrices
+ const Matrix<int> X(*Xrow, *Xcol, Xdata);
+ Matrix<double> Lambda(*Lamstartrow, *Lamstartcol, Lamstartdata);
+ Matrix<double> theta(*thetstartrow, *thetstartcol, thetstartdata);
+ const Matrix<double> Lambda_eq(*Lameqrow, *Lameqcol, Lameqdata);
+ const Matrix<double> Lambda_ineq(*Lamineqrow, *Lamineqcol,
+ Lamineqdata);
+ const Matrix<double> theta_eq(*theteqrow, *theteqcol,
+ theteqdata);
+ const Matrix<double> theta_ineq(*thetineqrow, *thetineqcol,
+ thetineqdata);
+ const Matrix<double> Lambda_prior_mean(*Lampmeanrow,
+ *Lampmeancol,
+ Lampmeandata);
+ const Matrix<double> Lambda_prior_prec(*Lampprecrow,
+ *Lamppreccol,
+ Lampprecdata);
- // sample delta0
- param = 2;
- w = *delta0_w;
- p = *delta0_p;
- L = -1.0;
- R = 1.0;
- funval = delta0_logfcd(delta0, X, Lambda,
- theta, delta0,
- delta1, Lambda_prior_mean,
- Lambda_prior_prec,
- Lambda_ineq, theta_ineq,
- *k0, *k1, *c0, *d0,
- *c1, *d1, 0, 0);
- z = funval - stream->rexp(1.0);
- if (*method_step == 1){
- StepOut(&delta0_logfcd, X, Lambda, theta, delta0, delta1,
- Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, 0, 0, z,
- w, p, stream, L, R, param);
- delta0 = shrinkageStep(&delta0_logfcd, X, Lambda, theta,
- delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq, theta_ineq,
- *k0, *k1, *c0, *d0, *c1, *d1, 0, 0,
- z, w, stream, L, R, param);
- }
- else{
- doubling(&delta0_logfcd, X, Lambda, theta, delta0, delta1,
- Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, 0, 0, z,
- w, p, stream, L, R, param);
- delta0 = shrinkageDoubling(&delta0_logfcd, X, Lambda, theta,
- delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq, theta_ineq,
- *k0, *k1, *c0, *d0, *c1, *d1, 0, 0,
- z, w, stream, L, R, param);
- }
-
-
-
- // sample delta1
- param = 3;
- w = *delta1_w;
- p = *delta1_p;
- L = -1.0;
- R = 1.0;
- funval = delta1_logfcd(delta1, X, Lambda,
- theta, delta0,
- delta1, Lambda_prior_mean,
- Lambda_prior_prec,
- Lambda_ineq, theta_ineq, *k0, *k1, *c0, *d0,
- *c1, *d1, 0, 0);
- z = funval - stream->rexp(1.0);
- if (*method_step == 1){
- StepOut(&delta1_logfcd, X, Lambda, theta, delta0, delta1,
- Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, 0, 0, z,
- w, p, stream, L, R, param);
- delta1 = shrinkageStep(&delta1_logfcd, X, Lambda, theta,
- delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq, theta_ineq,
- *k0, *k1, *c0, *d0, *c1, *d1, 0, 0,
- z, w, stream, L, R, param);
- }
- else{
- doubling(&delta1_logfcd, X, Lambda, theta, delta0, delta1,
- Lambda_prior_mean, Lambda_prior_prec, Lambda_ineq,
- theta_ineq, *k0, *k1, *c0, *d0, *c1, *d1, 0, 0, z,
- w, p, stream, L, R, param);
- delta1 = shrinkageDoubling(&delta1_logfcd, X, Lambda, theta,
- delta0, delta1, Lambda_prior_mean,
- Lambda_prior_prec, Lambda_ineq, theta_ineq,
- *k0, *k1, *c0, *d0, *c1, *d1, 0, 0,
- z, w, stream, L, R, param);
- }
-
- // print results to screen
- if (verbose[0] > 0 && iter % verbose[0] == 0){
- Rprintf("\n\nMCMCirtKdRob iteration %i of %i \n", (iter+1), tot_iter);
- }
-
- // store results
- if ((iter >= burnin[0]) && ((iter % thin[0]==0))) {
-
- // store Lambda
- if (storeitem[0]==1){
- Matrix<double> Lambda_store_vec = reshape(Lambda,1,K*D);
- for (int l=0; l<K*D; ++l)
- Lambda_store(count, l) = Lambda_store_vec[l];
- }
-
- // store theta
- if (storeability[0]==1){
- Matrix<double> theta_store_vec = reshape(theta, 1, N*D);
- for (int l=0; l<N*D; ++l)
- theta_store(count, l) = theta_store_vec[l];
- }
-
- // store delta0 and delta1
- delta0_store[count] = delta0;
- delta1_store[count] = delta1;
-
- count++;
- }
-
- // allow user interrupts
- R_CheckUserInterrupt();
- } // end MCMC loop
-
- delete stream; // clean up random number stream
- // return output
- Matrix<double> output = delta0_store;
- output = cbind(output, delta1_store);
- if (*storeitem == 1){
- output = cbind(output, Lambda_store);
- }
- if(*storeability == 1) {
- output = cbind(output, theta_store);
- }
-
- int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = output[i];
+
+
+ MCMCPACK_PASSRNG2MODEL(MCMCirtKdRob_impl, X, Lambda, theta,
+ Lambda_eq, Lambda_ineq, theta_eq,
+ theta_ineq, Lambda_prior_mean,
+ Lambda_prior_prec, burnin, mcmc, thin,
+ verbose,
+ method_step,
+ theta_w, theta_p,
+ lambda_w, lambda_p,
+ delta0_w, delta0_p,
+ delta1_w, delta1_p,
+ delta0start, delta1start,
+ k0, k1,
+ c0, c1,
+ d0, d1,
+ storeitem,
+ storeability,
+ sampledata, samplerow,
+ samplecol
+ );
-}
+ }
}
@@ -1065,6 +1175,6 @@ extern "C"{
-
+#endif
diff --git a/src/MCMClogit.cc b/src/MCMClogit.cc
index 6104744..dfceae4 100644
--- a/src/MCMClogit.cc
+++ b/src/MCMClogit.cc
@@ -18,139 +18,144 @@
// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
//
// updated to the new version of Scythe 7/25/2004 KQ
+//
+//
+#ifndef MCMCLOGIT_CC
+#define MCMCLOGIT_CC
#include <iostream>
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
+using namespace scythe;
using namespace std;
-static double logit_logpost(const Matrix<double>& Y, const Matrix<double>& X,
- const Matrix<double>& beta,
- const Matrix<double>& beta_prior_mean,
- const Matrix<double>& beta_prior_prec){
-
+static double
+logit_logpost(const Matrix<>& Y, const Matrix<>& X, const Matrix<>& beta,
+ const Matrix<>& beta_prior_mean,
+ const Matrix<>& beta_prior_prec)
+{
// likelihood
- const Matrix<double> eta = X * beta;
- const Matrix<double> p = 1.0/(1.0 + exp(-eta));
+ const Matrix<> eta = X * beta;
+ const Matrix<> p = 1.0 / (1.0 + exp(-eta));
double loglike = 0.0;
- for (int i=0; i<Y.rows(); ++i)
- loglike += Y[i]*::log(p[i]) + (1-Y[i])*::log(1-p[i]);
-
- // prior
+
+ for (unsigned int i = 0; i < Y.rows(); ++ i)
+ loglike += Y(i) * ::log(p(i)) + (1 - Y(i)) * ::log(1 - p(i));
+
+ //prior
double logprior = 0.0;
- if (beta_prior_prec(0,0) != 0){
+ if (beta_prior_prec(0) != 0)
logprior = lndmvn(beta, beta_prior_mean, invpd(beta_prior_prec));
- }
return (loglike + logprior);
}
-extern "C"{
+template <typename RNGTYPE>
+void
+MCMClogit_impl (rng<RNGTYPE>& stream, const Matrix<>& Y,
+ const Matrix<>& X, const Matrix<>& tune, Matrix<>& beta,
+ const Matrix<>& b0, const Matrix<>& B0,
+ const Matrix<>& V, unsigned int burnin, unsigned int mcmc,
+ unsigned int thin, unsigned int verbose,
+ Matrix<>& result)
+{
+
+ // define constants
+ const unsigned int tot_iter = burnin + mcmc; // total mcmc iterations
+ const unsigned int k = X.cols();
- void MCMClogit(double *sampledata, const int *samplerow,
- const int *samplecol, const double *Ydata,
- const int *Yrow, const int *Ycol, const double *Xdata,
- const int *Xrow, const int *Xcol, const int *burnin,
- const int *mcmc, const int *thin, const double *tunedata,
- const int *tunerow, const int *tunecol, const int *lecuyer,
- const int *seedarray, const int *lecuyerstream,
- const int *verbose, const double *betastartdata,
- const int *betastartrow, const int *betastartcol,
- const double *b0data, const int *b0row, const int *b0col,
- const double *B0data, const int *B0row, const int *B0col,
- const double *Vdata, const int *Vrow, const int *Vcol) {
+ // proposal parameters
+ const Matrix<> propV = tune * invpd(B0 + invpd(V)) * tune;
+ const Matrix<> propC = cholesky(propV) ;
+
+ double logpost_cur = logit_logpost(Y, X, beta, b0, B0);
+
+ // MCMC loop
+ unsigned int count = 0;
+ unsigned int accepts = 0;
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
+
+ // sample beta
+ const Matrix<> beta_can = gaxpy(propC, stream.rnorm(k, 1, 0, 1), beta);
- // pull together Matrix objects
- const Matrix <double> Y = r2scythe(*Yrow, *Ycol, Ydata);
- const Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- const Matrix <double> tune = r2scythe(*tunerow, *tunecol, tunedata);
- Matrix <double> beta = r2scythe(*betastartrow, *betastartcol,
- betastartdata);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- const Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
- const Matrix <double> V = r2scythe(*Vrow, *Vcol, Vdata);
+ const double logpost_can = logit_logpost(Y, X, beta_can, b0, B0);
+ const double ratio = ::exp(logpost_can - logpost_cur);
- // define constants
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols();
+ if (stream.runif() < ratio) {
+ beta = beta_can;
+ logpost_cur = logpost_can;
+ ++accepts;
+ }
+
+ // store values in matrices
+ if (iter >= burnin && ((iter % thin) == 0)) {
+ result(count++, _) = beta;
+ }
- // storage matrix or matrices
- Matrix<double> storemat(nstore, k);
+ // print output to stdout
+ if(verbose > 0 && iter % verbose == 0){
+ Rprintf("\n\nMCMClogit iteration %i of %i \n", (iter+1), tot_iter);
+ Rprintf("beta = \n");
+ for (unsigned int j = 0; j < k; ++j)
+ Rprintf("%10.5f\n", beta(j));
+ Rprintf("Metropolis acceptance rate for beta = %3.5f\n\n",
+ static_cast<double>(accepts) / static_cast<double>(iter+1));
+ }
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
+ R_CheckUserInterrupt(); // allow user interrupts
- // proposal parameters
- const Matrix<double> propV = tune * invpd(B0 + invpd(V)) * tune;
- const Matrix<double> propC = cholesky(propV) ;
+ }// end MCMC loop
- double logpost_cur = logit_logpost(Y, X, beta, b0, B0);
-
- // MCMC loop
- int count = 0;
- int accepts = 0;
- for (int iter = 0; iter < tot_iter; ++iter){
-
- // sample beta
- const Matrix<double> beta_can = gaxpy(propC, stream->rnorm(k,1), beta);
-
- const double logpost_can = logit_logpost(Y,X,beta_can, b0, B0);
- const double ratio = ::exp(logpost_can - logpost_cur);
-
- if (stream->runif() < ratio){
- beta = beta_can;
- logpost_cur = logpost_can;
- ++accepts;
- }
-
- // store values in matrices
- if (iter >= *burnin && ((iter % *thin)==0)){
-
- for (int j = 0; j < k; j++)
- storemat(count, j) = beta[j];
- ++count;
- }
-
- // print output to stdout
- if(*verbose > 0 && iter % *verbose == 0){
- Rprintf("\n\nMCMClogit iteration %i of %i \n", (iter+1), tot_iter);
- Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
- Rprintf("%10.5f\n", beta[j]);
- Rprintf("Metropolis acceptance rate for beta = %3.5f\n\n",
- static_cast<double>(accepts) /
- static_cast<double>(iter+1));
- }
-
- R_CheckUserInterrupt(); // allow user interrupts
-
- }// end MCMC loop
-
- delete stream; // clean up random number stream
+ Rprintf("\n\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+ Rprintf("The Metropolis acceptance rate for beta was %3.5f",
+ static_cast<double>(accepts) / static_cast<double>(tot_iter));
+ Rprintf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+}
+
+extern "C"{
- // return output
- const int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = storemat[i];
-
- Rprintf("\n\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
- Rprintf("The Metropolis acceptance rate for beta was %3.5f",
- static_cast<double>(accepts) / static_cast<double>(tot_iter));
- Rprintf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+ void MCMClogit(double *sampledata, const int *samplerow,
+ const int *samplecol, const double *Ydata,
+ const int *Yrow, const int *Ycol, const double *Xdata,
+ const int *Xrow, const int *Xcol, const int *burnin,
+ const int *mcmc, const int *thin, const double *tunedata,
+ const int *tunerow, const int *tunecol,
+ const int *uselecuyer, const int *seedarray,
+ const int *lecuyerstream, const int *verbose,
+ const double *betastartdata, const int *betastartrow,
+ const int *betastartcol, const double *b0data,
+ const int *b0row, const int *b0col, const double *B0data,
+ const int *B0row, const int *B0col, const double *Vdata,
+ const int *Vrow, const int *Vcol)
+ {
+ // pull together Matrix objects
+ Matrix<> Y(*Yrow, *Ycol, Ydata);
+ Matrix<> X(*Xrow, *Xcol, Xdata);
+ Matrix<> tune(*tunerow, *tunecol, tunedata);
+ Matrix<> beta(*betastartrow, *betastartcol, betastartdata);
+ Matrix<> b0(*b0row, *b0col, b0data);
+ Matrix<> B0(*B0row, *B0col, B0data);
+ Matrix<> V(*Vrow, *Vcol, Vdata);
+
+ Matrix<> result(*samplerow, *samplecol, false);
+ MCMCPACK_PASSRNG2MODEL(MCMClogit_impl, Y, X, tune, beta, b0, B0, V,
+ *burnin, *mcmc, *thin, *verbose, result);
+
+ unsigned int size = *samplecol * *samplerow;
+ for (unsigned int i = 0; i < size; ++i)
+ sampledata[i] = result(i);
}
-
}
+#endif
diff --git a/src/MCMClogituserprior.cc b/src/MCMClogituserprior.cc
index e5042e6..6808b8e 100644
--- a/src/MCMClogituserprior.cc
+++ b/src/MCMClogituserprior.cc
@@ -22,6 +22,10 @@
//
//
+
+#ifndef MCMCLOGITUSERPRIOR_CC
+#define MCMCLOGITUSERPRIOR_CC
+
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
@@ -34,132 +38,102 @@
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
-using namespace std;
-
-extern "C" {
-
#include <Rdefines.h>
#include <Rinternals.h>
- // function that evaluatees the user supplied R function
- static double user_fun_eval(SEXP fun, SEXP theta, SEXP myframe){
-
- SEXP R_fcall;
- if(!isFunction(fun)) error("`fun' must be a function");
- if(!isEnvironment(myframe)) error("myframe must be an environment");
- PROTECT(R_fcall = lang2(fun, R_NilValue));
- SETCADR(R_fcall, theta);
- SEXP funval = eval(R_fcall, myframe);
- if (!isReal(funval)) error("`fun' must return a double");
- double fv = REAL(funval)[0];
- UNPROTECT(1);
- return fv;
- }
+using namespace std;
+using namespace scythe;
- static double logit_loglike(const Matrix<double>& Y,
- const Matrix<double>& X,
- const Matrix<double>& beta){
-
- // likelihood
- const Matrix<double> eta = X * beta;
- const Matrix<double> p = 1.0/(1.0 + exp(-eta));
- double loglike = 0.0;
- for (int i=0; i<Y.rows(); ++i)
- loglike += Y[i]*::log(p[i]) + (1-Y[i])*::log(1-p[i]);
-
- return loglike;
- }
-
- // the function that actually does the sampling and returns a value to R
- SEXP MCMClogituserprior_cc(SEXP fun, SEXP Y_R, SEXP X_R,
- SEXP theta, SEXP myframe, SEXP burnin_R,
- SEXP mcmc_R, SEXP thin_R,
- SEXP verbose, SEXP lecuyer_R, SEXP seedarray_R,
- SEXP lecuyerstream_R, SEXP logfun,
- SEXP propvar_R){
+
+// function that evaluatees the user supplied R function
+static double user_fun_eval(SEXP fun, SEXP theta, SEXP myframe){
- // put burnin_R, mcmc_R, and thin_R into ints
- const int burnin = INTEGER(burnin_R)[0];
- const int mcmc = INTEGER(mcmc_R)[0];
- const int thin = INTEGER(thin_R)[0];
+ SEXP R_fcall;
+ if(!isFunction(fun)) error("`fun' must be a function");
+ if(!isEnvironment(myframe)) error("myframe must be an environment");
+ PROTECT(R_fcall = lang2(fun, R_NilValue));
+ SETCADR(R_fcall, theta);
+ SEXP funval = eval(R_fcall, myframe);
+ if (!isReal(funval)) error("`fun' must return a double");
+ double fv = REAL(funval)[0];
+ UNPROTECT(1);
+ return fv;
+}
+
+static double logit_loglike(const Matrix<double>& Y,
+ const Matrix<double>& X,
+ const Matrix<double>& beta){
- // put rng stuff together and initiate stream
- int seedarray[6];
- for(int i=0; i<6; ++i) seedarray[i] = INTEGER(seedarray_R)[i];
- rng *stream = MCMCpack_get_rng(INTEGER(lecuyer_R)[0],
- seedarray, INTEGER(lecuyerstream_R)[0]);
-
- // put propvar_R into a Matrix
- double* propvar_data = REAL(propvar_R);
- const int propvar_nr = nrows(propvar_R);
- const int propvar_nc = ncols(propvar_R);
- Matrix <double> propvar (propvar_nc, propvar_nr, propvar_data);
- propvar = t(propvar);
+ // likelihood
+ const Matrix<double> eta = X * beta;
+ const Matrix<double> p = 1.0/(1.0 + exp(-eta));
+ double loglike = 0.0;
+ for (unsigned int i=0; i<Y.rows(); ++i)
+ loglike += Y[i]*::log(p[i]) + (1-Y[i])*::log(1-p[i]);
- // put Y_R into a Scythe Matrix
- int* Y_data = INTEGER(Y_R);
- const int Y_nr = length(Y_R);
- const int Y_nc = 1;
- Matrix <int> Y_M (Y_nc, Y_nr, Y_data);
- Y_M = t(Y_M);
+ return loglike;
+}
+
+template <typename RNGTYPE>
+void MCMClogituserprior_impl(rng<RNGTYPE>& stream, SEXP fun,
+ SEXP theta, SEXP myframe,
+ unsigned int burnin,
+ unsigned int mcmc, unsigned int thin,
+ unsigned int verbose, bool logfun,
+ const Matrix<>& propvar, const Matrix<>& Y_M,
+ const Matrix<>& X_M, SEXP& sample_SEXP){
- // put X_R into a Scythe Matrix
- double* X_data = REAL(X_R);
- const int X_nr = nrows(X_R);
- const int X_nc = ncols(X_R);
- Matrix <double> X_M (X_nc, X_nr, X_data);
- X_M = t(X_M);
-
// define constants
- const int npar = length(theta);
- const int tot_iter = burnin + mcmc;
- const int nsamp = mcmc/thin;
- const Matrix <double> propc = cholesky(propvar);
+ const unsigned int npar = length(theta);
+ const unsigned int tot_iter = burnin + mcmc;
+ const unsigned int nsamp = mcmc/thin;
+ const Matrix <> propc = cholesky(propvar);
// define matrix to hold the sample
- Matrix <double> sample (nsamp, npar);
+ Matrix <> sample (nsamp, npar, false);
// put theta into a Scythe Matrix
double* theta_data = REAL(theta);
const int theta_nr = length(theta);
const int theta_nc = 1;
- Matrix <double> theta_M (theta_nc, theta_nr, theta_data);
+ Matrix <> theta_M (theta_nc, theta_nr, theta_data);
theta_M = t(theta_M);
// evaluate userfun at starting value
double loglike_val = logit_loglike(Y_M, X_M, theta_M);
double userfun_cur = user_fun_eval(fun, theta, myframe);
- if (INTEGER(logfun)[0]==0) userfun_cur = ::log(userfun_cur);
+ if (! logfun)
+ userfun_cur = ::log(userfun_cur);
userfun_cur += loglike_val;
// THE METROPOLIS SAMPLING
int count = 0;
int accepts = 0;
- for (int iter=0; iter<tot_iter; ++iter){
+ for (unsigned int iter=0; iter<tot_iter; ++iter){
// generate candidate value of theta
- Matrix <double> theta_can_M = theta_M + propc * stream->rnorm(npar,1);
+ Matrix <> theta_can_M = theta_M + propc * stream.rnorm(npar,1, 0, 1);
// put theta_can_M into a SEXP
SEXP theta_can;
theta_can = PROTECT(allocVector(REALSXP, npar));
- for (int i=0; i<npar; ++i){
- REAL(theta_can)[i] = theta_can_M[i];
+ for (unsigned int i=0; i<npar; ++i){
+ REAL(theta_can)[i] = theta_can_M(i);
}
// evaluate user function fun at candidate theta
loglike_val = logit_loglike(Y_M, X_M, theta_can_M);
double userfun_can = user_fun_eval(fun, theta_can, myframe);
- if (INTEGER(logfun)[0]==0) userfun_can = ::log(userfun_can);
+ if (! logfun)
+ userfun_can = std::log(userfun_can);
userfun_can += loglike_val;
- const double ratio = ::exp(userfun_can - userfun_cur);
+ const double ratio = std::exp(userfun_can - userfun_cur);
- if (stream->runif() < ratio){
+ if (stream() < ratio){
theta = theta_can;
theta_M = theta_can_M;
userfun_cur = userfun_can;
@@ -168,15 +142,15 @@ extern "C" {
// store values in matrices
if ((iter%thin)==0 && iter >= burnin){
- for (int j = 0; j < npar; j++)
+ for (unsigned int j = 0; j < npar; j++)
sample(count, j) = REAL(theta)[j];
++count;
}
- if (INTEGER(verbose)[0] > 0 && iter % INTEGER(verbose)[0] == 0) {
+ if (verbose && iter % verbose == 0) {
Rprintf("MCMClogit iteration %i of %i \n", (iter+1), tot_iter);
Rprintf("beta = \n");
- for (int i=0; i<npar; ++i)
+ for (unsigned int i=0; i<npar; ++i)
Rprintf("%10.5f\n", REAL(theta)[i]);
Rprintf("function value = %10.5f\n", userfun_cur);
Rprintf("Metropolis acceptance rate = %3.5f\n\n",
@@ -190,16 +164,14 @@ extern "C" {
}
// put the sample into a SEXP and return it
- SEXP sample_SEXP;
sample_SEXP = PROTECT(allocMatrix(REALSXP, nsamp, npar));
- for (int i=0; i<nsamp; ++i){
- for (int j=0; j<npar; ++j){
+ for (unsigned int i=0; i<nsamp; ++i){
+ for (unsigned int j=0; j<npar; ++j){
REAL(sample_SEXP)[i + nsamp*j] = sample(i,j);
}
}
UNPROTECT(1);
- delete stream; // clean up random number stream
// print the the acceptance rate to the console in a way that
// everyone (even Windows users) can see
@@ -208,8 +180,77 @@ extern "C" {
static_cast<double>(accepts) / static_cast<double>(tot_iter));
Rprintf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+
+}
+
+
+
+
+
+
+
+
+extern "C" {
+
+ // the function that actually does the sampling and returns a value to R
+ SEXP MCMClogituserprior_cc(SEXP fun, SEXP Y_R, SEXP X_R,
+ SEXP theta, SEXP myframe, SEXP burnin_R,
+ SEXP mcmc_R, SEXP thin_R,
+ SEXP verbose, SEXP lecuyer_R, SEXP seedarray_R,
+ SEXP lecuyerstream_R, SEXP logfun,
+ SEXP propvar_R){
+
+
+ // put rng stuff together and initiate stream
+ int seedarray[6];
+ for(int i=0; i<6; ++i) seedarray[i] = INTEGER(seedarray_R)[i];
+ int uselecuyer_cc = INTEGER(lecuyer_R)[0];
+ int lecuyerstream_cc = INTEGER(lecuyerstream_R)[0];
+ int* uselecuyer = &uselecuyer_cc;
+ int* lecuyerstream = &lecuyerstream_cc;
+
+
+ // put propvar_R into a Matrix
+ double* propvar_data = REAL(propvar_R);
+ const int propvar_nr = nrows(propvar_R);
+ const int propvar_nc = ncols(propvar_R);
+ Matrix <double,Row> propvarpre (propvar_nc, propvar_nr, propvar_data);
+ //propvar = Matrix<>(propvar.rows(), propvar.cols(),
+ // propvar.begin_f<Row>());
+ Matrix<> propvar = t(propvarpre);
+
+ // put Y_R into a Scythe Matrix
+ int* Y_data = INTEGER(Y_R);
+ const int Y_nr = length(Y_R);
+ const int Y_nc = 1;
+ Matrix <int,Row> Y_Mpre (Y_nc, Y_nr, Y_data);
+ //Y_M = Matrix<int>(Y_M.rows(), Y_M.cols(), Y_M.begin_f<Row>());
+ Matrix<int> Y_M = t(Y_Mpre);
+
+ // put X_R into a Scythe Matrix
+ double* X_data = REAL(X_R);
+ const int X_nr = nrows(X_R);
+ const int X_nc = ncols(X_R);
+ Matrix <double,Row> X_Mpre (X_nc, X_nr, X_data);
+ //X_M = Matrix<>(X_M.rows(), X_M.cols(), X_M.begin_f<Row>());
+ Matrix<> X_M = t(X_Mpre);
+
+
+ SEXP sample_SEXP;
+ MCMCPACK_PASSRNG2MODEL(MCMClogituserprior_impl, fun, theta, myframe,
+ INTEGER(burnin_R)[0], INTEGER(mcmc_R)[0],
+ INTEGER(thin_R)[0],
+ INTEGER(verbose)[0], INTEGER(logfun)[0],
+ propvar, Y_M, X_M,
+ sample_SEXP)
+
+
// return the sample
return sample_SEXP;
}
}
+
+
+
+#endif
diff --git a/src/MCMCmetrop1R.cc b/src/MCMCmetrop1R.cc
index 3db8cce..a7be8ac 100644
--- a/src/MCMCmetrop1R.cc
+++ b/src/MCMCmetrop1R.cc
@@ -20,6 +20,9 @@
// KQ 6/24/2004
// updated to work with new Scythe and RNGs ADM 7/24/2004
+#ifndef MCMCMETROP1R_CC
+#define MCMCMETROP1R_CC
+
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
@@ -32,148 +35,161 @@
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
-using namespace std;
-
-extern "C" {
-
#include <Rdefines.h>
#include <Rinternals.h>
- // function that evaluatees the user supplied R function
- static double user_fun_eval(SEXP fun, SEXP theta, SEXP myframe){
+using namespace std;
+using namespace scythe;
+
+// function that evaluatees the user supplied R function
+double user_fun_eval(SEXP fun, SEXP theta, SEXP myframe) {
+
+ SEXP R_fcall;
+ if(!isFunction(fun)) error("`fun' must be a function");
+ if(!isEnvironment(myframe)) error("myframe must be an environment");
+ PROTECT(R_fcall = lang2(fun, R_NilValue));
+ SETCADR(R_fcall, theta);
+ SEXP funval = eval(R_fcall, myframe);
+ if (!isReal(funval)) error("`fun' must return a double");
+ double fv = REAL(funval)[0];
+ UNPROTECT(1);
+ return fv;
+}
+
+template <typename RNGTYPE>
+void MCMCmetrop1R_impl (rng<RNGTYPE>& stream, SEXP fun,
+ SEXP theta, SEXP myframe,
+ unsigned int burnin,
+ unsigned int mcmc, unsigned int thin,
+ unsigned int verbose, bool logfun,
+ const Matrix<>& propvar, SEXP& sample_SEXP)
+{
+ // define constants
+ const unsigned int npar = length(theta);
+ const unsigned int tot_iter = burnin + mcmc;
+ const unsigned int nsamp = mcmc / thin;
+ const Matrix <> propc = cholesky(propvar);
+
+ // initialize matrix to hold the sample
+ Matrix<> sample(nsamp, npar, false);
+
+ // put theta into a Scythe Matrix
+ double* theta_data = REAL(theta);
+ const int theta_nr = length(theta);
+ const int theta_nc = 1;
+ Matrix <> theta_M (theta_nc, theta_nr, theta_data);
+ theta_M = t(theta_M);
+
+ // evaluate userfun at starting value
+ double userfun_cur = user_fun_eval(fun, theta, myframe);
+ if (! logfun)
+ userfun_cur = std::log(userfun_cur);
+
+
+ // THE METROPOLIS SAMPLING
+ unsigned int count = 0;
+ unsigned int accepts = 0;
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
+
+ // generate candidate value of theta
+ Matrix <> theta_can_M = theta_M + propc * stream.rnorm(npar,1, 0, 1);
+
+ // put theta_can_M into a SEXP
+ SEXP theta_can;
+ theta_can = PROTECT(allocVector(REALSXP, npar));
+ for (unsigned int i = 0; i < npar; ++i) {
+ REAL(theta_can)[i] = theta_can_M(i);
+ }
+
+ // evaluate user function fun at candidate theta
+ double userfun_can = user_fun_eval(fun, theta_can, myframe);
+ if (! logfun)
+ userfun_can = std::log(userfun_can);
+ const double ratio = std::exp(userfun_can - userfun_cur);
- SEXP R_fcall;
- if(!isFunction(fun)) error("`fun' must be a function");
- if(!isEnvironment(myframe)) error("myframe must be an environment");
- PROTECT(R_fcall = lang2(fun, R_NilValue));
- SETCADR(R_fcall, theta);
- SEXP funval = eval(R_fcall, myframe);
- if (!isReal(funval)) error("`fun' must return a double");
- double fv = REAL(funval)[0];
- UNPROTECT(1);
- return fv;
+ if (stream() < ratio) {
+ theta = theta_can;
+ theta_M = theta_can_M;
+ userfun_cur = userfun_can;
+ ++accepts;
+ }
+
+ // store values in matrices
+ if ((iter%thin) == 0 && iter >= burnin) {
+ for (unsigned int j = 0; j < npar; j++)
+ sample(count, j) = REAL(theta)[j];
+ ++count;
+ }
+
+ if (verbose && iter % verbose == 0) {
+ Rprintf("MCMCmetrop1R iteration %i of %i \n", (iter+1), tot_iter);
+ Rprintf("theta = \n");
+ for (unsigned int i = 0; i < npar; ++i)
+ Rprintf("%10.5f\n", REAL(theta)[i]);
+ Rprintf("function value = %10.5f\n", userfun_cur);
+ Rprintf("Metropolis acceptance rate = %3.5f\n\n",
+ static_cast<double>(accepts) / static_cast<double>(iter+1));
+ }
+
+
+ UNPROTECT(1);
+ R_CheckUserInterrupt(); // allow user interrupts
}
+ // put the sample into a SEXP and return it
+ sample_SEXP = PROTECT(allocMatrix(REALSXP, nsamp, npar));
+ for (unsigned int i = 0; i < nsamp; ++i) {
+ for (unsigned int j = 0; j < npar; ++j) {
+ REAL(sample_SEXP)[i + nsamp * j] = sample(i,j);
+ }
+ }
+ UNPROTECT(1);
+
+ // print the the acceptance rate to the console in a way that
+ // everyone (even Windows users) can see
+ Rprintf("\n\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+ Rprintf("The Metropolis acceptance rate was %3.5f",
+ static_cast<double>(accepts) / static_cast<double>(tot_iter));
+ Rprintf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+}
+
+
+extern "C" {
// the function that actually does the sampling and returns a value to R
SEXP MCMCmetrop1R_cc(SEXP fun, SEXP theta, SEXP myframe, SEXP burnin_R,
SEXP mcmc_R, SEXP thin_R,
SEXP verbose, SEXP lecuyer_R, SEXP seedarray_R,
SEXP lecuyerstream_R, SEXP logfun,
- SEXP propvar_R){
-
- // put burnin_R, mcmc_R, and thin_R into ints
- const int burnin = INTEGER(burnin_R)[0];
- const int mcmc = INTEGER(mcmc_R)[0];
- const int thin = INTEGER(thin_R)[0];
-
- // put rng stuff together and initiate stream
+ SEXP propvar_R)
+ {
+ // put rng stuff together
int seedarray[6];
for(int i=0; i<6; ++i) seedarray[i] = INTEGER(seedarray_R)[i];
- rng *stream = MCMCpack_get_rng(INTEGER(lecuyer_R)[0],
- seedarray, INTEGER(lecuyerstream_R)[0]);
-
+ int uselecuyer_cc = INTEGER(lecuyer_R)[0];
+ int lecuyerstream_cc = INTEGER(lecuyerstream_R)[0];
+ int* uselecuyer = &uselecuyer_cc;
+ int* lecuyerstream = &lecuyerstream_cc;
+
// put propvar_R into a Matrix
double* propvar_data = REAL(propvar_R);
const int propvar_nr = nrows(propvar_R);
const int propvar_nc = ncols(propvar_R);
- Matrix <double> propvar (propvar_nc, propvar_nr, propvar_data);
+ Matrix <> propvar (propvar_nc, propvar_nr, propvar_data);
propvar = t(propvar);
-
- // define constants
- const int npar = length(theta);
- const int tot_iter = burnin + mcmc;
- const int nsamp = mcmc/thin;
- const Matrix <double> propc = cholesky(propvar);
-
- // define matrix to hold the sample
- Matrix <double> sample (nsamp, npar);
-
- // put theta into a Scythe Matrix
- double* theta_data = REAL(theta);
- const int theta_nr = length(theta);
- const int theta_nc = 1;
- Matrix <double> theta_M (theta_nc, theta_nr, theta_data);
- theta_M = t(theta_M);
-
- // evaluate userfun at starting value
- double userfun_cur = user_fun_eval(fun, theta, myframe);
- if (INTEGER(logfun)[0]==0) userfun_cur = ::log(userfun_cur);
-
-
- // THE METROPOLIS SAMPLING
- int count = 0;
- int accepts = 0;
- for (int iter=0; iter<tot_iter; ++iter){
- // generate candidate value of theta
- Matrix <double> theta_can_M = theta_M + propc * stream->rnorm(npar,1);
-
- // put theta_can_M into a SEXP
- SEXP theta_can;
- theta_can = PROTECT(allocVector(REALSXP, npar));
- for (int i=0; i<npar; ++i){
- REAL(theta_can)[i] = theta_can_M[i];
- }
-
- // evaluate user function fun at candidate theta
- double userfun_can = user_fun_eval(fun, theta_can, myframe);
- if (INTEGER(logfun)[0]==0) userfun_can = ::log(userfun_can);
- const double ratio = ::exp(userfun_can - userfun_cur);
-
- if (stream->runif() < ratio){
- theta = theta_can;
- theta_M = theta_can_M;
- userfun_cur = userfun_can;
- ++accepts;
- }
-
- // store values in matrices
- if ((iter%thin)==0 && iter >= burnin){
- for (int j = 0; j < npar; j++)
- sample(count, j) = REAL(theta)[j];
- ++count;
- }
-
- if (INTEGER(verbose)[0] > 0 && iter % INTEGER(verbose)[0] == 0) {
- Rprintf("MCMCmetrop1R iteration %i of %i \n", (iter+1), tot_iter);
- Rprintf("theta = \n");
- for (int i=0; i<npar; ++i)
- Rprintf("%10.5f\n", REAL(theta)[i]);
- Rprintf("function value = %10.5f\n", userfun_cur);
- Rprintf("Metropolis acceptance rate = %3.5f\n\n",
- static_cast<double>(accepts) /
- static_cast<double>(iter+1));
- }
-
-
- UNPROTECT(1);
- R_CheckUserInterrupt(); // allow user interrupts
- }
-
- // put the sample into a SEXP and return it
SEXP sample_SEXP;
- sample_SEXP = PROTECT(allocMatrix(REALSXP, nsamp, npar));
- for (int i=0; i<nsamp; ++i){
- for (int j=0; j<npar; ++j){
- REAL(sample_SEXP)[i + nsamp*j] = sample(i,j);
- }
- }
- UNPROTECT(1);
-
- delete stream; // clean up random number stream
-
- // print the the acceptance rate to the console in a way that
- // everyone (even Windows users) can see
- Rprintf("\n\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
- Rprintf("The Metropolis acceptance rate was %3.5f",
- static_cast<double>(accepts) / static_cast<double>(tot_iter));
- Rprintf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+ MCMCPACK_PASSRNG2MODEL(MCMCmetrop1R_impl, fun, theta, myframe,
+ INTEGER(burnin_R)[0], INTEGER(mcmc_R)[0],
+ INTEGER(thin_R)[0],
+ INTEGER(verbose)[0], INTEGER(logfun)[0],
+ propvar, sample_SEXP)
+
// return the sample
return sample_SEXP;
-
}
}
+
+#endif
diff --git a/src/MCMCmixfactanal.cc b/src/MCMCmixfactanal.cc
index 7e34d46..207cf80 100644
--- a/src/MCMCmixfactanal.cc
+++ b/src/MCMCmixfactanal.cc
@@ -23,9 +23,14 @@
// fixed a bug pointed out by Alexander Raach 1/16/2005 KQ
//
-#include<iostream>
+
+#ifndef MCMCMIXFACTANAL_CC
+#define MCMCMIXFACTANAL_CC
+
+#include <iostream>
#include "matrix.h"
+#include "algorithm.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
@@ -37,319 +42,360 @@
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
-using namespace std;
+typedef Matrix<double,Row,View> rmview;
+using namespace std;
+using namespace scythe;
-extern "C"{
-// function called by R to fit model
-void
-mixfactanalpost (double* sampledata, const int* samplerow,
- const int* samplecol,
- const double* Xdata, const int* Xrow, const int* Xcol,
- const int* burnin, const int* mcmc, const int* thin,
- const double* tune, const int *lecuyer, const int *seedarray,
- const int *lecuyerstream, const int* verbose,
- const double* Lamstartdata, const int* Lamstartrow,
- const int* Lamstartcol,
- const double* gamdata, const int* gamrow, const int* gamcol,
- const double* Psistartdata,
- const int* Psistartrow, const int* Psistartcol,
- const int* ncatdata, const int* ncatrow, const int* ncatcol,
- const double* Lameqdata, const int* Lameqrow,
- const int* Lameqcol,
- const double* Lamineqdata, const int* Lamineqrow,
- const int* Lamineqcol,
- const double* Lampmeandata, const int* Lampmeanrow,
- const int* Lampmeancol,
- const double* Lampprecdata, const int* Lampprecrow,
- const int* Lamppreccol,
- const double* a0data, const int* a0row, const int* a0col,
- const double* b0data, const int* b0row, const int* b0col,
- const int* storelambda,
- const int* storescores,
- int* acceptsdata, const int* acceptsrow,
- const int* acceptscol
- ) {
-
- // put together matrices
- const Matrix<double> Xstar = r2scythe(*Xrow, *Xcol, Xdata);
- const Matrix<int> X = Matrix<int>(*Xrow, *Xcol);
- for (int i=0; i<(*Xrow * *Xcol); ++i)
- X[i] = static_cast<int>(Xstar[i]);
-
- Matrix<double> Lambda = r2scythe(*Lamstartrow, *Lamstartcol,
- Lamstartdata);
- const Matrix<double> gamma = r2scythe(*gamrow, *gamcol, gamdata);
- const Matrix<double> Psi = r2scythe(*Psistartrow, *Psistartcol,
- Psistartdata);
- const Matrix<double> Psi_inv = invpd(Psi);
- const Matrix<int> ncateg = r2scythe(*ncatrow, *ncatcol, ncatdata);
- const Matrix<double> Lambda_eq = r2scythe(*Lameqrow, *Lameqcol,
- Lameqdata);
- const Matrix<double> Lambda_ineq = r2scythe(*Lamineqrow, *Lamineqcol,
- Lamineqdata);
- const Matrix<double> Lambda_prior_mean = r2scythe(*Lampmeanrow,
- *Lampmeancol,
- Lampmeandata);
- const Matrix<double> Lambda_prior_prec = r2scythe(*Lampprecrow,
- *Lamppreccol,
- Lampprecdata);
- const Matrix <double> a0 = r2scythe(*a0row, *a0col, a0data);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- Matrix<int> accepts = r2scythe(*acceptsrow, *acceptscol, acceptsdata);
+template <typename RNGTYPE>
+void MCMCmixfactanal_impl(rng<RNGTYPE>& stream,
+ const Matrix<int>& X,
+ const Matrix<>& Xstar,
+ Matrix<>& Psi,
+ Matrix<>& Psi_inv,
+ const Matrix<>& a0,
+ const Matrix<>& b0,
+ Matrix<>& Lambda,
+ Matrix<>& gamma, const Matrix<>& ncateg,
+ const Matrix<>& Lambda_eq,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const double* tune,
+ bool storelambda, bool storescores,
+ unsigned int burnin,
+ unsigned int mcmc, unsigned int thin,
+ unsigned int verbose, Matrix<int>& accepts,
+ Matrix<>& output
+ ){
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
- // constants
- const int K = X.cols(); // number of manifest variables
- int n_ord_ge3 = 0; // number of ordinal varibles with >= 3 categories
- for (int i=0; i<K; ++i)
- if (ncateg[i] >= 3) ++n_ord_ge3;
- const int N = X.rows(); // number of observations
- const int D = Lambda.cols(); // number of factors (including constant)
- const int tot_iter = *burnin + *mcmc;
- const int nsamp = *mcmc / *thin;
- const Matrix<double> I = eye<double>(D-1);
- const Matrix<double> Lambda_free_indic = Matrix<double>(K, D);
- for (int i=0; i<(K*D); ++i){
- if (Lambda_eq[i] == -999) Lambda_free_indic[i] = 1.0;
- }
+ // constants
+ const unsigned int K = X.cols(); // number of manifest variables
+ int n_ord_ge3 = 0; // number of ordinal varibles with >= 3 categories
+ for (unsigned int i=0; i<K; ++i)
+ if (ncateg[i] >= 3) ++n_ord_ge3;
+ const unsigned int N = X.rows(); // number of observations
+ const unsigned int D = Lambda.cols(); // number of factors
+ // (including constant)
+ const unsigned int tot_iter = burnin + mcmc;
+ const unsigned int nsamp = mcmc / thin;
+ const Matrix<> I = eye<double>(D-1);
+ const Matrix<> Lambda_free_indic(K, D);
+ for (unsigned int i=0; i<(K*D); ++i){
+ if (Lambda_eq(i) == -999) Lambda_free_indic(i) = 1.0;
+ }
- // starting values for phi and gamma_p
- Matrix<double> phi = Matrix<double>(N,D-1);
- phi = cbind(ones<double>(N,1), phi);
+ // starting values for phi and gamma_p
+ Matrix<> phi(N,D-1);
+ phi = cbind(ones<double>(N,1), phi);
- // storage matrices (row major order)
- Matrix<double> Lambda_store;
- if (*storelambda==1){
- Lambda_store = Matrix<double>(nsamp,K*D);
- }
- Matrix<double> gamma_store = Matrix<double>(nsamp,
- gamrow[0]*gamcol[0]);
- Matrix<double> phi_store;
- if (*storescores==1){
- phi_store = Matrix<double>(nsamp, N*D);
- }
- Matrix<double> Psi_store = Matrix<double>(nsamp, K);
-
-
- ///////////////////
- // Gibbs Sampler //
- ///////////////////
- int count = 0;
- for (int iter=0; iter < tot_iter; ++iter){
-
- // sample Xstar
- for (int i=0; i<N; ++i){
- const Matrix<double> X_mean = Lambda * t(phi(i,_));
- for (int j=0; j<K; ++j){
- if (ncateg[j] >= 2){ // ordinal data
- if (X(i,j) == -999){ // if missing
- Xstar(i,j) = stream->rnorm(X_mean[j], 1.0);
- }
- else { // if not missing
- Xstar(i,j) = stream->rtnorm_combo(X_mean[j], 1.0,
- gamma(X(i,j)-1, j), gamma(X(i,j), j));
+ // storage matrices (row major order)
+ Matrix<> Lambda_store;
+ if (storelambda==1){
+ Lambda_store = Matrix<>(nsamp,K*D);
+ }
+ Matrix<> gamma_store(nsamp, gamma.size());
+ Matrix<> phi_store;
+ if (storescores==1){
+ phi_store = Matrix<>(nsamp, N*D);
+ }
+ Matrix<> Psi_store(nsamp, K);
+
+
+ ///////////////////
+ // Gibbs Sampler //
+ ///////////////////
+ int count = 0;
+ for (unsigned int iter=0; iter < tot_iter; ++iter){
+
+ // sample Xstar
+ for (unsigned int i=0; i<N; ++i){
+ const Matrix<> X_mean = Lambda * t(phi(i,_));
+ for (unsigned int j=0; j<K; ++j){
+ if (ncateg[j] >= 2){ // ordinal data
+ if (X(i,j) == -999){ // if missing
+ Xstar(i,j) = stream.rnorm(X_mean[j], 1.0);
+ }
+ else { // if not missing
+ Xstar(i,j) = stream.rtnorm_combo(X_mean[j], 1.0,
+ gamma(X(i,j)-1, j),
+ gamma(X(i,j), j));
+ }
}
- }
- else { // continuous data
- if (X(i,j) == -999){ // if missing
- Xstar(i,j) = stream->rnorm(X_mean[j], std::sqrt(Psi(j,j)));
+ else { // continuous data
+ if (X(i,j) == -999){ // if missing
+ Xstar(i,j) = stream.rnorm(X_mean[j], std::sqrt(Psi(j,j)));
+ }
}
}
}
- }
- // sample phi
- const Matrix<double> Lambda_const = Lambda(_,0);
- const Matrix<double> Lambda_rest = Lambda(0, 1, K-1, D-1);
- // if Psi_inv is *not* diagonal then use:
- //Matrix<double> phi_post_var = invpd(I + t(Lambda_rest) *
- // Psi_inv * Lambda_rest);
- // instead of the following 2 lines:
- const Matrix<double> AAA = SCYTHE::sqrt(Psi_inv) * Lambda_rest;
- const Matrix<double> phi_post_var = invpd(I + crossprod(AAA));
- // /////////////////////////////////////////////////////
- const Matrix<double> phi_post_C = cholesky(phi_post_var);
- for (int i=0; i<N; ++i){
- const Matrix<double> phi_post_mean = phi_post_var *
- (t(Lambda_rest) * Psi_inv * (t(Xstar(i,_))-Lambda_const));
- const Matrix<double> phi_samp = gaxpy(phi_post_C, stream->rnorm(D-1, 1),
- phi_post_mean);
- for (int j=0; j<(D-1); ++j)
- phi(i,j+1) = phi_samp[j];
- }
-
- // sample Lambda
- NormNormfactanal_Lambda_draw(Lambda, Lambda_free_indic,
- Lambda_prior_mean,
- Lambda_prior_prec,
- phi, Xstar, Psi_inv, Lambda_ineq,
- D, K, stream);
-
- // sample Psi (assumes diagonal Psi)
- for (int i=0; i<K; ++i){
- if (ncateg[i] < 2){ // continuous data
- const Matrix<double> epsilon = gaxpy(phi, -1*(t(Lambda(i,_))),
- Xstar(_,i));
- const Matrix<double> SSE = crossprod(epsilon);
- const double new_a0 = (a0[i] + N)*0.5;
- const double new_b0 = (b0[i] + SSE[0])*0.5;
- Psi(i,i) = stream->rigamma(new_a0, new_b0);
- Psi_inv(i,i) = 1.0 / Psi(i,i);
+ // sample phi
+ const Matrix<> Lambda_const = Lambda(_,0);
+ const Matrix<> Lambda_rest = Lambda(0, 1, K-1, D-1);
+ // if Psi_inv is *not* diagonal then use:
+ //Matrix<double> phi_post_var = invpd(I + t(Lambda_rest) *
+ // Psi_inv * Lambda_rest);
+ // instead of the following 2 lines:
+ const Matrix<> AAA = scythe::sqrt(Psi_inv) * Lambda_rest;
+ const Matrix<> phi_post_var = invpd(I + crossprod(AAA));
+ // /////////////////////////////////////////////////////
+ const Matrix<> phi_post_C = cholesky(phi_post_var);
+ for (unsigned int i=0; i<N; ++i){
+ const Matrix<> phi_post_mean = phi_post_var *
+ (t(Lambda_rest) * Psi_inv * (t(Xstar(i,_))-Lambda_const));
+ const Matrix<> phi_samp = gaxpy(phi_post_C,
+ stream.rnorm(D-1, 1, 0.0, 1.0),
+ phi_post_mean);
+ for (unsigned int j=0; j<(D-1); ++j)
+ phi(i,j+1) = phi_samp[j];
}
- }
+
+ // sample Lambda
+ NormNormfactanal_Lambda_draw(Lambda, Lambda_free_indic,
+ Lambda_prior_mean,
+ Lambda_prior_prec,
+ phi, Xstar, Psi_inv, Lambda_ineq,
+ D, K, stream);
- // sample gamma
- for (int j=0; j<K; ++j){ // do the sampling for each categ. var
- Matrix<double> gamma_p = gamma(_,j);
- if (ncateg[j] <= 2){
- ++accepts[j];
+ // sample Psi (assumes diagonal Psi)
+ for (unsigned int i=0; i<K; ++i){
+ if (ncateg[i] < 2){ // continuous data
+ const Matrix<> epsilon = gaxpy(phi, -1*(t(Lambda(i,_))),
+ Xstar(_,i));
+ const Matrix<> SSE = crossprod(epsilon);
+ const double new_a0 = (a0[i] + N)*0.5;
+ const double new_b0 = (b0[i] + SSE[0])*0.5;
+ Psi(i,i) = stream.rigamma(new_a0, new_b0);
+ Psi_inv(i,i) = 1.0 / Psi(i,i);
+ }
}
- if (ncateg[j] > 2){
- const Matrix<double> X_mean = phi * t(Lambda(j,_));
- for (int i=2; i<(ncateg[j]); ++i){
- if (i==(ncateg[j]-1)){
- gamma_p[i] = stream->rtbnorm_combo(gamma(i,j),
- ::pow(tune[j], 2.0),
- gamma_p[i-1]);
- }
- else {
- gamma_p[i] = stream->rtnorm_combo(gamma(i,j), ::pow(tune[j], 2.0),
- gamma_p[i-1],
- gamma(i+1, j));
- }
+
+ // sample gamma
+ for (unsigned int j=0; j<K; ++j){ // do the sampling for each categ. var
+ Matrix<> gamma_p = gamma(_,j);
+ if (ncateg[j] <= 2){
+ ++accepts[j];
}
- double loglikerat = 0.0;
- double loggendenrat = 0.0;
-
- // loop over observations and construct the acceptance ratio
- for (int i=0; i<N; ++i){
- if (X(i,j) != -999){
- if (X(i,j) == ncateg[j]){
- loglikerat = loglikerat
- + log(1.0 -
- pnorm(gamma_p[X(i,j)-1] - X_mean[i]) )
- - log(1.0 -
- pnorm(gamma(X(i,j)-1,j) - X_mean[i]) );
+ if (ncateg[j] > 2){
+ const Matrix<> X_mean = phi * t(Lambda(j,_));
+ for (int i=2; i<(ncateg[j]); ++i){
+ if (i==(ncateg[j]-1)){
+ gamma_p(i) = stream.rtbnorm_combo(gamma(i,j),
+ ::pow(tune[j], 2.0),
+ gamma_p[i-1]);
}
- else if (X(i,j) == 1){
- loglikerat = loglikerat
- + log(pnorm(gamma_p[X(i,j)] - X_mean[i]) )
- - log(pnorm(gamma(X(i,j), j) - X_mean[i]) );
+ else {
+ gamma_p(i) = stream.rtnorm_combo(gamma(i,j),
+ ::pow(tune[j], 2.0),
+ gamma_p[i-1],
+ gamma(i+1, j));
}
- else{
- loglikerat = loglikerat
- + log(pnorm(gamma_p[X(i,j)] - X_mean[i]) -
- pnorm(gamma_p[X(i,j)-1] - X_mean[i]) )
- - log(pnorm(gamma(X(i,j), j) - X_mean[i]) -
- pnorm(gamma(X(i,j)-1, j) - X_mean[i]) );
+ }
+ double loglikerat = 0.0;
+ double loggendenrat = 0.0;
+
+ // loop over observations and construct the acceptance ratio
+ for (unsigned int i=0; i<N; ++i){
+ if (X(i,j) != -999){
+ if (X(i,j) == ncateg[j]){
+ loglikerat = loglikerat
+ + log(1.0 -
+ pnorm(gamma_p[X(i,j)-1] - X_mean[i], 0.0, 1.0) )
+ - log(1.0 -
+ pnorm(gamma(X(i,j)-1,j) - X_mean[i], 0.0, 1.0) );
+ }
+ else if (X(i,j) == 1){
+ loglikerat = loglikerat
+ + log(pnorm(gamma_p[X(i,j)] - X_mean[i], 0.0, 1.0) )
+ - log(pnorm(gamma(X(i,j), j) - X_mean[i], 0.0, 1.0) );
+ }
+ else{
+ loglikerat = loglikerat
+ + log(pnorm(gamma_p[X(i,j)] - X_mean[i], 0.0, 1.0) -
+ pnorm(gamma_p[X(i,j)-1] - X_mean[i], 0.0, 1.0) )
+ - log(pnorm(gamma(X(i,j), j) - X_mean[i], 0.0, 1.0) -
+ pnorm(gamma(X(i,j)-1, j) - X_mean[i], 0.0, 1.0) );
+ }
}
}
- }
- for (int k=2; k<ncateg[j]; ++k){
- loggendenrat = loggendenrat
- + log(pnorm(gamma(k+1,j), gamma(k,j), tune[j]) -
- pnorm(gamma_p[k-1], gamma(k,j), tune[j]) )
- - log(pnorm(gamma_p[k+1], gamma_p[k], tune[j]) -
- pnorm(gamma(k-1,j), gamma_p[k], tune[j]) );
- }
- double logacceptrat = loglikerat + loggendenrat;
+ for (unsigned int k=2; k<ncateg[j]; ++k){
+ loggendenrat = loggendenrat
+ + log(pnorm(gamma(k+1,j), gamma(k,j), tune[j]) -
+ pnorm(gamma_p[k-1], gamma(k,j), tune[j]) )
+ - log(pnorm(gamma_p[k+1], gamma_p[k], tune[j]) -
+ pnorm(gamma(k-1,j), gamma_p[k], tune[j]) );
+ }
+ double logacceptrat = loglikerat + loggendenrat;
- if (stream->runif() <= exp(logacceptrat)){
- for (int i=0; i<*gamrow; ++i){
- if (gamma(i,j) == 300) break;
- gamma(i,j) = gamma_p[i];
+ if (stream() <= exp(logacceptrat)){
+ for (unsigned int i=0; i<gamma.rows(); ++i){
+ if (gamma(i,j) == 300) break;
+ gamma(i,j) = gamma_p[i];
+ }
+ ++accepts[j];
}
- ++accepts[j];
}
}
- }
- // print results to screen
- if (*verbose > 0 && iter % *verbose == 0){
- Rprintf("\n\nMCMCmixfactanal iteration %i of %i \n", (iter+1), tot_iter);
- Rprintf("Lambda = \n");
- for (int i=0; i<K; ++i){
- for (int j=0; j<D; ++j){
- Rprintf("%10.5f", Lambda(i,j));
+ // print results to screen
+ if (verbose > 0 && iter % verbose == 0){
+ Rprintf("\n\nMCMCmixfactanal iteration %i of %i \n", (iter+1), tot_iter);
+ Rprintf("Lambda = \n");
+ for (unsigned int i=0; i<K; ++i){
+ for (unsigned int j=0; j<D; ++j){
+ Rprintf("%10.5f", Lambda(i,j));
+ }
+ Rprintf("\n");
+ }
+ Rprintf("diag(Psi) = \n");
+ for (unsigned int i=0; i<K; ++i){
+ Rprintf("%10.5f", Psi(i,i));
}
Rprintf("\n");
+ Rprintf("\nMetropolis-Hastings acceptance rates = \n");
+ for (unsigned int j = 0; j<K; ++j){
+ Rprintf("%6.2f",
+ static_cast<double>(accepts[j]) /
+ static_cast<double>((iter+1)));
+ }
}
- Rprintf("diag(Psi) = \n");
- for (int i=0; i<K; ++i){
- Rprintf("%10.5f", Psi(i,i));
- }
- Rprintf("\n");
- Rprintf("\nMetropolis-Hastings acceptance rates = \n");
- for (int j = 0; j<K; ++j){
- Rprintf("%6.2f",
- static_cast<double>(accepts[j]) /
- static_cast<double>((iter+1)));
- }
- }
- // store results
- if ((iter >= *burnin) && ((iter % *thin==0))) {
+
+ // store results
+ if ((iter >= burnin) && ((iter % thin==0))) {
- // store Lambda
- if (*storelambda==1){
- Matrix<double> Lambda_store_vec = reshape(Lambda,1,K*D);
- for (int l=0; l<K*D; ++l)
- Lambda_store(count, l) = Lambda_store_vec[l];
- }
+ // store Lambda
+ if (storelambda==1){
+ //Matrix<double> Lambda_store_vec = reshape(Lambda,1,K*D);
+ //for (int l=0; l<K*D; ++l)
+ // Lambda_store(count, l) = Lambda_store_vec[l];
+ rmview(Lambda_store(count, _)) = Lambda;
+ }
- // store gamma
- Matrix<double> gamma_store_vec = reshape(gamma, 1, *gamrow* *gamcol);
- for (int l=0; l<*gamrow* *gamcol; ++l)
- gamma_store(count, l) = gamma_store_vec[l];
-
- // store Psi
- for (int l=0; l<K; ++l)
- Psi_store(count, l) = Psi(l,l);
+ // store gamma
+ //Matrix<double> gamma_store_vec = reshape(gamma, 1, *gamrow* *gamcol);
+ //for (int l=0; l<*gamrow* *gamcol; ++l)
+ // gamma_store(count, l) = gamma_store_vec[l];
+ rmview(gamma_store(count, _)) = gamma;
+
+ // store Psi
+ for (unsigned int l=0; l<K; ++l)
+ Psi_store(count, l) = Psi(l,l);
- // store phi
- if (*storescores==1){
- Matrix<double> phi_store_vec = reshape(phi, 1, N*D);
- for (int l=0; l<N*D; ++l)
- phi_store(count, l) = phi_store_vec[l];
+ // store phi
+ if (storescores==1){
+ //Matrix<double> phi_store_vec = reshape(phi, 1, N*D);
+ //for (int l=0; l<N*D; ++l)
+ // phi_store(count, l) = phi_store_vec[l];
+ rmview(phi_store(count, _)) = phi;
+ }
+ count++;
}
- count++;
- }
- // allow user interrupts
- R_CheckUserInterrupt();
+ // allow user interrupts
+ R_CheckUserInterrupt();
+
+ } // end Gibbs loop
+
+
+ // Matrix<double> output;
+ if (storelambda==1){
+ output = cbind(Lambda_store, gamma_store);
+ }
+ else {
+ output = gamma_store;
+ }
+ if(storescores == 1) {
+ output = cbind(output, phi_store);
+ }
+ output = cbind(output, Psi_store);
+
+}
+
+
+
+
+extern "C"{
+
+ // function called by R to fit model
+ void
+ mixfactanalpost (double* sampledata, const int* samplerow,
+ const int* samplecol,
+ const double* Xdata, const int* Xrow, const int* Xcol,
+ const int* burnin, const int* mcmc, const int* thin,
+ const double* tune, const int *uselecuyer,
+ const int *seedarray,
+ const int *lecuyerstream, const int* verbose,
+ const double* Lamstartdata, const int* Lamstartrow,
+ const int* Lamstartcol,
+ const double* gamdata, const int* gamrow, const int* gamcol,
+ const double* Psistartdata,
+ const int* Psistartrow, const int* Psistartcol,
+ const int* ncatdata, const int* ncatrow, const int* ncatcol,
+ const double* Lameqdata, const int* Lameqrow,
+ const int* Lameqcol,
+ const double* Lamineqdata, const int* Lamineqrow,
+ const int* Lamineqcol,
+ const double* Lampmeandata, const int* Lampmeanrow,
+ const int* Lampmeancol,
+ const double* Lampprecdata, const int* Lampprecrow,
+ const int* Lamppreccol,
+ const double* a0data, const int* a0row, const int* a0col,
+ const double* b0data, const int* b0row, const int* b0col,
+ const int* storelambda,
+ const int* storescores,
+ int* acceptsdata, const int* acceptsrow,
+ const int* acceptscol
+ ) {
- } // end Gibbs loop
+ // put together matrices
+ const Matrix<> Xstar(*Xrow, *Xcol, Xdata);
+ const Matrix<int> X = Matrix<int>(*Xrow, *Xcol);
+ for (int i=0; i<(*Xrow * *Xcol); ++i)
+ X[i] = static_cast<int>(Xstar[i]);
- delete stream; // clean up random number stream
+ Matrix<> Lambda(*Lamstartrow, *Lamstartcol, Lamstartdata);
+ Matrix<> gamma(*gamrow, *gamcol, gamdata);
+ Matrix<> Psi(*Psistartrow, *Psistartcol, Psistartdata);
+ Matrix<> Psi_inv = invpd(Psi);
+ const Matrix<int> ncateg(*ncatrow, *ncatcol, ncatdata);
+ const Matrix<> Lambda_eq(*Lameqrow, *Lameqcol, Lameqdata);
+ const Matrix<> Lambda_ineq(*Lamineqrow, *Lamineqcol, Lamineqdata);
+ const Matrix<> Lambda_prior_mean(*Lampmeanrow, *Lampmeancol, Lampmeandata);
+ const Matrix<> Lambda_prior_prec(*Lampprecrow, *Lamppreccol, Lampprecdata);
+ const Matrix <> a0(*a0row, *a0col, a0data);
+ const Matrix <> b0(*b0row, *b0col, b0data);
+ Matrix<int> accepts(*acceptsrow, *acceptscol, acceptsdata);
+
- // return output
- Matrix<double> output;
- if (*storelambda==1){
- output = cbind(Lambda_store, gamma_store);
- }
- else {
- output = gamma_store;
- }
- if(*storescores == 1) {
- output = cbind(output, phi_store);
- }
- output = cbind(output, Psi_store);
- const int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = output[i];
+ // return output
+ Matrix<double> output;
+ MCMCPACK_PASSRNG2MODEL(MCMCmixfactanal_impl, X,
+ Xstar, Psi, Psi_inv, a0, b0,
+ Lambda, gamma,
+ ncateg, Lambda_eq, Lambda_ineq, Lambda_prior_mean,
+ Lambda_prior_prec, tune, *storelambda,
+ *storescores,
+ *burnin, *mcmc, *thin, *verbose, accepts, output);
- for (int j=0; j<K; ++j)
- acceptsdata[j] = accepts[j];
+
+ const unsigned int size = (unsigned int) *samplerow * *samplecol;
+ for (unsigned int i=0; i<size; ++i)
+ sampledata[i] = output[i];
+
+ for (unsigned int j=0; j<X.cols(); ++j)
+ acceptsdata[j] = accepts[j];
+
+
+ }
}
-}
+#endif
diff --git a/src/MCMCmnl.h b/src/MCMCmnl.h
new file mode 100644
index 0000000..44cb79a
--- /dev/null
+++ b/src/MCMCmnl.h
@@ -0,0 +1,74 @@
+// MCMCmnl.h contains multinomial logit functions called by both the
+// metropolis hastings and slice sampling implemenetation of MCMCmnl,
+// such as a function that returns the log posterior.
+//
+// Andrew D. Martin
+// Dept. of Political Science
+// Washington University in St. Louis
+// admartin at wustl.edu
+//
+// Kevin M. Quinn
+// Dept. of Government
+// Harvard University
+// kevin_quinn at harvard.edu
+//
+// This software is distributed under the terms of the GNU GENERAL
+// PUBLIC LICENSE Version 2, June 1991. See the package LICENSE
+// file for more information.
+//
+// Copyright (C) 2007 Andrew D. Martin and Kevin M. Quinn
+//
+// DBP 7/27/2007
+
+#ifndef MCMCMNL_H
+#define MCMCMNL_H
+
+#include "matrix.h"
+#include "algorithm.h"
+#include "distributions.h"
+#include "la.h"
+#include "smath.h"
+
+using namespace std;
+using namespace scythe;
+
+inline double
+mnl_logpost(const Matrix<>& Y, const Matrix<>& X, const Matrix<>& beta,
+ const Matrix<>& beta_prior_mean,
+ const Matrix<>& beta_prior_prec)
+{
+
+ // likelihood
+ double loglike = 0.0;
+ Matrix<double,Row> numera = exp(X * beta);
+ //numer = reshape(numer, Y.rows(), Y.cols());
+ //numer.resize(Y.rows(), Y.cols(), true);
+ Matrix<double,Row> numer(Y.rows(), Y.cols(), false);
+ copy<Row,Row>(numera, numer);
+ double *denom = new double[Y.rows()];
+ for (unsigned int i = 0; i < Y.rows(); ++i) {
+ denom[i] = 0.0;
+ for (unsigned int j = 0; j < Y.cols(); ++j) {
+ if (Y(i,j) != -999){
+ denom[i] += numer(i,j);
+ }
+ }
+ for (unsigned int j = 0; j < Y.cols(); ++j) {
+ if (Y(i,j) == 1.0){
+ loglike += std::log(numer(i,j) / denom[i]);
+ }
+ }
+ }
+
+ delete [] denom;
+
+ // prior
+ double logprior = 0.0;
+ if (beta_prior_prec(0,0) != 0) {
+ logprior = lndmvn(beta, beta_prior_mean, invpd(beta_prior_prec));
+ }
+
+ return (loglike + logprior);
+}
+
+#endif
diff --git a/src/MCMCmnlMH.cc b/src/MCMCmnlMH.cc
index 230d482..0f7a984 100644
--- a/src/MCMCmnlMH.cc
+++ b/src/MCMCmnlMH.cc
@@ -23,6 +23,10 @@
//
// This file was initially generated on Wed Dec 29 15:27:08 2004
// 12/31/2004 filled out template and got it initial version working (KQ)
+// 7/27/2007 DBP ported to scythe 1.0
+
+#ifndef MCMCMNLMH_CC
+#define MCMCMNLMH_CC
#include "matrix.h"
#include "distributions.h"
@@ -32,46 +36,78 @@
#include "smath.h"
#include "MCMCrng.h"
#include "MCMCfcds.h"
+#include "MCMCmnl.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
-
-static double mnl_logpost(const Matrix<double>& Y, const Matrix<double>& X,
- const Matrix<double>& beta,
- const Matrix<double>& beta_prior_mean,
- const Matrix<double>& beta_prior_prec){
-
- // likelihood
- double loglike = 0.0;
- Matrix<double> numer = exp(X * beta);
- numer = reshape(numer, Y.rows(), Y.cols());
- double *denom = new double[Y.rows()];
- for (int i=0; i<Y.rows(); ++i){
- denom[i] = 0.0;
- for (int j=0; j<Y.cols(); ++j){
- if (Y(i,j) != -999){
- denom[i] += numer(i,j);
- }
- }
- for (int j=0; j<Y.cols(); ++j){
- if (Y(i,j) == 1.0){
- loglike += std::log(numer(i,j) / denom[i]);
- }
- }
- }
-
- delete [] denom;
-
- // prior
- double logprior = 0.0;
- if (beta_prior_prec(0,0) != 0){
- logprior = lndmvn(beta, beta_prior_mean, invpd(beta_prior_prec));
- }
-
- return (loglike + logprior);
+using namespace scythe;
+
+template <typename RNGTYPE>
+void MCMCmnlMH_impl(rng<RNGTYPE>& stream, const Matrix<>& Y,
+ const Matrix<>& X, const Matrix<>& b0,
+ const Matrix<>& B0, const Matrix<>& V,
+ Matrix<>& beta, const Matrix<>& tune,
+ unsigned int burnin, unsigned int mcmc,
+ unsigned int thin, unsigned int verbose,
+ Matrix<>& storemat)
+{
+ // define constants
+ const unsigned int tot_iter = burnin + mcmc; // total iterations
+ const unsigned int nstore = mcmc / thin; // # of draws to store
+ const unsigned int k = X.cols();
+
+ // Initialize storage matrix
+ storemat = Matrix<>(nstore, k, false);
+
+ // proposal parameters
+ const Matrix<> propV = tune * invpd(B0 + invpd(V)) * tune;
+ const Matrix<> propC = cholesky(propV) ;
+
+ double logpost_cur = mnl_logpost(Y, X, beta, b0, B0);
+
+ int count = 0;
+ int accepts = 0;
+ ///// MCMC SAMPLING OCCURS IN THIS FOR LOOP
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
+
+ // sample beta
+ const
+ Matrix<> beta_can = gaxpy(propC, stream.rnorm(k,1,0,1), beta);
+
+ const double logpost_can = mnl_logpost(Y, X, beta_can, b0, B0);
+ const double ratio = std::exp(logpost_can - logpost_cur);
+
+ if (stream() < ratio) {
+ beta = beta_can;
+ logpost_cur = logpost_can;
+ ++accepts;
+ }
+
+ // store values in matrices
+ if (iter >= burnin && ((iter % thin) == 0)) {
+ for (unsigned int j = 0; j < k; j++)
+ storemat(count, j) = beta[j];
+
+ ++count;
+ }
+
+ // print output to stdout
+ if (verbose > 0 && iter % verbose == 0) {
+ Rprintf("\n\nMCMCmnl Metropolis iteration %i of %i \n",
+ (iter+1), tot_iter);
+ Rprintf("beta = \n");
+
+ for (unsigned int j=0; j<k; ++j)
+ Rprintf("%10.5f\n", beta[j]);
+
+ Rprintf("Metropolis acceptance rate for beta = %3.5f\n\n",
+ static_cast<double>(accepts) / static_cast<double>(iter+1));
+ }
+
+ R_CheckUserInterrupt(); // allow user interrupts
+ } // end MCMC loop
}
@@ -84,7 +120,7 @@ extern "C" {
const double *Xdata, const int *Xrow, const int *Xcol,
const int *burnin, const int *mcmc, const int *thin,
const double *tunedata, const int *tunerow,
- const int *tunecol, const int *lecuyer,
+ const int *tunecol, const int *uselecuyer,
const int *seedarray, const int *lecuyerstream,
const int *verbose, const double *betastartdata,
const int *betastartrow, const int *betastartcol,
@@ -92,82 +128,29 @@ extern "C" {
const int *b0col, const double *B0data,
const int *B0row, const int *B0col,
const double *Vdata, const int *Vrow,
- const int *Vcol) {
+ const int *Vcol)
+ {
- // pull together Matrix objects
+ // pull together Matrix objects
// REMEMBER TO ACCESS PASSED ints AND doubles PROPERLY
- const Matrix <double> Y = r2scythe(*Yrow, *Ycol, Ydata);
- const Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- const Matrix <double> tune = r2scythe(*tunerow, *tunecol, tunedata);
- Matrix <double> beta = r2scythe(*betastartrow, *betastartcol,
- betastartdata);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- const Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
- const Matrix <double> V = r2scythe(*Vrow, *Vcol, Vdata);
-
- // define constants
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols();
+ const Matrix<> Y(*Yrow, *Ycol, Ydata);
+ const Matrix<> X(*Xrow, *Xcol, Xdata);
+ const Matrix<> tune(*tunerow, *tunecol, tunedata);
+ Matrix<> beta(*betastartrow, *betastartcol, betastartdata);
+ const Matrix<> b0(*b0row, *b0col, b0data);
+ const Matrix<> B0(*B0row, *B0col, B0data);
+ const Matrix<> V(*Vrow, *Vcol, Vdata);
// storage matrix or matrices
- Matrix<double> storemat(nstore, k);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // proposal parameters
- const Matrix<double> propV = tune * invpd(B0 + invpd(V)) * tune;
- const Matrix<double> propC = cholesky(propV) ;
-
- double logpost_cur = mnl_logpost(Y, X, beta, b0, B0);
-
- int count = 0;
- int accepts = 0;
- ///// MCMC SAMPLING OCCURS IN THIS FOR LOOP
- for(int iter = 0; iter < tot_iter; ++iter){
-
- // sample beta
- const Matrix<double> beta_can = gaxpy(propC, stream->rnorm(k,1), beta);
-
- const double logpost_can = mnl_logpost(Y,X,beta_can, b0, B0);
- const double ratio = ::exp(logpost_can - logpost_cur);
-
- if (stream->runif() < ratio){
- beta = beta_can;
- logpost_cur = logpost_can;
- ++accepts;
- }
-
- // store values in matrices
- if (iter >= *burnin && ((iter % *thin)==0)){
-
- for (int j = 0; j < k; j++)
- storemat(count, j) = beta[j];
- ++count;
- }
-
- // print output to stdout
- if(*verbose > 0 && iter % *verbose == 0){
- Rprintf("\n\nMCMCmnl Metropolis iteration %i of %i \n",
- (iter+1), tot_iter);
- Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
- Rprintf("%10.5f\n", beta[j]);
- Rprintf("Metropolis acceptance rate for beta = %3.5f\n\n",
- static_cast<double>(accepts) /
- static_cast<double>(iter+1));
- }
-
- R_CheckUserInterrupt(); // allow user interrupts
- } // end MCMC loop
-
- delete stream; // clean up random number stream
-
- // load draws into sample array
- const int size = *samplerow * *samplecol;
- for(int i = 0; i < size; ++i)
- sampledata[i] = storemat[i];
+ Matrix<> storemat;
+ MCMCPACK_PASSRNG2MODEL(MCMCmnlMH_impl, Y, X, b0, B0, V, beta,
+ tune, *burnin, *mcmc, *thin, *verbose, storemat);
+
+ // load draws into sample array
+ for(unsigned int i = 0; i < storemat.size(); ++i)
+ sampledata[i] = storemat(i);
} // end MCMCmnlMH
} // end extern "C"
+
+#endif
diff --git a/src/MCMCmnlslice.cc b/src/MCMCmnlslice.cc
index 9b5f70e..df9385b 100644
--- a/src/MCMCmnlslice.cc
+++ b/src/MCMCmnlslice.cc
@@ -22,6 +22,11 @@
//
// This file was initially generated on Wed Dec 29 15:27:40 2004
// REVISION HISTORY
+//
+// 7/28/07 DBP ported to scythe 1.0
+
+#ifndef MCMCMNLSLICE_CC
+#define MCMCMNLSLICE_CC
#include "matrix.h"
#include "distributions.h"
@@ -31,306 +36,250 @@
#include "smath.h"
#include "MCMCrng.h"
#include "MCMCfcds.h"
+#include "MCMCmnl.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
-
-static double mnl_logpost(const Matrix<double>& Y, const Matrix<double>& X,
- const Matrix<double>& beta,
- const Matrix<double>& beta_prior_mean,
- const Matrix<double>& beta_prior_prec){
-
- // likelihood
- double loglike = 0.0;
- Matrix<double> numer = exp(X * beta);
- numer = reshape(numer, Y.rows(), Y.cols());
- double *denom = new double[Y.rows()];
- for (int i=0; i<Y.rows(); ++i){
- denom[i] = 0.0;
- for (int j=0; j<Y.cols(); ++j){
- if (Y(i,j) != -999){
- denom[i] += numer(i,j);
- }
- }
- for (int j=0; j<Y.cols(); ++j){
- if (Y(i,j) == 1.0){
- loglike += std::log(numer(i,j) / denom[i]);
- }
- }
- }
-
- delete [] denom;
-
- // prior
- double logprior = 0.0;
- if (beta_prior_prec(0,0) != 0){
- logprior = lndmvn(beta, beta_prior_mean, invpd(beta_prior_prec));
- }
-
- return (loglike + logprior);
-}
-
-
-
+using namespace scythe;
// eventually all of the slice sampling functions should be made more
// general and put in MCMCfcds.{h cc}
//
// Radford Neal's (2000) doubling procedure coded for a logdensity
- static void doubling(double (*logfun)(const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&),
- const Matrix<double>& beta, const int& index,
- const double& z,
- const double& w, const int& p,
- const Matrix<double>& Y,
- const Matrix<double>& X,
- const Matrix<double>& beta_prior_mean,
- const Matrix<double>& beta_prior_prec,
- rng* stream, double& L, double& R){
-
- const double U = stream->runif();
- const double x0 = beta[index];
- Matrix<double> beta_L = beta;
- Matrix<double> beta_R = beta;
- L = x0 - w*U;
- beta_L[index] = L;
+template <typename RNGTYPE>
+static void
+doubling(double (*logfun)(const Matrix<>&, const Matrix<>&,
+ const Matrix<>&, const Matrix<>&,
+ const Matrix<>&), const Matrix<>& beta,
+ int index, double z, double w, int p, const Matrix<>& Y,
+ const Matrix<>& X, const Matrix<>& beta_prior_mean,
+ const Matrix<>& beta_prior_prec, rng<RNGTYPE>& stream,
+ double& L, double& R){
+
+ const double U = stream();
+ const double x0 = beta(index);
+ Matrix<> beta_L = beta;
+ Matrix<> beta_R = beta;
+ L = x0 - w * U;
+ beta_L(index) = L;
R = L + w;
- beta_R[index] = R;
+ beta_R(index) = R;
int K = p;
while (K > 0 &&
(z < logfun(Y, X, beta_L, beta_prior_mean, beta_prior_prec) ||
- z < logfun(Y, X, beta_R, beta_prior_mean, beta_prior_prec))){
- double V = stream->runif();
+ z < logfun(Y, X, beta_R, beta_prior_mean, beta_prior_prec))) {
+ double V = stream();
if (V < 0.5){
L = L - (R - L);
- beta_L[index] = L;
+ beta_L(index) = L;
}
else {
R = R + (R - L);
- beta_R[index] = R;
+ beta_R(index) = R;
}
--K;
}
}
// Radford Neal's (2000) Accept procedure coded for a logdensity
-static const bool Accept(double (*logfun)(const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&),
- const Matrix<double>& beta, const int& index,
- const double x0,
- const double& z, const double& w,
- const Matrix<double>& Y,
- const Matrix<double>& X,
- const Matrix<double>& beta_prior_mean,
- const Matrix<double>& beta_prior_prec,
- const double& L, const double& R){
-
+static const bool
+Accept(double (*logfun)(const Matrix<>&, const Matrix<>&,
+ const Matrix<>&, const Matrix<>&,
+ const Matrix<>&), const Matrix<>& beta,
+ int index, double x0, double z, double w, const Matrix<>& Y,
+ const Matrix<>& X, const Matrix<>& beta_prior_mean,
+ const Matrix<>& beta_prior_prec, double L, double R)
+{
double Lhat = L;
double Rhat = R;
bool D = false;
- while ((Rhat - Lhat ) > 1.1 * w){
+ while ((Rhat - Lhat ) > 1.1 * w) {
double M = (Lhat + Rhat) / 2.0;
- if ( (x0 < M && beta[index] >= M) || (x0 >= M && beta[index] < M)){
+ if ( (x0 < M && beta(index) >= M) || (x0 >= M && beta(index) < M)){
D = true;
}
- if (beta[index] < M){
+ if (beta(index) < M){
Rhat = M;
}
else {
Lhat = M;
}
- Matrix<double> beta_L = beta;
- Matrix<double> beta_R = beta;
+ Matrix<> beta_L = beta;
+ Matrix<> beta_R = beta;
beta_L[index] = Lhat;
beta_R[index] = Rhat;
- if (D && z >= logfun(Y, X, beta_L, beta_prior_mean, beta_prior_prec) &&
- z >= logfun(Y, X, beta_R, beta_prior_mean, beta_prior_prec)){
+ if (D && z >= logfun(Y, X, beta_L, beta_prior_mean, beta_prior_prec)
+ &&
+ z >= logfun(Y, X, beta_R, beta_prior_mean, beta_prior_prec)) {
return(false);
}
}
+
return(true);
}
// Radford Neal's (2000) shrinkage procedure coded for a log density
-static double shrinkage(double (*logfun)(const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&,
- const Matrix<double>&),
- const Matrix<double>& beta, const int& index,
- const double& z, const double& w,
- const Matrix<double>& Y,
- const Matrix<double>& X,
- const Matrix<double>& beta_prior_mean,
- const Matrix<double>& beta_prior_prec,
- rng* stream, const double& L, const double& R){
-
+template <typename RNGTYPE>
+static double
+shrinkage(double (*logfun)(const Matrix<>&, const Matrix<>&,
+ const Matrix<>&, const Matrix<>&,
+ const Matrix<>&), const Matrix<>& beta,
+ int index, double z, double w, const Matrix<>& Y,
+ const Matrix<>& X, const Matrix<>& beta_prior_mean,
+ const Matrix<>& beta_prior_prec, rng<RNGTYPE>& stream,
+ double L, double R)
+{
double Lbar = L;
double Rbar = R;
- Matrix<double> beta_x1 = beta;
+ Matrix<> beta_x1 = beta;
const double x0 = beta[index];
- for (;;){
- const double U = stream->runif();
+ for (;;) {
+ const double U = stream();
const double x1 = Lbar + U*(Rbar - Lbar);
- beta_x1[index] = x1;
+ beta_x1(index) = x1;
if (z <= logfun(Y, X, beta_x1, beta_prior_mean, beta_prior_prec) &&
- Accept(logfun, beta_x1, index, x0, z, w,
- Y, X, beta_prior_mean, beta_prior_prec, L, R)){
+ Accept(logfun, beta_x1, index, x0, z, w, Y, X, beta_prior_mean,
+ beta_prior_prec, L, R)) {
return(x1);
}
- if (x1 < x0){
+ if (x1 < x0) {
Lbar = x1;
- }
- else {
+ } else {
Rbar = x1;
}
} // end infinite loop
}
+template <typename RNGTYPE>
+void MCMCmnlslice_impl(rng<RNGTYPE>& stream, const Matrix<>& Y,
+ const Matrix<>& X, const Matrix<>& b0,
+ const Matrix<>& B0, const Matrix<>& V,
+ Matrix<>& beta, unsigned int burnin,
+ unsigned int mcmc, unsigned int thin,
+ unsigned int verbose, Matrix<>& storemat){
+ // DEFINE constants
+ const unsigned int tot_iter = burnin + mcmc; // total iterations
+ const unsigned int nstore = mcmc / thin; // # of draws to store
+ const unsigned int k = X.cols();
+
+ // Initialize storage matrix
+ storemat = Matrix<>(nstore, k, false);
+
+ // proposal parameters
+ const Matrix<> propV = invpd(B0 + invpd(V));
+ const Matrix<> w_init = ones<double>(k, 1);
+ for (unsigned int i = 0; i < k; ++i)
+ w_init(i) = sqrt(propV(i,i)) *0.05;
+
+ // starting values
+ double L = -1.0;
+ double R = 1.0;
+
+ const unsigned int warmup_iter = 100;
+ const unsigned int warmup_burnin = 10;
+ const unsigned int p_init = 15;
+ const Matrix<> widthmat(warmup_iter - warmup_burnin, k);
+ // warm up sampling to choose the slice sampling parameters
+ for (unsigned int iter = 0; iter < warmup_iter; ++iter) {
+ for (unsigned int index = 0; index < k; ++index) {
+ double funval = mnl_logpost(Y, X, beta, b0, B0);
+ double z = funval - stream.rexp(1.0);
+ doubling(&mnl_logpost, beta, index, z, w_init[index], p_init, Y,
+ X, b0, B0, stream, L, R);
+ beta(index) = shrinkage(&mnl_logpost, beta, index, z,
+ w_init(index), Y, X, b0, B0, stream, L, R);
+ if (iter >= warmup_burnin)
+ widthmat(iter-warmup_burnin, index) = R - L;
+ }
+ }
+ const Matrix<> w = meanc(widthmat);
+ Matrix<int> p = ones<int>(k,1);
+ for (unsigned int index = 0; index < k; ++index) {
+ int p_temp = 2;
+ while ((w(index) * pow(2.0, p_temp) ) < max(widthmat(_,index))) {
+ ++p_temp;
+ }
+ p(index) = p_temp + 1;
+ }
+
+ unsigned int count = 0;
+ ///// REAL MCMC SAMPLING OCCURS IN THIS FOR LOOP
+ for(unsigned int iter = 0; iter < tot_iter; ++iter) {
+ for (unsigned int index = 0; index < k; ++index) {
+ double funval = mnl_logpost(Y, X, beta, b0, B0);
+ double z = funval - stream.rexp(1.0);
+ doubling(&mnl_logpost, beta, index, z, w(index), p(index), Y, X,
+ b0, B0, stream, L, R);
+ beta(index) = shrinkage(&mnl_logpost, beta, index, z, w(index),
+ Y, X, b0, B0, stream, L, R);
+ }
+ // store draws in storage matrix (or matrices)
+ if(iter >= burnin && (iter % thin == 0)) {
+ for (unsigned int j = 0; j < k; j++)
+ storemat(count, j) = beta(j);
+ ++count;
+ }
+ // print output to stdout
+ if(verbose > 0 && iter % verbose == 0) {
+ Rprintf("\n\nMCMCmnl slice iteration %i of %i \n", (iter+1),
+ tot_iter);
+ Rprintf("beta = \n");
+ for (unsigned int j = 0; j < k; ++j)
+ Rprintf("%10.5f\n", beta[j]);
+ }
-
+ R_CheckUserInterrupt(); // allow user interrupts
+
+ } // end MCMC loop
+}
extern "C" {
- // MCMC sampling for MNL model via slice sampling
- void MCMCmnlslice(double *sampledata, const int *samplerow,
- const int *samplecol, const double *Ydata,
- const int *Yrow, const int *Ycol,
- const double *Xdata, const int *Xrow,
- const int *Xcol, const int *burnin,
- const int *mcmc, const int *thin,
- const int *lecuyer,
- const int *seedarray, const int *lecuyerstream,
- const int *verbose, const double *betastartdata,
- const int *betastartrow, const int *betastartcol,
- const double *b0data, const int *b0row,
- const int *b0col, const double *B0data,
- const int *B0row, const int *B0col,
- const double *Vdata, const int *Vrow,
- const int *Vcol) {
+ // MCMC sampling for MNL model via slice sampling
+ void MCMCmnlslice(double *sampledata, const int *samplerow,
+ const int *samplecol, const double *Ydata,
+ const int *Yrow, const int *Ycol,
+ const double *Xdata, const int *Xrow,
+ const int *Xcol, const int *burnin,
+ const int *mcmc, const int *thin,
+ const int *uselecuyer,
+ const int *seedarray, const int *lecuyerstream,
+ const int *verbose, const double *betastartdata,
+ const int *betastartrow, const int *betastartcol,
+ const double *b0data, const int *b0row,
+ const int *b0col, const double *B0data,
+ const int *B0row, const int *B0col,
+ const double *Vdata, const int *Vrow,
+ const int *Vcol) {
- // pull together Matrix objects
- // REMEMBER TO ACCESS PASSED ints AND doubles PROPERLY
- const Matrix <double> Y = r2scythe(*Yrow, *Ycol, Ydata);
- const Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix <double> beta = r2scythe(*betastartrow, *betastartcol,
- betastartdata);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- const Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
- const Matrix <double> V = r2scythe(*Vrow, *Vcol, Vdata);
-
- // define constants
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols();
-
- // storage matrix or matrices
- Matrix<double> storemat(nstore, k);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // proposal parameters
- const Matrix<double> propV = invpd(B0 + invpd(V));
- const Matrix<double> w_init = ones<double>(k, 1);
- for (int i=0; i<k; ++i)
- w_init[i] = sqrt(propV(i,i))*0.05;
-
- // starting values
- double L = -1.0;
- double R = 1.0;
-
-
- const int warmup_iter = 100;
- const int warmup_burnin = 10;
- const int p_init = 15;
- const Matrix<double> widthmat(warmup_iter - warmup_burnin, k);
- // warm up sampling to choose the slice sampling parameters
- for (int iter=0; iter<warmup_iter; ++iter){
- for (int index=0; index<k; ++index){
-
- double funval = mnl_logpost(Y, X, beta, b0,
- B0);
- double z = funval - stream->rexp(1.0);
- doubling(&mnl_logpost, beta, index, z, w_init[index], p_init, Y, X,
- b0, B0, stream, L, R);
-
- beta[index] = shrinkage(&mnl_logpost, beta, index, z,
- w_init[index], Y, X, b0,
- B0, stream, L, R);
- if (iter >= warmup_burnin){
- widthmat(iter-warmup_burnin, index) = R - L;
- }
- }
- }
- const Matrix<double> w = meanc(widthmat);
- Matrix<int> p = ones<int>(k,1);
- for (int index=0; index<k; ++index){
- int p_temp = 2;
- while ((w[index] * pow(2.0, p_temp) ) < max(widthmat(_,index))){
- ++p_temp;
- }
- p[index] = p_temp + 1;
- }
-
-
-
- int count = 0;
- ///// REAL MCMC SAMPLING OCCURS IN THIS FOR LOOP
- for(int iter = 0; iter < tot_iter; ++iter){
- for (int index=0; index<k; ++index){
-
- double funval = mnl_logpost(Y, X, beta, b0,
- B0);
- double z = funval - stream->rexp(1.0);
- doubling(&mnl_logpost, beta, index, z, w[index], p[index],
- Y, X, b0, B0, stream, L, R);
- beta[index] = shrinkage(&mnl_logpost, beta, index, z,
- w[index], Y, X, b0,
- B0, stream, L, R);
- }
-
-
- // store draws in storage matrix (or matrices)
- if(iter >= *burnin && (iter % *thin == 0)){
- for (int j = 0; j < k; j++)
- storemat(count, j) = beta[j];
- ++count;
- }
-
- // print output to stdout
- if(*verbose > 0 && iter % *verbose == 0){
- Rprintf("\n\nMCMCmnl slice iteration %i of %i \n", (iter+1),
- tot_iter);
- Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
- Rprintf("%10.5f\n", beta[j]);
- }
-
- R_CheckUserInterrupt(); // allow user interrupts
-
- } // end MCMC loop
-
- delete stream; // clean up random number stream
-
- // load draws into sample array
- const int size = *samplerow * *samplecol;
- for(int i = 0; i < size; ++i)
- sampledata[i] = storemat[i];
-
- } // end MCMCmnlslice
+ // pull together Matrix objects
+ // REMEMBER TO ACCESS PASSED ints AND doubles PROPERLY
+ const Matrix<> Y(*Yrow, *Ycol, Ydata);
+ const Matrix<> X(*Xrow, *Xcol, Xdata);
+ Matrix<> beta(*betastartrow, *betastartcol, betastartdata);
+ const Matrix<> b0(*b0row, *b0col, b0data);
+ const Matrix<> B0(*B0row, *B0col, B0data);
+ const Matrix<> V(*Vrow, *Vcol, Vdata);
+
+ // storage matrix or matrices
+ Matrix<double> storemat;
+ MCMCPACK_PASSRNG2MODEL(MCMCmnlslice_impl, Y, X, b0,
+ B0, V, beta,
+ *burnin, *mcmc, *thin,
+ *verbose, storemat);
+
+ // load draws into sample array
+ for(unsigned int i = 0; i < storemat.size(); ++i)
+ sampledata[i] = storemat(i);
+
+ } // end MCMCmnlslice
} // end extern "C"
+
+#endif
diff --git a/src/MCMCoprobit.cc b/src/MCMCoprobit.cc
index addb3b6..7327daf 100644
--- a/src/MCMCoprobit.cc
+++ b/src/MCMCoprobit.cc
@@ -19,154 +19,142 @@
//
// updated to the new version of Scythe 7/26/2004 KQ
// fixed a bug pointed out by Alexander Raach 1/16/2005 KQ
+// updated to Scythe 1.0.X 7/10/2007 ADM
//
+#ifndef MCMCOPROBIT_CC
+#define MCMCOPROBIT_CC
-#include<iostream>
-
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
+#include "rng.h"
+#include "mersenne.h"
+#include "lecuyer.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
+using namespace scythe;
-extern "C"{
-
-
- void MCMCoprobit(double *sampledata, const int *samplerow,
- const int *samplecol, const int *Y,
- const double *Xdata,
- const int *Xrow, const int *Xcol, const int *burnin,
- const int *mcmc, const int *thin, const double* tune,
- const int *lecuyer, const int *seedarray,
- const int *lecuyerstream, const int *verbose,
- const double *betadata, const int *betarow,
- const int *betacol, const double* gammadata,
- const int* gammarow, const int* gammacol,
- const double *b0data, const int *b0row, const int *b0col,
- const double *B0data, const int *B0row, const int *B0col) {
-
- // pull together Matrix objects
- const Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix <double> beta = r2scythe(*betarow, *betacol,
- betadata);
- Matrix <double> gamma = r2scythe(*gammarow, *gammacol,
- gammadata);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- const Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
+/* MCMCoprobit implementation. Takes Matrix<> reference which it
+ * fills with the posterior.
+ */
+template <typename RNGTYPE>
+void MCMCoprobit_impl (rng<RNGTYPE>& stream, const int * Y,
+ const Matrix<>& X, Matrix<>& beta, Matrix<>& gamma,
+ const Matrix<>& b0, const Matrix<>& B0,
+ const unsigned int burnin, const unsigned int mcmc, const unsigned int thin,
+ const unsigned int verbose, const double tune, Matrix<>& result) {
// define constants and from cross-product matrices
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols();
- const int N = X.rows();
+ const unsigned int tot_iter = burnin + mcmc; // total number of mcmc iterations
+ const unsigned int nstore = mcmc / thin; // number of draws to store
+ const unsigned int k = X.cols();
+ const unsigned int N = X.rows();
const int ncat = gamma.rows() - 1;
- const Matrix<double> XpX = crossprod(X);
+ const Matrix<> XpX = crossprod(X);
// storage matrix or matrices
- Matrix<double> storemat(nstore, k+ncat+1);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
+ Matrix<> storemat(nstore, k+ncat+1);
+
// initialize Z
- Matrix<double> gamma_p = gamma;
- Matrix<double> Z(N,1);
- Matrix<double> Xbeta = X * beta;
+ Matrix<> gamma_p = gamma;
+ Matrix<> Z(N,1);
+ Matrix<> Xbeta = X * beta;
+
// Gibbs loop
int count = 0;
int accepts = 0;
- for (int iter = 0; iter < tot_iter; ++iter){
-
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
+
// [gamma | Z, beta]
for (int i=2; i<(ncat); ++i){
if (i==(ncat-1)){
- gamma_p[i] = stream->rtbnorm_combo(gamma[i], ::pow(tune[0], 2.0),
- gamma_p[i-1]);
+ gamma_p[i] = stream.rtbnorm_combo(gamma[i], ::pow(tune, 2.0),
+ gamma_p[i-1]);
}
else {
- gamma_p[i] = stream->rtnorm_combo(gamma[i], ::pow(tune[0], 2.0),
- gamma_p[i-1],
- gamma[i+1]);
+ gamma_p[i] = stream.rtnorm_combo(gamma[i], ::pow(tune, 2.0),
+ gamma_p[i-1],
+ gamma[i+1]);
}
}
double loglikerat = 0.0;
double loggendenrat = 0.0;
-
+
// loop over observations and construct the acceptance ratio
- for (int i=0; i<N; ++i){
+ for (unsigned int i=0; i<N; ++i){
if (Y[i] == ncat){
loglikerat = loglikerat
+ log(1.0 -
- pnorm(gamma_p[Y[i]-1] - Xbeta[i]) )
+ pnorm(gamma_p[Y[i]-1] - Xbeta[i], 0.0, 1.0) )
- log(1.0 -
- pnorm(gamma[Y[i]-1] - Xbeta[i]) );
+ pnorm(gamma[Y[i]-1] - Xbeta[i], 0.0, 1.0) );
}
else if (Y[i] == 1){
loglikerat = loglikerat
- + log(pnorm(gamma_p[Y[i]] - Xbeta[i]) )
- - log(pnorm(gamma[Y[i]] - Xbeta[i]) );
+ + log(pnorm(gamma_p[Y[i]] - Xbeta[i], 0.0, 1.0) )
+ - log(pnorm(gamma[Y[i]] - Xbeta[i], 0.0, 1.0) );
}
else{
loglikerat = loglikerat
- + log(pnorm(gamma_p[Y[i]] - Xbeta[i]) -
- pnorm(gamma_p[Y[i]-1] - Xbeta[i]) )
- - log(pnorm(gamma[Y[i]] - Xbeta[i]) -
- pnorm(gamma[Y[i]-1] - Xbeta[i]) );
+ + log(pnorm(gamma_p[Y[i]] - Xbeta[i], 0.0, 1.0) -
+ pnorm(gamma_p[Y[i]-1] - Xbeta[i], 0.0, 1.0) )
+ - log(pnorm(gamma[Y[i]] - Xbeta[i], 0.0, 1.0) -
+ pnorm(gamma[Y[i]-1] - Xbeta[i], 0.0, 1.0) );
}
}
- for (int j=2; j<ncat; ++j){
- loggendenrat = loggendenrat
- + log(pnorm(gamma[j+1], gamma[j], tune[0]) -
- pnorm(gamma_p[j-1], gamma[j], tune[0]) )
- - log(pnorm(gamma_p[j+1], gamma_p[j], tune[0]) -
- pnorm(gamma[j-1], gamma_p[j], tune[0]) );
-
- }
+ // for (int j=2; j<ncat; ++j){
+ // loggendenrat = loggendenrat
+ // + log(pnorm(gamma[j+1], gamma[j], tune) -
+ // pnorm(gamma_p[j-1], gamma[j], tune) )
+ // - log(pnorm(gamma_p[j+1], gamma_p[j], tune) -
+ // pnorm(gamma[j-1], gamma_p[j], tune) );
+ // }
double logacceptrat = loglikerat + loggendenrat;
- if (stream->runif() <= exp(logacceptrat)){
+ if (stream.runif() <= exp(logacceptrat)){
gamma = gamma_p;
++accepts;
}
-
-
+
+
// [Z| gamma, beta, y]
//Matrix<double> Z_mean = X * beta;
- for (int i=0; i<N; ++i){
- Z[i] = stream->rtnorm_combo(Xbeta[i], 1.0, gamma[Y[i]-1], gamma[Y[i]]);
+ for (unsigned int i=0; i<N; ++i){
+ Z[i] = stream.rtnorm_combo(Xbeta[i], 1.0, gamma[Y[i]-1], gamma[Y[i]]);
}
-
// [beta|Z, gamma]
- const Matrix<double> XpZ = t(X) * Z;
+ const Matrix<> XpZ = t(X) * Z;
beta = NormNormregress_beta_draw(XpX, XpZ, b0, B0, 1.0, stream);
Xbeta = X * beta;
-
-
+
+
// store values in matrices
- if (iter >= *burnin && ((iter % *thin)==0)){
- for (int j=0; j<k; ++j)
+ if (iter >= burnin && ((iter % thin)==0)){
+ for (unsigned int j=0; j<k; ++j)
storemat(count, j) = beta[j];
for (int j=0; j<(ncat+1); ++j)
storemat(count, j+k) = gamma[j];
++count;
}
+
+
+
// print output to stdout
- if(*verbose > 0 && iter % *verbose == 0){
+ if(verbose > 0 && iter % verbose == 0){
Rprintf("\n\nMCMCoprobit iteration %i of %i \n", (iter+1), tot_iter);
Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
+ for (unsigned int j=0; j<k; ++j)
Rprintf("%10.5f\n", beta[j]);
Rprintf("Metropolis acceptance rate for gamma = %3.5f\n\n",
static_cast<double>(accepts) /
@@ -175,19 +163,50 @@ extern "C"{
R_CheckUserInterrupt(); // allow user interrupts
}
-
- delete stream; // clean up random number stream
-
- // return output
- const int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = storemat[i];
+ result = storemat;
+
Rprintf("\n\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
Rprintf("The Metropolis acceptance rate for beta was %3.5f",
static_cast<double>(accepts) / static_cast<double>(tot_iter));
Rprintf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
- }
+}
+
+
+extern "C"{
+ void MCMCoprobit(double *sampledata, const int *samplerow,
+ const int *samplecol, const int *Y,
+ const double *Xdata,
+ const int *Xrow, const int *Xcol, const int *burnin,
+ const int *mcmc, const int *thin, const double* tune,
+ const int *uselecuyer, const int *seedarray,
+ const int *lecuyerstream, const int *verbose,
+ const double *betadata, const int *betarow,
+ const int *betacol, const double* gammadata,
+ const int* gammarow, const int* gammacol,
+ const double *b0data, const int *b0row, const int *b0col,
+ const double *B0data, const int *B0row, const int *B0col) {
+
+ // pull together Matrix objects
+ const Matrix <> X(*Xrow, *Xcol, Xdata);
+ Matrix <> beta(*betarow, *betacol,
+ betadata);
+ Matrix <> gamma(*gammarow, *gammacol,
+ gammadata);
+ const Matrix <> b0(*b0row, *b0col, b0data);
+ const Matrix <> B0(*B0row, *B0col, B0data);
+
+ Matrix<> storagematrix;
+ MCMCPACK_PASSRNG2MODEL(MCMCoprobit_impl, Y, X, beta, gamma, b0, B0,
+ *burnin, *mcmc, *thin, *verbose, *tune,
+ storagematrix);
+
+ const unsigned int size = *samplerow * *samplecol;
+ for (unsigned int i = 0; i < size; ++i)
+ sampledata[i] = storagematrix(i);
+ }
}
+
+#endif
diff --git a/src/MCMCordfactanal.cc b/src/MCMCordfactanal.cc
index 02a1fb9..d0b951a 100644
--- a/src/MCMCordfactanal.cc
+++ b/src/MCMCordfactanal.cc
@@ -23,9 +23,13 @@
// fixed a bug pointed out by Alexander Raach 1/16/2005 KQ
//
+#ifndef MCMCORDFACTANAL_CC
+#define MCMCORDFACTANAL_CC
+
#include <iostream>
#include "matrix.h"
+#include "algorithm.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
@@ -37,238 +41,211 @@
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
-using namespace std;
-
+typedef Matrix<double,Row,View> rmview;
-extern "C"{
+using namespace std;
+using namespace scythe;
-// function called by R to fit model
-void
-ordfactanalpost (double* sampledata, const int* samplerow,
- const int* samplecol,
- const int* Xdata, const int* Xrow, const int* Xcol,
- const int* burnin, const int* mcmc, const int* thin,
- const double* tune, const int *lecuyer, const int *seedarray,
- const int *lecuyerstream, const int* verbose,
- const double* Lamstartdata, const int* Lamstartrow,
- const int* Lamstartcol,
- const double* gamdata, const int* gamrow, const int* gamcol,
- const int* ncatdata, const int* ncatrow, const int* ncatcol,
- const double* Lameqdata, const int* Lameqrow,
- const int* Lameqcol,
- const double* Lamineqdata, const int* Lamineqrow,
- const int* Lamineqcol,
- const double* Lampmeandata, const int* Lampmeanrow,
- const int* Lampmeancol,
- const double* Lampprecdata, const int* Lampprecrow,
- const int* Lamppreccol, const int* storelambda,
- const int* storescores,
- int* acceptsdata, const int* acceptsrow,
- const int* acceptscol, const int* outswitch
- ) {
+template <typename RNGTYPE>
+void MCMCordfactanal_impl(rng<RNGTYPE>& stream,
+ const Matrix<int>& X, Matrix<>& Lambda,
+ Matrix<>& gamma, const Matrix<>& ncateg,
+ const Matrix<>& Lambda_eq,
+ const Matrix<>& Lambda_ineq,
+ const Matrix<>& Lambda_prior_mean,
+ const Matrix<>& Lambda_prior_prec,
+ const double* tune,
+ bool storelambda, bool storescores,
+ int outswitch, unsigned int burnin,
+ unsigned int mcmc, unsigned int thin,
+ unsigned int verbose, Matrix<int>& accepts,
+ Matrix<>& output)
+{
+ // constants
+ const unsigned int K = X.cols(); // number of manifest variables
+ const unsigned int N = X.rows(); // number of observations
+ const unsigned int D = Lambda.cols(); // # of factors (incl constant)
+ const unsigned int tot_iter = burnin + mcmc;
+ const unsigned int nsamp = mcmc / thin;
+ const Matrix<> I = eye<double>(D-1);
+ const Matrix<bool> Lambda_free_indic(K, D);
+ for (unsigned int i = 0; i < (K * D); ++i)
+ if (Lambda_eq(i) == -999)
+ Lambda_free_indic(i) = true;
- // put together matrices
- const Matrix<int> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix<double> Lambda = r2scythe(*Lamstartrow, *Lamstartcol, Lamstartdata);
- Matrix<double> gamma = r2scythe(*gamrow, *gamcol, gamdata);
- const Matrix<double> ncateg = r2scythe(*ncatrow, *ncatcol, ncatdata);
- const Matrix<double> Lambda_eq = r2scythe(*Lameqrow, *Lameqcol, Lameqdata);
- const Matrix<double> Lambda_ineq = r2scythe(*Lamineqrow, *Lamineqcol,
- Lamineqdata);
- const Matrix<double> Lambda_prior_mean = r2scythe(*Lampmeanrow,
- *Lampmeancol,
- Lampmeandata);
- const Matrix<double> Lambda_prior_prec = r2scythe(*Lampprecrow,
- *Lamppreccol,
- Lampprecdata);
- Matrix<int> accepts = r2scythe(*acceptsrow, *acceptscol, acceptsdata);
+ const Matrix<> Psi = eye<double>(K);
+ const Matrix<> Psi_inv = eye<double>(K);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // constants
- const int K = X.cols(); // number of manifest variables
- const int N = X.rows(); // number of observations
- const int D = Lambda.cols(); // number of factors (including constant)
- const int tot_iter = *burnin + *mcmc;
- const int nsamp = *mcmc / *thin;
- const Matrix<double> I = eye<double>(D-1);
- const Matrix<double> Lambda_free_indic = Matrix<double>(K, D);
- for (int i=0; i<(K*D); ++i){
- if (Lambda_eq[i] == -999) Lambda_free_indic[i] = 1.0;
- }
- const Matrix<double> Psi = eye<double>(K);
- const Matrix<double> Psi_inv = eye<double>(K);
-
+ //Rprintf("Switches are %i %i %i\n", storelambda, storescores, outswitch);
// starting values for phi, Xstar, and gamma_p
- Matrix<double> phi = Matrix<double>(N, D-1);
+ Matrix<> phi(N, D-1);
//Matrix<double> phi = stream->rnorm(N, D-1);
phi = cbind(ones<double>(N,1), phi);
- Matrix<double> Xstar = Matrix<double>(N, K);
+ Matrix<> Xstar(N, K);
// storage matrices (row major order)
- Matrix<double> Lambda_store;
- if (storelambda[0]==1){
+ Matrix<> Lambda_store;
+ if (storelambda){
Lambda_store = Matrix<double>(nsamp, K*D);
}
- Matrix<double> gamma_store = Matrix<double>(nsamp, *gamrow * *gamcol);
- Matrix<double> phi_store;
- if (*storescores==1){
- phi_store = Matrix<double>(nsamp, N*D);
+ Matrix<> gamma_store(nsamp, gamma.size());
+ Matrix<> phi_store;
+ if (storescores){
+ phi_store = Matrix<>(nsamp, N*D);
}
///////////////////
// Gibbs Sampler //
///////////////////
int count = 0;
- for (int iter=0; iter < tot_iter; ++iter){
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
// sample Xstar
- for (int i=0; i<N; ++i){
- Matrix<double> X_mean = Lambda * t(phi(i,_));
- for (int j=0; j<K; ++j){
- if (X(i,j) == -999){ // if missing
- Xstar(i,j) = stream->rnorm(X_mean[j], 1.0);
- }
- else { // if not missing
- Xstar(i,j) = stream->rtnorm_combo(X_mean[j], 1.0,
- gamma(X(i,j)-1, j), gamma(X(i,j), j));
+ for (unsigned int i = 0; i < N; ++i) {
+ Matrix<> X_mean = Lambda * t(phi(i,_));
+ for (unsigned int j = 0; j < K; ++j) {
+ if (X(i,j) == -999) { // if missing
+ Xstar(i,j) = stream.rnorm(X_mean[j], 1.0);
+ } else { // if not missing
+ Xstar(i,j) = stream.rtnorm_combo(X_mean[j], 1.0,
+ gamma(X(i,j)-1, j), gamma(X(i,j), j));
}
}
}
-
// sample phi
- Matrix<double> Lambda_const = Lambda(_,0);
- Matrix<double> Lambda_rest = Lambda(0, 1, K-1, D-1);
- Matrix<double> phi_post_var = invpd(I + crossprod(Lambda_rest) );
- Matrix<double> phi_post_C = cholesky(phi_post_var);
- for (int i=0; i<N; ++i){
- Matrix<double> phi_post_mean = phi_post_var *
- (t(Lambda_rest) * (t(Xstar(i,_))-Lambda_const));
- Matrix<double> phi_samp = gaxpy(phi_post_C, stream->rnorm(D-1, 1),
- phi_post_mean);
- for (int j=0; j<(D-1); ++j)
- phi(i,j+1) = phi_samp[j];
+ Matrix<> Lambda_const = Lambda(_,0);
+ Matrix<> Lambda_rest = Lambda(0, 1, K-1, D-1);
+ Matrix<> phi_post_var = invpd(I + crossprod(Lambda_rest) );
+ Matrix<> phi_post_C = cholesky(phi_post_var);
+ for (unsigned int i = 0; i < N; ++i) {
+ Matrix<> phi_post_mean = phi_post_var * (t(Lambda_rest)
+ * (t(Xstar(i,_))-Lambda_const));
+ Matrix<> phi_samp = gaxpy(phi_post_C, stream.rnorm(D-1, 1, 0, 1),
+ phi_post_mean);
+ for (unsigned int j = 0; j < (D-1); ++j)
+ phi(i,j+1) = phi_samp(j);
}
-
+
// sample Lambda
- NormNormfactanal_Lambda_draw(Lambda, Lambda_free_indic,
- Lambda_prior_mean,
- Lambda_prior_prec,
- phi, Xstar, Psi_inv, Lambda_ineq,
- D, K, stream);
+ NormNormfactanal_Lambda_draw(Lambda, Lambda_free_indic,
+ Lambda_prior_mean, Lambda_prior_prec,
+ phi, Xstar, Psi_inv, Lambda_ineq, D, K,
+ stream);
// sample gamma
- for (int j=0; j<K; ++j){ // do the sampling for each manifest var
- Matrix<double> gamma_p = gamma(_,j);
- Matrix<double> X_mean = phi * t(Lambda(j,_));
- for (int i=2; i<(ncateg[j]); ++i){
- if (i==(ncateg[j]-1)){
- gamma_p[i] = stream->rtbnorm_combo(gamma(i,j), ::pow(tune[j], 2.0),
- gamma_p[i-1]);
- }
- else {
- gamma_p[i] = stream->rtnorm_combo(gamma(i,j), ::pow(tune[j], 2.0),
- gamma_p[i-1],
- gamma(i+1, j));
+ for (unsigned int j = 0; j < K; ++j) {
+ // do the sampling for each manifest var
+ Matrix<> gamma_p = gamma(_,j);
+ Matrix<> X_mean = phi * t(Lambda(j,_));
+ for (unsigned int i = 2; i < (ncateg(j)); ++i) {
+ if (i == (ncateg(j)-1)) {
+ gamma_p(i) = stream.rtbnorm_combo(gamma(i,j),
+ std::pow(tune[j], 2.0), gamma_p[i-1]);
+ } else {
+ gamma_p[i] = stream.rtnorm_combo(gamma(i,j),
+ std::pow(tune[j], 2.0), gamma_p[i-1], gamma(i+1, j));
}
}
double loglikerat = 0.0;
double loggendenrat = 0.0;
-
-
+
+
// loop over observations and construct the acceptance ratio
- for (int i=0; i<N; ++i){
- if (X(i,j) != -999){
- if (X(i,j) == ncateg[j]){
- loglikerat = loglikerat
- + log(1.0 -
- pnorm(gamma_p[X(i,j)-1] - X_mean[i]) )
- - log(1.0 -
- pnorm(gamma(X(i,j)-1,j) - X_mean[i]) );
- }
- else if (X(i,j) == 1){
- loglikerat = loglikerat
- + log(pnorm(gamma_p[X(i,j)] - X_mean[i]) )
- - log(pnorm(gamma(X(i,j), j) - X_mean[i]) );
- }
- else{
- loglikerat = loglikerat
- + log(pnorm(gamma_p[X(i,j)] - X_mean[i]) -
- pnorm(gamma_p[X(i,j)-1] - X_mean[i]) )
- - log(pnorm(gamma(X(i,j), j) - X_mean[i]) -
- pnorm(gamma(X(i,j)-1, j) - X_mean[i]) );
+ for (unsigned int i = 0; i < N; ++i) {
+ if (X(i,j) != -999) {
+ if (X(i,j) == ncateg(j)) {
+ loglikerat = loglikerat +
+ log(1.0 - pnorm(gamma_p[X(i,j)-1] - X_mean[i], 0, 1) )
+ - log(1.0 - pnorm(gamma(X(i,j)-1,j) - X_mean[i], 0, 1) );
+ } else if (X(i,j) == 1) {
+ loglikerat = loglikerat +
+ log(pnorm(gamma_p[X(i,j)] - X_mean[i], 0, 1) )
+ - log(pnorm(gamma(X(i,j), j) - X_mean[i], 0, 1) );
+ } else {
+ loglikerat = loglikerat +
+ log(pnorm(gamma_p[X(i,j)] - X_mean[i], 0, 1)
+ - pnorm(gamma_p[X(i,j)-1] - X_mean[i], 0, 1) )
+ - log(pnorm(gamma(X(i,j), j) - X_mean[i], 0, 1) -
+ pnorm(gamma(X(i,j)-1, j) - X_mean[i], 0, 1) );
}
}
}
- for (int k=2; k<ncateg[j]; ++k){
+
+ for (unsigned int k = 2; k < ncateg(j); ++k) {
loggendenrat = loggendenrat
- + log(pnorm(gamma(k+1,j), gamma(k,j), tune[j]) -
- pnorm(gamma_p[k-1], gamma(k,j), tune[j]) )
- - log(pnorm(gamma_p[k+1], gamma_p[k], tune[j]) -
- pnorm(gamma(k-1,j), gamma_p[k], tune[j]) );
+ + log(pnorm(gamma(k+1,j), gamma(k,j), tune[j]) -
+ pnorm(gamma_p[k-1], gamma(k,j), tune[j]) ) -
+ log(pnorm(gamma_p[k+1], gamma_p[k], tune[j]) -
+ pnorm(gamma(k-1,j), gamma_p[k], tune[j]) );
}
double logacceptrat = loglikerat + loggendenrat;
- if (stream->runif() <= exp(logacceptrat)){
- for (int i=0; i<gamrow[0]; ++i){
+ if (stream() <= exp(logacceptrat)) {
+ for (unsigned int i = 0; i < gamma.rows(); ++i) {
if (gamma(i,j) == 300) break;
gamma(i,j) = gamma_p[i];
}
- ++accepts[j];
+ ++accepts(j);
}
}
-
-
+
+
// print results to screen
- if (verbose[0] > 0 && iter % verbose[0] == 0 && *outswitch == 1){
- Rprintf("\n\nMCMCordfactanal iteration %i of %i \n", (iter+1), tot_iter);
+ if (verbose > 0 && iter % verbose == 0 && outswitch == 1) {
+ Rprintf("\n\nMCMCordfactanal iteration %i of %i \n", (iter+1),
+ tot_iter);
Rprintf("Lambda = \n");
- for (int i=0; i<K; ++i){
- for (int j=0; j<D; ++j){
+ for (unsigned int i = 0; i < K; ++i) {
+ for (unsigned int j = 0; j < D; ++j) {
Rprintf("%10.5f", Lambda(i,j));
}
Rprintf("\n");
}
Rprintf("\nMetropolis-Hastings acceptance rates = \n");
- for (int j = 0; j<K; ++j){
- Rprintf("%6.2f",
- static_cast<double>(accepts[j]) /
- static_cast<double>((iter+1)));
- }
+ for (unsigned int j = 0; j < K; ++j) {
+ Rprintf("%6.2f", static_cast<double>(accepts[j]) /
+ static_cast<double>((iter+1)));
+ }
}
- if (verbose[0] > 0 && iter % verbose[0] == 0 && *outswitch == 2){
- Rprintf("\n\nMCMCirtKd iteration %i of %i \n", (iter+1), tot_iter);
+ if (verbose > 0 && iter % verbose == 0 && outswitch == 2) {
+ Rprintf("\n\nMCMCirtKd iteration %i of %i \n", (iter+1),
+ tot_iter);
}
-
-
+
// store results
- if ((iter >= burnin[0]) && ((iter % thin[0]==0))) {
+ if ((iter >= burnin) && ((iter % thin==0))) {
// store Lambda
- if (storelambda[0]==1){
- if (*outswitch==2){
- for(int l=0; l<K; ++l){
+ if (storelambda) {
+ if (outswitch == 2) {
+ for(unsigned int l = 0; l < K; ++l) {
Lambda(l,0) = Lambda(l,0) * -1.0;
- }
+ }
}
- Matrix<double> Lambda_store_vec = reshape(Lambda,1,K*D);
- for (int l=0; l<K*D; ++l)
- Lambda_store(count, l) = Lambda_store_vec[l];
+ // XXX delete when sure working
+ //Matrix<> Lambda_store_vec = reshape(Lambda, 1, K*D);
+ //for (unsigned int l = 0; l < K * D; ++l)
+ // Lambda_store(count, l) = Lambda_store_vec(l);
+ rmview(Lambda_store(count, _)) = Lambda;
+ //Rprintf("\n\n");
+ //for (int l = 0; l < K * D; ++l)
+ // Rprintf("%10.5f", Lambda_store(count, l));
+ //Rprintf("\n\n");
+
}
-
+
// store gamma
- Matrix<double> gamma_store_vec = reshape(gamma, 1, gamrow[0]*gamcol[0]);
- for (int l=0; l<gamrow[0]*gamcol[0]; ++l)
- gamma_store(count, l) = gamma_store_vec[l];
+ //Matrix<> gamma_store_vec = reshape(gamma, 1, gamma.size());
+ //for (unsigned int l = 0; l < gamma.size(); ++l)
+ // gamma_store(count, l) = gamma_store_vec(l);
+ rmview(gamma_store(count, _)) = gamma;
// store phi
- if (storescores[0]==1){
- Matrix<double> phi_store_vec = reshape(phi, 1, N*D);
- for (int l=0; l<N*D; ++l)
- phi_store(count, l) = phi_store_vec[l];
+ if (storescores) {
+ //Matrix<> phi_store_vec = reshape(phi, 1, N*D);
+ //for (unsigned int l = 0; l < N * D; ++l)
+ // phi_store(count, l) = phi_store_vec(l);
+ rmview(phi_store(count, _)) = phi;
}
count++;
}
@@ -277,29 +254,75 @@ ordfactanalpost (double* sampledata, const int* samplerow,
R_CheckUserInterrupt();
} // end MCMC loop
-
- delete stream; // clean up random number stream
-
- // return output
- Matrix<double> output;
- if (*storelambda == 1){
+
+ if (storelambda) {
output = cbind(Lambda_store, gamma_store);
- }
- else {
+ } else {
output = gamma_store;
}
- if(*storescores == 1) {
+ if(storescores) {
output = cbind(output, phi_store);
}
- int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = output[i];
-
- for (int j=0; j<K; ++j)
- acceptsdata[j] = accepts[j];
-
}
-}
+extern "C"{
+ // function called by R to fit model
+ void
+ ordfactanalpost (double* sampledata, const int* samplerow,
+ const int* samplecol,
+ const int* Xdata, const int* Xrow, const int* Xcol,
+ const int* burnin, const int* mcmc, const int* thin,
+ const double* tune, const int *uselecuyer,
+ const int *seedarray,
+ const int *lecuyerstream, const int* verbose,
+ const double* Lamstartdata, const int* Lamstartrow,
+ const int* Lamstartcol,
+ const double* gamdata, const int* gamrow, const int* gamcol,
+ const int* ncatdata, const int* ncatrow, const int* ncatcol,
+ const double* Lameqdata, const int* Lameqrow,
+ const int* Lameqcol,
+ const double* Lamineqdata, const int* Lamineqrow,
+ const int* Lamineqcol,
+ const double* Lampmeandata, const int* Lampmeanrow,
+ const int* Lampmeancol,
+ const double* Lampprecdata, const int* Lampprecrow,
+ const int* Lamppreccol, const int* storelambda,
+ const int* storescores,
+ int* acceptsdata, const int* acceptsrow,
+ const int* acceptscol, const int* outswitch)
+ {
+
+ // put together matrices
+ const Matrix<int> X(*Xrow, *Xcol, Xdata);
+ Matrix<> Lambda(*Lamstartrow, *Lamstartcol, Lamstartdata);
+ Matrix<> gamma(*gamrow, *gamcol, gamdata);
+ const Matrix<> ncateg(*ncatrow, *ncatcol, ncatdata);
+ const Matrix<> Lambda_eq(*Lameqrow, *Lameqcol, Lameqdata);
+ const Matrix<> Lambda_ineq(*Lamineqrow, *Lamineqcol, Lamineqdata);
+ const Matrix<> Lambda_prior_mean(*Lampmeanrow, *Lampmeancol,
+ Lampmeandata);
+ const Matrix<> Lambda_prior_prec(*Lampprecrow, *Lamppreccol,
+ Lampprecdata);
+ Matrix<int> accepts(*acceptsrow, *acceptscol, acceptsdata);
+
+
+
+ // return output
+ Matrix<double> output;
+ MCMCPACK_PASSRNG2MODEL(MCMCordfactanal_impl, X, Lambda, gamma,
+ ncateg, Lambda_eq, Lambda_ineq, Lambda_prior_mean,
+ Lambda_prior_prec, tune, *storelambda,
+ *storescores, *outswitch,
+ *burnin, *mcmc, *thin, *verbose, accepts, output);
+
+
+ for (unsigned int i = 0; i < output.size(); ++i)
+ sampledata[i] = output(i);
+
+ for (unsigned int j = 0; j < X.cols(); ++j)
+ acceptsdata[j] = accepts(j);
+ }
+}
+#endif
diff --git a/src/MCMCpanel.cc b/src/MCMCpanel.cc
deleted file mode 100644
index 76fa6ed..0000000
--- a/src/MCMCpanel.cc
+++ /dev/null
@@ -1,229 +0,0 @@
-// MCMCpanel.cc is C++ code to implement a general linear panel
-// model. It is called from R.
-//
-// ADM 10/10/2002
-// updated to new Scythe spec and new rngs ADM 7/28/2004
-
-#include "matrix.h"
-#include "distributions.h"
-#include "stat.h"
-#include "la.h"
-#include "ide.h"
-#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
-
-#include <R.h> // needed to use Rprintf()
-#include <R_ext/Utils.h> // needed to allow user interrupts
-
-extern "C"{
-
-using namespace SCYTHE;
-using namespace std;
-
-// simulate from posterior density and return a Gibbs by parameters matrix
-// of the posterior density sample
-void
-panelpost (double* sample, const int* samrow, const int* samcol,
- const double* obs, const int* obsrow, const int* obscol,
- const double* Y, const int* Yrow, const int* Ycol,
- const double* X, const int* Xrow, const int* Xcol,
- const double* W, const int* Wrow, const int* Wcol,
- const int* burnin, const int* gibbs, const int* thin,
- const int *lecuyer, const int *seedarray,
- const int *lecuyerstream, const int* verbose,
- const double* bstart, const int* bstartrow, const int* bstartcol,
- const double* sigma2start, const double* Dstart,
- const int* Dstartrow, const int* Dstartcol,
- const double* b0, const int* b0row, const int* b0col,
- const double* B0, const int* B0row, const int* B0col,
- const double* nu0, const double* delta0, const int* eta0,
- const double* R0, const int* R0row, const int* R0col,
- const int* n, const int* k, const int* p, const int* q
- )
- {
-
- // put together matrices
- Matrix<double> Msample(samcol[0], samrow[0], sample);
- Msample = t(Msample);
- Matrix<double> Mobs(obscol[0], obsrow[0], obs);
- Mobs = t(Mobs);
- Matrix<double> MX(Xcol[0], Xrow[0], X);
- MX = t(MX);
- Matrix<double> MY(Ycol[0], Yrow[0], Y);
- MY = t(MY);
- Matrix<double> MW(Wcol[0], Wrow[0], W);
- MW = t(MW);
- Matrix<double> Mbetastart(bstartcol[0],bstartrow[0], bstart);
- Mbetastart = t(Mbetastart);
- Matrix<double> MDstart(Dstartcol[0],Dstartrow[0], Dstart);
- MDstart = t(MDstart);
- Matrix<double> Mb0(b0col[0], b0row[0], b0);
- Mb0 = t(Mb0);
- Matrix<double> MB0(B0col[0], B0row[0], B0);
- MB0 = t(MB0);
- Matrix<double> MR0(R0col[0], R0row[0], R0);
- MR0 = t(MR0);
-
- // redefine constants
- int Mn = n[0];
- int Mk = k[0];
- int Mp = p[0];
- int Mq = q[0];
- int Mgibbs = gibbs[0];
- int Mburnin = burnin[0];
- int Mthin = thin[0];
- int Mtotiter = Mburnin + Mgibbs;
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // create arrays of matrices for data access
- // Matrix<double> Yarr[Mn];
- Matrix<double>* Yarr = new Matrix<double>[Mn];
- for(int i = 0; i < Mn; ++i) {
- Yarr[i] = Matrix<double>(Mk,1);
- int start = i * Mk;
- for(int j = 0; j < Mk; ++j) {
- Yarr[i](j,0) = MY(start + j,0);
- }
- }
-
- //Matrix<double> Xarr[Mn];
- Matrix<double>* Xarr = new Matrix<double>[Mn];
- for(int i = 0; i < Mn; ++i) {
- Xarr[i] = Matrix<double>(Mk, Mp, 0.0);
- int start = i * Mk;
- for(int l=0; l<Mk; ++l) {
- for(int m=0; m<Mp; ++m) {
- Xarr[i](l,m) = MX(start + l, m);
- }
- }
- }
-
- //Matrix<double> Warr[Mn];
- Matrix<double>* Warr = new Matrix<double>[Mn];
- for(int i = 0; i < Mn; ++i) {
- Warr[i] = Matrix<double>(Mk, Mq, 0.0);
- int start = i * Mk;
- for(int l=0; l<Mk; ++l) {
- for(int m=0; m<Mq; ++m) {
- Warr[i](l,m) = MW(start + l, m);
- }
- }
- }
-
- // holding matrices
- Matrix<double> beta_holder(Mgibbs/Mthin,Mp);
- Matrix<double> D_holder(Mgibbs/Mthin,Mq*Mq);
- Matrix<double> sigma2_holder(Mgibbs/Mthin, 1);
-
- // starting values for sampler
- Matrix<double> beta_sim = Mbetastart;
- double sigma2_sim = sigma2start[0];
- Matrix<double> D_sim = MDstart;
-
- // gibbs loop
- int count = 0;
- for(int g = 0; g < Mtotiter; ++g) {
-
- // simulate \beta | Y, \sigma^2, D
- Matrix<double> beta_var_sum(Mp,Mp);
- Matrix<double> beta_mean_sum(Mp,1);
- for(int i = 0; i < Mn; ++i) {
- Matrix<double> invVi = invpd(sigma2_sim * eye<double>(Mk) + Warr[i] * D_sim * t(Warr[i]));
- beta_var_sum = beta_var_sum + t(Xarr[i]) * invVi * Xarr[i];
- beta_mean_sum = beta_mean_sum + t(Xarr[i]) * invVi * Yarr[i];
- }
- Matrix<double> beta_sim_var = invpd(MB0 + beta_var_sum);
- Matrix<double> beta_sim_mean = beta_sim_var * (MB0 * Mb0 + beta_mean_sum);
- Matrix<double> beta_sim = beta_sim_mean + cholesky(beta_sim_var) *
- stream->rnorm(Mp,1);
-
- // simulate \b_i | Y, \beta, \sigma^2, D
- // note: these are not stored because of their large number
- Matrix<double> bi(Mn,Mq);
- for(int i = 0; i < Mn; ++i) {
- Matrix<double> b_sim_var = invpd(invpd(D_sim) + (1/sigma2_sim) * t(Warr[i]) * Warr[i]);
- Matrix<double> b_sim_mean = b_sim_var * (1/sigma2_sim * t(Warr[i]) * (Yarr[i] - Xarr[i] * beta_sim));
- Matrix<double> bi_sim = b_sim_mean + cholesky(b_sim_var) *
- stream->rnorm(Mq,1,0,1);
- for(int w = 0; w < Mq; ++w) {
- bi(i,w) = bi_sim(w,0);
- }
- }
-
- // simulate D^-1 | Y, \beta, \b_i, \sigma^2
- Matrix<double> SSB(Mq,Mq);
- for(int i = 0; i < Mn; ++i) {
- Matrix<double> bi_sim(Mq,1);
- for(int w = 0; w < Mq; ++w) {
- bi_sim(w,0) = bi(i,w);
- }
- SSB = SSB + (bi_sim * t(bi_sim));
- }
- int D_sim_dof = eta0[0] + Mn;
- Matrix<double> D_sim_scale = invpd(invpd(MR0) + SSB);
- D_sim = invpd(stream->rwish(D_sim_dof,D_sim_scale));
-
- // simulate \sigma^2 | Y, \beta, \b_i, D
- double SSE = 0;
- for(int i=0; i<Mn; ++i) {
- Matrix<double> bi_sim(Mq,1);
- for(int w = 0; w < Mq; ++w) {
- bi_sim(w,0) = bi(i,w);
- }
- Matrix<double> e = t(Yarr[i] - Xarr[i] * beta_sim - Warr[i] * bi_sim) *
- (Yarr[i] - Xarr[i] * beta_sim - Warr[i] * bi_sim);
- SSE = SSE + e[0];
- }
- double nu_sim = (nu0[0] + Mn * Mk)/2;
- double delta_sim = (delta0[0] + SSE)/2;
- sigma2_sim = 1/stream->rgamma(nu_sim, delta_sim);
-
- // save values
- if (g >= Mburnin && (g % Mthin == 0)) {
- for(int j = 0; j < Mp; ++j) {
- beta_holder(count,j) = beta_sim(j,0);
- }
- int Dcounter = 0;
- for(int j = 0; j < Mq; ++j) {
- for(int m = 0; m < Mq; ++m) {
- D_holder(count,Dcounter) = D_sim(j,m);
- ++Dcounter;
- }
- }
- sigma2_holder(count,0) = sigma2_sim;
- ++count;
- }
-
- // print output to stdout
- if(*verbose > 0 && g % *verbose == 0) {
- Rprintf("\n\nMCMCpanel iteration %i of %i \n",
- (g+1), Mtotiter);
- Rprintf("beta = \n");
- for (int j=0; j<Mp; ++j)
- Rprintf("%10.5f\n", beta_sim[j]);
- Rprintf("sigma2 = %10.5f\n", sigma2_sim);
- }
-
- R_CheckUserInterrupt(); // allow user interrupt
- }
-
- delete stream; // clean up random number stream
-
- // return posterior denisty sample to R
- Matrix<double> storeagem = cbind(beta_holder, D_holder);
- storeagem = cbind(storeagem, sigma2_holder);
- int loop = samrow[0] * samcol[0];
- for (int i=0; i<loop; ++i) {
- sample[i] = storeagem[i];
- }
-
- delete [] Xarr;
- delete [] Yarr;
- delete [] Warr;
- } // panelpost function
-
-} // extern
-
diff --git a/src/MCMCpoisson.cc b/src/MCMCpoisson.cc
index 4c5d26e..aebf7f5 100644
--- a/src/MCMCpoisson.cc
+++ b/src/MCMCpoisson.cc
@@ -18,34 +18,40 @@
// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
//
// updated to the new version of Scythe 7/26/2004 KQ
+// updated to Scythe 1.0.X 7/7/2007 ADM
+//
+#ifndef MCMCPOISSON_CC
+#define MCMCPOISSON_CC
-#include <iostream>
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
+#include "rng.h"
+#include "mersenne.h"
+#include "lecuyer.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
+using namespace scythe;
-static double poisson_logpost(const Matrix<double>& Y,
- const Matrix<double>& X,
- const Matrix<double>& beta,
- const Matrix<double>& beta_prior_mean,
- const Matrix<double>& beta_prior_prec){
+static double poisson_logpost(const Matrix<>& Y,
+ const Matrix<>& X,
+ const Matrix<>& beta,
+ const Matrix<>& beta_prior_mean,
+ const Matrix<>& beta_prior_prec){
// likelihood
- const Matrix<double> eta = X * beta;
- const Matrix<double> mu = exp(eta);
+ const Matrix<> eta = X * beta;
+ const Matrix<> mu = exp(eta);
double loglike = 0.0;
- for (int i=0; i<Y.rows(); ++i)
+ for (unsigned int i=0; i<Y.rows(); ++i)
loglike += -mu[i] + Y[i] * eta[i];
// prior
@@ -57,101 +63,105 @@ static double poisson_logpost(const Matrix<double>& Y,
return (loglike + logprior);
}
-extern "C"{
-
- void MCMCpoisson(double *sampledata, const int *samplerow,
- const int *samplecol, const double *Ydata,
- const int *Yrow, const int *Ycol, const double *Xdata,
- const int *Xrow, const int *Xcol, const int *burnin,
- const int *mcmc, const int *thin, const double *tunedata,
- const int *tunerow, const int *tunecol, const int *lecuyer,
- const int *seedarray, const int *lecuyerstream,
- const int *verbose, const double *betastartdata,
- const int *betastartrow, const int *betastartcol,
- const double *b0data, const int *b0row, const int *b0col,
- const double *B0data, const int *B0row, const int *B0col,
- const double *Vdata, const int *Vrow, const int *Vcol) {
-
- // pull together Matrix objects
- const Matrix <double> Y = r2scythe(*Yrow, *Ycol, Ydata);
- const Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- const Matrix <double> tune = r2scythe(*tunerow, *tunecol, tunedata);
- Matrix <double> beta = r2scythe(*betastartrow, *betastartcol,
- betastartdata);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- const Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
- const Matrix <double> V = r2scythe(*Vrow, *Vcol, Vdata);
-
+/* MCMCpoisson implementation. Takes Matrix<> reference and fills with the
+ * posterior.
+ */
+template <typename RNGTYPE>
+void MCMCpoisson_impl (rng<RNGTYPE>& stream, const Matrix<>& Y,
+ const Matrix<>& X, const Matrix<>& tune, Matrix<>& beta, const Matrix<>& b0,
+ const Matrix<>& B0, const Matrix<>& V, unsigned int burnin,
+ unsigned int mcmc, unsigned int thin, unsigned int verbose, Matrix<>& result) {
+
// define constants
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols();
+ const unsigned int tot_iter = burnin + mcmc; // total number iterations
+ const unsigned int nstore = mcmc / thin; // number of draws to store
+ const unsigned int k = X.cols();
// storage matrix or matrices
- Matrix<double> storemat(nstore, k);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
+ Matrix<> storemat(nstore, k);
// proposal parameters
- const Matrix<double> propV = tune * invpd(B0 + invpd(V)) * tune;
- const Matrix<double> propC = cholesky(propV) ;
-
+ const Matrix<> propV = tune * invpd(B0 + invpd(V)) * tune;
+ const Matrix<> propC = cholesky(propV) ;
+
double logpost_cur = poisson_logpost(Y, X, beta, b0, B0);
// MCMC loop
int count = 0;
int accepts = 0;
- for (int iter = 0; iter < tot_iter; ++iter){
+ for (unsigned int iter = 0; iter < tot_iter; ++iter){
- // sample beta
- const Matrix<double> beta_can = gaxpy(propC, stream->rnorm(k,1), beta);
-
- const double logpost_can = poisson_logpost(Y,X,beta_can, b0, B0);
- const double ratio = ::exp(logpost_can - logpost_cur);
+ // sample beta
+ const Matrix<> beta_can = gaxpy(propC, stream.rnorm(k,1,0,1), beta);
+ const double logpost_can = poisson_logpost(Y,X,beta_can, b0, B0);
+ const double ratio = ::exp(logpost_can - logpost_cur);
- if (stream->runif() < ratio){
- beta = beta_can;
- logpost_cur = logpost_can;
- ++accepts;
- }
+ if (stream.runif() < ratio){
+ beta = beta_can;
+ logpost_cur = logpost_can;
+ ++accepts;
+ }
// store values in matrices
- if (iter >= *burnin && ((iter % *thin)==0)){
- for (int j = 0; j < k; j++)
- storemat(count, j) = beta[j];
- ++count;
- }
+ if (iter >= burnin && (iter % thin==0)){
+ storemat(count,_) = beta;
+ ++count;
+ }
// print output to stdout
- if(*verbose > 0 && iter % *verbose == 0){
- Rprintf("\n\nMCMCpoisson iteration %i of %i \n", (iter+1), tot_iter);
- Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
- Rprintf("%10.5f\n", beta[j]);
- Rprintf("Metropolis acceptance rate for beta = %3.5f\n\n",
- static_cast<double>(accepts) /
- static_cast<double>(iter+1));
+ if(verbose > 0 && iter % verbose == 0){
+ Rprintf("\n\nMCMCpoisson iteration %i of %i \n", (iter+1), tot_iter);
+ Rprintf("beta = \n");
+ for (unsigned int j=0; j<k; ++j)
+ Rprintf("%10.5f\n", beta[j]);
+ Rprintf("Metropolis acceptance rate for beta = %3.5f\n\n",
+ static_cast<double>(accepts) /
+ static_cast<double>(iter+1));
}
R_CheckUserInterrupt(); // allow user interrupts
+ }// end MCMC loop
+ result = storemat;
+
+ Rprintf("\n\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+ Rprintf("The Metropolis acceptance rate for beta was %3.5f",
+ static_cast<double>(accepts) / static_cast<double>(tot_iter));
+ Rprintf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+}
- }// end MCMC loop
-
- delete stream; // clean up random number stream
-
- // return output
- const int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = storemat[i];
+extern "C"{
+void MCMCpoisson(double *sampledata, const int *samplerow,
+ const int *samplecol, const double *Ydata,
+ const int *Yrow, const int *Ycol, const double *Xdata,
+ const int *Xrow, const int *Xcol, const int *burnin,
+ const int *mcmc, const int *thin, const double *tunedata,
+ const int *tunerow, const int *tunecol, const int *uselecuyer,
+ const int *seedarray, const int *lecuyerstream,
+ const int *verbose, const double *betastartdata,
+ const int *betastartrow, const int *betastartcol,
+ const double *b0data, const int *b0row, const int *b0col,
+ const double *B0data, const int *B0row, const int *B0col,
+ const double *Vdata, const int *Vrow, const int *Vcol) {
- Rprintf("\n\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
- Rprintf("The Metropolis acceptance rate for beta was %3.5f",
- static_cast<double>(accepts) / static_cast<double>(tot_iter));
- Rprintf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
+ // pull together Matrix objects
+ const Matrix <> Y(*Yrow, *Ycol, Ydata);
+ const Matrix <> X(*Xrow, *Xcol, Xdata);
+ const Matrix <> tune(*tunerow, *tunecol, tunedata);
+ Matrix <> beta(*betastartrow, *betastartcol,
+ betastartdata);
+ const Matrix <> b0(*b0row, *b0col, b0data);
+ const Matrix <> B0(*B0row, *B0col, B0data);
+ const Matrix <> V(*Vrow, *Vcol, Vdata);
- }
-
+ Matrix<> storagematrix;
+ MCMCPACK_PASSRNG2MODEL(MCMCpoisson_impl, Y, X, tune, beta, b0, B0,
+ V, *burnin, *mcmc, *thin, *verbose, storagematrix);
+
+ const unsigned int size = *samplerow * *samplecol;
+ for (unsigned int i=0; i<size; ++i)
+ sampledata[i] = storagematrix(i);
+ }
}
+#endif
diff --git a/src/MCMCprobit.cc b/src/MCMCprobit.cc
index 3429253..fad1e0e 100644
--- a/src/MCMCprobit.cc
+++ b/src/MCMCprobit.cc
@@ -18,103 +18,116 @@
// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
//
// updated to the new version of Scythe 7/26/2004 KQ
+// updated to Scythe 1.0.X 7/7/2007 ADM
+//
+#ifndef MCMCPROBIT_CC
+#define MCMCPROBIT_CC
-#include <iostream>
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
+#include "rng.h"
+#include "mersenne.h"
+#include "lecuyer.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
+using namespace scythe;
-extern "C"{
-
- void MCMCprobit(double *sampledata, const int *samplerow,
- const int *samplecol, const double *Ydata,
- const int *Yrow, const int *Ycol, const double *Xdata,
- const int *Xrow, const int *Xcol, const int *burnin,
- const int *mcmc, const int *thin, const int *lecuyer,
- const int *seedarray, const int *lecuyerstream,
- const int *verbose, const double *betastartdata,
- const int *betastartrow, const int *betastartcol,
- const double *b0data, const int *b0row, const int *b0col,
- const double *B0data, const int *B0row, const int *B0col) {
-
- // pull together Matrix objects
- const Matrix <double> Y = r2scythe(*Yrow, *Ycol, Ydata);
- const Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix <double> beta = r2scythe(*betastartrow, *betastartcol,
- betastartdata);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- const Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
+/* MCMCprobit implementation. Takes Matrix<> reference and fills with the
+ * posterior.
+ */
+template <typename RNGTYPE>
+void MCMCprobit_impl (rng<RNGTYPE>& stream, const Matrix<>& Y,
+ const Matrix<>& X, Matrix<>& beta, const Matrix<>& b0,
+ const Matrix<>& B0, unsigned int burnin, unsigned int mcmc,
+ unsigned int thin, unsigned int verbose, Matrix<>& result) {
// define constants and from cross-product matrices
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols();
- const int N = X.rows();
- const Matrix<double> XpX = crossprod(X);
+ const unsigned int tot_iter = burnin + mcmc; // total iterations
+ const unsigned int nstore = mcmc / thin; // number of draws to store
+ const unsigned int k = X.cols();
+ const unsigned int N = X.rows();
+ const Matrix<> XpX = crossprod(X);
// storage matrix or matrices
- Matrix<double> storemat(nstore, k);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
+ Matrix<> storemat(nstore, k);
// initialize Z
- Matrix<double> Z(N,1);
+ Matrix<> Z(N,1);
// MCMC sampling starts here
- int count = 0;
- for (int iter = 0; iter < tot_iter; ++iter)
- {
+ unsigned int count = 0;
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
- // [Z| beta, y]
- const Matrix<double> Z_mean = X * beta;
- for (int i=0; i<N; ++i){
- if (Y[i] == 1.0)
- Z[i] = stream->rtbnorm_combo(Z_mean[i], 1.0, 0);
- if (Y[i] == 0.0)
- Z[i] = stream->rtanorm_combo(Z_mean[i], 1.0, 0);
- }
+ // [Z| beta, y]
+ const Matrix<> Z_mean = X * beta;
+ for (unsigned int i=0; i<N; ++i){
+ if (Y[i] == 1.0)
+ Z[i] = stream.rtbnorm_combo(Z_mean[i], 1.0, 0);
+ if (Y[i] == 0.0)
+ Z[i] = stream.rtanorm_combo(Z_mean[i], 1.0, 0);
+ }
- // [beta|Z]
- const Matrix<double> XpZ = t(X) * Z;
- beta = NormNormregress_beta_draw(XpX, XpZ, b0, B0, 1.0, stream);
+ // [beta|Z]
+ const Matrix<> XpZ = t(X) * Z;
+ beta = NormNormregress_beta_draw(XpX, XpZ, b0, B0, 1.0, stream);
- // store values in matrices
- if (iter >= *burnin && ((iter % *thin)==0)){
- for (int j = 0; j < k; ++j)
- storemat(count, j) = beta[j];
- ++count;
- }
+ // store values in matrices
+ if (iter >= burnin && (iter % thin==0)){
+ storemat(count,_) = beta;
+ ++count;
+ }
// print output to stdout
- if(*verbose > 0 && iter % *verbose == 0){
+ if(verbose > 0 && iter % verbose == 0){
Rprintf("\n\nMCMCprobit iteration %i of %i \n", (iter+1), tot_iter);
Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
+ for (unsigned int j=0; j<k; ++j)
Rprintf("%10.5f\n", beta[j]);
- }
+ }
- R_CheckUserInterrupt(); // allow user interrupts
-
- } // end MCMC loop
- delete stream; // clean up random number stream
-
- // return output
- const int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = storemat[i];
-
- }
+ R_CheckUserInterrupt(); // allow user interrupts
+ }
+ result = storemat;
+}
+
+extern "C"{
+ void MCMCprobit(double *sampledata, const int *samplerow,
+ const int *samplecol, const double *Ydata,
+ const int *Yrow, const int *Ycol, const double *Xdata,
+ const int *Xrow, const int *Xcol, const int *burnin,
+ const int *mcmc, const int *thin, const int *uselecuyer,
+ const int *seedarray, const int *lecuyerstream,
+ const int *verbose, const double *betastartdata,
+ const int *betastartrow, const int *betastartcol,
+ const double *b0data, const int *b0row, const int *b0col,
+ const double *B0data, const int *B0row, const int *B0col) {
+
+ // pull together Matrix objects
+ const Matrix <> Y(*Yrow, *Ycol, Ydata);
+ const Matrix <> X(*Xrow, *Xcol, Xdata);
+ Matrix <> beta (*betastartrow, *betastartcol,
+ betastartdata);
+ const Matrix <> b0(*b0row, *b0col, b0data);
+ const Matrix <> B0(*B0row, *B0col, B0data);
+
+ Matrix<> storagematrix;
+ MCMCPACK_PASSRNG2MODEL(MCMCprobit_impl, Y, X, beta, b0, B0, *burnin,
+ *mcmc, *thin, *verbose, storagematrix);
+
+ const unsigned int size = *samplerow * *samplecol;
+ for (unsigned int i=0; i<size; ++i)
+ sampledata[i] = storagematrix(i);
+ }
}
+
+#endif
diff --git a/src/MCMCprobitres.cc b/src/MCMCprobitres.cc
index 072b664..caa8079 100644
--- a/src/MCMCprobitres.cc
+++ b/src/MCMCprobitres.cc
@@ -18,22 +18,101 @@
// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
//
// updated to the new version of Scythe 7/26/2004 KQ
+// updated to Scythe 1.0.X 7/28/2007 KQ
-#include <iostream>
+#ifndef MCMCPROBITRES_CC
+#define MCMCPROBITRES_CC
+
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
+#include "rng.h"
+#include "mersenne.h"
+#include "lecuyer.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
+using namespace scythe;
+
+/* MCMCprobitres implementation. Takes Matrix<> reference and fills with the
+ * posterior.
+ */
+template <typename RNGTYPE>
+void MCMCprobitres_impl (rng<RNGTYPE>& stream, const Matrix<>& Y,
+ const Matrix<>& X, Matrix<>& beta,
+ Matrix<>& resvec,
+ const Matrix<>& b0,
+ const Matrix<>& B0, unsigned int burnin,
+ unsigned int mcmc,
+ unsigned int thin, unsigned int verbose,
+ Matrix<>& result) {
+
+ // define constants and from cross-product matrices
+ const unsigned int tot_iter = burnin + mcmc; // total number of mcmc iterations
+ const unsigned int nstore = mcmc / thin; // number of draws to store
+ const unsigned int k = X.cols();
+ const unsigned int N = X.rows();
+ const Matrix<> XpX = crossprod(X);
+
+ // holding matrices
+ Matrix<> storemat(nstore, k+resvec.rows());
+
+ // initialize Z
+ Matrix<> Z(N,1);
+
+ // MCMC sampling starts here
+ unsigned int count = 0;
+ for (unsigned int iter = 0; iter < tot_iter; ++iter){
+
+ // [Z| beta, y]
+ const Matrix<> Z_mean = X * beta;
+ for (unsigned int i=0; i<N; ++i){
+ if (Y[i] == 1.0)
+ Z[i] = stream.rtbnorm_combo(Z_mean[i], 1.0, 0);
+ if (Y[i] == 0.0)
+ Z[i] = stream.rtanorm_combo(Z_mean[i], 1.0, 0);
+ }
+
+ // [beta|Z]
+ const Matrix<> XpZ = t(X) * Z;
+ beta = NormNormregress_beta_draw(XpX, XpZ, b0, B0, 1.0, stream);
+
+ // store values in matrices
+ if (iter >= burnin && ((iter % thin)==0)){
+ for (unsigned int j = 0; j < k; j++)
+ storemat(count, j) = beta[j];
+ for (unsigned int j=0; j<(resvec.rows()); ++j){
+ const int i = static_cast<int>(resvec[j]) - 1;
+ storemat(count, j+k) = Z[i] - Z_mean[i];
+ }
+ ++count;
+ }
+
+ // print output to stdout
+ if(verbose > 0 && iter % verbose == 0){
+ Rprintf("\n\nMCMCprobit iteration %i of %i \n", (iter+1), tot_iter);
+ Rprintf("beta = \n");
+ for (unsigned int j=0; j<k; ++j)
+ Rprintf("%10.5f\n", beta[j]);
+ }
+
+ R_CheckUserInterrupt(); // allow user interrupts
+
+ } // end MCMC loop
+
+ result = storemat;
+
+}
+
+
+
extern "C"{
@@ -43,7 +122,7 @@ extern "C"{
const int *Xrow, const int *Xcol,
const double *resvecdata, const int *resvecrow,
const int *resveccol, const int *burnin,
- const int *mcmc, const int *thin, const int *lecuyer,
+ const int *mcmc, const int *thin, const int *uselecuyer,
const int *seedarray, const int *lecuyerstream,
const int *verbose, const double *betastartdata,
const int *betastartrow, const int *betastartcol,
@@ -52,78 +131,27 @@ extern "C"{
const int *B0row, const int *B0col) {
// pull together Matrix objects
- const Matrix <double> Y = r2scythe(*Yrow, *Ycol, Ydata);
- const Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- const Matrix <double> resvec = r2scythe(*resvecrow, *resveccol,
- resvecdata);
- Matrix <double> beta = r2scythe(*betastartrow, *betastartcol,
- betastartdata);
- const Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- const Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
+ const Matrix <> Y(*Yrow, *Ycol, Ydata);
+ const Matrix <> X(*Xrow, *Xcol, Xdata);
+ Matrix <> resvec(*resvecrow, *resveccol,
+ resvecdata);
+ Matrix <> beta(*betastartrow, *betastartcol,
+ betastartdata);
+ const Matrix <> b0(*b0row, *b0col, b0data);
+ const Matrix <> B0(*B0row, *B0col, B0data);
- // define constants and from cross-product matrices
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols();
- const int N = X.rows();
- const Matrix<double> XpX = crossprod(X);
-
- // holding matrices
- Matrix<double> storemat(nstore, k+resvec.rows());
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // initialize Z
- Matrix<double> Z(N,1);
-
- // MCMC sampling starts here
- int count = 0;
- for (int iter = 0; iter < tot_iter; ++iter)
- {
-
- // [Z| beta, y]
- const Matrix<double> Z_mean = X * beta;
- for (int i=0; i<N; ++i){
- if (Y[i] == 1.0)
- Z[i] = stream->rtbnorm_combo(Z_mean[i], 1.0, 0);
- if (Y[i] == 0.0)
- Z[i] = stream->rtanorm_combo(Z_mean[i], 1.0, 0);
- }
-
- // [beta|Z]
- const Matrix<double> XpZ = t(X) * Z;
- beta = NormNormregress_beta_draw(XpX, XpZ, b0, B0, 1.0, stream);
-
- // store values in matrices
- if (iter >= *burnin && ((iter % *thin)==0)){
- for (int j = 0; j < k; j++)
- storemat(count, j) = beta[j];
- for (int j=0; j<(resvec.rows()); ++j){
- const int i = static_cast<int>(resvec[j]) - 1;
- storemat(count, j+k) = Z[i] - Z_mean[i];
- }
- ++count;
- }
-
- // print output to stdout
- if(*verbose > 0 && iter % *verbose == 0){
- Rprintf("\n\nMCMCprobit iteration %i of %i \n", (iter+1), tot_iter);
- Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
- Rprintf("%10.5f\n", beta[j]);
- }
-
- R_CheckUserInterrupt(); // allow user interrupts
-
- } // end MCMC loop
-
- delete stream; // clean up random number stream
+ Matrix<> storagematrix;
+ MCMCPACK_PASSRNG2MODEL(MCMCprobitres_impl, Y, X, beta, resvec,
+ b0, B0, *burnin,
+ *mcmc, *thin, *verbose,
+ storagematrix);
// return output
- const int size = *samplerow * *samplecol;
- for (int i=0; i<size; ++i)
- sampledata[i] = storemat[i];
+ const unsigned int size = *samplerow * *samplecol;
+ for (unsigned int i=0; i<size; ++i)
+ sampledata[i] = storagematrix(i);
}
}
+
+#endif
diff --git a/src/MCMCregress.cc b/src/MCMCregress.cc
index 26efd10..a338bf4 100644
--- a/src/MCMCregress.cc
+++ b/src/MCMCregress.cc
@@ -27,170 +27,170 @@
// ADM 6/2/04 [re-written using template]
// KQ 6/18/04 [modified to meet new developer specification]
// ADM 7/22/04 [modified to work with new Scythe and rngs]
+// DBP 7/1/07 [ported to scythe 1.0.x]
+//
+#ifndef MCMCREGRESS_CC
+#define MCMCREGRESS_CC
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
+#include "rng.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
+using namespace scythe;
-
-static double digamma(const double& theta, const double& a, const double& b){
- double logf = a * log(b) - lngammafn(a) + -(a+1) * log(theta) + -b/theta;
-
+static double digamma(double theta, double a, double b) {
+ double logf = a * log(b) - lngammafn(a) + -(a+1) * log(theta) +
+ -b/theta;
return exp(logf);
//pow(b, a) / gammafn(a) * pow(theta, -(a+1)) * exp(-b/theta);
}
-extern "C" {
+/* MCMCregress implementation. Takes Matrix<> reference which it
+ * fills with the posterior. The logmarklike double reference is
+ * filled with the log marginal likelihood if asked for.
+ */
+template <typename RNGTYPE>
+void MCMCregress_impl (rng<RNGTYPE>& stream, const Matrix<>& Y,
+ const Matrix<>& X, Matrix<>& beta, const Matrix<>& b0,
+ const Matrix<>& B0, double c0, double d0,
+ unsigned int burnin, unsigned int mcmc, unsigned int thin,
+ unsigned int verbose, bool chib,
+ Matrix<>& result, double& logmarglike)
+{
+ // define constants and form cross-product matrices
+ const unsigned int tot_iter = burnin + mcmc; //total iterations
+ const unsigned int nstore = mcmc / thin; // number of draws to store
+ const unsigned int k = X.cols ();
+ const Matrix<> XpX = crossprod(X);
+ const Matrix<> XpY = t(X) * Y;
+
+ // storage matrices
+ Matrix<> betamatrix (k, nstore);
+ Matrix<> sigmamatrix (1, nstore);
+
+ // Gibbs sampler
+ unsigned int count = 0;
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
+ double sigma2 = NormIGregress_sigma2_draw (X, Y, beta, c0, d0,
+ stream);
+ beta = NormNormregress_beta_draw (XpX, XpY, b0, B0, sigma2, stream);
+
+ // store draws in storage matrix (or matrices)
+ if (iter >= burnin && (iter % thin == 0)) {
+ sigmamatrix (0, count) = sigma2;
+ betamatrix(_, count) = beta;
+ ++count;
+ }
+
+ // print output to stdout
+ if(verbose > 0 && iter % verbose == 0) {
+ Rprintf("\n\nMCMCregress iteration %i of %i \n",
+ (iter+1), tot_iter);
+ Rprintf("beta = \n");
+ for (unsigned int j=0; j<k; ++j)
+ Rprintf("%10.5f\n", beta(j));
+ Rprintf("sigma2 = %10.5f\n", sigma2);
+ }
+
+ R_CheckUserInterrupt(); // allow user interrupts
+
+ } // end MCMC loop
+
+ if (chib == 1) {
+ // marginal likelihood calculation stuff starts here
+ const double sigma2star = meanc(t(sigmamatrix))(0);
+ double sigma2fcdsum = 0.0;
+
+ // second set of Gibbs scans
+ for (unsigned int iter = 0; iter < tot_iter; ++iter) {
+ double sigma2 = NormIGregress_sigma2_draw (X, Y, beta, c0, d0,
+ stream);
+ beta = NormNormregress_beta_draw (XpX, XpY, b0, B0, sigma2,
+ stream);
+ const Matrix<> e = gaxpy(X, (-1*beta), Y);
+ const Matrix<> SSE = crossprod (e);
+ const double c_post = (c0 + X.rows ()) * 0.5;
+ const double d_post = (d0 + SSE[0]) * 0.5;
+ sigma2fcdsum += digamma(sigma2star, c_post, d_post);
+
+ // print output to stdout
+ if(verbose > 0 && iter % verbose == 0) {
+ Rprintf("\n\nMCMCregress (reduced) iteration %i of %i \n",
+ (iter+1), tot_iter);
+ }
+
+ R_CheckUserInterrupt(); // allow user interrupts
+ } // end MCMC loop
+
+ double sigma2fcdmean = sigma2fcdsum / static_cast<double>(tot_iter);
+
+ const Matrix<> betastar = t(meanc(t(betamatrix)));
+ const double sig2_inv = 1.0 / sigma2star;
+ const Matrix<> sig_beta = invpd (B0 + XpX * sig2_inv);
+ const Matrix<> betahat = sig_beta * gaxpy(B0, b0, XpY*sig2_inv);
+ const double logbetafcd = lndmvn(betastar, betahat, sig_beta);
+
+ // calculate loglikelihood at (betastar, sigma2star)
+ double sigmastar = sqrt(sigma2star);
+ Matrix<> eta = X * betastar;
+ double loglike = 0.0;
+ for (unsigned int i = 0; i < X.rows(); ++i) {
+ loglike += lndnorm(Y(i), eta(i), sigmastar);
+ }
+
+ // calculate log prior ordinate
+ double logprior = log(digamma(sigma2star, c0/2.0, d0/2.0)) +
+ lndmvn(betastar, b0, invpd(B0));
+
+ // put pieces together and print the marginal likelihood
+ logmarglike = loglike + logprior - logbetafcd - log(sigma2fcdmean);
+ }
+
+ result = cbind(t(betamatrix), t(sigmamatrix));
+ } // end MCMCregress
- // simulate from posterior density and return an mcmc by parameters
- // matrix of the posterior density sample
+extern "C" {
void MCMCregress(double *sampledata, const int *samplerow,
const int *samplecol, const double *Ydata, const int *Yrow,
const int *Ycol, const double *Xdata, const int *Xrow,
const int *Xcol, const int *burnin, const int *mcmc,
- const int *thin, const int *lecuyer, const int *seedarray,
+ const int *thin, const int *uselecuyer, const int *seedarray,
const int *lecuyerstream, const int *verbose,
const double *betastartdata, const int *betastartrow,
const int *betastartcol, const double *b0data,
const int *b0row, const int *b0col,
const double *B0data, const int *B0row,
const int *B0col, const double *c0, const double *d0,
- double* logmarglikeholder, const int* chib) {
-
+ double* logmarglikeholder, const int* chib)
+ {
// pull together Matrix objects
- Matrix <double> Y = r2scythe(*Yrow, *Ycol, Ydata);
- Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix <double> betastart = r2scythe(*betastartrow,
- *betastartcol, betastartdata);
- Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
-
- // define constants and form cross-product matrices
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols ();
- const Matrix <double> XpX = crossprod(X);
- const Matrix <double> XpY = t(X) * Y;
-
- // storage matrices
- Matrix <double> betamatrix (k, nstore);
- Matrix <double> sigmamatrix (1, nstore);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // set starting values
- Matrix <double> beta = betastart;
-
- // Gibbs sampler
- int count = 0;
- for (int iter = 0; iter < tot_iter; ++iter) {
- double sigma2 = NormIGregress_sigma2_draw (X, Y, beta, *c0,
- *d0, stream);
- beta = NormNormregress_beta_draw (XpX, XpY, b0, B0, sigma2,
- stream);
-
- // store draws in storage matrix (or matrices)
- if (iter >= *burnin && (iter % *thin == 0)) {
- sigmamatrix (0, count) = sigma2;
- for (int j = 0; j < k; j++)
- betamatrix (j, count) = beta[j];
- ++count;
- }
-
- // print output to stdout
- if(*verbose > 0 && iter % *verbose == 0) {
- Rprintf("\n\nMCMCregress iteration %i of %i \n",
- (iter+1), tot_iter);
- Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
- Rprintf("%10.5f\n", beta[j]);
- Rprintf("sigma2 = %10.5f\n", sigma2);
- }
-
- R_CheckUserInterrupt(); // allow user interrupts
-
- } // end MCMC loop
+ Matrix<> Y(*Yrow, *Ycol, Ydata);
+ Matrix<> X(*Xrow, *Xcol, Xdata);
+ Matrix<> betastart(*betastartrow, *betastartcol, betastartdata);
+ Matrix<> b0(*b0row, *b0col, b0data);
+ Matrix<> B0(*B0row, *B0col, B0data);
+
+ double logmarglike;
+ Matrix<> storagematrix;
+ MCMCPACK_PASSRNG2MODEL(MCMCregress_impl, Y, X, betastart, b0, B0,
+ *c0, *d0, *burnin, *mcmc, *thin, *verbose,
+ *chib, storagematrix, logmarglike);
+ logmarglikeholder[0] = logmarglike;
+ const unsigned int size = *samplerow * *samplecol;
+ for (unsigned int i = 0; i < size; ++i)
+ sampledata[i] = storagematrix(i);
+ }
+}
- if (*chib == 1){
- // marginal likelihood calculation stuff starts here
- const double sigma2star = meanc(t(sigmamatrix))[0];
- double sigma2fcdsum = 0.0;
- // second set of Gibbs scans
- for (int iter = 0; iter < tot_iter; ++iter) {
- double sigma2 = NormIGregress_sigma2_draw (X, Y, beta, *c0,
- *d0, stream);
- beta = NormNormregress_beta_draw (XpX, XpY, b0, B0, sigma2,
- stream);
- const Matrix <double> e = gaxpy(X, (-1*beta), Y);
- const Matrix <double> SSE = crossprod (e);
- const double c_post = (*c0 + X.rows ()) * 0.5;
- const double d_post = (*d0 + SSE[0]) * 0.5;
- sigma2fcdsum += digamma(sigma2star, c_post, d_post);
-
- // print output to stdout
- if(*verbose > 0 && iter % *verbose == 0) {
- Rprintf("\n\nMCMCregress (reduced) iteration %i of %i \n",
- (iter+1), tot_iter);
- }
-
- R_CheckUserInterrupt(); // allow user interrupts
-
- } // end MCMC loop
- double sigma2fcdmean = sigma2fcdsum / static_cast<double>(tot_iter);
-
-
- const Matrix<double> betastar = t(meanc(t(betamatrix)));
- const double sig2_inv = 1.0 / sigma2star;
- const Matrix <double> sig_beta = invpd (B0 + XpX * sig2_inv);
- const Matrix <double> betahat = sig_beta *
- gaxpy(B0, b0, XpY*sig2_inv);
- const double logbetafcd = lndmvn(betastar, betahat, sig_beta);
-
-
-
- // calculate loglikelihood at (betastar, sigma2star)
- double sigmastar = sqrt(sigma2star);
- Matrix<double> eta = X * betastar;
- double loglike = 0.0;
- for (int i=0; i<X.rows(); ++i){
- loglike += lndnorm(Y[i], eta[i], sigmastar);
- }
-
- // calculate log prior ordinate
- double logprior = log(digamma(sigma2star, *c0/2.0, *d0/2.0)) +
- lndmvn(betastar, b0, invpd(B0));
-
-
- // put pieces together and print the marginal likelihood
- double logmarglike = loglike + logprior - logbetafcd -
- log(sigma2fcdmean);
-
-
- logmarglikeholder[0] = logmarglike;
-
- }
-
- delete stream; // clean up random number stream
-
- // load draws into sample array
- Matrix <double> storeagematrix = cbind (t (betamatrix), t (sigmamatrix));
- const int size = *samplerow * *samplecol;
- for(int i = 0; i < size; ++i)
- sampledata[i] = storeagematrix[i];
-
-
- } // end MCMCregress
-} // end extern "C"
+#endif
diff --git a/src/MCMCrng.cc b/src/MCMCrng.cc
deleted file mode 100644
index e800a3b..0000000
--- a/src/MCMCrng.cc
+++ /dev/null
@@ -1,59 +0,0 @@
-// MCMCrng.h contains a function used to handle random number
-// generator streams.
-//
-// Andrew D. Martin
-// Dept. of Political Science
-// Washington University in St. Louis
-// admartin at wustl.edu
-//
-// Kevin M. Quinn
-// Dept. of Government
-// Harvard University
-// kevin_quinn at harvard.edu
-//
-// This software is distributed under the terms of the GNU GENERAL
-// PUBLIC LICENSE Version 2, June 1991. See the package LICENSE
-// file for more information.
-//
-// Copyright (C) 2004 Andrew D. Martin and Kevin M. Quinn
-//
-// ADM 7/23/04 (Lilja's birthday!)
-
-#ifndef MCMCRNG_H
-#define MCMCRNG_H
-
-#include "rng.h"
-#include "mersenne.h"
-#include "lecuyer.h"
-
-//#include <R.h> // needed to use Rprintf()
-
-using namespace std;
-//using namespace SCYTHE;
-
-namespace SCYTHE {
-
- // function to initiate random number streams
- // needs to be moved someplace else
- rng *MCMCpack_get_rng(const int lec, const int seed_array [],
- const int lecuyer_stream) {
- unsigned long u_seed_array[6];
- for(int i=0; i<6; ++i) u_seed_array[i] =
- static_cast<unsigned long>(seed_array[i]);
- if (lec==1) {
- lecuyer::SetPackageSeed (u_seed_array);
- for(int i=0; i<(lecuyer_stream-1); ++i) {
- rng *retval = new lecuyer();
- delete retval;
- }
- return new lecuyer();
- } else {
- rng *retval = new mersenne();
- dynamic_cast<mersenne *>(retval)->initialize(u_seed_array[0]);
- return retval;
- }
- }
-
-}// end namespace SCYTHE
-
-#endif
diff --git a/src/MCMCrng.h b/src/MCMCrng.h
index 8acc11a..d4207b8 100644
--- a/src/MCMCrng.h
+++ b/src/MCMCrng.h
@@ -22,21 +22,41 @@
#ifndef MCMCRNG_H
#define MCMCRNG_H
-#include "rng.h"
#include "mersenne.h"
#include "lecuyer.h"
-//#include <R.h> // needed to use Rprintf()
-
-using namespace std;
-//using namespace SCYTHE;
-
-namespace SCYTHE {
-
- // function that sets rng streams
- rng *MCMCpack_get_rng(const int, const int [], const int);
-
-}// end namespace SCYTHE
-
+/* This allows model handles to efficiently pass the appropriate rng
+ * to object a model's implementation. The first arg is the name of
+ * the model implementation function. The remaining arguments are the
+ * arguments to the model implementation function.
+ *
+ * The macro assumes that the function it is called in contains an int
+ * pointer named uselecuyer holding a boolean indication of whether or
+ * not to use the lecuyer rng. Secondly, it assumes the function
+ * contains a pointer to an array of integers called seedarray that
+ * contains six random number seeds (or just one if using mersenne).
+ * Finally, it assumes it contains a pointer to an integer called
+ * lecuyerstream that indicates which of the lecuyer generator's
+ * streams to use.
+ */
+
+#define MCMCPACK_PASSRNG2MODEL(MODEL_IMPL, ...) \
+{ \
+ unsigned long u_seed_array[6]; \
+ for (int i = 0; i < 6; ++i) \
+ u_seed_array[i] = static_cast<unsigned long>(seedarray[i]); \
+ \
+ if (*uselecuyer == 0) { \
+ mersenne the_rng; \
+ the_rng.initialize(u_seed_array[0]); \
+ MODEL_IMPL(the_rng, __VA_ARGS__); \
+ } else { \
+ lecuyer::SetPackageSeed(u_seed_array); \
+ for (int i = 0; i < (*lecuyerstream - 1); ++i) \
+ lecuyer skip_rng; \
+ lecuyer the_rng; \
+ MODEL_IMPL(the_rng, __VA_ARGS__); \
+ } \
+}
#endif
diff --git a/src/MCMCtobit.cc b/src/MCMCtobit.cc
index 4f1d2ad..c80654f 100644
--- a/src/MCMCtobit.cc
+++ b/src/MCMCtobit.cc
@@ -2,7 +2,6 @@
// density of a linear regression model with Gaussian errors when the
// dependent variable is censored from below and/or above.
//
-//
// The initial version of this file was generated by the
// auto.Scythe.call() function in the MCMCpack R package
// written by:
@@ -26,22 +25,88 @@
// This file was initially generated on Tue Sep 14 00:50:08 2004
// ADM and KQ 10/10/2002 [ported to Scythe0.3]
// BG 09/18/2004 [updated to new specification, added above censoring]
+// ADM 7/7/2007 [updated to Scythe 1.0.X]
+
+#ifndef MCMCTOBIT_CC
+#define MCMCTOBIT_CC
+#include "MCMCrng.h"
+#include "MCMCfcds.h"
#include "matrix.h"
#include "distributions.h"
#include "stat.h"
#include "la.h"
#include "ide.h"
#include "smath.h"
-#include "MCMCrng.h"
-#include "MCMCfcds.h"
-
+#include "rng.h"
+#include "mersenne.h"
+#include "lecuyer.h"
#include <R.h> // needed to use Rprintf()
#include <R_ext/Utils.h> // needed to allow user interrupts
-using namespace SCYTHE;
using namespace std;
+using namespace scythe;
+
+/* MCMCtobit implemenation. Takes Matrix<> reference which it
+ * fills with the posterior.
+ */
+template <typename RNGTYPE>
+void MCMCtobit_impl (rng<RNGTYPE>& stream, const Matrix<>& Y,
+ const Matrix<>& X, Matrix<>& beta, const Matrix<>& b0,
+ const Matrix<>& B0, double c0, double d0, double below, double above,
+ unsigned int burnin, unsigned int mcmc, unsigned int thin,
+ unsigned int verbose, Matrix<>& result) {
+
+ // define constants
+ const unsigned int tot_iter = burnin + mcmc; // total number of mcmc iterations
+ const unsigned int nstore = mcmc / thin; // number of draws to store
+ const unsigned int k = X.cols();
+ const unsigned int N = X.rows();
+ const Matrix <> XpX = crossprod(X);
+
+ // storage matrix or matrices
+ Matrix <> betamatrix (k, nstore);
+ Matrix <> sigmamatrix (1, nstore);
+
+ ///// MCMC SAMPLING OCCURS IN THIS FOR LOOP
+ int count = 0;
+ Matrix <> Z = Y;
+ for(unsigned int iter = 0; iter < tot_iter; ++iter){
+ double sigma2 = NormIGregress_sigma2_draw (X, Z, beta, c0, d0,
+ stream);
+ Matrix <> Z_mean = X * beta;
+
+ for (unsigned int i=0; i<N; ++i) {
+ if (Y[i] <= below)
+ Z[i] = stream.rtanorm_combo(Z_mean[i], sigma2, below);
+ if (Y[i] >= above)
+ Z[i] = stream.rtbnorm_combo(Z_mean[i], sigma2, above);
+ }
+ Matrix <> XpZ = t(X) * Z;
+ beta = NormNormregress_beta_draw (XpX, XpZ, b0, B0, sigma2, stream);
+
+ // store draws in storage matrix (or matrices)
+ if (iter >= burnin && (iter % thin == 0)) {
+ sigmamatrix (0, count) = sigma2;
+ betamatrix(_, count) = beta;
+ ++count;
+ }
+
+ // print output to stdout
+ if(verbose > 0 && iter % verbose == 0) {
+ Rprintf("\n\nMCMCtobit iteration %i of %i \n",
+ (iter+1), tot_iter);
+ Rprintf("beta = \n");
+ for (unsigned int j=0; j<k; ++j)
+ Rprintf("%10.5f\n", beta[j]);
+ Rprintf("sigma2 = %10.5f\n", sigma2);
+ }
+
+ R_CheckUserInterrupt(); // allow user interrupts
+ } // end MCMC loop
+ result = cbind (t(betamatrix), t(sigmamatrix));
+}
extern "C" {
@@ -53,7 +118,7 @@ extern "C" {
const int *Xrow, const int *Xcol,
const double *below, const double *above,
const int *burnin, const int *mcmc, const int *thin,
- const int *lecuyer,
+ const int *uselecuyer,
const int *seedarray, const int *lecuyerstream,
const int *verbose,
const double *betastartdata, const int *betastartrow,
@@ -64,82 +129,22 @@ extern "C" {
const double *d0) {
// pull together Matrix objects
- // REMEMBER TO ACCESS PASSED ints AND doubles PROPERLY
- Matrix <double> Y = r2scythe(*Yrow, *Ycol, Ydata);
- Matrix <double> X = r2scythe(*Xrow, *Xcol, Xdata);
- Matrix <double> betastart = r2scythe(*betastartrow, *betastartcol,
+ const Matrix <> Y(*Yrow, *Ycol, Ydata);
+ const Matrix <> X(*Xrow, *Xcol, Xdata);
+ Matrix <double> betastart(*betastartrow, *betastartcol,
betastartdata);
- Matrix <double> b0 = r2scythe(*b0row, *b0col, b0data);
- Matrix <double> B0 = r2scythe(*B0row, *B0col, B0data);
- Matrix <double> t_X = t(X);
-
-
- // define constants
- const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations
- const int nstore = *mcmc / *thin; // number of draws to store
- const int k = X.cols ();
- const int N = X.rows ();
- const Matrix <double> XpX = crossprod(X);
-
- // storage matrix or matrices
- Matrix <double> betamatrix (k, nstore);
- Matrix <double> sigmamatrix (1, nstore);
-
- // initialize rng stream
- rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);
-
- // set starting values
- Matrix <double> beta = betastart;
-
- ///// MCMC SAMPLING OCCURS IN THIS FOR LOOP
- int count = 0;
- Matrix <double> Z = Y;
- for(int iter = 0; iter < tot_iter; ++iter){
- double sigma2 = NormIGregress_sigma2_draw (X, Z, beta, *c0, *d0,
- stream);
- Matrix <double> Z_mean = X * beta;
-
- for (int i=0; i<N; ++i) {
- if (Y[i] <= *below)
- Z[i] = stream->rtanorm_combo(Z_mean[i], sigma2, *below);
- if (Y[i] >= *above)
- Z[i] = stream->rtbnorm_combo(Z_mean[i], sigma2, *above);
- }
-
- Matrix <double> XpZ = t (X) * Z;
-
- beta = NormNormregress_beta_draw (XpX, XpZ, b0, B0, sigma2, stream);
-
- // store draws in storage matrix (or matrices)
- if (iter >= *burnin && (iter % 1 == 0)) {
+ const Matrix <> b0(*b0row, *b0col, b0data);
+ const Matrix <> B0(*B0row, *B0col, B0data);
+
+ Matrix<> storagematrix;
+ MCMCPACK_PASSRNG2MODEL(MCMCtobit_impl, Y, X, betastart, b0, B0,
+ *c0, *d0, *below, *above, *burnin, *mcmc, *thin, *verbose,
+ storagematrix);
- sigmamatrix (0, count) = sigma2;
- for (int j = 0; j < k; j++)
- betamatrix (j, count) = beta[j];
- ++count;
- }
-
- // print output to stdout
- if(*verbose > 0 && iter % *verbose == 0) {
- Rprintf("\n\nMCMCtobit iteration %i of %i \n",
- (iter+1), tot_iter);
- Rprintf("beta = \n");
- for (int j=0; j<k; ++j)
- Rprintf("%10.5f\n", beta[j]);
- Rprintf("sigma2 = %10.5f\n", sigma2);
- }
+ const unsigned int size = *samplerow * *samplecol;
+ for (unsigned int i=0; i<size; ++i)
+ sampledata[i] = storagematrix(i);
+ }
+}
- R_CheckUserInterrupt(); // allow user interrupts
-
- } // end MCMC loop
-
- delete stream; // clean up random number stream
-
- // load draws into sample array
- Matrix <double> storeagematrix = cbind (t (betamatrix), t (sigmamatrix));
- const int size = *samplerow * *samplecol;
- for(int i = 0; i < size; ++i)
- sampledata[i] = storeagematrix[i];
-
- } // end MCMCtobit
-} // end extern "C"
+#endif
diff --git a/src/Makevars b/src/Makevars
index 174a0f5..8f3a8df 100644
--- a/src/Makevars
+++ b/src/Makevars
@@ -1 +1 @@
-PKG_CXXFLAGS = -DSCYTHE_COMPILE_DIRECT -DSCYTHE_NO_RANGE -DHAVE_TRUNC
+PKG_CXXFLAGS = -DSCYTHE_COMPILE_DIRECT -DSCYTHE_DEBUG=0 -DHAVE_TRUNC -DHAVE_TRUNC
diff --git a/src/Makevars.in b/src/Makevars.in
index 5c12b4a..afaee3c 100644
--- a/src/Makevars.in
+++ b/src/Makevars.in
@@ -1 +1 @@
-PKG_CXXFLAGS = -DSCYTHE_COMPILE_DIRECT -DSCYTHE_NO_RANGE @MV_HAVE_IEEEFP_H@ @MV_HAVE_TRUNC@
+PKG_CXXFLAGS = -DSCYTHE_COMPILE_DIRECT -DSCYTHE_DEBUG=0 -DHAVE_TRUNC @MV_HAVE_IEEEFP_H@ @MV_HAVE_TRUNC@
diff --git a/src/algorithm.h b/src/algorithm.h
new file mode 100644
index 0000000..c5bf5ad
--- /dev/null
+++ b/src/algorithm.h
@@ -0,0 +1,202 @@
+/*
+ * Scythe Statistical Library
+ * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
+ * 2002-present Andrew D. Martin, Kevin M. Quinn, and Daniel
+ * Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * under the terms of the GNU General Public License as published by
+ * Free Software Foundation; either version 2 of the License, or (at
+ * your option) any later version. See the text files COPYING
+ * and LICENSE, distributed with this source code, for further
+ * information.
+ * --------------------------------------------------------------------
+ * scythestat/algorithm.h
+ */
+
+/*! \file algorithm.h
+ *
+ * \brief Generic algorithms for Scythe objects.
+ *
+ * This file provides implementations of a few algorithms that operate
+ * on Scythe objects and also contains the definitions of a handful of
+ * useful function objects. These functions and functors are primarily
+ * intended for use within the library. We add algorithms to this
+ * header as need arises and do not currently attempt to provide a
+ * comprehensive set of generic algorithms for working with Scythe
+ * matrices.
+ *
+ */
+
+#ifndef SCYTHE_ALGORITHM_H
+#define SCYTHE_ALGORITHM_H
+
+#include <cmath>
+#include <functional>
+#include <algorithm>
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "defs.h"
+#include "matrix.h"
+#include "matrix_random_access_iterator.h"
+#else
+#include "scythestat/defs.h"
+#include "scythestat/matrix.h"
+#include "scythestat/matrix_random_access_iterator.h"
+#endif
+
+namespace scythe {
+ namespace {
+ typedef unsigned int uint;
+ }
+
+ /* Matrix forward declaration */
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE>
+ class Matrix;
+
+ /*! \brief A Functor encapsulating exponentiation.
+ *
+ * This function object wraps exponentiation operations for use in
+ * generic algorithms.
+ */
+ template <typename T>
+ struct exponentiate : std::binary_function<T, T, T>
+ {
+ T operator() (T base, T exp) const
+ {
+ return std::pow(base, exp);
+ }
+ };
+
+ /*! \brief A Functor encapsulating \f$ax+b\f$.
+ *
+ * This function object wraps the operation \f$ax+b\f$ for use in
+ * generic algorithms, where a is some constant.
+ */
+ template <typename T>
+ struct ax_plus_b : std::binary_function<T,T,T>
+ {
+ T a_;
+ ax_plus_b (T a) : a_ (a) {}
+ T operator() (T x, T b) const
+ {
+ return (a_ * x + b);
+ }
+ };
+
+ /*! \brief Iterate through a Matrix in order.
+ *
+ * This function iterates through a Matrix, \a M, in order,
+ * setting each element in the Matrix to the result of an invocation
+ * of the function object, \a func. The () operator of \a func
+ * should take two unsigned integer parameters (i - the row offset
+ * into \a M; j - the column offset into \a M) and return a result
+ * of type T.
+ *
+ * \param M The Matrix to iterate over.
+ * \param func The functor to execute on each iteration.
+ *
+ */
+
+ template <typename T, matrix_order O, matrix_style S, class FUNCTOR>
+ void
+ for_each_ij_set (Matrix<T,O,S>& M, FUNCTOR func)
+ {
+ if (O == Col) {
+ for (uint j = 0; j < M.cols(); ++j)
+ for (uint i = 0; i < M.rows(); ++i)
+ M(i, j) = func(i, j);
+ } else {
+ for (uint i = 0; i < M.cols(); ++i)
+ for (uint j = 0; j < M.rows(); ++j)
+ M(i, j) = func(i, j);
+ }
+ }
+
+ /*! \brief Copy the contents of one Matrix into another.
+ *
+ * This function copies the contents of one Matrix into
+ * another, traversing each Matrix in the order specified by the
+ * template terms ORDER1 and ORDER2. This function requires an
+ * explicit template call that specifies ORDER1 and ORDER2.
+ *
+ * \param source The Matrix to copy.
+ * \param dest The Matrix to copy into.
+ */
+
+ template <matrix_order ORDER1, matrix_order ORDER2,
+ typename T, typename S, matrix_order SO, matrix_style SS,
+ matrix_order DO, matrix_style DS>
+ void
+ copy(const Matrix<T,SO,SS>& source, Matrix<S,DO,DS>& dest)
+ {
+ std::copy(source.template begin_f<ORDER1>(),
+ source.template end_f<ORDER1>(),
+ dest.template begin_f<ORDER2>());
+ }
+
+ /*! \brief Copy the contents of one Matrix into another.
+ *
+ * This function copies the contents of one Matrix into
+ * another, traversing each Matrix in the order specified by the
+ * template terms ORDER1 and ORDER2. If \a source is larger than \a
+ * dest, the function only copies as many elements from \a source as
+ * will fit in \a dest. On the other hand, if \a source is smaller
+ * than \a dest, the function will start over at the beginning of
+ * \a source, recycling the contents of \a source as many times as
+ * necessary to fill \a dest. This function requires an explicit
+ * template call that specifies ORDER1 and ORDER2.
+ *
+ * \param source The Matrix to copy.
+ * \param dest The Matrix to copy into.
+ */
+ template <matrix_order ORDER1, matrix_order ORDER2,
+ typename T, matrix_order SO, matrix_style SS,
+ matrix_order DO, matrix_style DS>
+ void
+ copy_recycle (const Matrix<T,SO,SS>& source, Matrix<T,DO,DS>& dest)
+ {
+ if (source.size() == dest.size()) {
+ copy<ORDER1,ORDER2> (source, dest);
+ } else if (source.size() > dest.size()) {
+ const_matrix_random_access_iterator<T,ORDER1,SO,SS> s_iter
+ = source.template begin<ORDER1>();
+ std::copy(s_iter, s_iter + dest.size(),
+ dest.template begin_f<ORDER2>());
+ } else {
+ const_matrix_random_access_iterator<T,ORDER1,SO,SS> s_begin
+ = source.template begin<ORDER1> ();
+ matrix_random_access_iterator<T,ORDER2,DO,DS> d_iter
+ = dest.template begin<ORDER2>();
+ matrix_random_access_iterator<T,ORDER2,DO,DS> d_end
+ = dest.template end<ORDER2>();
+ while (d_iter != d_end) {
+ unsigned int span = std::min(source.size(),
+ (unsigned int) (d_end - d_iter));
+ d_iter = std::copy(s_begin, s_begin + span, d_iter);
+ }
+ }
+ }
+
+ /*! \brief Determine the sign of a number.
+ *
+ * This function compares \a x to (T) 0, returning (T) 1 if \a x is
+ * greater than zero, (T) -1 if \a x is less than zero, and (T) 0
+ * otherwise.
+ *
+ * \param x The value to check.
+ */
+ template <class T>
+ inline T sgn (const T & x)
+ {
+ if (x > (T) 0)
+ return (T) 1;
+ else if (x < (T) 0)
+ return (T) -1;
+ else
+ return (T) 0;
+ }
+
+} // end namespace scythe
+
+#endif /* SCYTHE_ALGORITHM_H */
diff --git a/src/datablock.h b/src/datablock.h
new file mode 100644
index 0000000..934e74a
--- /dev/null
+++ b/src/datablock.h
@@ -0,0 +1,361 @@
+
+/*
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
+ * information.
+ * --------------------------------------------------------------------
+ * scythestat/datablock.h
+ */
+
+/*! \file datablock.h
+ * \brief Definitions of internal Matrix data management classes
+ *
+ * DataBlock and DataBlockReference objects provide the data half of
+ * the data/view container model used by Scythe's matrices. A
+ * DataBlock contains a data array of a given type, some information
+ * about the DataBlock, and a reference count. Matrix objects
+ * provide views to the DataBlock, thus allowing us to provide
+ * Matrix objects that reference subsets of other matrices. When no
+ * matrices remain that reference the DataBlock the reference count
+ * falls to zero and the block is automatically deallocated.
+ *
+ * DataBlock uses a simple doubling/halving memory allocation scheme
+ * but this may change in later releases.
+ *
+ * The DataBlock classes are used exclusively within the library and
+ * do not constitute a part of Scythe's public interface.
+ *
+ * Based on code in Blitz++ (http://www.oonumerics.org/blitz/) by
+ * Todd Veldhuizen <tveldhui at oonumerics.org>. Blitz++ is
+ * distributed under the terms of the GNU GPL.
+ */
+
+#ifndef SCYTHE_DATABLOCK_H
+#define SCYTHE_DATABLOCK_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "error.h"
+#else
+#include "scythestat/error.h"
+#endif
+
+namespace scythe {
+ /* Convenience typedefs */
+ namespace { // local to this file
+ typedef unsigned int uint;
+ }
+
+ /*! \brief Handles Matrix data internals.
+ *
+ * Handles data allocation, reallocation, and deletion of blocks of
+ * elements; the actual data Matrix objects point to. Keeps a
+ * reference count.
+ */
+ template <typename T_type>
+ class DataBlock {
+ public:
+ /**** CONSTRUCTORS ****/
+
+ /*
+ * Create an empty data block.
+ */
+
+ DataBlock ()
+ : data_ (0),
+ size_ (0),
+ refs_ (0)
+ {}
+
+ /*
+ * Create a block of a given size.
+ */
+ explicit
+ DataBlock (uint size)
+ : data_ (0),
+ size_ (0),
+ refs_ (0)
+ {
+ resize(size);
+ SCYTHE_DEBUG_MSG("Constructed new " << size << "(" << size_
+ << ") DataBlock at address " << data_);
+ }
+
+ /*
+ * Create an exact copy of another data block.
+ */
+ DataBlock (const DataBlock<T_type>& b)
+ : data_ (b.data_),
+ size_ (b.size_),
+ refs_ (b.refs_)
+ {}
+
+ /**** DESTRUCTOR ****/
+
+ ~DataBlock ()
+ {
+ SCYTHE_DEBUG_MSG("Destructing block at " << data_);
+ deallocate();
+ }
+
+ /**** REFERENCE COUNTING ****/
+
+ inline uint addReference ()
+ {
+ SCYTHE_DEBUG_MSG("Added reference to DataBlock at address "
+ << data_);
+ return ++refs_;
+ }
+
+ inline uint removeReference ()
+ {
+ SCYTHE_DEBUG_MSG("Removed reference to DataBlock at address "
+ << data_);
+ return --refs_ ;
+ }
+
+ inline uint references ()
+ {
+ return refs_;
+ }
+
+ /**** ACCESSORS ****/
+
+ inline T_type* data()
+ {
+ return data_;
+ }
+
+ inline const T_type* data() const
+ {
+ return data_;
+ }
+
+ inline uint size () const
+ {
+ return size_;
+ }
+
+ protected:
+ /**** (DE)ALLOCATION AND RESIZING ****/
+
+ /* Allocate data given the current block size. */
+ inline void allocate (uint size)
+ {
+ /* TODO Think about cache boundary allocations for big blocks
+ * see blitz++ */
+
+ if (data_ != 0) // Get rid of previous allocation if it exists
+ deallocate();
+
+ data_ = new (std::nothrow) T_type[size];
+
+ SCYTHE_CHECK_10(data_ == 0, scythe_alloc_error,
+ "Failure allocating DataBlock of size " << size);
+ }
+
+ /* Deallocate a block's data */
+ inline void deallocate ()
+ {
+ SCYTHE_DEBUG_MSG(" Deallocating DataBlock of size " << size_
+ << " at address " << data_);
+ delete[] data_;
+ data_ = 0;
+ }
+
+ public:
+ /* TODO At the moment, references call this method directly. Not
+ * sure if this is the best interface choice. */
+ /* Resize a block. */
+ void resize (uint newsize)
+ {
+ if (newsize > size_)
+ grow(newsize);
+ else if (newsize < size_ / 4)
+ shrink();
+ }
+
+ protected:
+ /* Make a block larger. Expects to be called by resize and does
+ * not reset the size_ variable. */
+ inline void grow (uint newsize)
+ {
+ size_ = size_ ? size_ : 1; // make sure not zero
+
+ /* TODO Can we speed this up? In 20 iters we're at
+ * 1048576 elems doing the math might be more costly...
+ */
+ while (size_ < newsize)
+ size_ <<= 1;
+
+ allocate(size_);
+ }
+
+ /* Make a block smaller. Expects to be called by resize */
+ inline void shrink ()
+ {
+ size_ >>= 1;
+ allocate(size_);
+ }
+
+ private:
+ /**** INSTANCE VARIABLES ****/
+ T_type *data_; // The data array
+ uint size_; // The number of elements in the block
+ uint refs_; // The number of views looking at this block
+ }; // end class DataBlock
+
+ /*! \brief Null data block object.
+ *
+ * A nice little way to represent empty data blocks.
+ */
+ template <class T_type>
+ class NullDataBlock : public DataBlock<T_type>
+ {
+ typedef DataBlock<T_type> T_base;
+ public:
+
+ NullDataBlock ()
+ : DataBlock<T_type> ()
+ {
+ // never want to deallocate (or resize) this one
+ T_base::addReference();
+ SCYTHE_DEBUG_MSG("Constructed NULL datablock");
+ }
+
+ ~NullDataBlock ()
+ {}
+
+ }; // end class NullDataBlock
+
+
+ /*!
+ * \brief Handle to DataBlock objects.
+ *
+ * Matrices inherit from this object. It provides a handle into
+ * DataBlock objects and automates cleanup when the referenced
+ * object runs out of referants.
+ */
+ template <class T_type>
+ class DataBlockReference {
+ public:
+ /**** CONSTRUCTORS ****/
+
+ /* Default constructor: points the object at a static null block
+ */
+ DataBlockReference ()
+ : data_ (0),
+ block_ (&nullBlock_)
+ {
+ block_->addReference();
+ }
+
+ /* New block constructor: creates a new underlying block of a
+ * given size and points at it. */
+ explicit
+ DataBlockReference (uint size)
+ : data_ (0),
+ block_ (0)
+ {
+ block_ = new (std::nothrow) DataBlock<T_type> (size);
+ SCYTHE_CHECK_10 (block_ == 0, scythe_alloc_error,
+ "Could not allocate DataBlock object");
+
+ data_ = block_->data();
+ block_->addReference();
+ }
+
+ /* Refrence to an existing block constructor: points to an
+ * offset within an existing block. */
+ DataBlockReference (const DataBlockReference<T_type>& reference,
+ uint offset = 0)
+ : data_ (reference.data_ + offset),
+ block_ (reference.block_)
+ {
+ block_->addReference();
+ }
+
+ /**** DESTRUCTOR ****/
+ /* Automates removal of underlying block objects when refcount
+ * hits nil.
+ */
+ virtual ~DataBlockReference ()
+ {
+ withdrawReference();
+ }
+
+ protected:
+
+ /**** MEMBERS CALLED BY DERIVED CLASS ****/
+ void referenceOther (const DataBlockReference<T_type>& ref,
+ uint offset = 0)
+ {
+ withdrawReference ();
+ block_ = ref.block_;
+ block_->addReference();
+ data_ = ref.data_ + offset;
+ }
+
+ void referenceNew (uint size)
+ {
+ /* If we are the only referent to this data block, resize it.
+ * Otherwise, shift the reference to point to a newly
+ * constructed block.
+ */
+ if (block_->references() == 1) {
+ block_->resize(size);
+ data_ = block_->data(); // This is a pretty good indication
+ // that the interface and implementation are too tightly
+ // coupled for resizing.
+ } else {
+ withdrawReference();
+ block_ = 0;
+ block_ = new (std::nothrow) DataBlock<T_type> (size);
+ SCYTHE_CHECK_10(block_ == 0, scythe_alloc_error,
+ "Could not allocate new data block");
+ data_ = block_->data();
+ block_->addReference();
+ }
+ }
+
+ private:
+ /**** INTERNAL MEMBERS ****/
+ void withdrawReference ()
+ {
+ if (block_->removeReference() == 0
+ && block_ != &nullBlock_)
+ delete block_;
+ }
+
+ void referenceNull ()
+ {
+ withdrawReference();
+ block_ = &nullBlock_;
+ block_->addReference();
+ data_ = 0;
+ }
+
+
+ /**** INSTANCE VARIABLES ****/
+ protected:
+ T_type* data_; // Pointer to the underlying data (offset)
+
+ private:
+ DataBlock<T_type>* block_;
+ static NullDataBlock<T_type> nullBlock_;
+
+ }; // end class DataBlockReference
+
+ /* Instantiation of the static null memory block */
+ template <typename T>
+ NullDataBlock<T> DataBlockReference<T>::nullBlock_;
+
+} // end namespace scythe
+
+#endif /* SCYTHE_DATABLOCK_H */
diff --git a/src/defs.h b/src/defs.h
new file mode 100644
index 0000000..ec3f839
--- /dev/null
+++ b/src/defs.h
@@ -0,0 +1,261 @@
+/*
+ * Scythe Statistical Library
+ * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
+ * 2002-present Andrew D. Martin, Kevin M. Quinn, and Daniel
+ * Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * under the terms of the GNU General Public License as published by
+ * Free Software Foundation; either version 2 of the License, or (at
+ * your option) any later version. See the text files COPYING
+ * and LICENSE, distributed with this source code, for further
+ * information.
+ * --------------------------------------------------------------------
+ * scythestat/defs.h
+ */
+
+/*! \file defs.h
+ * \brief Global Scythe definitions.
+ *
+ * This file provides a variety of global definitions used throughout
+ * the Scythe library.
+ *
+ * The majority of these definitions are used only within the library
+ * itself. Those definitions that are part of the public interface
+ * are documented.
+ *
+ */
+
+/* Doxygen main page text */
+/*! \mainpage Scythe Statistical Library: Application Programmers' Interface
+ *
+ * \section intro Introduction
+ *
+ * The Scythe Statistical Library is an open source C++ library for
+ * statistical computation, written by Daniel Pemstein (University of
+ * Illinois), Kevin M. Quinn (Harvard University), and Andrew D.
+ * Martin (Washington University). It includes a suite of matrix
+ * manipulation functions, a suite of pseudo-random number generators,
+ * and a suite of numerical optimization routines. Programs written
+ * using Scythe are generally much faster than those written in
+ * commonly used interpreted languages, such as R and MATLAB, and can
+ * be compiled on any system with the GNU GCC compiler (and perhaps
+ * with other C++ compilers). One of the primary design goals of the
+ * Scythe developers has been ease of use for non-expert C++
+ * programmers. We provide ease of use through three primary
+ * mechanisms: (1) operator and function over-loading, (2) numerous
+ * pre-fabricated utility functions, and (3) clear documentation and
+ * example programs. Additionally, Scythe is quite flexible and
+ * entirely extensible because the source code is available to all
+ * users under the GNU General Public License.
+ *
+ * \section thisdoc About This Document
+ *
+ * This document is the application programmer's interface (API) to
+ * Scythe. It provides documentation for every class, function, and
+ * object in Scythe that is part of the library's public interface.
+ * In addition, the sections below explain how to obtain, install, and
+ * compile the library.
+ *
+ * \section obtain Obtaining Scythe
+ *
+ * The most recent version of Scythe is available for download at
+ * http://scythe.wustl.edu.
+ *
+ * \section install Installation
+ *
+ * Scythe installs as a header-only C++ library. After uncompressing,
+ * simply follow the instructions in the INSTALL file included with
+ * Scythe to install the library. Alternatively, you may copy the
+ * source files in scythestat and scythestat/rng into your project
+ * directory and compile directly, using the SCYTHE_COMPILE_DIRECT
+ * pre-processor flag.
+ *
+ * \section compile Compilation
+ *
+ * Scythe should work with the GNU GCC compiler, version 4.0.1 and
+ * greater. Scythe has not been tested with other compilers. Scythe
+ * provides a number of pre-processor flags. The
+ * SCYTHE_COMPILE_DIRECT allows the user to compile Scythe sources
+ * directly. The SCYTHE_VIEW_ASSIGNMENT_FLAG turns on R-style
+ * recycling in Matrix::operator=() for view matrices.
+ *
+ * The SCYTHE_DEBUG_LEVEL controls the amount of error trapping in
+ * Scythe. This level ranges from 0 (virtually no checking) to 3 (all
+ * checking, including Matrix bounds checking, turned on). By
+ * default, the level is set to 3. Here's an example of how to
+ * compile a program with only basic error checking:
+ *
+ * \verbatim $ g++ myprog.cc -DSCYTHE_DEBUG_LEVEL=1 \endverbatim
+ *
+ * Finally, the SCYTHE_LAPACK flag enables LAPACK/BLAS. You must have
+ * the LAPACK and BLAS libraries installed on your system and compile
+ * your program with the appropriate linker flags for this to work. For
+ * example, on linux you can enable LAPACK/BLAS support like this:
+ *
+ * \verbatim $ g++ myprog.cc -DSCYTHE_LAPACK -llapack -lblas -pthread \endverbatim
+ *
+ * \section copy Copyright
+ *
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with library's source code, for
+ * further information.
+ *
+ * \section acknowledge Acknowledgments
+ *
+ * We gratefully acknowledge support from the United States National
+ * Science Foundation (Grants SES-0350646 and SES-0350613), the
+ * Department of Political Science, the Weidenbaum Center, and the
+ * Center for Empirical Research in the Law at Washington University,
+ * and the Department of Government and The Institute for Quantitative
+ * Social Science at Harvard University. Neither the foundation,
+ * Washington University, nor Harvard University bear any
+ * responsibility for this software.
+ *
+ * We'd also like to thank the research assistants who have helped us
+ * with Scythe: Matthew Fasman, Steve Haptonstahl, Kate Jensen, Laura
+ * Keys, Kevin Rompala, Joe Sheehan, and Jean Yang.
+ */
+
+#ifndef SCYTHE_DEFS_H
+#define SCYTHE_DEFS_H
+
+/* In many functions returning matrices, we want to allow the user to
+ * get a matrix of any style, but want to work with concretes inside
+ * the function, for efficiency. This macro originally contained the
+ * code:
+ *
+ * if (_STYLE_ == View) \
+ * return Matrix<_TYPE_,_ORDER_,View>(_MATRIX_); \
+ * else \
+ * return _MATRIX_;
+ *
+ * to convert to View before return if necessary. Of course, this is
+ * completely redundant, since the copy constructor gets called on
+ * return anyway, so the body of the macro was replaced with a simple
+ * return. If we change our minds down the road about how to handle
+ * these returns, code changes will be centered on this macro.
+ */
+#define SCYTHE_VIEW_RETURN(_TYPE_, _ORDER_, _STYLE_, _MATRIX_) \
+ return _MATRIX_;
+
+/* Some macros to do bounds checking for iterator accesses. The first
+ * two are only called by the [] operator in the random access
+ * iterator. The third macro handles everything for checks on simple
+ * current iterator location accesses.
+ */
+#define SCYTHE_ITER_CHECK_POINTER_BOUNDS(POINTER) \
+{ \
+ SCYTHE_CHECK_30(POINTER >= start_ + size_ || POINTER < start_, \
+ scythe_bounds_error, "Iterator access (offset " \
+ << offset_ << ") out of matrix bounds") \
+}
+
+#define SCYTHE_ITER_CHECK_OFFSET_BOUNDS(OFFSET) \
+{ \
+ SCYTHE_CHECK_30(OFFSET >= size_, scythe_bounds_error, \
+ "Iterator access (offset " << offset_ << ") out of matrix bounds")\
+}
+
+#define SCYTHE_ITER_CHECK_BOUNDS() \
+{ \
+ if (M_STYLE != Concrete || M_ORDER != ORDER) { \
+ SCYTHE_ITER_CHECK_OFFSET_BOUNDS(offset_); \
+ } else { \
+ SCYTHE_ITER_CHECK_POINTER_BOUNDS(pos_); \
+ } \
+}
+
+/*! \namespace scythe
+ * \brief The Scythe library namespace.
+ *
+ * All Scythe library declarations are defined within the scythe
+ * namespace. This prevents name clashing with other libraries'
+ * members or with declarations in users' program code.
+ */
+namespace scythe {
+
+ /*!
+ * \brief Matrix order enumerator.
+ *
+ * Matrix templates may be either column-major or row-major ordered
+ * and this enumerator is used to differentiate between the two
+ * types.
+ *
+ * The enumerator provides two values: Concrete and View.
+ *
+ * \see Matrix
+ */
+ enum matrix_order { Col, Row };
+
+ /*!
+ * \brief Matrix style enumerator.
+ *
+ * Matrix templates may be either concrete matrices or views and
+ * this enumerator is used to differentiate between the two types.
+ *
+ * Concrete matrices provide direct access to an underlying array of
+ * matrix data, while views offer a more general interface to data
+ * arrays, with potentially many views referencing the same
+ * underlying data structure.
+ *
+ * The enum provides two values: Col and Row.
+ *
+ * \see Matrix
+ */
+ enum matrix_style { Concrete, View };
+
+ /*!
+ * \brief A convenient marker for vector submatrix access.
+
+ * Passing an all_elements object to a two-argument Matrix submatrix
+ * method allows the caller to access a full vector submatrix. We
+ * further define an instance of all_elements named "_" in the
+ * scythe namespace to allow users to easily reference entire
+ * vectors within matrices.
+ *
+ * \see Matrix::operator()(const all_elements, uint)
+ * \see Matrix::operator()(const all_elements, uint) const
+ * \see Matrix::operator()(uint, const all_elements)
+ * \see Matrix::operator()(uint, const all_elements) const
+ *
+ */
+
+ struct all_elements {
+ } const _ = {};
+
+ // A little helper method to see if more col-order or row-order.
+ // Tie breaks towards col.
+ template <matrix_order o1, matrix_order o2, matrix_order o3>
+ bool maj_col()
+ {
+ if ((o1 == Col && o2 == Col) ||
+ (o1 == Col && o3 == Col) ||
+ (o2 == Col && o3 == Col))
+ return true;
+ return false;
+ }
+
+ template <matrix_order o1, matrix_order o2, matrix_order o3,
+ matrix_order o4>
+ bool maj_col()
+ {
+ if ((o1 == Col && o2 == Col) ||
+ (o1 == Col && o3 == Col) ||
+ (o1 == Col && o4 == Col) ||
+ (o2 == Col && o3 == Col) ||
+ (o2 == Col && o4 == Col) ||
+ (o3 == Col && o4 == Col))
+ return true;
+ return false;
+ }
+} // end namespace scythe
+
+#endif /* SCYTHE_ERROR_H */
diff --git a/src/distributions.cc b/src/distributions.cc
deleted file mode 100644
index 22d82fd..0000000
--- a/src/distributions.cc
+++ /dev/null
@@ -1,2055 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/distributions.cc
- *
- * Provides implementations of PDFs, CDFs, and some common functions
- * (gamma, beta, etc).
- *
- */
-
-#ifndef SCYTHE_DISTRIBUTIONS_CC
-#define SCYTHE_DISTRIBUTIONS_CC
-
-#include <iostream>
-#include <cmath>
-#include <cfloat>
-#include <climits>
-#include <algorithm>
-
-#ifdef HAVE_IEEEFP_H
-#include <ieeefp.h>
-#endif
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "distributions.h"
-#include "error.h"
-#include "util.h"
-#include "ide.h"
-#include "stat.h"
-#include "la.h"
-#else
-#include "scythestat/distributions.h"
-#include "scythestat/error.h"
-#include "scythestat/util.h"
-#include "scythestat/ide.h"
-#include "scythestat/stat.h"
-#include "scythestat/la.h"
-#endif
-
-#ifndef HAVE_TRUNC
-inline double trunc(double x) throw ()
-{
- if (x >= 0)
- return floor(x);
- else
- return ceil(x);
-}
-#endif
-
-/* Many random number generators, pdfs, cdfs, and functions (gamma,
- * etc) in this file are based on code from the R Project, version
- * 1.6.0-1.7.1. This code is available under the terms of the GNU
- * GPL. Original copyright:
- *
- * Copyright (C) 1998 Ross Ihaka
- * Copyright (C) 2000-2002 The R Development Core Team
- * Copyright (C) 2003 The R Foundation
- */
-
-namespace SCYTHE {
-
- /* Non-convergence flag setup */
-#ifdef __MINGW32__
- static bool THROW_ON_NONCONV = false;
-#else
- namespace {
- bool THROW_ON_NONCONV = false;
- }
-#endif
-
- void throw_on_nonconv (bool t) {
- THROW_ON_NONCONV = t;
- }
-
- /*************
- * Functions *
- *************/
-
- /* The gamma function */
- double
- gammafn (const double &x)
- {
- const double gamcs[22] = {
- +.8571195590989331421920062399942e-2,
- +.4415381324841006757191315771652e-2,
- +.5685043681599363378632664588789e-1,
- -.4219835396418560501012500186624e-2,
- +.1326808181212460220584006796352e-2,
- -.1893024529798880432523947023886e-3,
- +.3606925327441245256578082217225e-4,
- -.6056761904460864218485548290365e-5,
- +.1055829546302283344731823509093e-5,
- -.1811967365542384048291855891166e-6,
- +.3117724964715322277790254593169e-7,
- -.5354219639019687140874081024347e-8,
- +.9193275519859588946887786825940e-9,
- -.1577941280288339761767423273953e-9,
- +.2707980622934954543266540433089e-10,
- -.4646818653825730144081661058933e-11,
- +.7973350192007419656460767175359e-12,
- -.1368078209830916025799499172309e-12,
- +.2347319486563800657233471771688e-13,
- -.4027432614949066932766570534699e-14,
- +.6910051747372100912138336975257e-15,
- -.1185584500221992907052387126192e-15,
- };
-
-
- double y = fabs(x);
-
- if (y <= 10) {
-
- /* Compute gamma(x) for -10 <= x <= 10
- * Reduce the interval and find gamma(1 + y) for 0 <= y < 1
- * first of all. */
-
- int n = (int) x;
- if (x < 0)
- --n;
-
- y = x - n;/* n = floor(x) ==> y in [ 0, 1 ) */
- --n;
- double value = INTERNAL::chebyshev_eval(y * 2 - 1, gamcs, 22)
- + .9375;
-
- if (n == 0)
- return value;/* x = 1.dddd = 1+y */
-
- if (n < 0) {
- /* compute gamma(x) for -10 <= x < 1 */
-
- /* If the argument is exactly zero or a negative integer */
- /* then return NaN. */
- if (x == 0 || (x < 0 && x == n + 2))
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "x is 0 or a negative integer");
-
- /* The answer is less than half precision */
- /* because x too near a negative integer. */
- if (x < -0.5 && std::fabs(x - (int)(x - 0.5) / x) < 67108864.0)
- throw scythe_precision_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- std::string("Answer < 1/2 precision because x is ")
- & "too near a negative integer");
-
- /* The argument is so close to 0 that the result
- * * would overflow. */
- if (y < 2.2474362225598545e-308)
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "x too close to 0");
-
- n = -n;
-
- for (int i = 0; i < n; i++)
- value /= (x + i);
-
- return value;
- } else {
- /* gamma(x) for 2 <= x <= 10 */
-
- for (int i = 1; i <= n; i++) {
- value *= (y + i);
- }
- return value;
- }
- } else {
- /* gamma(x) for y = |x| > 10. */
-
- if (x > 171.61447887182298) /* Overflow */
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Overflow");
-
- if (x < -170.5674972726612) /* Underflow */
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Underflow");
-
- double value = std::exp((y - 0.5) * std::log(y) - y
- + M_LN_SQRT_2PI + INTERNAL::lngammacor(y));
-
- if (x > 0)
- return value;
-
- if (std::fabs((x - (int)(x - 0.5))/x) < 67108864.0)
- throw scythe_precision_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- std::string("Answer < 1/2 precision because x is ")
- & "too near a negative integer");
-
- double sinpiy = std::sin(M_PI * y);
-
- if (sinpiy == 0) /* Negative integer arg - overflow */
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Overflow");
-
- return -M_PI / (y * sinpiy * value);
- }
- }
-
- /* The natural log of the absolute value of the gamma function */
- double
- lngammafn(const double &x)
- {
- if (x <= 0 && x == (int)x)
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "x is 0 or a negative integer");
-
- double y = fabs(x);
-
- if (y <= 10)
- return log(fabs(gammafn(x)));
-
- if (y > 2.5327372760800758e+305)
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Overflow");
-
- if (x > 0) /* i.e. y = x > 10 */
- return M_LN_SQRT_2PI + (x - 0.5) * log(x) - x
- + INTERNAL::lngammacor(x);
-
- /* else: x < -10; y = -x */
- double sinpiy = fabs(sin(M_PI * y));
-
- if (sinpiy == 0) /* Negative integer argument */
- throw scythe_exception("UNEXPECTED ERROR",
- __FILE__, __PRETTY_FUNCTION__, __LINE__,
- "ERROR: Should never happen!");
-
- double ans = M_LN_SQRT_PId2 + (x - 0.5) * log(y) - x - log(sinpiy)
- - INTERNAL::lngammacor(y);
-
- if(fabs((x - (int)(x - 0.5)) * ans / x) < 1.490116119384765696e-8)
- throw scythe_precision_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("Answer < 1/2 precision because x is ")
- & "too near a negative integer");
-
- return ans;
- }
-
- /* The beta function */
- double
- betafn(const double &a, const double &b)
- {
- if (a <= 0 || b <= 0)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "a or b < 0");
-
- if (a + b < 171.61447887182298) /* ~= 171.61 for IEEE */
- return gammafn(a) * gammafn(b) / gammafn(a+b);
-
- double val = lnbetafn(a, b);
- if (val < -708.39641853226412)
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Underflow");
-
- return std::exp(val);
- }
-
- /* The natural log of the beta function */
- double
- lnbetafn (const double &a, const double &b)
- {
- double p, q;
-
- p = q = a;
- if(b < p) p = b;/* := min(a,b) */
- if(b > q) q = b;/* := max(a,b) */
-
- if (p <= 0 || q <= 0)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "a or b <= 0");
-
- if (p >= 10) {
- /* p and q are big. */
- double corr = INTERNAL::lngammacor(p) + INTERNAL::lngammacor(q)
- - INTERNAL::lngammacor(p + q);
- return std::log(q) * -0.5 + M_LN_SQRT_2PI + corr
- + (p - 0.5) * log(p / (p + q)) + q * log(1 + (-p / (p + q)));
- } else if (q >= 10) {
- /* p is small, but q is big. */
- double corr = INTERNAL::lngammacor(q)
- - INTERNAL::lngammacor(p + q);
- return lngammafn(p) + corr + p - p * std::log(p + q)
- + (q - 0.5) * log(1 + (-p / (p + q)));
- }
-
- /* p and q are small: p <= q > 10. */
- return std::log(gammafn(p) * (gammafn(q) / gammafn(p + q)));
- }
-
- /* Compute the factorial of a non-negative integer */
- int
- factorial (const int &n)
- {
- if (n < 0)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "n < 0");
-
- if (n == 0)
- return 1;
-
- return n * factorial(n - 1);
- }
-
- /* Compute the natural log of the factorial of a non-negative
- * integer
- */
- double
- lnfactorial (const int &n)
- {
- if (n < 0)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "n < 0");
-
- double x = n+1;
- double cof[6] = {
- 76.18009172947146, -86.50532032941677,
- 24.01409824083091, -1.231739572450155,
- 0.1208650973866179e-2, -0.5395239384953e-5
- };
- double y = x;
- double tmp = x + 5.5 - (x + 0.5) * ::log(x + 5.5);
- double ser = 1.000000000190015;
- for (int j = 0; j <= 5; j++) {
- ser += (cof[j] / ++y);
- }
- return(std::log(2.5066282746310005 * ser / x) - tmp);
- }
-
- /*********************************
- * Fully Specified Distributions *
- *********************************/
-
- /**** The Beta Distribution ****/
-
- /* CDFs */
- double
- pbeta(const double& x, const double& pin, const double& qin)
- {
- if (pin <= 0 || qin <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "pin or qin <= 0");
- }
-
- if (x <= 0)
- return 0.;
- if (x >= 1)
- return 1.;
-
- return INTERNAL::pbeta_raw(x,pin,qin);
- }
-
- Matrix<double>
- pbeta(const int& rows, const int& cols, const double& x,
- const double& pin, const double& qin)
- {
- int size = rows*cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i=0; i<size; i++)
- temp[i] = pbeta(x,pin,qin);
-
- return temp;
- }
-
- /* PDFs */
- double
- dbeta(const double& x, const double& a, const double& b)
- {
- if ((x < 0.0) || (x > 1.0)) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "x not in [0,1]");
- }
- if (a < 0.0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "a < 0");
- }
- if (b < 0.0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "b < 0");
- }
-
- return (std::pow(x, (a-1.0)) * std::pow((1.0-x), (b-1.0)) )
- / betafn(a,b);
- }
-
- Matrix<double>
- dbeta(const int& rows, const int& cols, const double& x,
- const double& a, const double& b)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dbeta(x,a,b);
-
- return temp;
- }
-
- /* Returns the natural log of the ordinate of the Beta density
- * evaluated at x with Shape1 a, and Shape2 b
- */
- double
- lndbeta1(const double& x, const double& a, const double& b)
- {
- if ((x < 0.0) || (x > 1.0)) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "x not in [0,1]");
- }
- if (a < 0.0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "a < 0");
- }
- if (b < 0.0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "b < 0");
- }
-
- return (a-1.0) * std::log(x) + (b-1) * std::log(1.0-x)
- - lnbetafn(a,b);
- }
-
- /**** The Binomial Distribution ****/
-
- /* CDFs */
- double
- pbinom(const double &x, const double &n,const double &p)
- {
- double N = std::floor(n + 0.5);
-
- if (N <= 0 || p < 0 || p > 1){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "floor(n + 0.5) <= 0 or p < 0 or p > 1");
- }
- double X = std::floor(x);
-
- if (X < 0.0)
- return 0;
-
- if (N <= X)
- return 1;
-
- return pbeta(1 - p, N - X, X + 1);
- }
-
- Matrix<double>
- pbinom (const int& rows, const int& cols, const double& x,
- const double& n, const double& p)
- {
- int size = rows*cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for(int i = 0; i < size; i++)
- temp[i] = pbinom(x,n,p);
-
- return temp;
- }
-
- /* PDFs */
- double
- dbinom(const double& x, const double& n, const double& p)
- {
- if (p < 0 || p > 1) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p not in [0,1]");
- }
-
- double N = floor(n + 0.5);
- double X = floor(x + 0.5);
-
- return INTERNAL::dbinom_raw(X, N, p, 1 - p);
- }
-
- Matrix<double>
- dbinom( const int& rows, const int& cols, const double& x,
- const double& n, const double& p)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dbinom(x,n,p);
-
- return temp;
- }
-
- /**** The Chi Squared Distribution ****/
-
- /* CDFs */
- double
- pchisq(const double& x, const double& df)
- {
- return pgamma(x, df/2.0, 2.0);
- }
-
-
- Matrix<double>
- pchisq (const int& rows, const int& cols, const double& x,
- const double& df)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
-
- for (int i = 0; i < size; i++)
- temp[i] = pchisq(x,df);
-
- return temp;
- }
-
- /* PDFs */
- double
- dchisq(const double& x, const double& df)
- {
- return dgamma(x, df / 2.0, 2.0);
- }
-
- Matrix<double>
- dchisq( const int& rows, const int& cols, const double& x,
- const double& df)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dchisq(x,df);
-
- return temp;
- }
-
- /**** The Exponential Distribution ****/
-
- /* CDFs */
- double
- pexp(const double& x, const double& scale)
- {
- if (scale <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "scale <= 0");
- }
-
- if (x <= 0)
- return 0;
-
- return (1 - std::exp(-x*scale));
- }
-
- Matrix<double>
- pexp( const int& rows, const int& cols, const double& x,
- const double& scale)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = pexp(x,scale);
-
- return temp;
- }
-
- /* PDFs */
- double
- dexp(const double& x, const double& scale)
- {
- if (scale <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "scale <= 0");
- }
-
- if (x < 0)
- return 0;
-
- return std::exp(-x * scale) * scale;
- }
-
- Matrix<double>
- dexp( const int& rows, const int& cols, const double& x,
- const double& scale)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dexp(x,scale);
-
- return temp;
- }
-
- /**** The f Distribution ****/
-
- /* CDFs */
- double
- pf(const double& x, const double& n1, const double& n2)
- {
- if (n1 <= 0 || n2 <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "n1 or n2 <= 0");
- }
-
- if (x <= 0)
- return 0;
-
- if (n2 > 4e5)
- return pchisq(x*n1,n1);
- if (n1 > 4e5)
- return 1-pchisq(n2/x,n2);
-
- return (1-pbeta(n2/(n2+n1*x),n2/2.0,n1/2.0));
- }
-
- Matrix<double>
- pf (const int& rows, const int& cols, const double& x,
- const double& n1, const double& n2)
- {
- int size = rows * cols;
- if (size <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for(int i = 0; i < size; i++)
- temp [i] = pf(x,n1,n2);
-
- return temp;
- }
-
- /* PDFs */
- double
- df(const double& x, const double& m, const double& n)
- {
- double dens;
-
- if (m <= 0 || n <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "m or n <= 0");
- }
-
- if (x <= 0)
- return 0;
-
- double f = 1 / (n + x * m);
- double q = n * f;
- double p = x * m * f;
-
- if (m >= 2) {
- f = m * q / 2;
- dens = INTERNAL::dbinom_raw((m - 2) / 2,(m + n - 2) / 2, p, q);
- } else {
- f = (m * m * q) /(2 * p * (m + n));
- dens = INTERNAL::dbinom_raw(m / 2,(m + n)/ 2, p, q);
- }
-
- return f*dens;
- }
-
- Matrix<double>
- df( const int& rows, const int& cols, const double& x,
- const double& m, const double& n)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = df(x, m, n);
-
- return temp;
- }
-
- /**** The Gamma Distribution ****/
-
- /* CDFs */
- double
- pgamma (double x, const double &alph, const double &scale)
- {
- const double xbig = 1.0e+8, xlarge = 1.0e+37,
- alphlimit = 1000.;/* normal approx. for alph > alphlimit */
-
- int lower_tail = 1;
-
- double pn1, pn2, pn3, pn4, pn5, pn6, arg, a, b, c, an, osum, sum;
- long n;
- int pearson;
-
- /* check that we have valid values for x and alph */
-
- if(alph <= 0. || scale <= 0.)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "alph or scale <= 0");
-
- x /= scale;
-
- if (x <= 0.)
- return 0.0;
-
- /* use a normal approximation if alph > alphlimit */
-
- if (alph > alphlimit) {
- pn1 = std::sqrt(alph) * 3. * (std::pow(x/alph, 1./3.) + 1.
- / (9. * alph) - 1.);
- return pnorm(pn1, 0., 1.);
- }
-
- /* if x is extremely large __compared to alph__ then return 1 */
-
- if (x > xbig * alph)
- return 1.0;
-
- if (x <= 1. || x < alph) {
- pearson = 1;/* use pearson's series expansion. */
- arg = alph * std::log(x) - x - lngammafn(alph + 1.);
- c = 1.;
- sum = 1.;
- a = alph;
- do {
- a += 1.;
- c *= x / a;
- sum += c;
- } while (c > DBL_EPSILON);
- arg += std::log(sum);
- }
- else { /* x >= max( 1, alph) */
- pearson = 0;/* use a continued fraction expansion */
- arg = alph * std::log(x) - x - lngammafn(alph);
- a = 1. - alph;
- b = a + x + 1.;
- pn1 = 1.;
- pn2 = x;
- pn3 = x + 1.;
- pn4 = x * b;
- sum = pn3 / pn4;
- for (n = 1; ; n++) {
- a += 1.;/* = n+1 -alph */
- b += 2.;/* = 2(n+1)-alph+x */
- an = a * n;
- pn5 = b * pn3 - an * pn1;
- pn6 = b * pn4 - an * pn2;
- if (std::fabs(pn6) > 0.) {
- osum = sum;
- sum = pn5 / pn6;
- if (std::fabs(osum - sum) <= DBL_EPSILON * min(1., sum))
- break;
- }
- pn1 = pn3;
- pn2 = pn4;
- pn3 = pn5;
- pn4 = pn6;
- if (std::fabs(pn5) >= xlarge) {
- /* re-scale terms in continued fraction if they are large */
- pn1 /= xlarge;
- pn2 /= xlarge;
- pn3 /= xlarge;
- pn4 /= xlarge;
- }
- }
- arg += std::log(sum);
- }
-
- lower_tail = (lower_tail == pearson);
-
- sum = exp(arg);
-
- return (lower_tail) ? sum : 1 - sum;
- }
-
- Matrix<double>
- pgamma( const int& rows, const int& cols, const double& x,
- const double& alph, const double& scale)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = pgamma(x, alph, scale);
-
- return temp;
- }
-
-
- /* PDFs */
- double
- dgamma(const double& x, const double& shape, const double& scale)
- {
- if (shape <= 0 || scale <= 0)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "shape or scale <= 0");
-
-
- if (x < 0)
- return 0.0;
-
- if (x == 0) {
- if (shape < 1)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "x == 0 and shape < 1");
-
- if (shape > 1)
- return 0.0;
-
- return 1 / scale;
- }
-
- if (shape < 1) {
- double pr = INTERNAL::dpois_raw(shape, x/scale);
- return pr * shape / x;
- }
-
- /* else shape >= 1 */
- double pr = INTERNAL::dpois_raw(shape - 1, x / scale);
- return pr / scale;
- }
-
- Matrix<double>
- dgamma( const int& rows, const int& cols, const double& x,
- const double& shape, const double& scale)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dgamma(x, shape, scale);
-
- return temp;
- }
-
- /**** The Logistic Distribution ****/
-
- /* CDFs */
- double
- plogis (const double& x, const double& location,
- const double& scale)
- {
- if (scale <= 0.0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "scale <= 0");
- }
-
- double X = (x-location) / scale;
-
- X = std::exp(-X);
-
- return 1 / (1+X);
- }
-
- Matrix<double>
- plogis (const int& rows, const int& cols, const double& x,
- const double& location, const double& scale)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = plogis(x,location,scale);
-
- return temp;
- }
-
- /* PDFs */
- double
- dlogis( const double& x, const double& location,
- const double& scale)
- {
- if (scale <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "scale <= 0");
- }
-
- double X = (x - location) / scale;
- double e = std::exp(-X);
- double f = 1.0 + e;
-
- return e / (scale * f * f);
- }
-
- Matrix<double>
- dlogis( const int& rows, const int& cols, const double& x,
- const double& location, const double& scale)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dlogis(x,location,scale);
-
- return temp;
- }
-
- double
- lndlogis( const double& x, const double& location,
- const double& scale)
- {
- if (scale <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "scale <= 0");
- }
-
- double X = (x - location) / scale;
- double e = std::exp(-X);
- double f = 1.0 + e;
- return std::log(e) - std::log(scale) - 2.0*std::log(f);
- }
-
- Matrix<double>
- lndlogis( const int& rows, const int& cols, const double& x,
- const double& location, const double& scale)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = lndlogis(x,location,scale);
-
- return temp;
- }
-
- /**** The Log Normal Distribution ****/
-
- /* CDFs */
-
- double
- plnorm (const double& x, const double &logmean,
- const double & logsd)
- {
- if (logsd <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "logsd <= 0");
- }
-
- if (x > 0)
- return pnorm(std::log(x), logmean, logsd);
-
- return 0;
- }
-
- Matrix<double>
- plnorm (const int& rows, const int& cols, const double& x,
- const double& logmean, const double& logsd)
- {
- int size = rows * cols;
- if (size <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for(int i=0; i<size; i++)
- temp[i] = plnorm(x,logmean,logsd);
-
- return temp;
- }
-
- /* PDFs */
- double
- dlnorm( const double& x, const double& logmean,
- const double& logsd)
- {
- if (logsd <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "logsd <= 0");
- }
-
- if (x == 0)
- return 0;
-
- double y = (::log(x) - logmean) / logsd;
-
- return (1 / (::sqrt(2 * M_PI))) * ::exp(-0.5 * y * y) / (x * logsd);
- }
-
- Matrix<double>
- dlnorm( const int& rows, const int& cols, const double& x,
- const double& logmean, const double& logsd)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dlnorm(x, logmean, logsd);
-
- return temp;
- }
-
- /**** The Negative Binomial Distribution ****/
-
- /* CDFs */
- double
- pnbinom(const double& x, const double& n, const double& p)
- {
- if (n <= 0 || p <= 0 || p >= 1){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "n <= 0 or p not in (0,1)");
- }
-
- double X = floor(x + 1e-7);
-
- if (X < 0)
- return 0.0;
-
- return pbeta(p, n, X + 1);
- }
-
- Matrix<double>
- pnbinom(const int& rows, const int& cols, const double& x,
- const double& n, const double& p)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
-
- for (int i = 0; i < size; i++)
- temp[i] = pnbinom(x,n,p);
-
- return temp;
- }
-
- /* PDFs */
- double
- dnbinom(const double& x, const double& n, const double& p)
- {
- if (p < 0 || p > 1 || n <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p not in [0,1] or n <= 0");
- }
-
- if (x < 0)
- return 0;
-
- double X = floor(x + 0.5);
-
- double prob = INTERNAL::dbinom_raw(n, X + n, p, 1 - p);
- double P = (double) n / (n + x);
-
- return P * prob;
- }
-
- Matrix<double>
- dnbinom(const int& rows, const int& cols, const double& x,
- const double& n, const double& p)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dnbinom(x,n,p);
-
- return temp;
- }
-
-
- /**** The Normal Distribution ****/
-
- /* CDFs */
- double
- pnorm (const double &x, const double &mu, const double &sigma)
-
- {
- if (sigma <= 0)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "negative standard deviation");
-
- return pnorm2((x - mu) / sigma, true, false);
- }
-
- Matrix<double>
- pnorm(const int& rows, const int& cols, const double& x,
- const double& mu, const double& sigma)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = pnorm(x,mu,sigma);
-
- return temp;
- }
-
- /* PDFs */
- double
- dnorm(const double& x, const double& mu,
- const double& sigma)
- {
- if (sigma <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "negative standard deviation");
- }
-
- double X = (x - mu) / sigma;
-
- return (M_1_SQRT_2PI * std::exp(-0.5 * X * X) / sigma);
- }
-
- Matrix<double>
- dnorm(const int& rows, const int& cols, const double& x,
- const double& mu, const double& sigma)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dnorm(x,mu,sigma);
-
- return temp;
- }
-
- /* A newer version of pnorm for 0.4+. The pnorm wrapper has been
- * updated to use this function, as have library calls that
- * previously used pnorm1.
- */
-
- // Many original comments left in for reference.
-
-#define SIXTEN 16
-#define do_del(X) \
- xsq = trunc(X * SIXTEN) / SIXTEN; \
- del = (X - xsq) * (X + xsq); \
- if(log_p) { \
- *cum = (-xsq * xsq * 0.5) + (-del * 0.5) + log(temp); \
- if((lower && x > 0.) || (upper && x <= 0.)) \
- *ccum = log1p(-exp(-xsq * xsq * 0.5) * \
- exp(-del * 0.5) * temp); \
- } \
- else { \
- *cum = exp(-xsq * xsq * 0.5) * exp(-del * 0.5) * temp; \
- *ccum = 1.0 - *cum; \
- }
-
-#define swap_tail \
- if (x > 0.) {/* swap ccum <--> cum */ \
- temp = *cum; if(lower) *cum = *ccum; *ccum = temp; \
- }
-
- void
- pnorm_both( double x, double *cum, double *ccum, int i_tail,
- bool log_p)
- {
- const double a[5] = {
- 2.2352520354606839287,
- 161.02823106855587881,
- 1067.6894854603709582,
- 18154.981253343561249,
- 0.065682337918207449113
- };
- const double b[4] = {
- 47.20258190468824187,
- 976.09855173777669322,
- 10260.932208618978205,
- 45507.789335026729956
- };
- const double c[9] = {
- 0.39894151208813466764,
- 8.8831497943883759412,
- 93.506656132177855979,
- 597.27027639480026226,
- 2494.5375852903726711,
- 6848.1904505362823326,
- 11602.651437647350124,
- 9842.7148383839780218,
- 1.0765576773720192317e-8
- };
- const double d[8] = {
- 22.266688044328115691,
- 235.38790178262499861,
- 1519.377599407554805,
- 6485.558298266760755,
- 18615.571640885098091,
- 34900.952721145977266,
- 38912.003286093271411,
- 19685.429676859990727
- };
- const double p[6] = {
- 0.21589853405795699,
- 0.1274011611602473639,
- 0.022235277870649807,
- 0.001421619193227893466,
- 2.9112874951168792e-5,
- 0.02307344176494017303
- };
- const double q[5] = {
- 1.28426009614491121,
- 0.468238212480865118,
- 0.0659881378689285515,
- 0.00378239633202758244,
- 7.29751555083966205e-5
- };
-
- double xden, xnum, temp, del, eps, xsq, y;
- int i, lower, upper;
-
- /* Consider changing these : */
- eps = DBL_EPSILON * 0.5;
-
- /* i_tail in {0,1,2} =^= {lower, upper, both} */
- lower = i_tail != 1;
- upper = i_tail != 0;
-
- y = std::fabs(x);
- if (y <= 0.67448975) {
- /* qnorm(3/4) = .6744.... -- earlier had 0.66291 */
- if (y > eps) {
- xsq = x * x;
- xnum = a[4] * xsq;
- xden = xsq;
- for (i = 0; i < 3; ++i) {
- xnum = (xnum + a[i]) * xsq;
- xden = (xden + b[i]) * xsq;
- }
- } else xnum = xden = 0.0;
-
- temp = x * (xnum + a[3]) / (xden + b[3]);
- if(lower) *cum = 0.5 + temp;
- if(upper) *ccum = 0.5 - temp;
- if(log_p) {
- if(lower) *cum = log(*cum);
- if(upper) *ccum = log(*ccum);
- }
- } else if (y <= M_SQRT_32) {
- /* Evaluate pnorm for 0.674.. = qnorm(3/4) < |x| <= sqrt(32)
- * ~= 5.657 */
-
- xnum = c[8] * y;
- xden = y;
- for (i = 0; i < 7; ++i) {
- xnum = (xnum + c[i]) * y;
- xden = (xden + d[i]) * y;
- }
- temp = (xnum + c[7]) / (xden + d[7]);
- do_del(y);
- swap_tail;
- } else if (log_p
- || (lower && -37.5193 < x && x < 8.2924)
- || (upper && -8.2929 < x && x < 37.5193)
- ) {
- /* Evaluate pnorm for x in (-37.5, -5.657) union (5.657, 37.5) */
- xsq = 1.0 / (x * x);
- xnum = p[5] * xsq;
- xden = xsq;
- for (i = 0; i < 4; ++i) {
- xnum = (xnum + p[i]) * xsq;
- xden = (xden + q[i]) * xsq;
- }
- temp = xsq * (xnum + p[4]) / (xden + q[4]);
- temp = (M_1_SQRT_2PI - temp) / y;
- do_del(x);
- swap_tail;
- } else {
- if (x > 0) {
- *cum = 1.;
- *ccum = 0.;
- } else {
- *cum = 0.;
- *ccum = 1.;
- }
- if (THROW_ON_NONCONV)
- throw scythe_convergence_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("x (") & x & "did not converge");
- }
-
- return;
- }
-#undef SIXTEN
-#undef do_del
-#undef swap_tail
-
- double
- pnorm2 (const double &x, const bool &lower_tail, const bool &log_p)
- {
- if (! finite(x))
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Quantile x is inifinte (+/-Inf) or NaN");
-
- double p, cp;
- pnorm_both(x, &p, &cp, (lower_tail ? 0 : 1), log_p);
-
- return (lower_tail ? p : cp);
- }
-
- /* Returns the quantile of the standard normal distribution
- * associated with a given probability p
- */
- double
- qnorm1 (const double& in_p)
- {
- double lim = 10e-20;
- double p0 = -0.322232431088;
- double q0 = 0.0993484626060;
- double p1 = -1.0;
- double q1 = 0.588581570495;
- double p2 = -0.342242088547;
- double q2 = 0.531103462366;
- double p3 = -0.0204231210245;
- double q3 = 0.103537752850;
- double p4 = -0.453642210148e-4;
- double q4 = 0.38560700634e-2;
- double xp = 0.0;
- double p = in_p;
-
- if (p > 0.5)
- p = 1 - p;
-
- if (p < lim) {
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p outside accuracy limit");
- }
-
- if (p == 0.5)
- return xp;
-
- double y = ::sqrt (::log (1.0 / ::pow (p, 2)));
- xp = y + ((((y * p4 + p3) * y + p2) * y + p1) * y + p0) /
- ((((y * q4 + q3) * y + q2) * y + q1) * y + q0);
-
- if (in_p < 0.5)
- xp = -1 * xp;
-
- return xp;
- }
-
- /* Return the natrual log of the normal PDF */
- double
- lndnorm (const double& x, const double& mu, const double& sigma)
- {
- if (sigma < 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "negative standard deviation");
- }
-
- if (sigma == 0.0){
- if (x != mu){
- return -std::numeric_limits<double>::infinity();
- }
- else {
- return std::numeric_limits<double>::infinity();
- }
- }
-
- double X = (x - mu) / sigma;
-
- return -(M_LN_SQRT_2PI + 0.5 * X * X + std::log(sigma));
- }
-
- /**** The Poison Distribution ****/
-
- /* CDFs */
- double
- ppois(const double& x, const double& lambda)
- {
- if(lambda<=0.0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "lambda <= 0");
- }
-
- double X = floor(x + 1e-7);
-
- if (X < 0)
- return 0;
- if (lambda == 1)
- return 1;
-
- return 1 - pgamma(lambda, X + 1, 1.0);
- }
-
- Matrix<double>
- ppois(const int& rows, const int& cols, const double& x,
- const double& lambda)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = ppois(x,lambda);
-
- return temp;
- }
-
- /* PDFs */
- double
- dpois(const int &x, const double &lambda)
- {
- if (x < 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "x < 0");
- }
- if (lambda <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "lambda <= 0");
- }
-
- // compute log(x!)
- double xx = x+1;
- double cof[6] = {
- 76.18009172947146, -86.50532032941677,
- 24.01409824083091, -1.231739572450155,
- 0.1208650973866179e-2, -0.5395239384953e-5
- };
- double y = xx;
- double tmp = xx + 5.5 - (xx + 0.5) * ::log(xx + 5.5);
- double ser = 1.000000000190015;
- for (int j = 0; j <= 5; j++) {
- ser += (cof[j] / ++y);
- }
- double lnfactx = ::log(2.5066282746310005 * ser / xx) - tmp;
-
- return (::exp( -1*lnfactx + x * ::log(lambda) - lambda));
- }
-
- Matrix<double>
- dpois(const int& rows, const int& cols, const double& x,
- const double& lambda)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dpois((int)x,lambda);
-
- return temp;
- }
-
- /**** The t Distribution ****/
-
- /* CDFs */
- double
- pt(const double& x, const double& n)
- {
- double val;
-
- if (n <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "n <= 0");
- }
-
- if (n > 4e5) {
- val = 1/(4*n);
- return pnorm2(x * (1 - val) / ::sqrt(1 + x * x * 2. * val),
- true, false);
- }
-
- val = pbeta(n / (n + x * x), n / 2.0, 0.5);
-
- val /= 2;
-
- if (x <= 0)
- return val;
- else
- return 1 - val;
- }
-
- Matrix<double>
- pt(const int& rows, const int& cols, const double& x, const double& n)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = pt(x,n);
-
- return temp;
- }
-
- /* PDFs */
- double
- dt(const double& x, const double& n)
- {
- double u;
- if (n <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "n <= 0");
- }
-
- double t = -INTERNAL::bd0(n/2., (n + 1) / 2.)
- + INTERNAL::stirlerr((n + 1) / 2.)
- - INTERNAL::stirlerr(n / 2.);
- if(x*x > 0.2*n)
- u = std::log(1+x*x/n)*n/2;
- else
- u = -INTERNAL::bd0(n/2., (n+x*x)/2.) + x*x/2;
-
- return std::exp(t-u)/std::sqrt(2*M_PI*(1+x*x/n));
- }
-
- Matrix<double>
- dt(const int& rows, const int& cols, const double& x, const double& n)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dt(x,n);
-
- return temp;
- }
-
- /* Other */
-
- /* Returns the univariate Student-t density evaluated at x
- * with mean mu, scale sigma^2, and nu degrees of freedom
- */
- double
- dt1(const double& x, const double& mu, const double& sigma2,
- const double& nu)
- {
- double logdens = lngammafn((nu + 1.0) /2.0)
- - std::log(std::sqrt(nu * M_PI))
- - lngammafn(nu / 2.0) - std::log(std::sqrt(sigma2))
- - (nu + 1.0) / 2.0 * std::log(1.0 + (std::pow((x - mu), 2.0))
- / (nu * sigma2));
-
- return(std::exp(logdens));
- }
-
- /* Returns the natural log of the univariate Student-t density
- * evaluated at x with mean mu, scale sigma^2, and nu
- * degrees of freedom
- */
- double
- lndt1( const double& x, const double& mu, const double& sigma2,
- const double& nu)
- {
- double logdens = lngammafn((nu+1.0)/2.0)
- - std::log(std::sqrt(nu*M_PI))
- - lngammafn(nu/2.0) - std::log(std::sqrt(sigma2))
- - (nu+1.0)/2.0 * std::log(1.0 + (std::pow((x-mu),2.0))
- /(nu * sigma2));
-
- return(logdens);
- }
-
- /**** The Uniform Distribution ****/
-
- /* CDFs */
- double
- punif(const double& x, const double& a, const double& b)
- {
- if (b <= a) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "b <= a");
- }
-
- if (x <= a)
- return 0.0;
-
- if (x >= b)
- return 1.0;
-
- return (x - a) / (b - a);
- }
-
- Matrix<double>
- punif(const int& rows, const int& cols, const double& x,
- const double& a, const double& b)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = punif(x,a,b);
-
- return temp;
- }
-
- /* PDFs */
- double
- dunif(const double& x, const double& a, const double& b)
- {
- if (b <= a) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "b <= a");
- }
-
- if (a <= x && x <= b)
- return 1.0 / (b - a);
-
- return 0.0;
- }
-
- Matrix<double>
- dunif(const int& rows, const int& cols, const double& x,
- const double& a, const double& b)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dunif(x,a,b);
-
- return temp;
- }
-
- /**** The Weibull Distribution ****/
-
- /* CDFs */
- double
- pweibull( const double& x, const double& shape,
- const double& scale)
- {
- if (shape <= 0 || scale <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "shape or scale <= 0");
- }
-
- if (x <= 0)
- return 0.0;
-
- return 1 - std::exp(-std::pow(x / scale, shape));
- }
-
- Matrix<double>
- pweibull( const int& rows, const int& cols, const double& x,
- const double& shape, const double& scale)
- {
- int size = rows * cols;
- if (size <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = pweibull(x,shape,scale);
-
- return temp;
- }
-
- /* PDFs */
- double
- dweibull( const double& x, const double& shape,
- const double& scale)
- {
- if (shape <= 0 || scale <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "shape or scale <= 0");
- }
- if (x < 0)
- return 0;
-
- double tmp1 = std::pow(x / scale, shape - 1);
- double tmp2 = tmp1*(x / scale);
-
- return shape * tmp1 * std::exp(-tmp2) / scale;
- }
-
- Matrix<double>
- dweibull( const int& rows, const int& cols, const double& x,
- const double& shape, const double& scale)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = dweibull(x,shape,scale);
-
- return temp;
- }
-
- /************************************
- * Partially Finished Distributions *
- ************************************/
-
- /* Multivariate Normal */
- double
- lndmvn (const Matrix<double> &x, const Matrix<double> &mu,
- const Matrix<double> &Sigma)
- {
- if (! x.isColVector()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "x not column vector");
- }
- if (! mu.isColVector()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "mu not column vector");
- }
- if (! Sigma.isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Sigma not square");
- }
- if (mu.rows() != Sigma.rows() || x.rows() != Sigma.rows()){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "mu, x have different number of rows than Sigma");
- }
- int k = mu.rows();
- return ( (-k/2.0)*::log(2*M_PI) -0.5 * ::log(~Sigma)
- -0.5 * (!(x - mu)) * invpd(Sigma) * (x-mu) )[0];
- }
-
- /********************
- * Helper Functions *
- ********************/
- namespace INTERNAL {
-
- /* Evaluate a Chebysheve series at a given point */
- double
- chebyshev_eval (const double &x, const double *a,
- const int &n)
- {
- if (n < 1 || n > 1000)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "n not on [1, 1000]");
-
- if (x < -1.1 || x > 1.1)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "x not on [-1.1, 1.1]");
-
- double b0, b1, b2;
- b0 = b1 = b2 = 0;
-
- double twox = x * 2;
-
- for (int i = 1; i <= n; ++i) {
- b2 = b1;
- b1 = b0;
- b0 = twox * b1 - b2 + a[n - i];
- }
-
- return (b0 - b2) * 0.5;
- }
-
- /* Computes the log gamma correction factor for x >= 10 */
- double
- lngammacor(const double &x)
- {
- const double algmcs[15] = {
- +.1666389480451863247205729650822e+0,
- -.1384948176067563840732986059135e-4,
- +.9810825646924729426157171547487e-8,
- -.1809129475572494194263306266719e-10,
- +.6221098041892605227126015543416e-13,
- };
-
- if (x < 10) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "This function requires x >= 10");
- } else if (x >= 3.745194030963158e306) {
- throw scythe_range_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Underflow");
-
- } else if (x < 94906265.62425156) {
- double tmp = 10 / x;
- return chebyshev_eval(tmp * tmp * 2 - 1, algmcs, 5) / x;
- }
-
- return 1 / (x * 12);
- }
-
- /* Helper for dpois and dgamma */
- double
- dpois_raw (const double &x, const double &lambda)
- {
- if (lambda == 0)
- return ( (x == 0) ? 1.0 : 0.0);
-
- if (x == 0)
- return std::exp(-lambda);
-
- if (x < 0)
- return 0.0;
-
- return std::exp(-stirlerr(x) - bd0(x, lambda))
- / std::sqrt(2 * M_PI * x);
- }
-
- /* Evaluates the "deviance part" */
- double
- bd0(const double &x, const double &np)
- {
-
- if(std::fabs(x - np) < 0.1 * (x + np)) {
- double v = (x - np) / (x + np);
- double s = (x - np) * v;
- double ej = 2 * x * v;
- v = v * v;
- for (int j = 1; ; j++) {
- ej *= v;
- double s1 = s + ej / ((j << 1) + 1);
- if (s1 == s)
- return s1;
- s = s1;
- }
- }
-
- return x * std::log(x / np) + np - x;
- }
-
- /* Computes the log of the error term in Stirling's formula */
- double
- stirlerr(const double &n)
- {
-#define S0 0.083333333333333333333 /* 1/12 */
-#define S1 0.00277777777777777777778 /* 1/360 */
-#define S2 0.00079365079365079365079365 /* 1/1260 */
-#define S3 0.000595238095238095238095238 /* 1/1680 */
-#define S4 0.0008417508417508417508417508/* 1/1188 */
-
- /* error for 0, 0.5, 1.0, 1.5, ..., 14.5, 15.0 */
- const double sferr_halves[31] = {
- 0.0, /* n=0 - wrong, place holder only */
- 0.1534264097200273452913848, /* 0.5 */
- 0.0810614667953272582196702, /* 1.0 */
- 0.0548141210519176538961390, /* 1.5 */
- 0.0413406959554092940938221, /* 2.0 */
- 0.03316287351993628748511048, /* 2.5 */
- 0.02767792568499833914878929, /* 3.0 */
- 0.02374616365629749597132920, /* 3.5 */
- 0.02079067210376509311152277, /* 4.0 */
- 0.01848845053267318523077934, /* 4.5 */
- 0.01664469118982119216319487, /* 5.0 */
- 0.01513497322191737887351255, /* 5.5 */
- 0.01387612882307074799874573, /* 6.0 */
- 0.01281046524292022692424986, /* 6.5 */
- 0.01189670994589177009505572, /* 7.0 */
- 0.01110455975820691732662991, /* 7.5 */
- 0.010411265261972096497478567, /* 8.0 */
- 0.009799416126158803298389475, /* 8.5 */
- 0.009255462182712732917728637, /* 9.0 */
- 0.008768700134139385462952823, /* 9.5 */
- 0.008330563433362871256469318, /* 10.0 */
- 0.007934114564314020547248100, /* 10.5 */
- 0.007573675487951840794972024, /* 11.0 */
- 0.007244554301320383179543912, /* 11.5 */
- 0.006942840107209529865664152, /* 12.0 */
- 0.006665247032707682442354394, /* 12.5 */
- 0.006408994188004207068439631, /* 13.0 */
- 0.006171712263039457647532867, /* 13.5 */
- 0.005951370112758847735624416, /* 14.0 */
- 0.005746216513010115682023589, /* 14.5 */
- 0.005554733551962801371038690 /* 15.0 */
- };
- double nn;
-
- if (n <= 15.0) {
- nn = n + n;
- if (nn == (int)nn)
- return(sferr_halves[(int)nn]);
- return (lngammafn(n + 1.) - (n + 0.5) * std::log(n) + n -
- std::log(std::sqrt(2 * M_PI)));
- }
-
- nn = n*n;
- if (n > 500)
- return((S0 - S1 / nn) / n);
- if (n > 80)
- return((S0 - (S1 - S2 / nn) / nn) / n);
- if (n > 35)
- return((S0 - (S1 - (S2 - S3 / nn) / nn) / nn) / n);
- /* 15 < n <= 35 : */
- return((S0 - (S1 - (S2 - (S3 - S4 / nn) / nn) / nn) / nn) / n);
- }
-
- /* helper for pbeta */
- double
- pbeta_raw(const double& x, const double& pin, const double& qin)
- {
- double ans, c, finsum, p, ps, p1, q, term, xb, xi, y;
- int n, i, ib, swap_tail;
-
- const double eps = .5 * DBL_EPSILON;
- const double sml = DBL_MIN;
- const double lneps = std::log(eps);
- const double lnsml = std::log(eps);
-
- if (pin / (pin + qin) < x) {
- swap_tail = 1;
- y = 1 - x;
- p = qin;
- q = pin;
- } else {
- swap_tail=0;
- y = x;
- p = pin;
- q = qin;
- }
-
- if ((p + q) * y / (p + 1) < eps) {
- ans = 0;
- xb = p * std::log(max(y,sml)) - std::log(p) - lnbetafn(p,q);
- if (xb > lnsml && y != 0)
- ans = std::exp(xb);
- if (swap_tail)
- ans = 1-ans;
- } else {
- ps = q - std::floor(q);
- if (ps == 0)
- ps = 1;
- xb = p * std::log(y) - lnbetafn(ps, p) - std::log(p);
- ans = 0;
- if (xb >= lnsml) {
- ans = std::exp(xb);
- term = ans * p;
- if (ps != 1) {
- n = (int)max(lneps/std::log(y), 4.0);
- for(i = 1; i <= n; i++){
- xi = i;
- term *= (xi-ps)*y/xi;
- ans += term/(p+xi);
- }
- }
- }
- if (q > 1) {
- xb = p * std::log(y) + q * std::log(1 - y)
- - lnbetafn(p, q) - std::log(q);
- ib = (int) max(xb / lnsml, 0.0);
- term = std::exp(xb - ib * lnsml);
- c = 1 / (1 - y);
- p1 = q * c / (p + q - 1);
-
- finsum = 0;
- n = (int) q;
- if(q == n)
- n--;
- for (i = 1; i <= n; i++) {
- if(p1 <= 1 && term / eps <= finsum)
- break;
- xi = i;
- term = (q -xi + 1) * c * term / (p + q - xi);
- if (term > 1) {
- ib--;
- term *= sml;
- }
- if (ib == 0)
- finsum += term;
- }
- ans += finsum;
- }
-
- if(swap_tail)
- ans = 1-ans;
- ans = max(min(ans,1.),0.);
- }
- return ans;
- }
-
-
- double
- dbinom_raw (const double &x, const double &n, const double &p,
- const double &q)
- {
- double f, lc;
-
- if (p == 0)
- return((x == 0) ? 1.0 : 0.0);
- if (q == 0)
- return((x == n) ? 1.0 : 0.0);
-
- if (x == 0) {
- if(n == 0)
- return 1.0;
-
- lc = (p < 0.1) ? -bd0(n, n * q) - n * p : n * std::log(q);
- return(std::exp(lc));
- }
- if (x == n) {
- lc = (q < 0.1) ? -bd0(n,n * p) - n * q : n * std::log(p);
- return(std::exp(lc));
- }
-
- if (x < 0 || x > n)
- return 0.0;
-
- lc = stirlerr(n) - stirlerr(x) - stirlerr(n-x) - bd0(x,n*p) -
- bd0(n - x, n * q);
-
- f = (M_2PI * x * (n-x)) / n;
-
- return (std::exp(lc) / std::sqrt(f));
- }
-
-
- } // end namespace INTERNAL
-} // end namespace SCYTHE
-
-
-#endif
diff --git a/src/distributions.h b/src/distributions.h
index 77ca771..d2a2571 100644
--- a/src/distributions.h
+++ b/src/distributions.h
@@ -1,33 +1,106 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * scythestat/distributions.h
+ * scythestat/distributions.h
*
- * Provides definitions for PDFs, CDFs, and some common functions
- * (gamma, beta, etc).
+ */
+
+/*! \file distributions.h
+ *
+ * \brief Definitions for probability density functions
+ * (PDFs), cumulative distribution functions (CDFs), and some common
+ * functions (gamma, beta, etc).
+ *
+ * This file provides functions that evaluate the PDFs and CDFs of a
+ * number of probability distributions. In addition, it includes
+ * definitions for another of related functions, such as the gamma
+ * and beta functions.
+ *
+ * The various distribution functions in this file operate on both
+ * scalar quantiles and matrices of quantiles and the
+ * definitions of both forms of these functions appear below. We
+ * provide explicit documentation only for the scalar versions of the
+ * these functions and describe the Matrix versions in the scalar
+ * calls' documents. Much like the operators in matrix.h, we
+ * implement these overloaded versions of the distribution functions
+ * in terms of both generalized and default templates to allow for
+ * explicit control over the template type of the returned Matrix.
+ *
+ * \note Doxygen does not correctly expand the macro definitions we use
+ * to generate the Matrix versions of the various distribution
+ * functions. Therefore, it incorrectly substitutes the macro
+ * variable
+ * __VA_ARGS__ for the actual parameter values in the parameter lists
+ * of each of these functions. For example, the definitions of the
+ * Matrix versions of pbeta are listed as
+ * \code
+ * template<matrix_order RO, matrix_style RS, matrix_order PO, matrix_style PS>
+ * Matrix<double, RO, RS> scythe::pbeta (const Matrix<double, PO, PS> &X, __VA_ARGS__)
*
+ * template<matrix_order O, matrix_style S>
+ * Matrix<double, O, Concrete> scythe::pbeta (const Matrix<double, O, S> &X, __VA_ARGS__)
+ * \endcode
+ * when they should be
+ * \code
+ * template<matrix_order RO, matrix_style RS, matrix_order PO, matrix_style PS>
+ * Matrix<double, RO, RS> scythe::pbeta (const Matrix<double, PO, PS> &X, double a, double b)
+ *
+ * template<matrix_order O, matrix_style S>
+ * Matrix<double, O, Concrete> scythe::pbeta (const Matrix<double, O, S> &X, double a, double b)
+ * \endcode
+ *
+ * \par
+ * Furthermore, Doxygen erroneously lists a number of variables at the
+ * end of this document that are not, in fact, declared in
+ * distributions.h. Again, this error is a result of Doxygen's macro
+ * parsing capabilities.
+ *
+ */
+
+/* TODO: Figure out how to get doxygen to stop listing erroneous
+ * variables at the end of the doc for this file. They stem from it
+ * misreading the nested macro calls used to generate matrix procs.
*/
+/* TODO: Full R-style versions of these function including arbitrary
+ * recycling of matrix arguments. This is going to have to wait for
+ * variadic templates to be doable without a complete mess. There is
+ * currently a variadic patch available for g++, perhaps we can add a
+ * SCYTHE_VARIADIC flag and include these as option until they become
+ * part of the standard in 2009. Something to come back to after 1.0.
+ */
#ifndef SCYTHE_DISTRIBUTIONS_H
#define SCYTHE_DISTRIBUTIONS_H
+#include <iostream>
+#include <cmath>
#include <cfloat>
+#include <climits>
+#include <algorithm>
+#include <limits>
+
+#ifdef HAVE_IEEEFP_H
+#include <ieeefp.h>
+#endif
#ifdef SCYTHE_COMPILE_DIRECT
#include "matrix.h"
+#include "ide.h"
+#include "error.h"
#else
#include "scythestat/matrix.h"
+#include "scythestat/ide.h"
+#include "scythestat/error.h"
#endif
/* Fill in some defs from R that aren't in math.h */
@@ -40,337 +113,2433 @@
#define M_2PI 6.28318530717958647692528676655
#define M_SQRT_32 5.656854249492380195206754896838
-namespace SCYTHE {
+#ifndef HAVE_TRUNC
+/*! @cond */
+inline double trunc(double x) throw ()
+{
+ if (x >= 0)
+ return std::floor(x);
+ else
+ return std::ceil(x);
+}
+/*! @endcond */
+#endif
+
+/* Many random number generators, pdfs, cdfs, and functions (gamma,
+ * etc) in this file are based on code from the R Project, version
+ * 1.6.0-1.7.1. This code is available under the terms of the GNU
+ * GPL. Original copyright:
+ *
+ * Copyright (C) 1998 Ross Ihaka
+ * Copyright (C) 2000-2002 The R Development Core Team
+ * Copyright (C) 2003 The R Foundation
+ */
+
+namespace scythe {
+
+ /*! @cond */
+
+ /* Forward declarations */
+ double gammafn (double);
+ double lngammafn (double);
+ double lnbetafn (double, double);
+ double pgamma (double, double, double);
+ double dgamma(double, double, double);
+ double pnorm (double, double, double);
+
+ /*! @endcond */
+
+ /********************
+ * Helper Functions *
+ ********************/
+ namespace {
+
+ /* Evaluate a Chebysheve series at a given point */
+ double
+ chebyshev_eval (double x, const double *a, int n)
+ {
+ SCYTHE_CHECK_10(n < 1 || n > 1000, scythe_invalid_arg,
+ "n not on [1, 1000]");
+
+ SCYTHE_CHECK_10(x < -1.1 || x > 1.1, scythe_invalid_arg,
+ "x not on [-1.1, 1.1]");
+
+ double b0, b1, b2;
+ b0 = b1 = b2 = 0;
+
+ double twox = x * 2;
+
+ for (int i = 1; i <= n; ++i) {
+ b2 = b1;
+ b1 = b0;
+ b0 = twox * b1 - b2 + a[n - i];
+ }
+
+ return (b0 - b2) * 0.5;
+ }
+
+ /* Computes the log gamma correction factor for x >= 10 */
+ double
+ lngammacor(double x)
+ {
+ const double algmcs[15] = {
+ +.1666389480451863247205729650822e+0,
+ -.1384948176067563840732986059135e-4,
+ +.9810825646924729426157171547487e-8,
+ -.1809129475572494194263306266719e-10,
+ +.6221098041892605227126015543416e-13,
+ };
+
+ SCYTHE_CHECK_10(x < 10, scythe_invalid_arg,
+ "This function requires x >= 10");
+ SCYTHE_CHECK_10(x >= 3.745194030963158e306, scythe_range_error,
+ "Underflow");
+
+ if (x < 94906265.62425156) {
+ double tmp = 10 / x;
+ return chebyshev_eval(tmp * tmp * 2 - 1, algmcs, 5) / x;
+ }
+
+ return 1 / (x * 12);
+ }
+
+ /* Evaluates the "deviance part" */
+ double
+ bd0(double x, double np)
+ {
+
+ if(std::fabs(x - np) < 0.1 * (x + np)) {
+ double v = (x - np) / (x + np);
+ double s = (x - np) * v;
+ double ej = 2 * x * v;
+ v = v * v;
+ for (int j = 1; ; j++) {
+ ej *= v;
+ double s1 = s + ej / ((j << 1) + 1);
+ if (s1 == s)
+ return s1;
+ s = s1;
+ }
+ }
+
+ return x * std::log(x / np) + np - x;
+ }
+
+ /* Computes the log of the error term in Stirling's formula */
+ double
+ stirlerr(double n)
+ {
+#define S0 0.083333333333333333333 /* 1/12 */
+#define S1 0.00277777777777777777778 /* 1/360 */
+#define S2 0.00079365079365079365079365 /* 1/1260 */
+#define S3 0.000595238095238095238095238 /* 1/1680 */
+#define S4 0.0008417508417508417508417508/* 1/1188 */
+
+ /* error for 0, 0.5, 1.0, 1.5, ..., 14.5, 15.0 */
+ const double sferr_halves[31] = {
+ 0.0, /* n=0 - wrong, place holder only */
+ 0.1534264097200273452913848, /* 0.5 */
+ 0.0810614667953272582196702, /* 1.0 */
+ 0.0548141210519176538961390, /* 1.5 */
+ 0.0413406959554092940938221, /* 2.0 */
+ 0.03316287351993628748511048, /* 2.5 */
+ 0.02767792568499833914878929, /* 3.0 */
+ 0.02374616365629749597132920, /* 3.5 */
+ 0.02079067210376509311152277, /* 4.0 */
+ 0.01848845053267318523077934, /* 4.5 */
+ 0.01664469118982119216319487, /* 5.0 */
+ 0.01513497322191737887351255, /* 5.5 */
+ 0.01387612882307074799874573, /* 6.0 */
+ 0.01281046524292022692424986, /* 6.5 */
+ 0.01189670994589177009505572, /* 7.0 */
+ 0.01110455975820691732662991, /* 7.5 */
+ 0.010411265261972096497478567, /* 8.0 */
+ 0.009799416126158803298389475, /* 8.5 */
+ 0.009255462182712732917728637, /* 9.0 */
+ 0.008768700134139385462952823, /* 9.5 */
+ 0.008330563433362871256469318, /* 10.0 */
+ 0.007934114564314020547248100, /* 10.5 */
+ 0.007573675487951840794972024, /* 11.0 */
+ 0.007244554301320383179543912, /* 11.5 */
+ 0.006942840107209529865664152, /* 12.0 */
+ 0.006665247032707682442354394, /* 12.5 */
+ 0.006408994188004207068439631, /* 13.0 */
+ 0.006171712263039457647532867, /* 13.5 */
+ 0.005951370112758847735624416, /* 14.0 */
+ 0.005746216513010115682023589, /* 14.5 */
+ 0.005554733551962801371038690 /* 15.0 */
+ };
+ double nn;
+
+ if (n <= 15.0) {
+ nn = n + n;
+ if (nn == (int)nn)
+ return(sferr_halves[(int)nn]);
+ return (scythe::lngammafn(n + 1.) - (n + 0.5) * std::log(n) + n -
+ std::log(std::sqrt(2 * M_PI)));
+ }
+
+ nn = n*n;
+ if (n > 500)
+ return((S0 - S1 / nn) / n);
+ if (n > 80)
+ return((S0 - (S1 - S2 / nn) / nn) / n);
+ if (n > 35)
+ return((S0 - (S1 - (S2 - S3 / nn) / nn) / nn) / n);
+ /* 15 < n <= 35 : */
+ return((S0 - (S1 - (S2 - (S3 - S4 / nn) / nn) / nn) / nn) / n);
+#undef S1
+#undef S2
+#undef S3
+#undef S4
+ }
+
+
+ /* Helper for dpois and dgamma */
+ double
+ dpois_raw (double x, double lambda)
+ {
+ if (lambda == 0)
+ return ( (x == 0) ? 1.0 : 0.0);
+
+ if (x == 0)
+ return std::exp(-lambda);
+
+ if (x < 0)
+ return 0.0;
- void throw_on_nonconv (bool);
+ return std::exp(-stirlerr(x) - bd0(x, lambda))
+ / std::sqrt(2 * M_PI * x);
+ }
+
+
+ /* helper for pbeta */
+ double
+ pbeta_raw(double x, double pin, double qin)
+ {
+ double ans, c, finsum, p, ps, p1, q, term, xb, xi, y;
+ int n, i, ib, swap_tail;
+
+ const double eps = .5 * DBL_EPSILON;
+ const double sml = DBL_MIN;
+ const double lneps = std::log(eps);
+ const double lnsml = std::log(eps);
+
+ if (pin / (pin + qin) < x) {
+ swap_tail = 1;
+ y = 1 - x;
+ p = qin;
+ q = pin;
+ } else {
+ swap_tail=0;
+ y = x;
+ p = pin;
+ q = qin;
+ }
+
+ if ((p + q) * y / (p + 1) < eps) {
+ ans = 0;
+ xb = p * std::log(std::max(y,sml)) - std::log(p) - lnbetafn(p,q);
+ if (xb > lnsml && y != 0)
+ ans = std::exp(xb);
+ if (swap_tail)
+ ans = 1-ans;
+ } else {
+ ps = q - std::floor(q);
+ if (ps == 0)
+ ps = 1;
+ xb = p * std::log(y) - lnbetafn(ps, p) - std::log(p);
+ ans = 0;
+ if (xb >= lnsml) {
+ ans = std::exp(xb);
+ term = ans * p;
+ if (ps != 1) {
+ n = (int)std::max(lneps/std::log(y), 4.0);
+ for(i = 1; i <= n; i++){
+ xi = i;
+ term *= (xi-ps)*y/xi;
+ ans += term/(p+xi);
+ }
+ }
+ }
+ if (q > 1) {
+ xb = p * std::log(y) + q * std::log(1 - y)
+ - lnbetafn(p, q) - std::log(q);
+ ib = (int) std::max(xb / lnsml, 0.0);
+ term = std::exp(xb - ib * lnsml);
+ c = 1 / (1 - y);
+ p1 = q * c / (p + q - 1);
+
+ finsum = 0;
+ n = (int) q;
+ if(q == n)
+ n--;
+ for (i = 1; i <= n; i++) {
+ if(p1 <= 1 && term / eps <= finsum)
+ break;
+ xi = i;
+ term = (q -xi + 1) * c * term / (p + q - xi);
+ if (term > 1) {
+ ib--;
+ term *= sml;
+ }
+ if (ib == 0)
+ finsum += term;
+ }
+ ans += finsum;
+ }
+
+ if(swap_tail)
+ ans = 1-ans;
+ ans = std::max(std::min(ans,1.),0.);
+ }
+ return ans;
+ }
+
+ /* Helper for dbinom */
+ double
+ dbinom_raw (double x, double n, double p, double q)
+ {
+ double f, lc;
+
+ if (p == 0)
+ return((x == 0) ? 1.0 : 0.0);
+ if (q == 0)
+ return((x == n) ? 1.0 : 0.0);
+
+ if (x == 0) {
+ if(n == 0)
+ return 1.0;
+
+ lc = (p < 0.1) ? -bd0(n, n * q) - n * p : n * std::log(q);
+ return(std::exp(lc));
+ }
+ if (x == n) {
+ lc = (q < 0.1) ? -bd0(n,n * p) - n * q : n * std::log(p);
+ return(std::exp(lc));
+ }
+
+ if (x < 0 || x > n)
+ return 0.0;
+
+ lc = stirlerr(n) - stirlerr(x) - stirlerr(n-x) - bd0(x,n*p) -
+ bd0(n - x, n * q);
+
+ f = (M_2PI * x * (n-x)) / n;
+
+ return (std::exp(lc) / std::sqrt(f));
+ }
+
+ /* The normal probability density function implementation. */
+
+#define SIXTEN 16
+#define do_del(X) \
+ xsq = trunc(X * SIXTEN) / SIXTEN; \
+ del = (X - xsq) * (X + xsq); \
+ if(log_p) { \
+ *cum = (-xsq * xsq * 0.5) + (-del * 0.5) + std::log(temp); \
+ if((lower && x > 0.) || (upper && x <= 0.)) \
+ *ccum = ::log1p(-std::exp(-xsq * xsq * 0.5) * \
+ std::exp(-del * 0.5) * temp); \
+ } \
+ else { \
+ *cum = std::exp(-xsq * xsq * 0.5) * std::exp(-del * 0.5) * temp; \
+ *ccum = 1.0 - *cum; \
+ }
+
+#define swap_tail \
+ if (x > 0.) {/* swap ccum <--> cum */ \
+ temp = *cum; if(lower) *cum = *ccum; *ccum = temp; \
+ }
+
+ void
+ pnorm_both(double x, double *cum, double *ccum, int i_tail,
+ bool log_p)
+ {
+ const double a[5] = {
+ 2.2352520354606839287,
+ 161.02823106855587881,
+ 1067.6894854603709582,
+ 18154.981253343561249,
+ 0.065682337918207449113
+ };
+ const double b[4] = {
+ 47.20258190468824187,
+ 976.09855173777669322,
+ 10260.932208618978205,
+ 45507.789335026729956
+ };
+ const double c[9] = {
+ 0.39894151208813466764,
+ 8.8831497943883759412,
+ 93.506656132177855979,
+ 597.27027639480026226,
+ 2494.5375852903726711,
+ 6848.1904505362823326,
+ 11602.651437647350124,
+ 9842.7148383839780218,
+ 1.0765576773720192317e-8
+ };
+ const double d[8] = {
+ 22.266688044328115691,
+ 235.38790178262499861,
+ 1519.377599407554805,
+ 6485.558298266760755,
+ 18615.571640885098091,
+ 34900.952721145977266,
+ 38912.003286093271411,
+ 19685.429676859990727
+ };
+ const double p[6] = {
+ 0.21589853405795699,
+ 0.1274011611602473639,
+ 0.022235277870649807,
+ 0.001421619193227893466,
+ 2.9112874951168792e-5,
+ 0.02307344176494017303
+ };
+ const double q[5] = {
+ 1.28426009614491121,
+ 0.468238212480865118,
+ 0.0659881378689285515,
+ 0.00378239633202758244,
+ 7.29751555083966205e-5
+ };
+
+ double xden, xnum, temp, del, eps, xsq, y;
+ int i, lower, upper;
+
+ /* Consider changing these : */
+ eps = DBL_EPSILON * 0.5;
+
+ /* i_tail in {0,1,2} =^= {lower, upper, both} */
+ lower = i_tail != 1;
+ upper = i_tail != 0;
+
+ y = std::fabs(x);
+ if (y <= 0.67448975) {
+ /* qnorm(3/4) = .6744.... -- earlier had 0.66291 */
+ if (y > eps) {
+ xsq = x * x;
+ xnum = a[4] * xsq;
+ xden = xsq;
+ for (i = 0; i < 3; ++i) {
+ xnum = (xnum + a[i]) * xsq;
+ xden = (xden + b[i]) * xsq;
+ }
+ } else xnum = xden = 0.0;
+
+ temp = x * (xnum + a[3]) / (xden + b[3]);
+ if(lower) *cum = 0.5 + temp;
+ if(upper) *ccum = 0.5 - temp;
+ if(log_p) {
+ if(lower) *cum = std::log(*cum);
+ if(upper) *ccum = std::log(*ccum);
+ }
+ } else if (y <= M_SQRT_32) {
+ /* Evaluate pnorm for 0.674.. = qnorm(3/4) < |x| <= sqrt(32)
+ * ~= 5.657 */
+
+ xnum = c[8] * y;
+ xden = y;
+ for (i = 0; i < 7; ++i) {
+ xnum = (xnum + c[i]) * y;
+ xden = (xden + d[i]) * y;
+ }
+ temp = (xnum + c[7]) / (xden + d[7]);
+ do_del(y);
+ swap_tail;
+ } else if (log_p
+ || (lower && -37.5193 < x && x < 8.2924)
+ || (upper && -8.2929 < x && x < 37.5193)
+ ) {
+ /* Evaluate pnorm for x in (-37.5, -5.657) union (5.657, 37.5) */
+ xsq = 1.0 / (x * x);
+ xnum = p[5] * xsq;
+ xden = xsq;
+ for (i = 0; i < 4; ++i) {
+ xnum = (xnum + p[i]) * xsq;
+ xden = (xden + q[i]) * xsq;
+ }
+ temp = xsq * (xnum + p[4]) / (xden + q[4]);
+ temp = (M_1_SQRT_2PI - temp) / y;
+ do_del(x);
+ swap_tail;
+ } else {
+ if (x > 0) {
+ *cum = 1.;
+ *ccum = 0.;
+ } else {
+ *cum = 0.;
+ *ccum = 1.;
+ }
+ //XXX commented out for debug-on testing of ordfactanal
+ //(and perhaps others) since they tend to throw on the first
+ //iteration
+ //SCYTHE_THROW_10(scythe_convergence_error, "Did not converge");
+ }
+
+ return;
+ }
+#undef SIXTEN
+#undef do_del
+#undef swap_tail
+
+ /* The standard normal distribution function */
+ double
+ pnorm1 (double x, bool lower_tail, bool log_p)
+ {
+ SCYTHE_CHECK_10(! finite(x), scythe_invalid_arg,
+ "Quantile x is inifinte (+/-Inf) or NaN");
+
+ double p, cp;
+ pnorm_both(x, &p, &cp, (lower_tail ? 0 : 1), log_p);
+
+ return (lower_tail ? p : cp);
+ }
+ } // anonymous namespace
/*************
* Functions *
*************/
-
+
/* The gamma function */
- double gammafn (const double &);
+
+ /*! \brief The gamma function.
+ *
+ * Computes the gamma function, evaluated at \a x.
+ *
+ * \param x The value to compute gamma at.
+ *
+ * \see lngammafn(double x)
+ * \see pgamma(double x, double shape, double scale)
+ * \see dgamma(double x, double shape, double scale)
+ * \see rng::rgamma(double shape, double scale)
+ *
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ gammafn (double x)
+ {
+ const double gamcs[22] = {
+ +.8571195590989331421920062399942e-2,
+ +.4415381324841006757191315771652e-2,
+ +.5685043681599363378632664588789e-1,
+ -.4219835396418560501012500186624e-2,
+ +.1326808181212460220584006796352e-2,
+ -.1893024529798880432523947023886e-3,
+ +.3606925327441245256578082217225e-4,
+ -.6056761904460864218485548290365e-5,
+ +.1055829546302283344731823509093e-5,
+ -.1811967365542384048291855891166e-6,
+ +.3117724964715322277790254593169e-7,
+ -.5354219639019687140874081024347e-8,
+ +.9193275519859588946887786825940e-9,
+ -.1577941280288339761767423273953e-9,
+ +.2707980622934954543266540433089e-10,
+ -.4646818653825730144081661058933e-11,
+ +.7973350192007419656460767175359e-12,
+ -.1368078209830916025799499172309e-12,
+ +.2347319486563800657233471771688e-13,
+ -.4027432614949066932766570534699e-14,
+ +.6910051747372100912138336975257e-15,
+ -.1185584500221992907052387126192e-15,
+ };
+
+
+ double y = std::fabs(x);
+
+ if (y <= 10) {
+
+ /* Compute gamma(x) for -10 <= x <= 10
+ * Reduce the interval and find gamma(1 + y) for 0 <= y < 1
+ * first of all. */
+
+ int n = (int) x;
+ if (x < 0)
+ --n;
+
+ y = x - n;/* n = floor(x) ==> y in [ 0, 1 ) */
+ --n;
+ double value = chebyshev_eval(y * 2 - 1, gamcs, 22) + .9375;
+
+ if (n == 0)
+ return value;/* x = 1.dddd = 1+y */
+
+ if (n < 0) {
+ /* compute gamma(x) for -10 <= x < 1 */
+
+ /* If the argument is exactly zero or a negative integer */
+ /* then return NaN. */
+ SCYTHE_CHECK_10(x == 0 || (x < 0 && x == n + 2),
+ scythe_range_error, "x is 0 or a negative integer");
+
+ /* The answer is less than half precision */
+ /* because x too near a negative integer. */
+ SCYTHE_CHECK_10(x < -0.5 &&
+ std::fabs(x - (int)(x - 0.5) / x) < 67108864.0,
+ scythe_precision_error,
+ "Answer < 1/2 precision because x is too near" <<
+ " a negative integer");
+
+ /* The argument is so close to 0 that the result
+ * * would overflow. */
+ SCYTHE_CHECK_10(y < 2.2474362225598545e-308, scythe_range_error,
+ "x too close to 0");
+
+ n = -n;
+
+ for (int i = 0; i < n; i++)
+ value /= (x + i);
+
+ return value;
+ } else {
+ /* gamma(x) for 2 <= x <= 10 */
+
+ for (int i = 1; i <= n; i++) {
+ value *= (y + i);
+ }
+ return value;
+ }
+ } else {
+ /* gamma(x) for y = |x| > 10. */
+
+ /* Overflow */
+ SCYTHE_CHECK_10(x > 171.61447887182298,
+ scythe_range_error,"Overflow");
+
+ /* Underflow */
+ SCYTHE_CHECK_10(x < -170.5674972726612,
+ scythe_range_error, "Underflow");
+
+ double value = std::exp((y - 0.5) * std::log(y) - y
+ + M_LN_SQRT_2PI + lngammacor(y));
+
+ if (x > 0)
+ return value;
+
+ SCYTHE_CHECK_10(std::fabs((x - (int)(x - 0.5))/x) < 67108864.0,
+ scythe_precision_error,
+ "Answer < 1/2 precision because x is " <<
+ "too near a negative integer");
+
+ double sinpiy = std::sin(M_PI * y);
+
+ /* Negative integer arg - overflow */
+ SCYTHE_CHECK_10(sinpiy == 0, scythe_range_error, "Overflow");
+
+ return -M_PI / (y * sinpiy * value);
+ }
+ }
/* The natural log of the absolute value of the gamma function */
- double lngammafn (const double &);
+ /*! \brief The natural log of the absolute value of the gamma
+ * function.
+ *
+ * Computes the natural log of the absolute value of the gamma
+ * function, evaluated at \a x.
+ *
+ * \param x The value to compute log(abs(gamma())) at.
+ *
+ * \see gammafn(double x)
+ * \see pgamma(double x, double shape, double scale)
+ * \see dgamma(double x, double shape, double scale)
+ * \see rng::rgamma(double shape, double scale)
+ *
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ lngammafn(double x)
+ {
+ SCYTHE_CHECK_10(x <= 0 && x == (int) x, scythe_range_error,
+ "x is 0 or a negative integer");
+
+ double y = std::fabs(x);
+
+ if (y <= 10)
+ return std::log(std::fabs(gammafn(x)));
+
+ SCYTHE_CHECK_10(y > 2.5327372760800758e+305, scythe_range_error,
+ "Overflow");
+
+ if (x > 0) /* i.e. y = x > 10 */
+ return M_LN_SQRT_2PI + (x - 0.5) * std::log(x) - x
+ + lngammacor(x);
+
+ /* else: x < -10; y = -x */
+ double sinpiy = std::fabs(std::sin(M_PI * y));
+
+ if (sinpiy == 0) /* Negative integer argument */
+ throw scythe_exception("UNEXPECTED ERROR",
+ __FILE__, __func__, __LINE__,
+ "ERROR: Should never happen!");
+
+ double ans = M_LN_SQRT_PId2 + (x - 0.5) * std::log(y) - x - std::log(sinpiy)
+ - lngammacor(y);
+
+ SCYTHE_CHECK_10(std::fabs((x - (int)(x - 0.5)) * ans / x)
+ < 1.490116119384765696e-8, scythe_precision_error,
+ "Answer < 1/2 precision because x is "
+ << "too near a negative integer");
+
+ return ans;
+ }
/* The beta function */
- double betafn (const double &, const double &);
+ /*! \brief The beta function.
+ *
+ * Computes beta function, evaluated at (\a a, \a b).
+ *
+ * \param a The first parameter.
+ * \param b The second parameter.
+ *
+ * \see lnbetafn(double a, double b)
+ * \see pbeta(double x, double a, double b)
+ * \see dbeta(double x, double a, double b)
+ * \see rng::rbeta(double a, double b)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ betafn(double a, double b)
+ {
+ SCYTHE_CHECK_10(a <= 0 || b <= 0, scythe_invalid_arg, "a or b < 0");
+
+ if (a + b < 171.61447887182298) /* ~= 171.61 for IEEE */
+ return gammafn(a) * gammafn(b) / gammafn(a+b);
+
+ double val = lnbetafn(a, b);
+ SCYTHE_CHECK_10(val < -708.39641853226412, scythe_range_error,
+ "Underflow");
+
+ return std::exp(val);
+ }
- /* The natrual log of the beta function */
- double lnbetafn(const double &, const double &);
+ /* The natural log of the beta function */
+ /*! \brief The natural log of the beta function.
+ *
+ * Computes the natural log of the beta function,
+ * evaluated at (\a a, \a b).
+ *
+ * \param a The first parameter.
+ * \param b The second parameter.
+ *
+ * \see betafn(double a, double b)
+ * \see pbeta(double x, double a, double b)
+ * \see dbeta(double x, double a, double b)
+ * \see rng::rbeta(double a, double b)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ lnbetafn (double a, double b)
+ {
+ double p, q;
+
+ p = q = a;
+ if(b < p) p = b;/* := min(a,b) */
+ if(b > q) q = b;/* := max(a,b) */
+
+ SCYTHE_CHECK_10(p <= 0 || q <= 0,scythe_invalid_arg, "a or b <= 0");
+
+ if (p >= 10) {
+ /* p and q are big. */
+ double corr = lngammacor(p) + lngammacor(q) - lngammacor(p + q);
+ return std::log(q) * -0.5 + M_LN_SQRT_2PI + corr
+ + (p - 0.5) * std::log(p / (p + q)) + q * std::log(1 + (-p / (p + q)));
+ } else if (q >= 10) {
+ /* p is small, but q is big. */
+ double corr = lngammacor(q) - lngammacor(p + q);
+ return lngammafn(p) + corr + p - p * std::log(p + q)
+ + (q - 0.5) * std::log(1 + (-p / (p + q)));
+ }
+
+ /* p and q are small: p <= q > 10. */
+ return std::log(gammafn(p) * (gammafn(q) / gammafn(p + q)));
+ }
- /* factorial */
- int factorial (const int &n);
-
- /* The natural log of the factorial */
- double lnfactorial (const int &n);
+ /* Compute the factorial of a non-negative integer */
+ /*! \brief The factorial function.
+ *
+ * Computes the factorial of \a n.
+ *
+ * \param n The non-negative integer value to compute the factorial of.
+ *
+ * \see lnfactorial(unsigned int n)
+ *
+ */
+ inline int
+ factorial (unsigned int n)
+ {
+ if (n == 0)
+ return 1;
+
+ return n * factorial(n - 1);
+ }
+
+ /* Compute the natural log of the factorial of a non-negative
+ * integer
+ */
+ /*! \brief The log of the factorial function.
+ *
+ * Computes the natural log of the factorial of \a n.
+ *
+ * \param n The non-negative integer value to compute the natural log of the factorial of.
+ *
+ * \see factorial(unsigned int n)
+ *
+ */
+ inline double
+ lnfactorial (unsigned int n)
+ {
+ double x = n+1;
+ double cof[6] = {
+ 76.18009172947146, -86.50532032941677,
+ 24.01409824083091, -1.231739572450155,
+ 0.1208650973866179e-2, -0.5395239384953e-5
+ };
+ double y = x;
+ double tmp = x + 5.5 - (x + 0.5) * std::log(x + 5.5);
+ double ser = 1.000000000190015;
+ for (int j = 0; j <= 5; j++) {
+ ser += (cof[j] / ++y);
+ }
+ return(std::log(2.5066282746310005 * ser / x) - tmp);
+ }
/*********************************
- * Fully Specified Distributions *
+ * Fully Specified Distributions *
*********************************/
-
- /**** beta distribution ****/
-
+
+ /* These macros provide a nice shorthand for the matrix versions of
+ * the pdf and cdf functions.
+ */
+
+#define SCYTHE_ARGSET(...) __VA_ARGS__
+
+#define SCYTHE_DISTFUN_MATRIX(NAME, XTYPE, ARGNAMES, ...) \
+ template <matrix_order RO, matrix_style RS, \
+ matrix_order PO, matrix_style PS> \
+ Matrix<double, RO, RS> \
+ NAME (const Matrix<XTYPE, PO, PS>& X, __VA_ARGS__) \
+ { \
+ Matrix<double, RO, Concrete> ret(X.rows(), X.cols(), false); \
+ const_matrix_forward_iterator<XTYPE,RO,PO,PS> xit; \
+ const_matrix_forward_iterator<XTYPE,RO,PO,PS> xlast \
+ = X.template end_f<RO>(); \
+ typename Matrix<double,RO,Concrete>::forward_iterator rit \
+ = ret.begin_f(); \
+ for (xit = X.template begin_f<RO>(); xit != xlast; ++xit) { \
+ *rit = NAME (*xit, ARGNAMES); \
+ ++rit; \
+ } \
+ SCYTHE_VIEW_RETURN(double, RO, RS, ret) \
+ } \
+ \
+ template <matrix_order O, matrix_style S> \
+ Matrix<double, O, Concrete> \
+ NAME (const Matrix<XTYPE, O, S>& X, __VA_ARGS__) \
+ { \
+ return NAME <O, Concrete, O, S> (X, ARGNAMES); \
+ }
+
+ /**** The Beta Distribution ****/
+
/* CDFs */
- double pbeta (const double &, const double &,
- const double &);
- Matrix<double> pbeta( const int &, const int &,
- const double &, const double &,
- const double &);
- /* PDFs */
- double dbeta (const double &, const double &,
- const double &);
+ /*! \brief The beta distribution function.
+ *
+ * Computes the value of the beta cumulative distribution function
+ * with shape parameters \a a and \a b at the desired quantile,
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile, between 0 and 1.
+ * \param a The first non-negative beta shape parameter.
+ * \param b The second non-negative beta shape parameter.
+ *
+ * \see dbeta(double x, double a, double b)
+ * \see rng::rbeta(double a, double b)
+ * \see betafn(double a, double b)
+ * \see lnbetafn(double a, double b)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ pbeta(double x, double a, double b)
+ {
+ SCYTHE_CHECK_10(a <= 0 || b <= 0,scythe_invalid_arg, "a or b <= 0");
+
+ if (x <= 0)
+ return 0.;
+ if (x >= 1)
+ return 1.;
+
+ return pbeta_raw(x,a,b);
+ }
+
+ SCYTHE_DISTFUN_MATRIX(pbeta, double, SCYTHE_ARGSET(a, b), double a, double b)
- Matrix<double> dbeta( const int &, const int &,
- const double &, const double &,
- const double &b);
+ /* PDFs */
+ /*! \brief The beta density function.
+ *
+ * Computes the value of the beta probability density function
+ * with shape parameters \a a and \a b at the desired quantile,
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile, between 0 and 1.
+ * \param a The first non-negative beta shape parameter.
+ * \param b The second non-negative beta shape parameter.
+ *
+ * \see pbeta(double x, double a, double b)
+ * \see rng::rbeta(double a, double b)
+ * \see betafn(double a, double b)
+ * \see lnbetafn(double a, double b)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ dbeta(double x, double a, double b)
+ {
+ SCYTHE_CHECK_10((x < 0.0) || (x > 1.0), scythe_invalid_arg,
+ "x not in [0,1]");
+ SCYTHE_CHECK_10(a < 0.0, scythe_invalid_arg, "a < 0");
+ SCYTHE_CHECK_10(b < 0.0, scythe_invalid_arg, "b < 0");
+
+ return (std::pow(x, (a-1.0)) * std::pow((1.0-x), (b-1.0)) )
+ / betafn(a,b);
+ }
- /* Other */
+ SCYTHE_DISTFUN_MATRIX(dbeta, double, SCYTHE_ARGSET(a, b), double a, double b)
/* Returns the natural log of the ordinate of the Beta density
* evaluated at x with Shape1 a, and Shape2 b
*/
- double lndbeta1(const double &, const double &,
- const double &b);
-
- /**** binomial distribution ****/
-
- /* CDFs */
- double pbinom(const double &, const double &,const double &);
- Matrix<double> pbinom ( const int &, const int &,
- const double &, const double &,
- const double &);
+ /*! \brief The natural log of the ordinate of the beta density
+ * function.
+ *
+ * Computes the value of the natural log of the ordinate of the beta
+ * probability density function
+ * with shape parameters \a a and \a b at the desired quantile,
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile, between 0 and 1.
+ * \param a The first non-negative beta shape parameter.
+ * \param b The second non-negative beta shape parameter.
+ *
+ * \see dbeta(double x, double a, double b)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ lndbeta1(double x, double a, double b)
+ {
+ SCYTHE_CHECK_10((x < 0.0) || (x > 1.0), scythe_invalid_arg,
+ "x not in [0,1]");
+ SCYTHE_CHECK_10(a < 0.0, scythe_invalid_arg, "a < 0");
+ SCYTHE_CHECK_10(b < 0.0, scythe_invalid_arg, "b < 0");
+
+ return (a-1.0) * std::log(x) + (b-1) * std::log(1.0-x)
+ - lnbetafn(a,b);
+ }
- /* PDFs */
- double dbinom(const double &, const double &, const double &);
+ SCYTHE_DISTFUN_MATRIX(lndbeta1, double, SCYTHE_ARGSET(a, b), double a, double b)
- Matrix<double> dbinom(const int &, const int &,
- const double &, const double &,
- const double &);
+ /**** The Binomial Distribution ****/
- /**** The Chi Square Distribution ****/
-
/* CDFs */
- double pchisq(const double &, const double &);
- Matrix<double> pchisq(const int &, const int &,
- const double &, const double &);
+ /*! \brief The binomial distribution function.
+ *
+ * Computes the value of the binomial cumulative distribution function
+ * with \a n trials and \a p probability of success on each trial,
+ * at the desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param n The number of trials.
+ * \param p The probability of success on each trial.
+ *
+ * \see dbinom(double x, unsigned int n, double p)
+ * \see rng::rbinom(unsigned int n, double p)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ pbinom(double x, unsigned int n, double p)
+ {
+
+ SCYTHE_CHECK_10(p < 0 || p > 1, scythe_invalid_arg, "p not in [0,1]");
+ double X = std::floor(x);
+
+ if (X < 0.0)
+ return 0;
+
+ if (n <= X)
+ return 1;
+
+ return pbeta(1 - p, n - X, X + 1);
+ }
+
+ SCYTHE_DISTFUN_MATRIX(pbinom, double, SCYTHE_ARGSET(n, p), unsigned int n, double p)
+
/* PDFs */
- double dchisq(const double &, const double &);
+ /*! \brief The binomial density function.
+ *
+ * Computes the value of the binomial probability density function
+ * with \a n trials and \a p probability of success on each trial,
+ * at the desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param n The number of trials.
+ * \param p The probability of success on each trial.
+ *
+ * \see pbinom(double x, unsigned int n, double p)
+ * \see rng::rbinom(unsigned int n, double p)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ dbinom(double x, unsigned int n, double p)
+ {
+ SCYTHE_CHECK_10(p < 0 || p > 1, scythe_invalid_arg, "p not in [0, 1]");
+ double X = std::floor(x + 0.5);
+ return dbinom_raw(X, n, p, 1 - p);
+ }
- Matrix<double> dchisq(const int &, const int &,
- const double &, const double &);
+ SCYTHE_DISTFUN_MATRIX(dbinom, double, SCYTHE_ARGSET(n, p), unsigned int n, double p)
+
+ /**** The Chi Squared Distribution ****/
+ /* CDFs */
+ /*! \brief The \f$\chi^2\f$ distribution function.
+ *
+ * Computes the value of the \f$\chi^2\f$ cumulative distribution
+ * function with \a df degrees of freedom, at the desired quantile
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param df The degrees of freedom.
+
+ * \see dchisq(double x, double df)
+ * \see rng::rchisq(double df)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ *
+ */
+ inline double
+ pchisq(double x, double df)
+ {
+ return pgamma(x, df/2.0, 2.0);
+ }
+
+ SCYTHE_DISTFUN_MATRIX(pchisq, double, df, double df)
+
+ /* PDFs */
+ /*! \brief The \f$\chi^2\f$ density function.
+ *
+ * Computes the value of the \f$\chi^2\f$ probability density
+ * function with \a df degrees of freedom, at the desired quantile
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param df The degrees of freedom.
+
+ * \see pchisq(double x, double df)
+ * \see rng::rchisq(double df)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ *
+ */
+ inline double
+ dchisq(double x, double df)
+ {
+ return dgamma(x, df / 2.0, 2.0);
+ }
+
+ SCYTHE_DISTFUN_MATRIX(dchisq, double, df, double df)
+
/**** The Exponential Distribution ****/
/* CDFs */
- double pexp(const double &, const double &);
+ /*! \brief The exponential distribution function.
+ *
+ * Computes the value of the exponential cumulative distribution
+ * function with given \a scale, at the desired quantile
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param scale The positive scale of the function.
+ *
+ * \see dexp(double x, double scale)
+ * \see rng::rexp(double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ pexp(double x, double scale)
+ {
+ SCYTHE_CHECK_10(scale <= 0, scythe_invalid_arg, "scale <= 0");
+
+ if (x <= 0)
+ return 0;
+
+ return (1 - std::exp(-x*scale));
+ }
- Matrix<double> pexp(const int &, const int &, const double &,
- const double &);
+ SCYTHE_DISTFUN_MATRIX(pexp, double, scale, double scale)
/* PDFs */
- double dexp(const double &, const double &);
+ /*! \brief The exponential density function.
+ *
+ * Computes the value of the exponential probability density
+ * function with given \a scale, at the desired quantile
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param scale The positive scale of the function.
+ *
+ * \see pexp(double x, double scale)
+ * \see rng::rexp(double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ dexp(double x, double scale)
+ {
+ SCYTHE_CHECK_10(scale <= 0, scythe_invalid_arg, "scale <= 0");
+
+ if (x < 0)
+ return 0;
+
+ return std::exp(-x * scale) * scale;
+ }
- Matrix<double> dexp(const int &, const int &, const double &,
- const double &);
+ SCYTHE_DISTFUN_MATRIX(dexp, double, scale, double scale)
/**** The f Distribution ****/
/* CDFs */
- double pf(const double &, const double &, const double &);
+ /*! \brief The F distribution function.
+ *
+ * Computes the value of the F cumulative distribution function with
+ * \a df1 and \a df2 degrees of freedom, at the desired quantile \a
+ * x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param df1 The non-negative degrees of freedom for the
+ * \f$\chi^2\f$ variate in the nominator of the F statistic.
+ * \param df2 The non-negative degrees of freedom for the
+ * \f$\chi^2\f$ variate in the denominator of the F statistic.
+ *
+ *
+ * \see df(double x, double df1, double df2)
+ * \see rng::rf(double df1, double df2)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ */
+ inline double
+ pf(double x, double df1, double df2)
+ {
+ SCYTHE_CHECK_10(df1 <= 0 || df2 <= 0, scythe_invalid_arg,
+ "df1 or df2 <= 0");
+
+ if (x <= 0)
+ return 0;
+
+ if (df2 > 4e5)
+ return pchisq(x*df1,df1);
+ if (df1 > 4e5)
+ return 1-pchisq(df2/x,df2);
+
+ return (1-pbeta(df2 / (df2 + df1 * x), df2 / 2.0, df1 / 2.0));
+ }
+
+ SCYTHE_DISTFUN_MATRIX(pf, double, SCYTHE_ARGSET(df1, df2), double df1, double df2)
- Matrix<double> pf(const int &, const int &, const double &,
- const double &, const double &);
/* PDFs */
- double df(const double &, const double &, const double &);
- Matrix<double> df(const int &, const int &, const double &,
- const double &, const double &);
+ /*! \brief The F density function.
+ *
+ * Computes the value of the F probability density function with
+ * \a df1 and \a df2 degrees of freedom, at the desired quantile \a
+ * x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param df1 The non-negative degrees of freedom for the
+ * \f$\chi^2\f$ variate in the nominator of the F statistic.
+ * \param df2 The non-negative degrees of freedom for the
+ * \f$\chi^2\f$ variate in the denominator of the F statistic.
+ *
+ * \see df(double x, double df1, double df2)
+ * \see rng::rf(double df1, double df2)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ */
+ inline double
+ df(double x, double df1, double df2)
+ {
+ double dens;
+
+ SCYTHE_CHECK_10(df1 <= 0 || df2 <= 0, scythe_invalid_arg,
+ "df1 or df2 <= 0");
+
+ if (x <= 0)
+ return 0;
+
+ double f = 1 / (df2 + x * df1);
+ double q = df2 * f;
+ double p = x * df1 * f;
+
+ if (df1 >= 2) {
+ f = df1 * q / 2;
+ dens = dbinom_raw((df1 - 2) / 2,(df1 + df2 - 2) / 2, p, q);
+ } else {
+ f = (df1 * df1 * q) /(2 * p * (df1 + df2));
+ dens = dbinom_raw(df1 / 2,(df1 + df2)/ 2, p, q);
+ }
+
+ return f*dens;
+ }
+
+ SCYTHE_DISTFUN_MATRIX(df, double, SCYTHE_ARGSET(df1, df2), double df1, double df2)
/**** The Gamma Distribution ****/
/* CDFs */
- // note that this takes scale (or 1/rate for R-users)
- double pgamma (double, const double &, const double &);
+ /*! \brief The gamma distribution function.
+ *
+ * Computes the value of the gamma cumulative distribution
+ * function with given \a shape and \a scale, at the desired quantile
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param shape The non-negative shape of the distribution.
+ * \param scale The non-negative scale of the distribution.
+ *
+ * \see dgamma(double x, double shape, double scale)
+ * \see rng::rgamma(double shape, double scale)
+ * \see gammafn(double x)
+ * \see lngammafn(double x)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ */
+ inline double
+ pgamma (double x, double shape, double scale)
+ {
+ const double xbig = 1.0e+8, xlarge = 1.0e+37,
+ alphlimit = 1000.;/* normal approx. for shape > alphlimit */
+
+ int lower_tail = 1;
+
+ double pn1, pn2, pn3, pn4, pn5, pn6, arg, a, b, c, an, osum, sum;
+ long n;
+ int pearson;
+
+ /* check that we have valid values for x and shape */
+
+ SCYTHE_CHECK_10(shape <= 0. || scale <= 0., scythe_invalid_arg,
+ "shape or scale <= 0");
+
+ x /= scale;
+
+ if (x <= 0.)
+ return 0.0;
+
+ /* use a normal approximation if shape > alphlimit */
+
+ if (shape > alphlimit) {
+ pn1 = std::sqrt(shape) * 3. * (std::pow(x/shape, 1./3.) + 1.
+ / (9. * shape) - 1.);
+ return pnorm(pn1, 0., 1.);
+ }
+
+ /* if x is extremely large __compared to shape__ then return 1 */
+
+ if (x > xbig * shape)
+ return 1.0;
+
+ if (x <= 1. || x < shape) {
+ pearson = 1;/* use pearson's series expansion. */
+ arg = shape * std::log(x) - x - lngammafn(shape + 1.);
+ c = 1.;
+ sum = 1.;
+ a = shape;
+ do {
+ a += 1.;
+ c *= x / a;
+ sum += c;
+ } while (c > DBL_EPSILON);
+ arg += std::log(sum);
+ }
+ else { /* x >= max( 1, shape) */
+ pearson = 0;/* use a continued fraction expansion */
+ arg = shape * std::log(x) - x - lngammafn(shape);
+ a = 1. - shape;
+ b = a + x + 1.;
+ pn1 = 1.;
+ pn2 = x;
+ pn3 = x + 1.;
+ pn4 = x * b;
+ sum = pn3 / pn4;
+ for (n = 1; ; n++) {
+ a += 1.;/* = n+1 -shape */
+ b += 2.;/* = 2(n+1)-shape+x */
+ an = a * n;
+ pn5 = b * pn3 - an * pn1;
+ pn6 = b * pn4 - an * pn2;
+ if (std::fabs(pn6) > 0.) {
+ osum = sum;
+ sum = pn5 / pn6;
+ if (std::fabs(osum - sum) <= DBL_EPSILON * std::min(1., sum))
+ break;
+ }
+ pn1 = pn3;
+ pn2 = pn4;
+ pn3 = pn5;
+ pn4 = pn6;
+ if (std::fabs(pn5) >= xlarge) {
+ /* re-scale terms in continued fraction if they are large */
+ pn1 /= xlarge;
+ pn2 /= xlarge;
+ pn3 /= xlarge;
+ pn4 /= xlarge;
+ }
+ }
+ arg += std::log(sum);
+ }
+
+ lower_tail = (lower_tail == pearson);
+
+ sum = std::exp(arg);
+
+ return (lower_tail) ? sum : 1 - sum;
+ }
- Matrix<double> pgamma(const int &, const int &, const double &,
- const double &scale = 1);
+ SCYTHE_DISTFUN_MATRIX(pgamma, double, SCYTHE_ARGSET(shape, scale), double shape, double scale)
/* PDFs */
- // note that this takes scale (or 1/rate for R-users)
- double dgamma(const double &, const double &,
- const double &scale = 1);
+ /*! \brief The gamma density function.
+ *
+ * Computes the value of the gamma probability density
+ * function with given \a shape and \a scale, at the desired quantile
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param shape The non-negative shape of the distribution.
+ * \param scale The non-negative scale of the distribution.
+ *
+ * \see pgamma(double x, double shape, double scale)
+ * \see rng::rgamma(double shape, double scale)
+ * \see gammafn(double x)
+ * \see lngammafn(double x)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ */
+ inline double
+ dgamma(double x, double shape, double scale)
+ {
+ SCYTHE_CHECK_10(shape <= 0 || scale <= 0,scythe_invalid_arg,
+ "shape or scale <= 0");
+
+ if (x < 0)
+ return 0.0;
+
+ if (x == 0) {
+ SCYTHE_CHECK_10(shape < 1,scythe_invalid_arg,
+ "x == 0 and shape < 1");
+
+ if (shape > 1)
+ return 0.0;
+
+ return 1 / scale;
+ }
+
+ if (shape < 1) {
+ double pr = dpois_raw(shape, x/scale);
+ return pr * shape / x;
+ }
+
+ /* else shape >= 1 */
+ double pr = dpois_raw(shape - 1, x / scale);
+ return pr / scale;
+ }
- Matrix<double> dgamma(const int &, const int &,
- const double &, const double &scale = 1);
+ SCYTHE_DISTFUN_MATRIX(dgamma, double, SCYTHE_ARGSET(shape, scale), double shape, double scale)
/**** The Logistic Distribution ****/
/* CDFs */
- double plogis(const double &, const double &location = 0.0,
- const double &scale = 1.0);
+ /*! \brief The logistic distribution function.
+ *
+ * Computes the value of the logistic cumulative distribution
+ * function with given \a location and \a scale, at the desired
+ * quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param location The location of the distribution.
+ * \param scale The positive scale of the distribution.
+ *
+ * \see dlogis(double x, double location, double scale)
+ * \see rng::rlogis(double location, double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ plogis (double x, double location, double scale)
+ {
+ SCYTHE_CHECK_10(scale <= 0.0, scythe_invalid_arg, "scale <= 0");
+
+ double X = (x-location) / scale;
+
+ X = std::exp(-X);
+
+ return 1 / (1+X);
+ }
- Matrix<double> plogis(const int &, const int &,
- const double &, const double &location = 0.0,
- const double &scale = 1.0);
+ SCYTHE_DISTFUN_MATRIX(plogis, double, SCYTHE_ARGSET(location, scale), double location, double scale)
/* PDFs */
- double dlogis(const double &, const double &location = 0.0,
- const double &scale = 1.0);
-
- Matrix<double> dlogis(const int &, const int &,
- const double &, const double &location = 0.0,
- const double &scale = 1.0);
+ /*! \brief The logistic density function.
+ *
+ * Computes the value of the logistic probability density
+ * function with given \a location and \a scale, at the desired
+ * quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param location The location of the distribution.
+ * \param scale The positive scale of the distribution.
+ *
+ * \see plogis(double x, double location, double scale)
+ * \see rng::rlogis(double location, double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ dlogis(double x, double location, double scale)
+ {
+ SCYTHE_CHECK_10(scale <= 0.0, scythe_invalid_arg, "scale <= 0");
+
+ double X = (x - location) / scale;
+ double e = std::exp(-X);
+ double f = 1.0 + e;
+
+ return e / (scale * f * f);
+ }
+ SCYTHE_DISTFUN_MATRIX(dlogis, double, SCYTHE_ARGSET(location, scale), double location, double scale)
/**** The Log Normal Distribution ****/
/* CDFs */
- double plnorm(const double& x, const double& logmean = 0.0,
- const double& logsd = 1.0);
+ /*! \brief The log-normal distribution function.
+ *
+ * Computes the value of the log-normal cumulative distribution
+ * function with mean \a logmean and standard
+ * deviation \a logsd, at the desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param logmean The mean of the distribution.
+ * \param logsd The positive standard deviation of the distribution.
+ *
+ * \see dlnorm(double x, double logmean, double logsd)
+ * \see rng::rlnorm(double logmean, double logsd)
+ * \see pnorm(double x, double logmean, double logsd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ */
+ inline double
+ plnorm (double x, double logmean, double logsd)
+ {
+ SCYTHE_CHECK_10(logsd <= 0, scythe_invalid_arg, "logsd <= 0");
+
+ if (x > 0)
+ return pnorm(std::log(x), logmean, logsd);
+
+ return 0;
+ }
- Matrix<double> plnorm(const int& rows, const int& cols,
- const double& x, const double& logmean = 0.0,
- const double& logsd = 1.0);
+ SCYTHE_DISTFUN_MATRIX(plnorm, double, SCYTHE_ARGSET(logmean, logsd), double logmean, double logsd)
/* PDFs */
- double dlnorm(const double& x, const double& logmean = 0.0,
- const double& logsd = 1.0);
+ /*! \brief The log-normal density function.
+ *
+ * Computes the value of the log-normal probability density
+ * function with mean \a logmean and standard
+ * deviation \a logsd, at the desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param logmean The mean of the distribution.
+ * \param logsd The positive standard deviation of the distribution.
+ *
+ * \see plnorm(double x, double logmean, double logsd)
+ * \see rng::rlnorm(double logmean, double logsd)
+ * \see dnorm(double x, double logmean, double logsd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ dlnorm(double x, double logmean, double logsd)
+ {
+ SCYTHE_CHECK_10(logsd <= 0, scythe_invalid_arg, "logsd <= 0");
+
+ if (x == 0)
+ return 0;
+
+ double y = (std::log(x) - logmean) / logsd;
+
+ return (1 / (std::sqrt(2 * M_PI))) * std::exp(-0.5 * y * y) / (x * logsd);
+ }
- Matrix<double> dlnorm(const int& rows, const int& cols,
- const double& x, const double& logmean = 0.0,
- const double& logsd = 1.0);
+ SCYTHE_DISTFUN_MATRIX(dlnorm, double, SCYTHE_ARGSET(logmean, logsd), double logmean, double logsd)
/**** The Negative Binomial Distribution ****/
/* CDFs */
- double pnbinom(const double &, const double &, const double &);
+ /*! \brief The negative binomial distribution function.
+ *
+ * Computes the value of the negative binomial cumulative distribution
+ * function with \a n target number of successful trials and \a p
+ * probability of success on each trial, at the desired quantile \a
+ * x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired non-negative, integer, quantile.
+ * \param n The positive target number of successful trials
+ * (dispersion parameter).
+ * \param p The probability of success on each trial.
+ *
+ * \see dnbinom(unsigned int x, double n, double p)
+ * \see rng::rnbinom(double n, double p)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ pnbinom(unsigned int x, double n, double p)
+ {
+ SCYTHE_CHECK_10(n == 0 || p <= 0 || p >= 1, scythe_invalid_arg,
+ "n == 0 or p not in (0,1)");
+
+ return pbeta(p, n, x + 1);
+ }
- Matrix<double> pnbinom( const int &, const int &,
- const double &, const double &,
- const double &);
+ SCYTHE_DISTFUN_MATRIX(pnbinom, unsigned int, SCYTHE_ARGSET(n, p), double n, double p)
/* PDFs */
- double dnbinom(const double &, const double &, const double &);
+ /*! \brief The negative binomial density function.
+ *
+ * Computes the value of the negative binomial probability density
+ * function with \a n target number of successful trials and \a p
+ * probability of success on each trial, at the desired quantile \a
+ * x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired non-negative, integer, quantile.
+ * \param n The positive target number of successful trials
+ * (dispersion parameter).
+ * \param p The probability of success on each trial.
+ *
+ * \see dnbinom(unsigned int x, double n, double p)
+ * \see rng::rnbinom(double n, double p)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ dnbinom(unsigned int x, double n, double p)
+ {
+ SCYTHE_CHECK_10(n == 0 || p <= 0 || p >= 1, scythe_invalid_arg,
+ "n == 0 or p not in (0,1)");
+
+ double prob = dbinom_raw(n, x + n, p, 1 - p);
+ double P = (double) n / (n + x);
+
+ return P * prob;
+ }
- Matrix<double> dnbinom( const int &, const int &,
- const double &, const double &,
- const double &);
+ SCYTHE_DISTFUN_MATRIX(dnbinom, unsigned int, SCYTHE_ARGSET(n, p), double n, double p)
/**** The Normal Distribution ****/
/* CDFs */
- double pnorm (const double &x, const double &mu = 0.0,
- const double &sigma = 1.0);
+ /*! \brief The normal distribution function.
+ *
+ * Computes the value of the normal cumulative distribution
+ * function with given \a mean and standard deviation \a sd, at the
+ * desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param mean The mean of the distribution.
+ * \param sd The positive standard deviation of the distribution.
+ *
+ * \see dnorm(double x, double mean, double sd)
+ * \see rng::rnorm(double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ */
+ inline double
+ pnorm (double x, double mean, double sd)
+
+ {
+ SCYTHE_CHECK_10(sd <= 0, scythe_invalid_arg,
+ "negative standard deviation");
- /* PDFs */
- double dnorm( const double& x, const double& mu = 0.0,
- const double& sigma = 1.0);
+ return pnorm1((x - mean) / sd, true, false);
+ }
- Matrix<double> dnorm( const int& rows, const int& cols,
- const double& x, const double& mu = 0.0,
- const double& sigma = 1.0);
- /* Other */
+ SCYTHE_DISTFUN_MATRIX(pnorm, double, SCYTHE_ARGSET(mean, sd), double mean, double sd)
- /* Returns the univariate standard normal cumulative distribution
- * function (CDF)
- */
- double pnorm2(const double &x, const bool &lower_tail,
- const bool &log_p);
- void pnorm_both(double x, double *cum, double *ccum, int i_tail,
- bool log_p);
+ /* PDFs */
+ /*! \brief The normal density function.
+ *
+ * Computes the value of the normal probability density
+ * function with given \a mean and standard deviation \a sd, at the
+ * desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param mean The mean of the distribution.
+ * \param sd The positive standard deviation of the distribution.
+ *
+ * \see pnorm(double x, double mean, double sd)
+ * \see rng::rnorm(double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ dnorm(double x, double mean, double sd)
+ {
+ SCYTHE_CHECK_10(sd <= 0, scythe_invalid_arg,
+ "negative standard deviation");
+
+ double X = (x - mean) / sd;
+
+ return (M_1_SQRT_2PI * std::exp(-0.5 * X * X) / sd);
+ }
- /* Returns the quantile of the standard normal distribution
- * associated with a given probability p
+ SCYTHE_DISTFUN_MATRIX(dnorm, double, SCYTHE_ARGSET(mean, sd), double mean, double sd)
+
+
+ /* Return the natural log of the normal PDF */
+ /*! \brief The natural log of normal density function.
+ *
+ * Computes the value of the natural log of the normal probability
+ * density function with given \a mean and standard deviation \a sd,
+ * at the desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param mean The mean of the distribution.
+ * \param sd The positive standard deviation of the distribution.
+ *
+ * \see dnorm(double x, double mean, double sd)
+ * \see pnorm(double x, double mean, double sd)
+ * \see rng::rnorm(double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
*/
- double qnorm1 (const double& in_p);
+ inline double
+ lndnorm (double x, double mean, double sd)
+ {
+ SCYTHE_CHECK_10(sd <= 0, scythe_invalid_arg,
+ "negative standard deviation");
+
+ double X = (x - mean) / sd;
+
+ return -(M_LN_SQRT_2PI + 0.5 * X * X + std::log(sd));
+ }
- /* Returns the log of the univariate normal density ordinate
- * evaluated at x
+ SCYTHE_DISTFUN_MATRIX(lndnorm, double, SCYTHE_ARGSET(mean, sd), double mean, double sd)
+
+ /* Quantile functions */
+ /*! \brief The standard normal quantile function.
+ *
+ * Computes the value of the standard normal quantile function
+ * at the desired probability \a in_p.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param in_p The desired probability.
+ *
+ * \see pnorm(double x, double mean, double sd)
+ * \see dnorm(double x, double mean, double sd)
+ * \see rng::rnorm(double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
*/
- double lndnorm (const double& x, const double& mu = 0.0,
- const double& sigma = 1.0);
+ inline double
+ qnorm1 (double in_p)
+ {
+ double p0 = -0.322232431088;
+ double q0 = 0.0993484626060;
+ double p1 = -1.0;
+ double q1 = 0.588581570495;
+ double p2 = -0.342242088547;
+ double q2 = 0.531103462366;
+ double p3 = -0.0204231210245;
+ double q3 = 0.103537752850;
+ double p4 = -0.453642210148e-4;
+ double q4 = 0.38560700634e-2;
+ double xp = 0.0;
+ double p = in_p;
+
+ if (p > 0.5)
+ p = 1 - p;
+
+ SCYTHE_CHECK_10(p < 10e-20, scythe_range_error,
+ "p outside accuracy limit");
+
+ if (p == 0.5)
+ return xp;
+
+ double y = std::sqrt (std::log (1.0 / std::pow (p, 2)));
+ xp = y + ((((y * p4 + p3) * y + p2) * y + p1) * y + p0) /
+ ((((y * q4 + q3) * y + q2) * y + q1) * y + q0);
+
+ if (in_p < 0.5)
+ xp = -1 * xp;
+
+ return xp;
+ }
+
+ SCYTHE_DISTFUN_MATRIX(qnorm1, double, in_p, double in_p)
+
+ /**** The Poisson Distribution ****/
- /**** The Poison Distribution ****/
-
/* CDFs */
+ /*! \brief The Poisson distribution function.
+ *
+ * Computes the value of the Poisson cumulative distribution
+ * function with expected number of occurrences \a lambda, at the
+ * desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired integer quantile.
+ * \param lambda The expected positive number of occurrences.
+ *
+ * \see dpois(unsigned int x, double lambda)
+ * \see rng::rpois(double lambda)
+ *
+ * \throws scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ */
+ inline double
+ ppois(unsigned int x, double lambda)
+ {
+ SCYTHE_CHECK_10(lambda<=0.0, scythe_invalid_arg, "lambda <= 0");
+
+ if (lambda == 1)
+ return 1;
+
+ return 1 - pgamma(lambda, x + 1, 1.0);
+ }
- double ppois(const double &, const double &);
+ SCYTHE_DISTFUN_MATRIX(ppois, unsigned int, lambda, double lambda)
- Matrix<double> ppois( const int &, const int &,
- const double &, const double &);
/* PDFs */
- double dpois(const int &, const double &);
-
- Matrix<double> dpois( const int &, const int &,
- const double &, const double &);
+ /*! \brief The Poisson density function.
+ *
+ * Computes the value of the Poisson probability density
+ * function with expected number of occurrences \a lambda, at the
+ * desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired integer quantile.
+ * \param lambda The expected positive number of occurrences.
+ *
+ * \see ppois(unsigned int x, double lambda)
+ * \see rng::rpois(double lambda)
+ *
+ * \throws scythe_invalid_arg (Level 1)
+ */
+ inline double
+ dpois(unsigned int x, double lambda)
+ {
+ SCYTHE_CHECK_10(lambda<=0.0, scythe_invalid_arg, "lambda <= 0");
+
+ // compute log(x!)
+ double xx = x+1;
+ double cof[6] = {
+ 76.18009172947146, -86.50532032941677,
+ 24.01409824083091, -1.231739572450155,
+ 0.1208650973866179e-2, -0.5395239384953e-5
+ };
+ double y = xx;
+ double tmp = xx + 5.5 - (xx + 0.5) * std::log(xx + 5.5);
+ double ser = 1.000000000190015;
+ for (int j = 0; j <= 5; j++) {
+ ser += (cof[j] / ++y);
+ }
+ double lnfactx = std::log(2.5066282746310005 * ser / xx) - tmp;
+
+ return (std::exp( -1*lnfactx + x * std::log(lambda) - lambda));
+ }
+
+ SCYTHE_DISTFUN_MATRIX(dpois, unsigned int, lambda, double lambda)
/**** The t Distribution ****/
/* CDFs */
+ /*! \brief The Student t distribution function.
+ *
+ * Computes the value of the Student t cumulative distribution
+ * function with \a n degrees of freedom, at the desired quantile
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param n The positive degrees of freedom of the distribution.
+ *
+ * \see dt(double x, bool b1, bool b2)
+ * \see rng::rt1(double mu, double sigma2, double nu)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ pt(double x, double n)
+ {
+ double val;
+
+ SCYTHE_CHECK_10(n <= 0, scythe_invalid_arg, "n <= 0");
+
+ if (n > 4e5) {
+ val = 1/(4*n);
+ return pnorm1(x * (1 - val) / ::sqrt(1 + x * x * 2. * val),
+ true, false);
+ }
+
+ val = pbeta(n / (n + x * x), n / 2.0, 0.5);
+
+ val /= 2;
+
+ if (x <= 0)
+ return val;
+ else
+ return 1 - val;
+ }
- double pt(const double &, const double &);
-
- Matrix<double> pt(const int &, const int &, const double &,
- const double &);
+ SCYTHE_DISTFUN_MATRIX(pt, double, n, double n)
+
/* PDFs */
- double dt(const double &, const double &);
+ /*! \brief The Student t distribution function.
+ *
+ * Computes the value of the Student t cumulative distribution
+ * function with \a n degrees of freedom, at the desired quantile
+ * \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param n The positive degrees of freedom of the distribution.
+ *
+ * \see pt(double x, bool b1, bool b2)
+ * \see rng::rt1(double mu, double sigma2, double nu)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ dt(double x, double n)
+ {
+ double u;
+
+ SCYTHE_CHECK_10(n <= 0, scythe_invalid_arg, "n <= 0");
+
+ double t = -bd0(n/2., (n + 1) / 2.)
+ + stirlerr((n + 1) / 2.)
+ - stirlerr(n / 2.);
+ if(x*x > 0.2*n)
+ u = std::log(1+x*x/n)*n/2;
+ else
+ u = -bd0(n/2., (n+x*x)/2.) + x*x/2;
+
+ return std::exp(t-u)/std::sqrt(2*M_PI*(1+x*x/n));
+ }
- Matrix<double> dt(const int &, const int &, const double &,
- const double &);
+ SCYTHE_DISTFUN_MATRIX(dt, double, n, double n)
- /* Others */
-
/* Returns the univariate Student-t density evaluated at x
- * with mean mu, scale sigma^2, and nu degrees of freedom
+ * with mean mu, scale sigma^2, and nu degrees of freedom.
+ *
+ * TODO: Do we want a pt for this distribution?
*/
- double dt1( const double &, const double &, const double &,
- const double &);
-
+
+ /*! \brief The univariate Student t density function.
+ *
+ * Computes the value of the univariate Student t probability
+ * density function with mean \a mu, variance \a sigma2,
+ * and degrees of freedom \a nu, at the desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param mu The mean of the distribution.
+ * \param sigma2 The variance of the distribution.
+ * \param nu The degrees of freedom of the distribution.
+ *
+ * \see rng::rt1(double mu, double sigma2, double nu)
+ * \see dt(double x, bool b1, bool b2)
+ * \see pt(double x, bool b1, bool b2)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ dt1(double x, double mu, double sigma2, double nu)
+ {
+ double logdens = lngammafn((nu + 1.0) /2.0)
+ - std::log(std::sqrt(nu * M_PI))
+ - lngammafn(nu / 2.0) - std::log(std::sqrt(sigma2))
+ - (nu + 1.0) / 2.0 * std::log(1.0 + (std::pow((x - mu), 2.0))
+ / (nu * sigma2));
+
+ return(std::exp(logdens));
+ }
+
+ SCYTHE_DISTFUN_MATRIX(dt1, double, SCYTHE_ARGSET(mu, sigma2, nu), double mu, double sigma2, double nu)
+
/* Returns the natural log of the univariate Student-t density
* evaluated at x with mean mu, scale sigma^2, and nu
* degrees of freedom
*/
- double lndt1(const double &, const double &,
- const double &, const double &);
+
+ /*! \brief The natural log of the univariate Student t density
+ * function.
+ *
+ * Computes the value of the natural log of the univariate Student t
+ * probability density function with mean \a mu, variance \a sigma2,
+ * and degrees of freedom \a nu, at the desired quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param mu The mean of the distribution.
+ * \param sigma2 The variance of the distribution.
+ * \param nu The degrees of freedom of the distribution.
+ *
+ * \see rng::rt1(double mu, double sigma2, double nu)
+ * \see dt(double x, bool b1, bool b2)
+ * \see pt(double x, bool b1, bool b2)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_range_error (Level 1)
+ * \throw scythe_precision_error (Level 1)
+ */
+ inline double
+ lndt1(double x, double mu, double sigma2, double nu)
+ {
+ double logdens = lngammafn((nu+1.0)/2.0)
+ - std::log(std::sqrt(nu*M_PI))
+ - lngammafn(nu/2.0) - std::log(std::sqrt(sigma2))
+ - (nu+1.0)/2.0 * std::log(1.0 + (std::pow((x-mu),2.0))
+ /(nu * sigma2));
+
+ return(logdens);
+ }
+
+ SCYTHE_DISTFUN_MATRIX(lndt1, double, SCYTHE_ARGSET(mu, sigma2, nu), double mu, double sigma2, double nu)
/**** The Uniform Distribution ****/
/* CDFs */
- double punif (const double &, const double &a = 0.0,
- const double &b = 1.0);
-
- Matrix<double> punif( const int &, const int &,
- const double &, const double &a = 0.0,
- const double &b = 1.0);
+ /*! \brief The uniform distribution function.
+ *
+ * Computes the value of the uniform cumulative distribution
+ * function evaluated on the interval [\a a, \a b], at the desired
+ * quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile x.
+ * \param a The lower end-point of the distribution.
+ * \param b The upper end-point of the distribution.
+ *
+ * \see dunif(double x, double a, double b)
+ * \see rng::runif()
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ punif(double x, double a, double b)
+ {
+ SCYTHE_CHECK_10(b <= a, scythe_invalid_arg, "b <= a");
+
+ if (x <= a)
+ return 0.0;
+
+ if (x >= b)
+ return 1.0;
+
+ return (x - a) / (b - a);
+ }
+
+ SCYTHE_DISTFUN_MATRIX(punif, double, SCYTHE_ARGSET(a, b), double a, double b)
/* PDFs */
- double dunif( const double &, const double &a = 0.0,
- const double &b = 1.0);
+ /*! \brief The uniform density function.
+ *
+ * Computes the value of the uniform probability density
+ * function evaluated on the interval [\a a, \a b], at the desired
+ * quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile x.
+ * \param a The lower end-point of the distribution.
+ * \param b The upper end-point of the distribution.
+ *
+ * \see punif(double x, double a, double b)
+ * \see rng::runif()
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ dunif(double x, double a, double b)
+ {
+ SCYTHE_CHECK_10(b <= a, scythe_invalid_arg, "b <= a");
+
+ if (a <= x && x <= b)
+ return 1.0 / (b - a);
+
+ return 0.0;
+ }
- Matrix<double> dunif( const int &, const int &,
- const double &, const double &a = 0.0,
- const double &b = 1.0);
+ SCYTHE_DISTFUN_MATRIX(dunif, double, SCYTHE_ARGSET(a, b), double a, double b)
/**** The Weibull Distribution ****/
-
+
/* CDFs */
- double pweibull(const double &, const double &,
- const double &scale = 1.0);
+ /*! \brief The Weibull distribution function.
+ *
+ * Computes the value of the Weibull cumulative distribution
+ * function with given \a shape and \a scale, at the desired
+ * quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param shape The positive shape of the distribution.
+ * \param scale The positive scale of the distribution.
+ *
+ * \see dweibull(double x, double shape, double scale)
+ * \see rng::rweibull(double shape, double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ pweibull(double x, double shape, double scale)
+ {
+ SCYTHE_CHECK_10(shape <= 0 || scale <= 0, scythe_invalid_arg,
+ "shape or scale <= 0");
+
+ if (x <= 0)
+ return 0.0;
+
+ return 1 - std::exp(-std::pow(x / scale, shape));
+ }
- Matrix<double> pweibull(const int &, const int &,
- const double &, const double &,
- const double &scale = 1.0);
+ SCYTHE_DISTFUN_MATRIX(pweibull, double, SCYTHE_ARGSET(shape, scale), double shape, double scale)
/* PDFs */
- double dweibull(const double &, const double &,
- const double &scale = 1.0);
+ /*! \brief The Weibull density function.
+ *
+ * Computes the value of the Weibull probability density
+ * function with given \a shape and \a scale, at the desired
+ * quantile \a x.
+ *
+ * It is also possible to call this function with a Matrix of
+ * doubles as its first argument. In this case the function will
+ * return a Matrix of doubles of the same dimension as \a x,
+ * containing the result of evaluating this function at each value
+ * in \a x, given the remaining fixed parameters. By default, the
+ * returned Matrix will be concrete and have the same matrix_order
+ * as \a x, but you may invoke a generalized version of the function
+ * with an explicit template call.
+ *
+ * \param x The desired quantile.
+ * \param shape The positive shape of the distribution.
+ * \param scale The positive scale of the distribution.
+ *
+ * \see pweibull(double x, double shape, double scale)
+ * \see rng::rweibull(double shape, double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ inline double
+ dweibull(double x, double shape, double scale)
+ {
+ SCYTHE_CHECK_10(shape <= 0 || scale <= 0, scythe_invalid_arg,
+ "shape or scale <= 0");
+
+ if (x < 0)
+ return 0.;
+
+ double tmp1 = std::pow(x / scale, shape - 1);
+ double tmp2 = tmp1*(x / scale);
+
+ return shape * tmp1 * std::exp(-tmp2) / scale;
+ }
- Matrix<double> dweibull(const int &, const int &,
- const double &, const double &,
- const double &scale = 1.0);
+ SCYTHE_DISTFUN_MATRIX(dweibull, double, SCYTHE_ARGSET(shape, scale), double shape, double scale)
- /************************************
- * Partially Finished Distributions *
- ************************************/
-
/* Multivariate Normal */
- double lndmvn ( const Matrix<double> &, const Matrix<double> &,
- const Matrix<double> &);
-
-
- /********************
- * Helper Functions *
- ********************/
- namespace INTERNAL {
-
- /* Evaluates an Chebyshev series at a given point */
- double chebyshev_eval (const double &, const double *, const int &);
-
- /* Computes the log gamma correction factor for x >= 10 */
- double lngammacor (const double &);
- /* Helper for dpois and dgamma */
- double dpois_raw (const double &, const double &);
-
- /* Evaluates the "deviance part" */
- double bd0 (const double &, const double &);
-
- /* Computes the log of the error term in Stirling's formula */
- double stirlerr (const double &);
-
- double pbeta_raw(const double &, const double &, const double &);
-
- double dbinom_raw(const double &, const double &, const double &,
- const double &);
+ // TODO: distribution function. Plain old (non-logged) dmvnorm.
+
+ /*! \brief The natural log of the multivariate normal density
+ * function.
+ *
+ * Computes the value of the natural log of the multivariate normal
+ * probability density function with vector of mean \a mu and
+ * variance-covariance matrix \a Sigma, at the vector of desired
+ * quantiles \a x.
+ *
+ * \param x The vector of desired quantiles.
+ * \param mu The vector of means.
+ * \param Sigma The variance-covariance matrix.
+ *
+ * \see rng:rmvnorm(const Matrix<double, PO1, PS1>& mu, const Matrix<double, PO2, PS2>& sigma)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_null_error (Level 1)
+ */
+ template <matrix_order O1, matrix_style S1,
+ matrix_order O2, matrix_style S2,
+ matrix_order O3, matrix_style S3>
+ double lndmvn (const Matrix<double, O1, S1>& x,
+ const Matrix<double, O2, S2>& mu,
+ const Matrix<double, O3, S3>& Sigma)
+ {
+ SCYTHE_CHECK_10(! x.isColVector(), scythe_dimension_error,
+ "x is not a column vector");
+ SCYTHE_CHECK_10(! mu.isColVector(), scythe_dimension_error,
+ "mu is not a column vector");
+ SCYTHE_CHECK_10(! Sigma.isSquare(), scythe_dimension_error,
+ "Sigma is not square");
+ SCYTHE_CHECK_10(mu.rows()!=Sigma.rows() || x.rows()!=Sigma.rows(),
+ scythe_conformation_error,
+ "mu, x and Sigma have mismatched row lengths")
+ int k = (int) mu.rows();
+ return ( (-k/2.0)*std::log(2*M_PI) -0.5 * std::log(det(Sigma))
+ -0.5 * (t(x - mu)) * invpd(Sigma) * (x-mu) )[0];
}
-}
+} // end namespace scythe
-#endif
+
+#endif /* SCYTHE_DISTRIBUTIONS_H */
diff --git a/src/error.h b/src/error.h
index d9df83f..b3d7df6 100644
--- a/src/error.h
+++ b/src/error.h
@@ -1,22 +1,51 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * scythestat/error.h
+ * scythestat/error.h
+ */
+
+/*! \file error.h
+ *
+ * \brief Definitions of Scythe exception classes.
*
- * Provides classes to handle various error conditions generated by
- * the library. These classes extend the std::exception class
- * provided by the Standard Template Library (STL)
+ * This file contains the class definitions for
+ * scythe::scythe_exception and its children. These exception classes
+ * describe all of the error conditions generated by Scythe library
+ * routines.
*
+ * Furthermore, error.h contains a series of macro definitions that
+ * regulate the inclusion of the library's error checking code in
+ * compiled code. These macros are controlled by the compiler flag
+ * SCYTHE_DEBUG and define four levels of scythe debug
+ * info, SCYTHE_DEBUG = 0, 1, 2, or 3. The library uses these macros to
+ * specify the debug level of thrown exceptions. If we are at level
+ * three, all throws are expanded into actual code, at level 2 only
+ * SCYTHE_THROW_10 AND SCYTHE_THROW_20 calls are expanded, and so on.
+ * Scythe developers should balance exception importance and
+ * efficiency costs when making exception level choices. For example,
+ * bounds checking in matrices is done at level three primarily
+ * because the added branch results in high performance penalties and
+ * out-of-bounds errors shouldn't occur in well-written code, while
+ * conformance checks in matrix multiplication are level 1 because the
+ * checks result in little overhead relative to the cost of matrix
+ * multiplication and conformation errors are easy to introduce by
+ * accident. At level 0, the library performs virtually no error
+ * checking.
+ *
+ * While the various SCYTHE_THROW, SCYTHE_CHECK, and SCYTHE_WARN
+ * macros will only typically be used by library developers, users
+ * should make extensive use the tiered error reporting in Scythe by
+ * setting the compiler flag SCYTHE_DEBUG. If not explicitly set by
+ * the user, the SCYTHE_DEBUG level is automatically set to 3.
*/
#ifndef SCYTHE_ERROR_H
@@ -26,19 +55,101 @@
#include <string>
#include <sstream>
#include <iostream>
+#include <vector>
+
+/*! @cond */
+#ifdef SCYTHE_DEBUG_LIB
+#define SCYTHE_DEBUG_MSG(MSG) \
+{ std::cout << "SCYTHE_DEBUG_LIB: " << MSG << std::endl; }
+#else
+#define SCYTHE_DEBUG_MSG(MSG)
+#endif
+/*! @endcond */
+
+#define SCYTHE_THROW(EXCEP,MSG) \
+ { \
+ std::stringstream _SCYTHE_DEBUG_ss; \
+ _SCYTHE_DEBUG_ss << MSG; \
+ throw EXCEP(__FILE__, __func__, __LINE__, \
+ _SCYTHE_DEBUG_ss.str()); \
+ }
+
+#define SCYTHE_CHECK(CHECK,EXCEP,MSG) \
+{ \
+ if (CHECK) \
+ SCYTHE_THROW(EXCEP,MSG) \
+}
-namespace SCYTHE
+/*! @cond */
+#ifndef SCYTHE_DEBUG
+#define SCYTHE_DEBUG 3
+#endif
+/*! @endcond */
+
+#if SCYTHE_DEBUG > 0
+#define SCYTHE_CHECK_10(CHECK,EXCEP,MSG) SCYTHE_CHECK(CHECK,EXCEP,MSG)
+#else
+#define SCYTHE_CHECK_10(CHECK, EXCEP, MSG)
+#endif
+
+#if SCYTHE_DEBUG > 1
+#define SCYTHE_CHECK_20(CHECK,EXCEP,MSG) SCYTHE_CHECK(CHECK,EXCEP,MSG)
+#else
+#define SCYTHE_CHECK_20(CHECK, EXCEP, MSG)
+#endif
+
+#if SCYTHE_DEBUG > 2
+#define SCYTHE_CHECK_30(CHECK,EXCEP,MSG) SCYTHE_CHECK(CHECK,EXCEP,MSG)
+#else
+#define SCYTHE_CHECK_30(CHECK, EXCEP, MSG)
+#endif
+
+#if SCYTHE_DEBUG > 0
+#define SCYTHE_THROW_10(EXCEP,MSG) SCYTHE_THROW(EXCEP,MSG)
+#else
+#define SCYTHE_THROW_10(EXCEP,MSG)
+#endif
+
+#if SCYTHE_DEBUG > 1
+#define SCYTHE_THROW_20(EXCEP,MSG) SCYTHE_THROW(EXCEP,MSG)
+#else
+#define SCYTHE_THROW_20(EXCEP,MSG)
+#endif
+
+#if SCYTHE_DEBUG > 2
+#define SCYTHE_THROW_30(EXCEP,MSG) SCYTHE_THROW(EXCEP,MSG)
+#else
+#define SCYTHE_THROW_30(EXCEP,MSG)
+#endif
+
+#define SCYTHE_WARN(MSG) \
+ { \
+ std::cerr << "WARNING in " << __FILE__ << ", " \
+ << __func__ << ", " << __LINE__ << ": " \
+ << MSG << "\n"; \
+ }
+
+#define SCYTHE_CHECK_WARN(CHECK,MSG) \
+ { \
+ if (CHECK) \
+ SCYTHE_WARN(MSG) \
+ }
+
+
+namespace scythe
{
+ /* Forward declaration for serr */
+ class scythe_exception;
/**** This file-local variable holds the output of the last
* scythe_exception constructed.
****/
#ifdef __MINGW32__
- static std::string serr;
+ static scythe_exception *serr;
#else
namespace
{
- std::string serr;
+ scythe_exception *serr;
}
#endif
@@ -49,6 +160,14 @@ namespace SCYTHE
inline void scythe_terminate ();
/**** The scythe exception abstract base class ****/
+ /*!
+ * \brief The Scythe exception abstract base class.
+ *
+ * The is the base class in Scythe's error handling class tree.
+ * This class extends std::exception and provides fields for
+ * information about the exception, including where the exception
+ * occurred in the library and a message describing the error.
+ */
class scythe_exception:public std::exception
{
public:
@@ -63,12 +182,16 @@ namespace SCYTHE
file_ (file),
function_ (function),
line_ (line),
- message_ (message)
+ message_ (message),
+ call_files_ (),
+ call_funcs_ (),
+ call_lines_ ()
{
std::ostringstream os;
os << head_ << " in " << file_ << ", " << function_ << ", "
- << line_ << ": " << message_ << "!";
- serr = os.str ();
+ << line_ << ": " << message_ << "!\n\n";
+
+ serr = this;
std::set_terminate (scythe_terminate);
if (halt)
std::terminate ();
@@ -80,7 +203,10 @@ namespace SCYTHE
file_ (e.file_),
function_ (e.function_),
line_ (e.line_),
- message_ (e.message_)
+ message_ (e.message_),
+ call_files_ (e.call_files_),
+ call_funcs_ (e.call_funcs_),
+ call_lines_ (e.call_lines_)
{
}
@@ -102,6 +228,10 @@ namespace SCYTHE
virtual const char *what () const throw ()
{
std::ostringstream os;
+ for (int i = call_files_.size() - 1; i > -1; ++i) {
+ os << "Called from " << call_files_[i] << ", "
+ << call_funcs_[i] << ", " << call_lines_[i] << std::endl;
+ }
os << head_ << " in " << file_ << ", " << function_ << ", "
<< line_ << ": " << message_ << "!";
return os.str ().c_str ();
@@ -112,16 +242,43 @@ namespace SCYTHE
return message_;
}
+ virtual void add_caller (const std::string &file,
+ const std::string &function, const unsigned int &line) throw ()
+ {
+
+ /* This if allows one to catch and rethrow an error in the same
+ * function w/out messing things up. Nice to keep try-catch
+ * blocks to a minimum
+ */
+
+ if (file != file_ && function != function_) {
+ call_files_.push_back(file);
+ call_funcs_.push_back(function);
+ call_lines_.push_back(line);
+ }
+ }
+
private:
std::string head_;
std::string file_;
std::string function_;
unsigned int line_;
std::string message_;
+ std::vector<std::string> call_files_;
+ std::vector<std::string> call_funcs_;
+ std::vector<unsigned int> call_lines_;
};
/**** Exception class types, added as needed ****/
+
+ /*!
+ * \brief Memory allocation error.
+ *
+ * Library members throw this exception in response to insufficient
+ * memory conditions, such as when one attempts to create a Matrix
+ * object that is bigger than available memory.
+ */
class scythe_alloc_error:public scythe_exception
{
public:
@@ -136,6 +293,13 @@ namespace SCYTHE
}
};
+ /*!
+ * \brief Invalid function argument.
+ *
+ * Library members throw this exception when callers pass incorrect
+ * arguments to a function, such as when one calls the factorial
+ * method with an argument less than 0.
+ */
class scythe_invalid_arg:public scythe_exception
{
public:
@@ -150,6 +314,13 @@ namespace SCYTHE
}
};
+ /*!
+ * \brief File i/o error.
+ *
+ * Library members throw this exception when errors occur during
+ * file reading, writing, or creation, such as when one passes an
+ * invalid file name to the Matrix class's save method.
+ */
class scythe_file_error:public scythe_exception
{
public:
@@ -164,6 +335,12 @@ namespace SCYTHE
}
};
+ /*! \brief Matrix conformation error.
+ *
+ * Library members throw this exception when a caller passes
+ * non-conforming matrices (matrices of incompatible dimensions) to
+ * a routine, such as when one attempt two row vectors.
+ */
class scythe_conformation_error:public scythe_exception
{
public:
@@ -178,6 +355,14 @@ namespace SCYTHE
}
};
+ /*! \brief Matrix dimension error.
+ *
+ * Library members throw this exception when a caller passes a
+ * Matrix of the wrong size or shape to a routine. For example,
+ * trying to take the Cholesky decomposition of a non-square Matrix
+ * causes this error.
+ */
+
class scythe_dimension_error:public scythe_exception
{
public:
@@ -192,6 +377,13 @@ namespace SCYTHE
}
};
+ /*! \brief Null Matrix error.
+ *
+ * Library members throw this exception when a caller passes a null
+ * Matrix to a routine when it expects a non-null argument. For
+ * example, taking the inverse of a null Matrix is impossible,
+ * resulting in this exception.
+ */
class scythe_null_error:public scythe_exception
{
public:
@@ -206,6 +398,15 @@ namespace SCYTHE
}
};
+ /*! \brief Matrix type error.
+ *
+ * Library members throw this exception when a caller passes a
+ * Matrix that does not satisfy some required property to a routine.
+ * For example, Cholesky decomposition is designed to work on
+ * positive definite matrices; trying to perform Cholesky
+ * decomposition on a Matrix that does not satisfy this requirement
+ * causes this exception.
+ */
class scythe_type_error:public scythe_exception
{
public:
@@ -220,20 +421,34 @@ namespace SCYTHE
}
};
- class scythe_out_of_range_error:public scythe_exception
+ /*! \brief Element out of bounds error.
+ *
+ * Library members throw this exception when a caller attempts to
+ * access an element outside the bounds of a data structure, such as
+ * when one tries to access the 1000th element of a 200-element
+ * Matrix.
+ */
+ class scythe_bounds_error:public scythe_exception
{
public:
- scythe_out_of_range_error(const std::string & file,
+ scythe_bounds_error(const std::string & file,
const std::string & function,
const unsigned int &line,
const std::string & message = "",
const bool & halt = false) throw ()
- : scythe_exception ("SCYTHE OUT OF RANGE ERROR", file, function,
+ : scythe_exception ("SCYTHE BOUNDS ERROR", file, function,
line, message, halt)
{
}
};
+ /*! \brief Numerical convergence error.
+ *
+ * Library members throw this exception when a numerical algorithm
+ * fails to converge to a stable value. For example, the BFGS
+ * optimization routine throws this exception when it cannot locate
+ * the minimum of a function to a given tolerance.
+ */
class scythe_convergence_error:public scythe_exception
{
public:
@@ -248,6 +463,14 @@ namespace SCYTHE
}
};
+ /*! \brief Numerical underflow or overflow error.
+ *
+ * Library members throw this exception when the result of a
+ * calculation, assignment, or other operation is to small or large
+ * for the data type holding the value. For example, passing
+ * certain values to the gammafn function can result in underflow or
+ * overflow conditions in the resulting calculations.
+ */
class scythe_range_error:public scythe_exception
{
public:
@@ -262,6 +485,15 @@ namespace SCYTHE
}
};
+ /*! \brief Numerical precision error.
+ *
+ * Library members throw this exception when a routine cannot
+ * complete a computation effectively and will sacrifice reasonable
+ * precision as a consequence. For example, passing a value too
+ * close to a negative integer to the gammafn function renders the
+ * function incapable of returning an accurate result and thus
+ * generates this exception.
+ */
class scythe_precision_error:public scythe_exception
{
public:
@@ -276,20 +508,14 @@ namespace SCYTHE
}
};
- class scythe_nan_error:public scythe_exception
- {
- public:
- scythe_nan_error(const std::string & file,
- const std::string & function,
- const unsigned int &line,
- const std::string & message = "",
- const bool & halt = false) throw ()
- : scythe_exception ("SCYTHE NOT-A-NUMBER ERROR", file, function,
- line, message, halt)
- {
- }
- };
-
+ /*! \brief Random number seed error.
+ *
+ * Library members throw this exception when a random number
+ * generator is provided with an illegitimate starting seed value.
+ * For example, the lecuyer class requires seeds within a certain
+ * range to operate properly and will throw this exception when
+ * seeded with a number outside of that range.
+ */
class scythe_randseed_error:public scythe_exception
{
public:
@@ -304,10 +530,70 @@ namespace SCYTHE
}
};
+ /*! \brief Matrix style error.
+ *
+ * Library members throw this exception when they are asked to
+ * operate on a Matrix of the incorrect style. Some routines
+ * require specifically a concrete Matrix or view to work correctly.
+ * For example, only views may reference other matrices; invoking
+ * the reference function on a concrete Matrix will generate this
+ * exception.
+ */
+ class scythe_style_error:public scythe_exception
+ {
+ public:
+ scythe_style_error(const std::string& file,
+ const std::string& function,
+ const unsigned int& line,
+ const std::string& message = "",
+ const bool& halt = false) throw ()
+ : scythe_exception("SCYTHE STYLE ERROR", file, function,
+ line, message, halt)
+ {}
+ };
+
+ /*! \brief LAPACK Internal Error
+ *
+ * Library members throw this exception when an underlying LAPACK or
+ * BLAS routine indicates that an internal error has occurred.
+ *
+ */
+ class scythe_lapack_internal_error:public scythe_exception
+ {
+ public:
+ scythe_lapack_internal_error(const std::string& file,
+ const std::string& function,
+ const unsigned int& line,
+ const std::string& message = "",
+ const bool& halt = false) throw ()
+ : scythe_exception("SCYTHE LAPACK/BLAS INTERNAL ERROR", file,
+ function, line, message, halt)
+ {}
+ };
+
+ /*! \brief Unexpected call to default error.
+ *
+ * This error should not occur. If it occurs in your code, please
+ * contact the Scythe developers to report the problem.
+ *
+ */
+ class scythe_unexpected_default_error:public scythe_exception
+ {
+ public:
+ scythe_unexpected_default_error(const std::string& file,
+ const std::string& function,
+ const unsigned int& line,
+ const std::string& message = "",
+ const bool& halt = false) throw ()
+ : scythe_exception("SCYTHE UNEXPECTED DEFAULT ERROR", file,
+ function, line, message, halt)
+ {}
+ };
+
// The definition of our terminate handler described above
inline void scythe_terminate ()
{
- std::cerr << serr << std::endl;
+ std::cerr << serr->what() << std::endl;
std::cerr << std::endl;
abort ();
}
diff --git a/src/ide.cc b/src/ide.cc
deleted file mode 100644
index 7b6b354..0000000
--- a/src/ide.cc
+++ /dev/null
@@ -1,534 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/ide.cc
- *
- * Provides implementations for inversion and decomposition
- * template functions that operate on Scythe's Matrix class.
- *
- */
-
-#ifndef SCYTHE_IDE_CC
-#define SCYTHE_IDE_CC
-
-#include <cmath>
-#include <algorithm>
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "ide.h"
-#include "error.h"
-#include "util.h"
-#else
-#include "scythestat/ide.h"
-#include "scythestat/error.h"
-#include "scythestat/util.h"
-#endif
-
-namespace SCYTHE {
-
- /* Cholesky Decomposition of a Symmetric Positive Definite Matrix */
- template <class T>
- Matrix<T>
- cholesky (const Matrix<T> &A){
-
- if (! A.isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix not square");
- }
-
- Matrix<T> temp (A.rows(), A.cols(), false);
- register T h;
-
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = i; j < A.cols(); ++j) {
- h = A(i,j);
- for (int k = 0; k < i; ++k) {
- h -= temp(i, k) * temp(j, k);
- }
- if (i == j) {
- if (h <= (T) 0) {
- throw scythe_type_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix not positive definite");
- }
- temp(i,i) = std::sqrt(h);
- } else {
- temp(j,i) = (((T) 1) / temp(i,i)) * h;
- temp(i,j) = (T) 0;
- }
- }
- }
-
- return temp;
- }
-
- /* Solve Ax=b for x via backsubstitution using cholesky decomp */
- template <class T>
- Matrix<T>
- chol_solve (const Matrix<T> & A, const Matrix<T> & b)
- {
- /* NOTE: cholesky() call does check for square/posdef of A */
-
- if ((! b.isColVector()) || A.rows() != b.rows() || ! A.isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Inputs not proper dimension");
- }
-
- Matrix<T> M = cholesky (A);
- register T holder;
- register T *y = new T[A.rows()];
- register T *x = new T[A.rows()];
-
- // solve M*y = b
- for (int i = 0; i < A.rows(); ++i) {
- holder = (T) 0;
- for (int j = 0; j < i; ++j) {
- holder += M(i,j) * y[j];
- }
- y[i] = (((T) 1) / M(i,i)) * (b[i] - holder);
- }
-
- // solve M'*x = y
- for (int i = A.rows() - 1; i >= 0; --i) {
- holder = (T) 0;
- for (int j = i + 1; j < A.rows(); ++j) {
- holder += M(j,i) * x[j];
- }
- x[i] = (((T) 1) / M(i,i)) * (y[i] - holder);
- }
-
- Matrix<T> temp (A.rows(), 1, x);
- delete[]y;
- delete[]x;
-
- return temp;
- }
-
- /* Solve Ax=b for x via backsub using cholesky decomp */
- template <class T>
- Matrix<T>
- chol_solve (const Matrix<T> &A, const Matrix<T> &b,
- const Matrix<T> &M)
- {
- if (b.cols() != 1 || A.rows() != b.rows() || A.rows() != M.rows()
- || ! A.isSquare() || ! M.isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Inputs not proper dimension");
- }
- register T *y = new T[A.rows()];
- register T *x = new T[A.rows()];
- register T holder;
-
- // solve M*y = b
- for (int i = 0; i < A.rows(); ++i) {
- holder = 0.0;
- for (int j = 0; j < i; ++j) {
- holder += M(i,j) * y[j];
- }
- y[i] = (1.0 / M(i,i)) * (b[i] - holder);
- }
-
- // solve M'*x = y
- for (int i = A.rows() - 1; i >= 0; --i) {
- holder = 0.0;
- for (int j = i + 1; j < A.rows(); ++j) {
- holder += M(j,i) * x[j];
- }
- x[i] = (1.0 / M(i,i)) * (y[i] - holder);
- }
-
- Matrix<T> temp (A.rows(), 1, x);
- delete[]y;
- delete[]x;
-
- return temp;
- }
-
-
- /* Calculate the inverse of a symmetric positive definite matrix */
- template <class T>
- Matrix<T>
- invpd (const Matrix<T> &A)
- {
- // SYMMETRY OF A *IS NOT* CHECKED
- if (! A.isSquare())
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix not square");
-
- // Cholesky decomp
- Matrix<T> M (A.rows(), A.cols(), false);
- register T h;
-
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = i; j < A.cols(); ++j) {
- h = A(i,j);
- for (int k = 0; k < i; ++k) {
- h -= M(i, k) * M(j, k);
- }
- if (i == j) {
- if (h <= (T) 0) {
- throw scythe_type_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix not positive definite");
- }
- M(i,i) = std::sqrt(h);
- } else {
- M(j,i) = (((T) 1) / M(i,i)) * h;
- M(i,j) = (T) 0;
- }
- }
- }
-
- // for chol_solve block
- register T *y = new T[A.rows()];
- register T *x = new T[A.rows()];
- Matrix<T> b(A.rows(), 1); // full of zeros
-
- // For final answer
- Matrix<T> Ainv(A.rows(), A.cols(), false);
-
- for (int k = 0; k < A.rows(); ++k) {
- b[k] = (T) 1;
-
- // begin chol_solve
- // solve M*y = b
- for (int i = 0; i < A.rows(); ++i) {
- h = (T) 0;
- for (int j = 0; j < i; ++j) {
- h += M(i,j) * y[j];
- }
- y[i] = (((T) 1) / M(i,i)) * (b[i] - h);
- }
-
- // solve M'*x = y
- for (int i = A.rows() - 1; i >= 0; --i) {
- h = (T) 0;
- for (int j = i + 1; j < A.rows(); ++j) {
- h += M(j,i) * x[j];
- }
- x[i] = (((T) 1) / M(i,i)) * (y[i] - h);
- }
- // end chol_solve
-
- b[k] = (T) 0;
- for (int l = 0; l < A.rows(); ++l)
- Ainv(l,k) = x[l];
- }
-
- delete[] y;
- delete[] x;
-
- return Ainv;
- }
-
-
- /* Calculates the inverse of a Symmetric Positive Definite Matrix */
- template <class T>
- Matrix<T>
- invpd (const Matrix<T> &A, const Matrix<T> &M)
- {
- if (A.rows() != M.cols() || A.cols() != M.rows())
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A and M do not conform");
-
- register T h;
-
- // for chol_solve block
- register T *y = new T[A.rows()];
- register T *x = new T[A.rows()];
- Matrix<T> b(A.rows(), 1); // full of zeros
-
- // For final answer
- Matrix<T> Ainv(A.rows(), A.cols(), false);
-
- for (int k = 0; k < A.rows(); ++k) {
- b[k] = (T) 1;
-
- // begin chol_solve
- // solve M*y = b
- for (int i = 0; i < A.rows(); ++i) {
- h = (T) 0;
- for (int j = 0; j < i; ++j) {
- h += M(i,j) * y[j];
- }
- y[i] = (((T) 1) / M(i,i)) * (b[i] - h);
- }
-
- // solve M'*x = y
- for (int i = A.rows() - 1; i >= 0; --i) {
- h = (T) 0;
- for (int j = i + 1; j < A.rows(); ++j) {
- h += M(j,i) * x[j];
- }
- x[i] = (((T) 1) / M(i,i)) * (y[i] - h);
- }
- // end chol_solve
-
- b[k] = (T) 0;
- for (int l = 0; l < A.rows(); ++l)
- Ainv(l,k) = x[l];
- }
-
- delete[] y;
- delete[] x;
-
- return Ainv;
- }
-
-// This code is based on Algorithm 3.4.1 of Golub and Van Loan
-// 3rd edition, 1996. Major difference is in how the output is
-// structured.
-
- /* Calculates the LU Decomposition of a square Matrix */
- template <class T>
- void
- lu_decomp(Matrix<T> A, Matrix<T> &L, Matrix<T> &U,
- Matrix<int> &perm_vec)
- {
- if (! A.isSquare())
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix A not square");
-
- if (A.isRowVector()) {
- L = Matrix<T> (1, 1, true, 1); // all 1s
- U = A;
- perm_vec = Matrix<int>(1, 1); // all 0s
- return;
- }
-
- L = U = Matrix<T>(A.rows(), A.cols(), false);
- perm_vec = Matrix<int> (A.rows() - 1, 1, false);
-
- int pivot;
- T temp;
-
- for (int k = 0; k < A.rows() - 1; ++k) {
- pivot = k;
- // find pivot
- for (int i = k; i < A.rows(); ++i) {
- if (std::fabs(A(pivot,k)) < std::fabs(A(i,k)))
- pivot = i;
- }
-
- if (A(pivot,k) == (T) 0)
- throw scythe_type_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix is singular");
-
- // permute
- if (k != pivot) {
- for (int i = 0; i < A.rows(); ++i) {
- temp = A(pivot,i);
- A(pivot,i) = A(k,i);
- A(k,i) = temp;
- }
- }
- perm_vec[k] = pivot;
-
- for (int i = k + 1; i < A.rows(); ++i) {
- A(i,k) = A(i,k) / A(k,k);
- for (int j = k + 1; j < A.rows(); ++j)
- A(i,j) = A(i,j) - A(i,k) * A(k,j);
- }
- }
-
- L = A;
-
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = i; j < A.rows(); ++j) {
- U(i,j) = A(i,j);
- L(i,j) = (T) 0;
- L(i,i) = (T) 1;
- }
- }
- }
-
-
- /* Solves A*x=b for x via lu_decomp */
- template <class T>
- Matrix<T>
- lu_solve(Matrix<T> A, const Matrix<T> &b)
- {
- if (! b.isColVector())
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "b is not a column vector");
-
- if (! A.isSquare())
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix A not square");
-
- if (A.rows() != b.rows())
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A.rows() != b.rows()");
-
- // step 1 compute the LU factorization
- Matrix<T> L, U;
- Matrix<int> perm_vec;
-
- if (A.isRowVector()) {
- L = Matrix<T> (1, 1, true, 1); // all 1s
- U = A;
- perm_vec = Matrix<int>(1, 1); // all 0s
- } else {
-
- L = U = Matrix<T>(A.rows(), A.cols(), false);
- perm_vec = Matrix<int> (A.rows() - 1, 1, false);
-
- int pivot;
- T temp;
-
- for (int k = 0; k < A.rows() - 1; ++k) {
- pivot = k;
- // find pivot
- for (int i = k; i < A.rows(); ++i) {
- if (std::fabs(A(pivot,k)) < std::fabs(A(i,k)))
- pivot = i;
- }
-
- if (A(pivot,k) == (T) 0)
- throw scythe_type_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix is singular");
-
- // permute
- if (k != pivot) {
- for (int i = 0; i < A.rows(); ++i) {
- temp = A(pivot,i);
- A(pivot,i) = A(k,i);
- A(k,i) = temp;
- }
- }
- perm_vec[k] = pivot;
-
- for (int i = k + 1; i < A.rows(); ++i) {
- A(i,k) = A(i,k) / A(k,k);
- for (int j = k + 1; j < A.rows(); ++j)
- A(i,j) = A(i,j) - A(i,k) * A(k,j);
- }
- }
-
- L = A;
-
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = i; j < A.rows(); ++j) {
- U(i,j) = A(i,j);
- L(i,j) = (T) 0;
- L(i,i) = (T) 1;
- }
- }
- }
- // step 2 solve L*y = Pb via forward substitution
- Matrix<T> bb = row_interchange(b, perm_vec);
- Matrix<T> y(A.rows(), 1, false);
- T sum;
-
- for (int i = 0; i < A.rows(); ++i) {
- sum = (T) 0;
- for (int j = 0; j < i; ++j)
- sum += L[i * A.cols() + j] * y[j];
-
- y[i] = (bb[i] - sum) / L[i * A.cols() + i];
- }
-
- // step 3 solve U*x = y via backsubstitution
- Matrix<T> x(A.rows(), 1, false);
- for (int i = A.rows() - 1; i >= 0; --i) {
- sum = (T) 0;
- for (int j = i + 1; j < A.rows(); ++j)
- sum += U[i * A.cols() + j] * x[j];
-
- x[i] = (y[i] - sum) / U[i * A.cols() + i];
- }
-
- return x;
- }
-
- /* lu_solve overrloaded: you need A, b + L, U, perm_vec from
- * lu_decomp
- */
- template <class T>
- Matrix<T>
- lu_solve (Matrix<T> A, const Matrix<T> &b, const Matrix<T> &L,
- const Matrix<T> &U, const Matrix<int> &perm_vec)
- {
- if (! b.isColVector())
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "b is not a column vector");
-
- if (! A.isSquare())
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A is not square");
-
- if (A.rows() != b.rows())
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A and b have different row sizes");
-
- if (A.rows() != L.rows() || A.rows() != U.rows() ||
- A.cols() != L.cols() || A.cols() != U.cols())
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A, L, and U do not conform");
-
- if (perm_vec.rows() + 1 != A.rows())
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "perm_vec does not have exactly one less row than A");
-
-
- // step 1 solve L*y = Pb via forward substitution
- Matrix<T> bb = row_interchange(b, perm_vec);
- Matrix<T> y(A.rows(), 1, false);
- T sum;
-
- for (int i = 0; i < A.rows(); ++i) {
- sum = (T) 0;
- for (int j = 0; j < i; ++j)
- sum += L[i * A.cols() + j] * y[j];
-
- y[i] = (bb[i] - sum) / L[i * A.cols() + i];
- }
-
- // step 2 solve U*x = y via backsubstitution
- Matrix<T> x(A.rows(), 1, false);
- for (int i = A.rows() - 1; i >= 0; --i) {
- sum = (T) 0;
- for (int j = i + 1; j < A.rows(); ++j)
- sum += U[i * A.cols() + j] * x[j];
-
- x[i] = (y[i] - sum) / U[i * A.cols() + i];
- }
-
- return x;
- }
-
- /* Interchanges the rows of A with those in vector p */
- //XXX maybe I should inline this and get rid of .t lines
- template <class T>
- Matrix<T>
- row_interchange(Matrix<T> A, const Matrix<int> &p){
- if (! p.isColVector()) {
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p not a column vector");
- }
- if (p.rows() + 1 != A.rows()) {
- throw scythe_conformation_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p must have one less row than A");
- }
-
- for (int i = 0; i < A.rows() - 1; ++i)
- swap_ranges(A.vec(i), A.vec(i + 1), A.vec(p[i]));
-
- return A;
- }
-
-} // end namespace SCYTHE
-
-#ifndef SCYTHE_COMPILE_DIRECT
-#include "scythestat/eti/ide.t"
-#endif
-
-#endif /* SCYTHE_IDE_CC */
diff --git a/src/ide.h b/src/ide.h
index 8d6a9c1..c2f32b8 100644
--- a/src/ide.h
+++ b/src/ide.h
@@ -1,20 +1,69 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * scythestat/ide.h
+ * scythestat/ide.h
*
- * Provides definitions for inversion and decomposition
- * template functions that operate on Scythe's Matrix class.
+ *
+ */
+
+/*! \file ide.h
+ *
+ * \brief Definitions for inversion and decomposition functions that
+ * operate on Scythe's Matrix objects.
+ *
+ * This file provides a number of common inversion and decomposition
+ * routines that operate on Matrix objects. It also provides related
+ * functions for solving linear systems of equations and calculating
+ * the determinant of a Matrix.
+ *
+ * Scythe will use LAPACK/BLAS routines to perform these operations on
+ * concrete column-major matrices of double-precision floating point
+ * numbers if LAPACK/BLAS is available and you compile your program
+ * with the SCYTHE_LAPACK flag enabled.
+ *
+ * \note As is the case throughout the library, we provide both
+ * general and default template definitions of the Matrix-returning
+ * functions in this file, explicitly providing documentation for only
+ * the general template versions. As is also often the case, Doxygen
+ * does not always correctly add the default template definition to
+ * the function list below; there is always a default template
+ * definition available for every function.
+ */
+
+/* TODO: This interface exposes the user to too much implementation.
+ * We need a solve function and a solver object. By default, solve
+ * would run lu_solve and the solver factory would return lu_solvers
+ * (or perhaps a solver object encapsulating an lu_solver). Users
+ * could choose cholesky when appropriate. Down the road, qr or svd
+ * would become the default and we'd be able to handle non-square
+ * matrices. Instead of doing an lu_decomp or a cholesky and keeping
+ * track of the results to repeatedly solve for different b's with A
+ * fixed in Ax=b, you'd just call the operator() on your solver object
+ * over and over, passing the new b each time. No decomposition
+ * specific solvers (except as toggles to the solver object and
+ * solve function). We'd still provide cholesky and lu_decomp. We
+ * could also think about a similar approach to inversion (one
+ * inversion function with an option for method).
+ *
+ * If virtual dispatch in C++ wasn't such a performance killer (no
+ * compiler optimization across virtual calls!!!) there would be an
+ * obvious implementation of this interface using simple polymorphism.
+ * Unfortunately, we need compile-time typing to maintain performance
+ * and makes developing a clean interface that doesn't force users to
+ * be template wizards much harder. Initial experiments with the
+ * Barton and Nackman trick were ugly. The engine approach might work
+ * a bit better but has its problems too. This is not going to get
+ * done for the 1.0 release, but it is something we should come back
+ * to.
*
*/
@@ -23,92 +72,1686 @@
#ifdef SCYTHE_COMPILE_DIRECT
#include "matrix.h"
+#include "error.h"
+#include "defs.h"
+#ifdef SCYTHE_LAPACK
+#include "lapack.h"
+#include "stat.h"
+#endif
#else
#include "scythestat/matrix.h"
+#include "scythestat/error.h"
+#include "scythestat/defs.h"
+#ifdef SCYTHE_LAPACK
+#include "scythestat/lapack.h"
+#include "scythestat/stat.h"
+#endif
#endif
-namespace SCYTHE {
+#include <cmath>
+#include <algorithm>
- /* Cholesky decomposition of a sym pos-def matrix */
- template <class T>
- Matrix<T>
- cholesky (const Matrix<T> &);
+namespace scythe {
- /* Solves Ax=b for x via backsubstitution using Cholesky
- * Decomposition (NOTE: function is overloaded) A must be symmetric
- * and positive definite
- */
- template <class T>
- Matrix<T>
- chol_solve (const Matrix<T> &, const Matrix<T> &);
-
- /* Solves Ax=b for x via backsubstitution using Cholesky
- * Decomposition. This function takes in the lower triangular L as
- * input and does not depend upon cholesky() A must be symmetric and
- * positive definite
+ namespace {
+ typedef unsigned int uint;
+ }
+
+ /*!
+ * \brief Cholesky decomposition of a symmetric positive-definite
+ * matrix.
+ *
+ * This function performs Cholesky decomposition. That is, given a
+ * symmetric positive definite Matrix, \f$A\f$, cholesky() returns a
+ * lower triangular Matrix \f$L\f$ such that \f$A = LL^T\f$. This
+ * function is faster than lu_decomp() and, therefore, preferable in
+ * cases where one's Matrix is symmetric positive definite.
+ *
+ * \param A The symmetric positive definite Matrix to decompose.
+ *
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &, const Matrix<T,PO3,PS3> &)
+ * \see lu_decomp(Matrix<T,PO1,PS1>, Matrix<T,PO2,Concrete>&, Matrix<T,PO3,Concrete>&, Matrix<unsigned int, PO4, Concrete>&)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_type_error (Level 2)
+ * \throw scythe_alloc_error (Level 1)
+ *
*/
- template <class T>
- Matrix<T> chol_solve (const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &);
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ cholesky (const Matrix<T, PO, PS>& A)
+ {
+ SCYTHE_CHECK_10(! A.isSquare(), scythe_dimension_error,
+ "Matrix not square");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "Matrix is NULL");
+ // Rounding errors can make this problematic. Leaving out for now
+ //SCYTHE_CHECK_20(! A.isSymmetric(), scythe_type_error,
+ // "Matrix not symmetric");
+
+ Matrix<T,RO,Concrete> temp (A.rows(), A.cols(), false);
+ T h;
+
+ if (PO == Row) { // row-major optimized
+ for (uint i = 0; i < A.rows(); ++i) {
+ for (uint j = i; j < A.cols(); ++j) {
+ h = A(i,j);
+ for (uint k = 0; k < i; ++k)
+ h -= temp(i, k) * temp(j, k);
+ if (i == j) {
+ SCYTHE_CHECK_20(h <= (T) 0, scythe_type_error,
+ "Matrix not positive definite");
+
+ temp(i,i) = std::sqrt(h);
+ } else {
+ temp(j,i) = (((T) 1) / temp(i,i)) * h;
+ temp(i,j) = (T) 0;
+ }
+ }
+ }
+ } else { // col-major optimized
+ for (uint j = 0; j < A.cols(); ++j) {
+ for (uint i = j; i < A.rows(); ++i) {
+ h = A(i, j);
+ for (uint k = 0; k < j; ++k)
+ h -= temp(j, k) * temp(i, k);
+ if (i == j) {
+ SCYTHE_CHECK_20(h <= (T) 0, scythe_type_error,
+ "Matrix not positive definite");
+ temp(j,j) = std::sqrt(h);
+ } else {
+ temp(i,j) = (((T) 1) / temp(j,j)) * h;
+ temp(j,i) = (T) 0;
+ }
+ }
+ }
+ }
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, temp)
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ cholesky (const Matrix<T,O,S>& A)
+ {
+ return cholesky<O,Concrete>(A);
+ }
+
+ namespace {
+ /* This internal routine encapsulates the
+ * algorithm used within chol_solve and lu_solve.
+ */
+ template <typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3>
+ inline void
+ solve(const Matrix<T,PO1,PS1>& L, const Matrix<T,PO2,PS2>& U,
+ Matrix<T,PO3,PS3> b, T* x, T* y)
+ {
+ T sum;
+
+ /* TODO: Consider optimizing for ordering. Experimentation
+ * shows performance gains are probably minor (compared col-major
+ * with and without lapack solve routines).
+ */
+ // solve M*y = b
+ for (uint i = 0; i < b.size(); ++i) {
+ sum = T (0);
+ for (uint j = 0; j < i; ++j) {
+ sum += L(i,j) * y[j];
+ }
+ y[i] = (b[i] - sum) / L(i, i);
+ }
+
+ // solve M'*x = y
+ if (U.isNull()) { // A= LL^T
+ for (int i = b.size() - 1; i >= 0; --i) {
+ sum = T(0);
+ for (uint j = i + 1; j < b.size(); ++j) {
+ sum += L(j,i) * x[j];
+ }
+ x[i] = (y[i] - sum) / L(i, i);
+ }
+ } else { // A = LU
+ for (int i = b.size() - 1; i >= 0; --i) {
+ sum = T(0);
+ for (uint j = i + 1; j < b.size(); ++j) {
+ sum += U(i,j) * x[j];
+ }
+ x[i] = (y[i] - sum) / U(i, i);
+ }
+ }
+ }
+ }
+
+ /*!\brief Solve \f$Ax=b\f$ for x via backward substitution, given a
+ * lower triangular matrix resulting from Cholesky decomposition
+ *
+ * This function solves the system of equations \f$Ax = b\f$ via
+ * backward substitution. \a L is the lower triangular matrix generated
+ * by Cholesky decomposition such that \f$A = LL'\f$.
+ *
+ * This function is intended for repeatedly solving systems of
+ * equations based on \a A. That is \a A stays constant while \a
+ * b varies.
+ *
+ * \param A A symmetric positive definite Matrix.
+ * \param b A column vector with as many rows as \a A.
+ * \param M The lower triangular matrix from the Cholesky decomposition of \a A.
+ *
+ * \see chol_solve(const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&)
+ * \see cholesky(const Matrix<T, PO, PS>&)
+ * \see lu_solve (const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<T,PO4,PS4>&, const Matrix<unsigned int, PO5, PS5>&)
+ * \see lu_solve (Matrix<T,PO1,PS1>, const Matrix<T,PO2,PS2>&)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ *
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3>
+ Matrix<T,RO,RS>
+ chol_solve (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& b,
+ const Matrix<T,PO3,PS3>& M)
+ {
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10(! b.isColVector(), scythe_dimension_error,
+ "b must be a column vector");
+ SCYTHE_CHECK_10(A.rows() != b.rows(), scythe_conformation_error,
+ "A and b do not conform");
+ SCYTHE_CHECK_10(A.rows() != M.rows(), scythe_conformation_error,
+ "A and M do not conform");
+ SCYTHE_CHECK_10(! M.isSquare(), scythe_dimension_error,
+ "M must be square");
+
+ T *y = new T[A.rows()];
+ T *x = new T[A.rows()];
+
+ solve(M, Matrix<>(), b, x, y);
+
+ Matrix<T,RO,RS> result(A.rows(), 1, x);
+
+ delete[]x;
+ delete[]y;
+
+ return result;
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3>
+ Matrix<T,PO1,Concrete>
+ chol_solve (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& b,
+ const Matrix<T,PO3,PS3>& M)
+ {
+ return chol_solve<PO1,Concrete>(A,b,M);
+ }
+
+ /*!\brief Solve \f$Ax=b\f$ for x via backward substitution,
+ * using Cholesky decomposition
+ *
+ * This function solves the system of equations \f$Ax = b\f$ via
+ * backward substitution and Cholesky decomposition. \a A must be a
+ * symmetric positive definite matrix for this method to work. This
+ * function calls cholesky() to perform the decomposition.
+ *
+ * \param A A symmetric positive definite matrix.
+ * \param b A column vector with as many rows as \a A.
+ *
+ * \see chol_solve(const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&)
+ * \see cholesky(const Matrix<T, PO, PS>&)
+ * \see lu_solve (const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<T,PO4,PS4>&, const Matrix<unsigned int, PO5, PS5>&)
+ * \see lu_solve (Matrix<T,PO1,PS1>, const Matrix<T,PO2,PS2>&)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_type_error (Level 2)
+ * \throw scythe_alloc_error (Level 1)
+ *
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ chol_solve (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& b)
+ {
+ /* NOTE: cholesky() call does check for square/posdef of A,
+ * and the overloaded chol_solve call handles dimensions
+ */
+
+ return chol_solve<RO,RS>(A, b, cholesky<RO,Concrete>(A));
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ chol_solve (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& b)
+ {
+ return chol_solve<PO1,Concrete>(A, b);
+ }
- /* Calculates the inverse of a Sym. Pos. Def. Matrix (NOTE: function
- * is overloaded)
+
+ /*!\brief Calculates the inverse of a symmetric positive definite
+ * matrix, given a lower triangular matrix resulting from Cholesky
+ * decomposition.
+ *
+ * This function returns the inverse of a symmetric positive
+ * definite matrix. Unlike the one-parameter version, this function
+ * requires the caller to perform Cholesky decomposition on the
+ * matrix to invert, ahead of time.
+ *
+ * \param A The symmetric positive definite matrix to invert.
+ * \param M The lower triangular matrix from the Cholesky decomposition of \a A.
+ *
+ * \see invpd(const Matrix<T, PO, PS>&)
+ * \see inv(const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<unsigned int,PO4,PS4>&)
+ * \see inv(const Matrix<T, PO, PS>&)
+ * \see cholesky(const Matrix<T, PO, PS>&)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
*/
- template <class T>
- Matrix<T> invpd (const Matrix<T> &);
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ invpd (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& M)
+ {
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10(! A.isSquare(), scythe_dimension_error,
+ "A is not square")
+ SCYTHE_CHECK_10(A.rows() != M.cols() || A.cols() != M.rows(),
+ scythe_conformation_error, "A and M do not conform");
+
+ // for chol_solve block
+ T *y = new T[A.rows()];
+ T *x = new T[A.rows()];
+ Matrix<T, RO, Concrete> b(A.rows(), 1); // full of zeros
+ Matrix<T, RO, Concrete> null;
+
+ // For final answer
+ Matrix<T, RO, Concrete> Ainv(A.rows(), A.cols(), false);
+
+ for (uint k = 0; k < A.rows(); ++k) {
+ b[k] = (T) 1;
+
+ solve(M, null, b, x, y);
+
+ b[k] = (T) 0;
+ for (uint l = 0; l < A.rows(); ++l)
+ Ainv(l,k) = x[l];
+ }
- /* Calculates the inverse of a Sym. Pos. Def. Matrix (NOTE: function
- * is overloaded)
+ delete[] y;
+ delete[] x;
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, Ainv)
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ invpd (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& M)
+ {
+ return invpd<PO1,Concrete>(A, M);
+ }
+
+ /*!\brief Calculate the inverse of a symmetric positive definite
+ * matrix.
+ *
+ * This function returns the inverse of a symmetric positive definite
+ * matrix, using cholesky() to do the necessary decomposition. This
+ * method is significantly faster than the generalized inverse
+ * function.
+ *
+ * \param A The symmetric positive definite matrix to invert.
+ *
+ * \see invpd(const Matrix<T, PO1, PS1>&, const Matrix<T, PO2, PS2>&)
+ * \see inv (const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<unsigned int,PO4,PS4>&)
+ * \see inv (const Matrix<T, PO, PS>&)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_type_error (Level 2)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ invpd (const Matrix<T, PO, PS>& A)
+ {
+ // Cholesky checks to see if A is square and symmetric
+
+ return invpd<RO,RS>(A, cholesky<RO,Concrete>(A));
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ invpd (const Matrix<T,O,S>& A)
+ {
+ return invpd<O,Concrete>(A);
+ }
+
+ /* This code is based on Algorithm 3.4.1 of Golub and Van Loan 3rd
+ * edition, 1996. Major difference is in how the output is
+ * structured. Returns the sign of the row permutation (used by
+ * det). Internal function, doesn't need doxygen.
*/
- template <class T>
- Matrix<T> invpd (const Matrix<T> &, const Matrix<T> &);
+ namespace {
+ template <matrix_order PO1, matrix_style PS1, typename T,
+ matrix_order PO2, matrix_order PO3, matrix_order PO4>
+ inline T
+ lu_decomp_alg(Matrix<T,PO1,PS1>& A, Matrix<T,PO2,Concrete>& L,
+ Matrix<T,PO3,Concrete>& U,
+ Matrix<unsigned int, PO4, Concrete>& perm_vec)
+ {
+ if (A.isRowVector()) {
+ L = Matrix<T,PO2,Concrete> (1, 1, true, 1); // all 1s
+ U = A;
+ perm_vec = Matrix<uint, PO4, Concrete>(1, 1); // all 0s
+ return (T) 0;
+ }
+
+ L = U = Matrix<T, PO2, Concrete>(A.rows(), A.cols(), false);
+ perm_vec = Matrix<uint, PO3, Concrete> (A.rows() - 1, 1, false);
+
+ uint pivot;
+ T temp;
+ T sign = (T) 1;
+
+ for (uint k = 0; k < A.rows() - 1; ++k) {
+ pivot = k;
+ // find pivot
+ for (uint i = k; i < A.rows(); ++i) {
+ if (std::fabs(A(pivot,k)) < std::fabs(A(i,k)))
+ pivot = i;
+ }
+
+ SCYTHE_CHECK_20(A(pivot,k) == (T) 0, scythe_type_error,
+ "Matrix is singular");
+
+ // permute
+ if (k != pivot) {
+ sign *= -1;
+ for (uint i = 0; i < A.rows(); ++i) {
+ temp = A(pivot,i);
+ A(pivot,i) = A(k,i);
+ A(k,i) = temp;
+ }
+ }
+ perm_vec[k] = pivot;
+
+ for (uint i = k + 1; i < A.rows(); ++i) {
+ A(i,k) = A(i,k) / A(k,k);
+ for (uint j = k + 1; j < A.rows(); ++j)
+ A(i,j) = A(i,j) - A(i,k) * A(k,j);
+ }
+ }
+
+ L = A;
+
+ for (uint i = 0; i < A.rows(); ++i) {
+ for (uint j = i; j < A.rows(); ++j) {
+ U(i,j) = A(i,j);
+ L(i,j) = (T) 0;
+ L(i,i) = (T) 1;
+ }
+ }
+ return sign;
+ }
+ }
/* Calculates the LU Decomposition of a square Matrix */
- template <class T>
- void lu_decomp (Matrix<T>, Matrix<T> &, Matrix<T> &,
- Matrix<int> &);
- /* Solve Ax=b for x via forward and backsubstitution using the LU
- * Decomp of Matrix A (NOTE: This function is overloaded)
+ /* Note that the L, U, and perm_vec must be concrete. A is passed by
+ * value, because it is changed during the decomposition. If A is a
+ * view, it will get mangled, but the decomposition will work fine.
+ * Not sure what the copy/view access trade-off is, but passing a
+ * view might speed things up if you don't care about messing up
+ * your matrix.
+ */
+ /*! \brief LU decomposition of a square matrix.
+ *
+ * This function performs LU decomposition. That is, given a
+ * non-singular square matrix \a A and three matrix references, \a
+ * L, \a U, and \a perm_vec, lu_decomp fills the latter three
+ * matrices such that \f$LU = A\f$. This method does not actually
+ * calculate the LU decomposition of \a A, but of a row-wise
+ * permutation of \a A. This permutation is recorded in perm_vec.
+ *
+ * \note Note that \a L, \a U, and \a perm_vec must be concrete.
+ * \a A is passed by value because the function modifies it during
+ * the decomposition. Users should generally avoid passing Matrix
+ * views as the first argument to this function because this
+ * results in modification to the Matrix being viewed.
+ *
+ * \param A Non-singular square matrix to decompose.
+ * \param L Lower triangular portion of LU decomposition of A.
+ * \param U Upper triangular portion of LU decomposition of A.
+ * \param perm_vec Permutation vector recording the row-wise permutation of A actually decomposed by the algorithm.
+ *
+ * \see cholesky (const Matrix<T, PO, PS>&)
+ * \see lu_solve (const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<T,PO4,PS4>&, const Matrix<unsigned int, PO5, PS5>&)
+ * \see lu_solve (Matrix<T,PO1,PS1>, const Matrix<T,PO2,PS2>&)
+ *
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_type_error (Level 2)
+ */
+ template <matrix_order PO1, matrix_style PS1, typename T,
+ matrix_order PO2, matrix_order PO3, matrix_order PO4>
+ void
+ lu_decomp(Matrix<T,PO1,PS1> A, Matrix<T,PO2,Concrete>& L,
+ Matrix<T,PO3,Concrete>& U,
+ Matrix<unsigned int, PO4, Concrete>& perm_vec)
+ {
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10(! A.isSquare(), scythe_dimension_error,
+ "Matrix A not square");
+
+ lu_decomp_alg(A, L, U, perm_vec);
+ }
+
+ /* lu_solve overloaded: you need A, b + L, U, perm_vec from
+ * lu_decomp.
+ *
+ */
+ /*! \brief Solve \f$Ax=b\f$ for x via forward and backward
+ * substitution, given the results of a LU decomposition.
+ *
+ * This function solves the system of equations \f$Ax = b\f$ via
+ * forward and backward substitution and LU decomposition. \a A
+ * must be a non-singular square matrix for this method to work.
+ * This function requires the actual LU decomposition to be
+ * performed ahead of time; by lu_decomp() for example.
+ *
+ * This function is intended for repeatedly solving systems of
+ * equations based on \a A. That is \a A stays constant while \a
+ * b varies.
+ *
+ * \param A Non-singular square Matrix to decompose, passed by reference.
+ * \param b Column vector with as many rows as \a A.
+ * \param L Lower triangular portion of LU decomposition of \a A.
+ * \param U Upper triangular portion of LU decomposition of \a A.
+ * \param perm_vec Permutation vector recording the row-wise permutation of \a A actually decomposed by the algorithm.
+ *
+ * \see lu_solve (Matrix<T,PO1,PS1>, const Matrix<T,PO2,PS2>&)
+ * \see lu_decomp(Matrix<T,PO1,PS1>, Matrix<T,PO2,Concrete>&, Matrix<T,PO3,Concrete>&, Matrix<unsigned int, PO4, Concrete>&)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &, const Matrix<T,PO3,PS3> &)
+ *
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3,
+ matrix_order PO4, matrix_style PS4,
+ matrix_order PO5, matrix_style PS5>
+ Matrix<T, RO, RS>
+ lu_solve (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& b,
+ const Matrix<T,PO3,PS3>& L, const Matrix<T,PO4,PS4>& U,
+ const Matrix<unsigned int, PO5, PS5> &perm_vec)
+ {
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10(! b.isColVector(), scythe_dimension_error,
+ "b is not a column vector");
+ SCYTHE_CHECK_10(! A.isSquare(), scythe_dimension_error,
+ "A is not square");
+ SCYTHE_CHECK_10(A.rows() != b.rows(), scythe_conformation_error,
+ "A and b have different row sizes");
+ SCYTHE_CHECK_10(A.rows() != L.rows() || A.rows() != U.rows() ||
+ A.cols() != L.cols() || A.cols() != U.cols(),
+ scythe_conformation_error,
+ "A, L, and U do not conform");
+ SCYTHE_CHECK_10(perm_vec.rows() + 1 != A.rows(),
+ scythe_conformation_error,
+ "perm_vec does not have exactly one less row than A");
+
+ T *y = new T[A.rows()];
+ T *x = new T[A.rows()];
+
+ Matrix<T,RO,Concrete> bb = row_interchange(b, perm_vec);
+ solve(L, U, bb, x, y);
+
+ Matrix<T,RO,RS> result(A.rows(), 1, x);
+
+ delete[]x;
+ delete[]y;
+
+ return result;
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3,
+ matrix_order PO4, matrix_style PS4,
+ matrix_order PO5, matrix_style PS5>
+ Matrix<T, PO1, Concrete>
+ lu_solve (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& b,
+ const Matrix<T,PO3,PS3>& L, const Matrix<T,PO4,PS4>& U,
+ const Matrix<unsigned int, PO5, PS5> &perm_vec)
+ {
+ return lu_solve<PO1,Concrete>(A, b, L, U, perm_vec);
+ }
+
+ /*! \brief Solve \f$Ax=b\f$ for x via forward and backward
+ * substitution, using LU decomposition
+ *
+ * This function solves the system of equations \f$Ax = b\f$ via
+ * forward and backward substitution and LU decomposition. \a A
+ * must be a non-singular square matrix for this method to work.
+ *
+ * \param A A non-singular square Matrix to decompose.
+ * \param b A column vector with as many rows as \a A.
+ *
+ * \see lu_solve (const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<T,PO4,PS4>&, const Matrix<unsigned int, PO5, PS5>&)
+ * \see lu_decomp(Matrix<T,PO1,PS1>, Matrix<T,PO2,Concrete>&, Matrix<T,PO3,Concrete>&, Matrix<unsigned int, PO4, Concrete>&)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &, const Matrix<T,PO3,PS3> &)
+ *
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_type_error (Level 2)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ lu_solve (Matrix<T,PO1,PS1> A, const Matrix<T,PO2,PS2>& b)
+ {
+ // step 1 compute the LU factorization
+ Matrix<T, RO, Concrete> L, U;
+ Matrix<uint, RO, Concrete> perm_vec;
+ lu_decomp_alg(A, L, U, perm_vec);
+
+ return lu_solve<RO,RS>(A, b, L, U, perm_vec);
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ lu_solve (Matrix<T,PO1,PS1> A, const Matrix<T,PO2,PS2>& b)
+ {
+ // Slight code rep here, but very few lines
+
+ // step 1 compute the LU factorization
+ Matrix<T, PO1, Concrete> L, U;
+ Matrix<uint, PO1, Concrete> perm_vec;
+ lu_decomp_alg(A, L, U, perm_vec);
+
+ return lu_solve<PO1,Concrete>(A, b, L, U, perm_vec);
+ }
+
+ /*!\brief Calculates the inverse of a non-singular square matrix,
+ * given an LU decomposition.
+ *
+ * This function returns the inverse of an arbitrary, non-singular,
+ * square matrix \a A when passed a permutation of an LU
+ * decomposition, such as that returned by lu_decomp(). A
+ * one-parameter version of this function exists that does not
+ * require the user to pre-decompose the system.
+ *
+ * \param A The Matrix to be inverted.
+ * \param L A Lower triangular matrix resulting from decomposition.
+ * \param U An Upper triangular matrix resulting from decomposition.
+ * \param perm_vec The permutation vector recording the row-wise permutation of \a A actually decomposed by the algorithm.
+ *
+ * \see inv (const Matrix<T, PO, PS>&)
+ * \see invpd(const Matrix<T, PO, PS>&)
+ * \see invpd(const Matrix<T, PO1, PS1>&, const Matrix<T, PO2, PS2>&)
+ * \see lu_decomp(Matrix<T,PO1,PS1>, Matrix<T,PO2,Concrete>&, Matrix<T,PO3,Concrete>&, Matrix<unsigned int, PO4, Concrete>&)
+ *
+ * \throw scythe_null_error(Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ */
+ template<matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3,
+ matrix_order PO4, matrix_style PS4>
+ Matrix<T,RO,RS>
+ inv (const Matrix<T,PO1,PS1>& A,
+ const Matrix<T,PO2,PS2>& L, const Matrix<T,PO3,PS3>& U,
+ const Matrix<unsigned int,PO4,PS4>& perm_vec)
+ {
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10 (! A.isSquare(), scythe_dimension_error,
+ "A is not square");
+ SCYTHE_CHECK_10(A.rows() != L.rows() || A.rows() != U.rows() ||
+ A.cols() != L.cols() || A.cols() != U.cols(),
+ scythe_conformation_error,
+ "A, L, and U do not conform");
+ SCYTHE_CHECK_10(perm_vec.rows() + 1 != A.rows()
+ && !(A.isScalar() && perm_vec.isScalar()),
+ scythe_conformation_error,
+ "perm_vec does not have exactly one less row than A");
+
+ // For the final result
+ Matrix<T,RO,Concrete> Ainv(A.rows(), A.rows(), false);
+
+ // for the solve block
+ T *y = new T[A.rows()];
+ T *x = new T[A.rows()];
+ Matrix<T, RO, Concrete> b(A.rows(), 1); // full of zeros
+ Matrix<T,RO,Concrete> bb;
+
+ for (uint k = 0; k < A.rows(); ++k) {
+ b[k] = (T) 1;
+ bb = row_interchange(b, perm_vec);
+
+ solve(L, U, bb, x, y);
+
+ b[k] = (T) 0;
+ for (uint l = 0; l < A.rows(); ++l)
+ Ainv(l,k) = x[l];
+ }
+
+ delete[] y;
+ delete[] x;
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, Ainv)
+ }
+
+ template<typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3,
+ matrix_order PO4, matrix_style PS4>
+ Matrix<T,PO1,Concrete>
+ inv (const Matrix<T,PO1,PS1>& A,
+ const Matrix<T,PO2,PS2>& L, const Matrix<T,PO3,PS3>& U,
+ const Matrix<unsigned int,PO4,PS4>& perm_vec)
+ {
+ return inv<PO1,Concrete>(A, L, U, perm_vec);
+ }
+
+ /*!\brief Invert an arbitrary, non-singular, square matrix.
+ *
+ * This function returns the inverse of a non-singular square matrix,
+ * using lu_decomp() to do the necessary decomposition. This method
+ * is significantly slower than the inverse function for symmetric
+ * positive definite matrices, invpd().
+ *
+ * \param A The Matrix to be inverted.
+ *
+ * \see inv (const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<unsigned int,PO4,PS4>&)
+ * \see invpd(const Matrix<T, PO, PS>&)
+ * \see invpd(const Matrix<T, PO1, PS1>&, const Matrix<T, PO2, PS2>&)
+ *
+ * \throw scythe_null_error(Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_type_error (Level 2)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ inv (const Matrix<T, PO, PS>& A)
+ {
+ // Make a copy of A for the decomposition (do it with an explicit
+ // copy to a concrete case A is a view)
+ Matrix<T,RO,Concrete> AA = A;
+
+ // step 1 compute the LU factorization
+ Matrix<T, RO, Concrete> L, U;
+ Matrix<uint, RO, Concrete> perm_vec;
+ lu_decomp_alg(AA, L, U, perm_vec);
+
+ return inv<RO,RS>(A, L, U, perm_vec);
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ inv (const Matrix<T, O, S>& A)
+ {
+ return inv<O,Concrete>(A);
+ }
+
+ /* Interchanges the rows of A with those in vector p */
+ /*!\brief Interchange the rows of a Matrix according to a
+ * permutation vector.
+ *
+ * This function permutes the rows of Matrix \a A according to \a
+ * perm_vec. Each element i of perm_vec contains a row-number, r.
+ * For each row, i, in \a A, A[i] is interchanged with A[r].
+ *
+ * \param A The matrix to permute.
+ * \param p The column vector describing the permutations to perform
+ * on \a A.
+ *
+ * \see lu_decomp(Matrix<T,PO1,PS1>, Matrix<T,PO2,Concrete>&, Matrix<T,PO3,Concrete>&, Matrix<unsigned int, PO4, Concrete>&)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ row_interchange (Matrix<T,PO1,PS1> A,
+ const Matrix<unsigned int,PO2,PS2>& p)
+ {
+ SCYTHE_CHECK_10(! p.isColVector(), scythe_dimension_error,
+ "p not a column vector");
+ SCYTHE_CHECK_10(p.rows() + 1 != A.rows() && ! p.isScalar(),
+ scythe_conformation_error, "p must have one less row than A");
+
+ for (uint i = 0; i < A.rows() - 1; ++i) {
+ Matrix<T,PO1,View> vec1 = A(i, _);
+ Matrix<T,PO1,View> vec2 = A(p[i], _);
+ std::swap_ranges(vec1.begin_f(), vec1.end_f(), vec2.begin_f());
+ }
+
+ return A;
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ row_interchange (const Matrix<T,PO1,PS1>& A,
+ const Matrix<unsigned int,PO2,PS2>& p)
+ {
+ return row_interchange<PO1,Concrete>(A, p);
+ }
+
+ /*! \brief Calculate the determinant of a square Matrix.
+ *
+ * This routine calculates the determinant of a square Matrix, using
+ * LU decomposition.
+ *
+ * \param A The Matrix to calculate the determinant of.
+ *
+ * \see lu_decomp(Matrix<T,PO1,PS1>, Matrix<T,PO2,Concrete>&, Matrix<T,PO3,Concrete>&, Matrix<unsigned int, PO4, Concrete>&)
+ *
+ * \throws scythe_dimension_error (Level 1)
+ * \throws scythe_null_error (Level 1)
+ */
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ det (const Matrix<T, PO, PS>& A)
+ {
+ SCYTHE_CHECK_10(! A.isSquare(), scythe_dimension_error,
+ "Matrix is not square")
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "Matrix is NULL")
+
+ // Make a copy of A for the decomposition (do it here instead of
+ // at parameter pass in case A is a view)
+ Matrix<T,PO,Concrete> AA = A;
+
+ // step 1 compute the LU factorization
+ Matrix<T, PO, Concrete> L, U;
+ Matrix<uint, PO, Concrete> perm_vec;
+ T sign = lu_decomp_alg(AA, L, U, perm_vec);
+
+ // step 2 calculate the product of diag(U) and sign
+ T det = (T) 1;
+ for (uint i = 0; i < AA.rows(); ++i)
+ det *= AA(i, i);
+
+ return sign * det;
+ }
+
+#ifdef SCYTHE_LAPACK
+
+ template<>
+ Matrix<>
+ cholesky (const Matrix<>& A)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for cholesky");
+ SCYTHE_CHECK_10(! A.isSquare(), scythe_dimension_error,
+ "Matrix not square");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "Matrix is NULL");
+
+ // We have to do an explicit copy within the func to match the
+ // template declaration of the more general template.
+ Matrix<> AA = A;
+
+ // Get a pointer to the internal array and set up some vars
+ double* Aarray = AA.getArray(); // internal array pointer
+ int rows = (int) AA.rows(); // the dim of the matrix
+ int err = 0; // The output error condition
+
+ // Cholesky decomposition step
+ lapack::dpotrf_("L", &rows, Aarray, &rows, &err);
+ SCYTHE_CHECK_10(err > 0, scythe_type_error,
+ "Matrix is not positive definite")
+ SCYTHE_CHECK_10(err < 0, scythe_invalid_arg,
+ "The " << err << "th value of the matrix had an illegal value")
+
+ // Zero out upper triangle
+ for (uint j = 1; j < AA.cols(); ++j)
+ for (uint i = 0; i < j; ++i)
+ AA(i, j) = 0;
+
+ return AA;
+ }
+
+ template<>
+ Matrix<>
+ chol_solve (const Matrix<>& A, const Matrix<>& b, const Matrix<>& M)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for chol_solve");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10(! b.isColVector(), scythe_dimension_error,
+ "b must be a column vector");
+ SCYTHE_CHECK_10(A.rows() != b.rows(), scythe_conformation_error,
+ "A and b do not conform");
+ SCYTHE_CHECK_10(A.rows() != M.rows(), scythe_conformation_error,
+ "A and M do not conform");
+ SCYTHE_CHECK_10(! M.isSquare(), scythe_dimension_error,
+ "M must be square");
+
+ // The algorithm modifies b in place. We make a copy.
+ Matrix<> bb = b;
+
+ // Get array pointers and set up some vars
+ const double* Marray = M.getArray();
+ double* barray = bb.getArray();
+ int rows = (int) bb.rows();
+ int cols = (int) bb.cols(); // currently always one, but generalizable
+ int err = 0;
+
+ // Solve the system
+ lapack::dpotrs_("L", &rows, &cols, Marray, &rows, barray, &rows, &err);
+ SCYTHE_CHECK_10(err > 0, scythe_type_error,
+ "Matrix is not positive definite")
+ SCYTHE_CHECK_10(err < 0, scythe_invalid_arg,
+ "The " << err << "th value of the matrix had an illegal value")
+
+ return bb;
+ }
+
+ template<>
+ Matrix<>
+ chol_solve (const Matrix<>& A, const Matrix<>& b)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for chol_solve");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10(! b.isColVector(), scythe_dimension_error,
+ "b must be a column vector");
+ SCYTHE_CHECK_10(A.rows() != b.rows(), scythe_conformation_error,
+ "A and b do not conform");
+
+ // The algorithm modifies both A and b in place, so we make copies
+ Matrix<> AA =A;
+ Matrix<> bb = b;
+
+ // Get array pointers and set up some vars
+ double* Aarray = AA.getArray();
+ double* barray = bb.getArray();
+ int rows = (int) bb.rows();
+ int cols = (int) bb.cols(); // currently always one, but generalizable
+ int err = 0;
+
+ // Solve the system
+ lapack::dposv_("L", &rows, &cols, Aarray, &rows, barray, &rows, &err);
+ SCYTHE_CHECK_10(err > 0, scythe_type_error,
+ "Matrix is not positive definite")
+ SCYTHE_CHECK_10(err < 0, scythe_invalid_arg,
+ "The " << err << "th value of the matrix had an illegal value")
+
+ return bb;
+ }
+
+ template <matrix_order PO2, matrix_order PO3, matrix_order PO4>
+ inline double
+ lu_decomp_alg(Matrix<>& A, Matrix<double,PO2,Concrete>& L,
+ Matrix<double,PO3,Concrete>& U,
+ Matrix<unsigned int, PO4, Concrete>& perm_vec)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for lu_decomp_alg");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error, "A is NULL")
+ SCYTHE_CHECK_10 (! A.isSquare(), scythe_dimension_error,
+ "A is not square");
+
+ if (A.isRowVector()) {
+ L = Matrix<double,PO2,Concrete> (1, 1, true, 1); // all 1s
+ U = A;
+ perm_vec = Matrix<uint, PO4, Concrete>(1, 1); // all 0s
+ return 0.;
+ }
+
+ L = U = Matrix<double, PO2, Concrete>(A.rows(), A.cols(), false);
+ perm_vec = Matrix<uint, PO3, Concrete> (A.rows(), 1, false);
+
+ // Get a pointer to the internal array and set up some vars
+ double* Aarray = A.getArray(); // internal array pointer
+ int rows = (int) A.rows(); // the dim of the matrix
+ int* ipiv = (int*) perm_vec.getArray(); // Holds the lu decomp pivot array
+ int err = 0; // The output error condition
+
+ // Do the decomposition
+ lapack::dgetrf_(&rows, &rows, Aarray, &rows, ipiv, &err);
+
+ SCYTHE_CHECK_10(err > 0, scythe_type_error, "Matrix is singular");
+ SCYTHE_CHECK_10(err < 0, scythe_lapack_internal_error,
+ "The " << err << "th value of the matrix had an illegal value");
+
+ // Now fill in the L and U matrices.
+ L = A;
+ for (uint i = 0; i < A.rows(); ++i) {
+ for (uint j = i; j < A.rows(); ++j) {
+ U(i,j) = A(i,j);
+ L(i,j) = 0.;
+ L(i,i) = 1.;
+ }
+ }
+
+ // Change to scythe's rows-1 perm_vec format and c++ indexing
+ // XXX Cutting off the last pivot term may be buggy if it isn't
+ // always just pointing at itself
+ if (perm_vec(perm_vec.size() - 1) != perm_vec.size())
+ SCYTHE_THROW(scythe_unexpected_default_error,
+ "This is an unexpected error. Please notify the developers.")
+ perm_vec = perm_vec(0, 0, perm_vec.rows() - 2, 0) - 1;
+
+ // Finally, figure out the sign of perm_vec
+ if (sum(perm_vec > 0) % 2 == 0)
+ return 1;
+
+ return -1;
+ }
+
+ /*! \brief The result of a QR decomposition.
+ *
+ * Objects of this type contain three matrices, \a QR, \a tau, and
+ * \a pivot, representing the results of a QR decomposition of a
+ * \f$m \times n\f$ matrix. After decomposition, the upper triangle
+ * of \a QR contains the min(\f$m\f$, \f$n\f$) by \f$n\f$ upper
+ * trapezoidal matrix \f$R\f$, while \a tau and the elements of \a
+ * QR below the diagonal represent the orthogonal matrix \f$Q\f$ as
+ * a product of min(\f$m\f$, \f$n\f$) elementary reflectors. The
+ * vector \a pivot is a permutation vector containing information
+ * about the pivoting strategy used in the factorization.
+ *
+ * \a QR is \f$m \times n\f$, tau is a vector of dimension
+ * min(\f$m\f$, \f$n\f$), and pivot is a vector of dimension
+ * \f$n\f$.
+ *
+ * \see qr_decomp (const Matrix<>& A)
*/
- template <class T>
- Matrix<T> lu_solve(Matrix<T>, const Matrix<T> &);
- /* Solve Ax=b for x via forward and backsubstitution using the LU
- * Decomp of Matrix A (NOTE: This function is overloaded)
+ struct QRdecomp {
+ Matrix<> QR;
+ Matrix<> tau;
+ Matrix<> pivot;
+ };
+
+ /*! \brief QR decomposition of a matrix.
+ *
+ * This function performs QR decomposition. That is, given a
+ * \f$m \times n \f$ matrix \a A, qr_decomp computes the QR factorization
+ * of \a A with column pivoting, such that \f$A \cdot P = Q \cdot
+ * R\f$. The resulting QRdecomp object contains three matrices, \a
+ * QR, \a tau, and \a pivot. The upper triangle of \a QR contains the
+ * min(\f$m\f$, \f$n\f$) by \f$n\f$ upper trapezoidal matrix
+ * \f$R\f$, while \a tau and the elements of \a QR below the
+ * diagonal represent the orthogonal matrix \f$Q\f$ as a product of
+ * min(\f$m\f$, \f$n\f$) elementary reflectors. The vector \a pivot
+ * is a permutation vector containing information about the pivoting
+ * strategy used in the factorization.
+ *
+ * \note This function requires BLAS/LAPACK functionality and is
+ * only available on machines that provide these libraries. Make
+ * sure you enable the SCYTHE_LAPACK preprocessor flag if you wish
+ * to use this function. Furthermore, note that this function takes
+ * and returns only column-major concrete matrices. Future versions
+ * of Scythe will provide a native C++ implementation of this
+ * function with support for general matrix templates.
+ *
+ * \param A A matrix to decompose.
+ *
+ * \see QRdecomp
+ * \see lu_decomp(Matrix<T,PO1,PS1>, Matrix<T,PO2,Concrete>&, Matrix<T,PO3,Concrete>&, Matrix<unsigned int, PO4, Concrete>&)
+ * \see cholesky (const Matrix<T, PO, PS>&)
+ * \see qr_solve (const Matrix<>& A, const Matrix<>& b, const QRdecomp& QR)
+ * \see qr_solve (const Matrix<>& A, const Matrix<>& b);
+ *
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_lapack_internal_error (Level 1)
*/
- template <class T>
- Matrix<T> lu_solve (Matrix<T>, const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &, const Matrix<int> &);
+ QRdecomp
+ qr_decomp (const Matrix<>& A)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for qr_decomp");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error, "A is NULL");
+
+ // Set up working variables
+ Matrix<> QR = A;
+ double* QRarray = QR.getArray(); // input/output array pointer
+ int rows = (int) QR.rows();
+ int cols = (int) QR.cols();
+ Matrix<unsigned int> pivot(cols, 1); // pivot vector
+ int* parray = (int*) pivot.getArray(); // pivot vector array pointer
+ Matrix<> tau = Matrix<>(rows < cols ? rows : cols, 1);
+ double* tarray = tau.getArray(); // tau output array pointer
+ double tmp, *work; // workspace vars
+ int lwork, info; // workspace size var and error info var
+
+ // Get workspace size
+ lwork = -1;
+ lapack::dgeqp3_(&rows, &cols, QRarray, &rows, parray, tarray, &tmp,
+ &lwork, &info);
- /* Interchanges the rows of A with those in vector p and returns the
- * modified Matrix.
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dgeqp3");
+
+ lwork = (int) tmp;
+ work = new double[lwork];
+
+ // run the routine for real
+ lapack::dgeqp3_(&rows, &cols, QRarray, &rows, parray, tarray, work,
+ &lwork, &info);
+
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dgeqp3");
+
+ delete[] work;
+
+ pivot -= 1;
+
+ QRdecomp result;
+ result.QR = QR;
+ result.tau = tau;
+ result.pivot = pivot;
+
+ return result;
+ }
+
+ /*! \brief Solve \f$Ax=b\f$ given a QR decomposition.
+ *
+ * This function solves the system of equations \f$Ax = b\f$ using
+ * the results of a QR decomposition. This function requires the
+ * actual QR decomposition to be performed ahead of time; by
+ * qr_decomp() for example.
+ *
+ * This function is intended for repeatedly solving systems of
+ * equations based on \a A. That is \a A stays constant while \a b
+ * varies.
+ *
+ * \note This function requires BLAS/LAPACK functionality and is
+ * only available on machines that provide these libraries. Make
+ * sure you enable the SCYTHE_LAPACK preprocessor flag if you wish
+ * to use this function. Furthermore, note that this function takes
+ * and returns only column-major concrete matrices. Future versions
+ * of Scythe will provide a native C++ implementation of this
+ * function with support for general matrix templates.
+ *
+ * \param A A Matrix to decompose.
+ * \param b A Matrix with as many rows as \a A.
+ * \param QR A QRdecomp object containing the result of the QR decomposition of \a A.
+ *
+ * \see QRdecomp
+ * \see qr_solve (const Matrix<>& A, const Matrix<>& b)
+ * \see qr_decomp (const Matrix<>& A)
+ * \see lu_solve (const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<T,PO4,PS4>&, const Matrix<unsigned int, PO5, PS5>&)
+ * \see lu_solve (Matrix<T,PO1,PS1>, const Matrix<T,PO2,PS2>&)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &, const Matrix<T,PO3,PS3> &)
+ *
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_type_error (Level 1)
+ * \throw scythe_lapack_internal_error (Level 1)
*/
- template <class T>
- Matrix<T> row_interchange(Matrix<T>, const Matrix<int> &);
+ inline Matrix<>
+ qr_solve(const Matrix<>& A, const Matrix<>& b, const QRdecomp& QR)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for qr_solve");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error, "A is NULL")
+ SCYTHE_CHECK_10(A.rows() != b.rows(), scythe_conformation_error,
+ "A and b do not conform");
+ SCYTHE_CHECK_10(A.rows() != QR.QR.rows() || A.cols() != QR.QR.cols(),
+ scythe_conformation_error, "A and QR do not conform");
+ int taudim = (int) (A.rows() < A.cols() ? A.rows() : A.cols());
+ SCYTHE_CHECK_10(QR.tau.size() != taudim, scythe_conformation_error,
+ "A and tau do not conform");
+ SCYTHE_CHECK_10(QR.pivot.size() != A.cols(), scythe_conformation_error,
+ "pivot vector is not the right length");
+
+ int rows = (int) QR.QR.rows();
+ int cols = (int) QR.QR.cols();
+ int nrhs = (int) b.cols();
+ int lwork, info;
+ double *work, tmp;
+ double* QRarray = QR.QR.getArray();
+ double* tarray = QR.tau.getArray();
+ Matrix<> bb = b;
+ double* barray = bb.getArray();
+
+ // Get workspace size
+ lwork = -1;
+ lapack::dormqr_("L", "T", &rows, &nrhs, &taudim, QRarray, &rows,
+ tarray, barray, &rows, &tmp, &lwork, &info);
+
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dormqr");
+
+ // And now for real
+ lwork = (int) tmp;
+ work = new double[lwork];
+ lapack::dormqr_("L", "T", &rows, &nrhs, &taudim, QRarray, &rows,
+ tarray, barray, &rows, work, &lwork, &info);
+
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dormqr");
+
+ lapack::dtrtrs_("U", "N", "N", &taudim, &nrhs, QRarray, &rows, barray,
+ &rows, &info);
- /* Calculate the Inverse of a square Matrix A via LU decomposition
+ SCYTHE_CHECK_10(info > 0, scythe_type_error, "Matrix is singular");
+ SCYTHE_CHECK_10(info < 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dtrtrs");
+
+ delete[] work;
+
+ Matrix<> result(A.cols(), b.cols(), false);
+ for (uint i = 0; i < QR.pivot.size(); ++i)
+ result(i, _) = bb(QR.pivot(i), _);
+ return result;
+ }
+
+ /*! \brief Solve \f$Ax=b\f$ using QR decomposition.
+ *
+ * This function solves the system of equations \f$Ax = b\f$ using
+ * QR decomposition. This function is intended for repeatedly
+ * solving systems of equations based on \a A. That is \a A stays
+ * constant while \a b varies.
+ *
+ * \note This function used BLAS/LAPACK support functionality and is
+ * only available on machines that provide these libraries. Make
+ * sure you enable the SCYTHE_LAPACK preprocessor flag if you wish
+ * to use this function. Furthermore, note that the function takes
+ * and returns only column-major concrete matrices. Future versions
+ * of Scythe will provide a native C++ implementation of this
+ * function with support for general matrix templates.
+ *
+ * \param A A Matrix to decompose.
+ * \param b A Matrix with as many rows as \a A.
*
- * DEPRECATED: see operator^= in Scythe_Matrix
+ * \see QRdecomp
+ * \see qr_solve (const Matrix<>& A, const Matrix<>& b, const QRdecomp& QR)
+ * \see qr_decomp (const Matrix<>& A)
+ * \see lu_solve (const Matrix<T,PO1,PS1>&, const Matrix<T,PO2,PS2>&, const Matrix<T,PO3,PS3>&, const Matrix<T,PO4,PS4>&, const Matrix<unsigned int, PO5, PS5>&)
+ * \see lu_solve (Matrix<T,PO1,PS1>, const Matrix<T,PO2,PS2>&)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &)
+ * \see chol_solve(const Matrix<T,PO1,PS1> &, const Matrix<T,PO2,PS2> &, const Matrix<T,PO3,PS3> &)
+ *
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_type_error (Level 1)
+ * \throw scythe_lapack_internal_error (Level 1)
*/
- template <class T>
- inline Matrix<T> inv(Matrix<T> A) {
- return (A ^= -1);
- }
-
- /* Calculates the determinant of Matrix A via LU Decomposition */
- template <class T>
- inline T det(const Matrix<T> &A)
- {
- return ~A;
- }
-
-} // end namespace SCYTHE
-
-#if defined (SCYTHE_COMPILE_DIRECT) && \
- (defined (__GNUG__) || defined (__MWERKS__) || \
- defined (_MSC_VER) || defined (EXPLICIT_TEMPLATE_INSTANTIATION))
-#include "ide.cc"
-#endif /* EXPLICIT_TEMPLATE_INSTANTIATION */
+ inline Matrix<>
+ qr_solve (const Matrix<>& A, const Matrix<>& b)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for qr_solve");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error, "A is NULL")
+ SCYTHE_CHECK_10(A.rows() != b.rows(), scythe_conformation_error,
+ "A and b do not conform");
+
+ /* Do decomposition */
+
+ // Set up working variables
+ Matrix<> QR = A;
+ double* QRarray = QR.getArray(); // input/output array pointer
+ int rows = (int) QR.rows();
+ int cols = (int) QR.cols();
+ Matrix<unsigned int> pivot(cols, 1); // pivot vector
+ int* parray = (int*) pivot.getArray(); // pivot vector array pointer
+ Matrix<> tau = Matrix<>(rows < cols ? rows : cols, 1);
+ double* tarray = tau.getArray(); // tau output array pointer
+ double tmp, *work; // workspace vars
+ int lwork, info; // workspace size var and error info var
+
+ // Get workspace size
+ lwork = -1;
+ lapack::dgeqp3_(&rows, &cols, QRarray, &rows, parray, tarray, &tmp,
+ &lwork, &info);
+
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dgeqp3");
+
+ lwork = (int) tmp;
+ work = new double[lwork];
+
+ // run the routine for real
+ lapack::dgeqp3_(&rows, &cols, QRarray, &rows, parray, tarray, work,
+ &lwork, &info);
+
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dgeqp3");
+
+ delete[] work;
+
+ pivot -= 1;
+
+ /* Now solve the system */
+
+ // working vars
+ int nrhs = (int) b.cols();
+ Matrix<> bb = b;
+ double* barray = bb.getArray();
+ int taudim = (int) tau.size();
+
+ // Get workspace size
+ lwork = -1;
+ lapack::dormqr_("L", "T", &rows, &nrhs, &taudim, QRarray, &rows,
+ tarray, barray, &rows, &tmp, &lwork, &info);
+
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dormqr");
+
+ // And now for real
+ lwork = (int) tmp;
+ work = new double[lwork];
+ lapack::dormqr_("L", "T", &rows, &nrhs, &taudim, QRarray, &rows,
+ tarray, barray, &rows, work, &lwork, &info);
+
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dormqr");
+
+ lapack::dtrtrs_("U", "N", "N", &taudim, &nrhs, QRarray, &rows, barray,
+ &rows, &info);
+
+ SCYTHE_CHECK_10(info > 0, scythe_type_error, "Matrix is singular");
+ SCYTHE_CHECK_10(info < 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dtrtrs");
+
+ delete[] work;
+
+ Matrix<> result(A.cols(), b.cols(), false);
+ for (uint i = 0; i < pivot.size(); ++i)
+ result(i, _) = bb(pivot(i), _);
+
+ return result;
+ }
+
+ template<>
+ Matrix<>
+ invpd (const Matrix<>& A)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for invpd");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10 (! A.isSquare(), scythe_dimension_error,
+ "A is not square");
+
+ // We have to do an explicit copy within the func to match the
+ // template declaration of the more general template.
+ Matrix<> AA = A;
+
+ // Get a pointer to the internal array and set up some vars
+ double* Aarray = AA.getArray(); // internal array pointer
+ int rows = (int) AA.rows(); // the dim of the matrix
+ int err = 0; // The output error condition
+
+ // Cholesky decomposition step
+ lapack::dpotrf_("L", &rows, Aarray, &rows, &err);
+ SCYTHE_CHECK_10(err > 0, scythe_type_error,
+ "Matrix is not positive definite")
+ SCYTHE_CHECK_10(err < 0, scythe_invalid_arg,
+ "The " << err << "th value of the matrix had an illegal value")
+
+ // Inversion step
+ lapack::dpotri_("L", &rows, Aarray, &rows, &err);
+ SCYTHE_CHECK_10(err > 0, scythe_type_error,
+ "The (" << err << ", " << err << ") element of the matrix is zero"
+ << " and the inverse could not be computed")
+ SCYTHE_CHECK_10(err < 0, scythe_invalid_arg,
+ "The " << err << "th value of the matrix had an illegal value")
+ lapack::make_symmetric(Aarray, rows);
+
+ return AA;
+ }
+
+ template<>
+ Matrix<>
+ invpd (const Matrix<>& A, const Matrix<>& M)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for invpd");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10 (! A.isSquare(), scythe_dimension_error,
+ "A is not square");
+ SCYTHE_CHECK_10(A.rows() != M.cols() || A.cols() != M.rows(),
+ scythe_conformation_error, "A and M do not conform");
+
+ // We have to do an explicit copy within the func to match the
+ // template declaration of the more general template.
+ Matrix<> MM = M;
+
+ // Get pointer and set up some vars
+ double* Marray = MM.getArray();
+ int rows = (int) MM.rows();
+ int err = 0;
+
+ // Inversion step
+ lapack::dpotri_("L", &rows, Marray, &rows, &err);
+ SCYTHE_CHECK_10(err > 0, scythe_type_error,
+ "The (" << err << ", " << err << ") element of the matrix is zero"
+ << " and the inverse could not be computed")
+ SCYTHE_CHECK_10(err < 0, scythe_invalid_arg,
+ "The " << err << "th value of the matrix had an illegal value")
+ lapack::make_symmetric(Marray, rows);
+
+ return MM;
+ }
+
+ template <>
+ Matrix<>
+ inv(const Matrix<>& A)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for inv");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "A is NULL")
+ SCYTHE_CHECK_10 (! A.isSquare(), scythe_dimension_error,
+ "A is not square");
+
+ // We have to do an explicit copy within the func to match the
+ // template declaration of the more general template.
+ Matrix<> AA = A;
+
+ // Get a pointer to the internal array and set up some vars
+ double* Aarray = AA.getArray(); // internal array pointer
+ int rows = (int) AA.rows(); // the dim of the matrix
+ int* ipiv = new int[rows]; // Holds the lu decomp pivot array
+ int err = 0; // The output error condition
+
+ // LU decomposition step
+ lapack::dgetrf_(&rows, &rows, Aarray, &rows, ipiv, &err);
+
+ SCYTHE_CHECK_10(err > 0, scythe_type_error, "Matrix is singular");
+ SCYTHE_CHECK_10(err < 0, scythe_invalid_arg,
+ "The " << err << "th value of the matrix had an illegal value");
+
+ // Inversion step; first do a workspace query, then the actual
+ // inversion
+ double work_query = 0;
+ int work_size = -1;
+ lapack::dgetri_(&rows, Aarray, &rows, ipiv, &work_query,
+ &work_size, &err);
+ double* workspace = new double[(work_size = (int) work_query)];
+ lapack::dgetri_(&rows, Aarray, &rows, ipiv, workspace, &work_size,
+ &err);
+ delete[] ipiv;
+ delete[] workspace;
+
+ SCYTHE_CHECK_10(err > 0, scythe_type_error, "Matrix is singular");
+ SCYTHE_CHECK_10(err < 0, scythe_invalid_arg,
+ "Internal error in LAPACK routine dgetri");
+
+ return AA;
+ }
+
+ /*!\brief The result of a singular value decomposition.
+ *
+ * Objects of this type hold the results of a singular value
+ * decomposition (SVD) of an \f$m \times n\f$ matrix \f$A\f$, as
+ * returned by svd(). The SVD takes the form: \f$A = U
+ * \cdot \Sigma \cdot V'\f$. SVD objects contain \a d, which
+ * holds the singular values of \f$A\f$ (the diagonal of
+ * \f$\Sigma\f$) in descending order. Furthermore, depending on the
+ * options passed to svd(), they may hold some or all of the
+ * left singular vectors of \f$A\f$ in \a U and some or all of the
+ * right singular vectors of \f$A\f$ in \a Vt.
+ *
+ * \see svd(const Matrix<>& A, int nu, int nv);
+ */
+
+ struct SVD {
+ Matrix<> d; // singular values
+ Matrix<> U; // left singular vectors
+ Matrix<> Vt; // transpose of right singular vectors
+ };
+
+ /*!\brief Calculates the singular value decomposition of a matrix,
+ * optionally computing the left and right singular vectors.
+ *
+ * This function returns the singular value decomposition (SVD) of a
+ * \f$m \times n\f$ matrix \a A, optionally computing the left and right
+ * singular vectors. It returns the singular values and vectors in
+ * a SVD object.
+ *
+ * \note This function requires BLAS/LAPACK functionality and is
+ * only available on machines that provide these libraries. Make
+ * sure you enable the SCYTHE_LAPACK preprocessor flag if you wish
+ * to use this function. Furthermore, note that this function takes
+ * and returns only column-major concrete matrices. Future versions
+ * of Scythe will provide a native C++ implementation of this
+ * function with support for general matrix templates.
+ *
+ * \param A The matrix to decompose.
+ * \param nu The number of left singular vectors to compute and return. Values less than zero are equivalent to min(\f$m\f$, \f$n\f$).
+ * \param nv The number of right singular vectors to compute and return. Values less than zero are equivalent to min(\f$m\f$, \f$n\f$).
+ *
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ * \throw scythe_lapack_internal_error (Level 1)
+ *
+ * \see SVD
+ * \see eigen(const Matrix<>& A, bool vectors)
+ */
+
+ inline SVD
+ svd (const Matrix<>& A, int nu = -1, int nv = -1)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for eigen");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "Matrix is NULL");
+
+ char* jobz;
+ int m = (int) A.rows();
+ int n = (int) A.cols();
+ int mn = (int) std::min(A.rows(), A.cols());
+ Matrix<> U;
+ Matrix<> V;
+ if (nu < 0) nu = mn;
+ if (nv < 0) nv = mn;
+ if (nu <= mn && nv<= mn) {
+ jobz = "S";
+ U = Matrix<>(m, mn, false);
+ V = Matrix<>(mn, n, false);
+ } else if (nu == 0 && nv == 0) {
+ jobz = "N";
+ } else {
+ jobz = "A";
+ U = Matrix<>(m, m, false);
+ V = Matrix<>(n, n, false);
+ }
+ double* Uarray = U.getArray();
+ double* Varray = V.getArray();
+
+ int ldu = (int) U.rows();
+ int ldvt = (int) V.rows();
+ Matrix<> X = A;
+ double* Xarray = X.getArray();
+ Matrix<> d(mn, 1, false);
+ double* darray = d.getArray();
+
+ double tmp, *work;
+ int lwork, info;
+ int *iwork = new int[8 * mn];
+
+ // get optimal workspace
+ lwork = -1;
+ lapack::dgesdd_(jobz, &m, &n, Xarray, &m, darray, Uarray, &ldu,
+ Varray, &ldvt, &tmp, &lwork, iwork, &info);
+ SCYTHE_CHECK_10(info < 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dgessd");
+ SCYTHE_CHECK_10(info > 0, scythe_convergence_error, "Did not converge");
+
+ lwork = (int) tmp;
+ work = new double[lwork];
+
+ // Now for real
+ lapack::dgesdd_(jobz, &m, &n, Xarray, &m, darray, Uarray, &ldu,
+ Varray, &ldvt, work, &lwork, iwork, &info);
+ SCYTHE_CHECK_10(info < 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dgessd");
+ SCYTHE_CHECK_10(info > 0, scythe_convergence_error, "Did not converge");
+ delete[] work;
+
+ if (nu < mn && nu > 0)
+ U = U(0, 0, U.rows() - 1, (unsigned int) std::min(m, nu) - 1);
+ if (nv < mn && nv > 0)
+ V = V(0, 0, (unsigned int) std::min(n, nv) - 1, V.cols() - 1);
+ SVD result;
+ result.d = d;
+ result.U = U;
+ result.Vt = V;
+
+ return result;
+ }
+
+ /*!\brief The result of an eigenvalue/vector decomposition.
+ *
+ * Objects of this type hold the results of the eigen() function.
+ * That is the eigenvalues and, optionally, the eigenvectors of a
+ * symmetric matrix of order \f$n\f$. The eigenvalues are stored in
+ * ascending order in the member column vector \a values. The
+ * vectors are stored in the \f$n \times n\f$ matrix \a vectors.
+ *
+ * \see eigen(const Matrix<>& A, bool vectors)
+ */
+
+ struct Eigen {
+ Matrix<> values;
+ Matrix<> vectors;
+ };
+
+ /*!\brief Calculates the eigenvalues and eigenvectors of a symmetric
+ * matrix.
+ *
+ * This function returns the eigenvalues and, optionally,
+ * eigenvectors of a symmetric matrix \a A of order \f$n\f$. It
+ * returns an Eigen object containing the vector of values, in
+ * ascending order, and, optionally, a matrix holding the vectors.
+ *
+ * \note This function requires BLAS/LAPACK functionality and is
+ * only available on machines that provide these libraries. Make
+ * sure you enable the SCYTHE_LAPACK preprocessor flag if you wish
+ * to use this function. Furthermore, note that this function takes
+ * and returns only column-major concrete matrices. Future versions
+ * of Scythe will provide a native C++ implementation of this
+ * function with support for general matrix templates.
+ *
+ * \param A The Matrix to be decomposed.
+ * \param vectors This boolean value indicates whether or not to
+ * return eigenvectors in addition to eigenvalues. It is set to true
+ * by default.
+ *
+ * \throw scythe_null_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_lapack_internal_error (Level 1)
+ *
+ * \see Eigen
+ * \see svd(const Matrix<>& A, int nu, int nv);
+ */
+ inline Eigen
+ eigen (const Matrix<>& A, bool vectors=true)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for eigen");
+ SCYTHE_CHECK_10(! A.isSquare(), scythe_dimension_error,
+ "Matrix not square");
+ SCYTHE_CHECK_10(A.isNull(), scythe_null_error,
+ "Matrix is NULL");
+ // Should be symmetric but rounding errors make checking for this
+ // difficult.
+
+ // Make a copy of A
+ Matrix<> AA = A;
+
+ // Get a point to the internal array and set up some vars
+ double* Aarray = AA.getArray(); // internal array points
+ int order = (int) AA.rows(); // input matrix is order x order
+ double dignored = 0; // we don't use this option
+ int iignored = 0; // or this one
+ double abstol = 0.0; // tolerance (default)
+ int m; // output value
+ Matrix<> result; // result matrix
+ char getvecs[1]; // are we getting eigenvectors?
+ if (vectors) {
+ getvecs[0] = 'V';
+ result = Matrix<>(order, order + 1, false);
+ } else {
+ result = Matrix<>(order, 1, false);
+ getvecs[0] = 'N';
+ }
+ double* eigenvalues = result.getArray(); // pointer to result array
+ int* isuppz = new int[2 * order]; // indices of nonzero eigvecs
+ double tmp; // inital temporary value for getting work-space info
+ int lwork, liwork, *iwork, itmp; // stuff for workspace
+ double *work; // and more stuff for workspace
+ int info = 0; // error code holder
+
+ // get optimal size for work arrays
+ lwork = -1;
+ liwork = -1;
+ lapack::dsyevr_(getvecs, "A", "L", &order, Aarray, &order, &dignored,
+ &dignored, &iignored, &iignored, &abstol, &m, eigenvalues,
+ eigenvalues + order, &order, isuppz, &tmp, &lwork, &itmp,
+ &liwork, &info);
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dsyevr");
+ lwork = (int) tmp;
+ liwork = itmp;
+ work = new double[lwork];
+ iwork = new int[liwork];
+
+ // do the actual operation
+ lapack::dsyevr_(getvecs, "A", "L", &order, Aarray, &order, &dignored,
+ &dignored, &iignored, &iignored, &abstol, &m, eigenvalues,
+ eigenvalues + order, &order, isuppz, work, &lwork, iwork,
+ &liwork, &info);
+ SCYTHE_CHECK_10(info != 0, scythe_lapack_internal_error,
+ "Internal error in LAPACK routine dsyevr");
+
+ delete[] isuppz;
+ delete[] work;
+ delete[] iwork;
+
+ Eigen resobj;
+ if (vectors) {
+ resobj.values = result(_, 0);
+ resobj.vectors = result(0, 1, result.rows() -1, result.cols() - 1);
+ } else {
+ resobj.values = result;
+ }
+
+ return resobj;
+ }
+
+#endif
+
+} // end namespace scythe
#endif /* SCYTHE_IDE_H */
diff --git a/src/la.cc b/src/la.cc
deleted file mode 100644
index 998a3f1..0000000
--- a/src/la.cc
+++ /dev/null
@@ -1,392 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/la.cc
- *
- * Provides implementations of functions that perform common
- * linear algebra manipulation on Scythe matrices.
- *
- */
-
-#ifndef SCYTHE_LA_CC
-#define SCYTHE_LA_CC
-
-#include <cmath>
-#include <algorithm>
-#include <numeric>
-#include <set>
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "error.h"
-#include "util.h"
-#include "la.h"
-#include "stat.h"
-#else
-#include "scythestat/error.h"
-#include "scythestat/util.h"
-#include "scythestat/la.h"
-#include "scythestat/stat.h"
-#endif
-
-namespace SCYTHE {
- /* Compute the transpose of a matrix. Kept for back-compatibility*/
- template <class T>
- Matrix<T>
- t (const Matrix<T> &old_matrix)
- {
- return (! old_matrix);
- }
-
- /* Create a matrix of ones from the given dimensions
- * Note: call is of from ones<double>(4,3) or ones<int>(5,8)
- */
- template <class T>
- Matrix<T>
- ones (const int& rows, const int& cols)
- {
- if (rows < 1 || cols < 1) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("Improper row (") & rows
- & ") or column (" & cols & ") dimension");
- }
-
- return Matrix<T> (rows, cols, true, (T) 1);
- }
-
- /* Create a k x k identity matrix
- * Note: class is of form eye<double>(4) or eye<int>(7
- */
- template <class T>
- Matrix<T>
- eye (const int &k)
- {
- Matrix<T> temp(k, k, false);
- for (int i = 0; i < temp.rows(); ++i) {
- for (int j = 0; j < temp.cols(); ++j) {
- if (i == j)
- temp(i,j) = (T) 1.0;
- else
- temp(i,j) = (T) 0.0;
- }
- }
-
- return temp;
- }
-
- /* Create a k x 1 vector-additive sequence matrix */
- template <class T>
- Matrix<T>
- seqa (T start, const T& incr, const int& size)
- {
- Matrix<T> temp (size, 1, false);
- for (int i = 0; i < size; ++i) {
- temp[i] = start;
- start += incr;
- }
-
- return temp;
- }
-
- /* Uses the STL sort to sort a Matrix in ascending row-major order */
- template <class T>
- Matrix<T>
- sort (Matrix<T> A) {
- sort(A.begin(), A.end());
- return A;
- }
-
- template <class T>
- Matrix<T>
- sortc (Matrix<T> A)
- {
- for (typename Matrix<T>::col_major_iterator it = A.beginc();
- it < A.endc(); it.next_vec())
- sort(it, it + A.rows());
-
- return A;
- }
-
- /* Column bind two matrices */
- template <class T>
- Matrix<T>
- cbind (const Matrix<T> &A, const Matrix<T> &B)
- {
- if (A.rows() != B.rows()) {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices have different number of rows");
- }
-
- Matrix<T> C(A.rows(), A.cols() + B.cols(), false);
- typename Matrix<T>::col_major_iterator write = C.beginc();
-
- for (typename Matrix<T>::const_col_major_iterator read = A.beginc();
- read < A.endc(); ++read)
- *(write++) = *read;
-
- for (typename Matrix<T>::const_col_major_iterator read = B.beginc();
- read < B.endc(); ++read)
- *(write++) = *read;
-
- return C;
- }
-
-
- /* Row bind two matrices: kept for backwards compatibility */
- template <class T>
- Matrix<T>
- rbind (const Matrix<T> &A, const Matrix<T> &B)
- {
- if (A.cols() != B.cols()) {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices have different number of rows");
- }
-
- Matrix<T> C(A.rows() + B.rows(), A.cols(), false);
- typename Matrix<T>::row_major_iterator write = C.begin();
-
- for (typename Matrix<T>::const_row_major_iterator read = A.begin();
- read < A.end(); ++read)
- *(write++) = *read;
-
- for (typename Matrix<T>::const_row_major_iterator read = B.begin();
- read < B.end(); ++read)
- *(write++) = *read;
-
- return C;
- }
-
- /* Calculates the order of each element in a Matrix */
- template <class T>
- Matrix<int>
- order(const Matrix<T> &A){
- if (! A.isColVector()) {
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A not a column vector");
- }
- Matrix<int> temp(A.rows(), 1, false);
- for (int i = 0; i < A.rows(); ++i) {
- temp[i] = sumc(A << A[i])[0];
- }
-
- return temp;
- }
-
- /* Selects all the rows of Matrix A for which binary column vector e
- * has an element equal to 1
- */
- template <class T>
- Matrix<T>
- selif(const Matrix<T> &A, const Matrix<bool> &e)
- {
- if (A.rows() != e.rows()) {
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A and e have different number of rows");
- }
-
- if (! e.isColVector()) {
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "e not a column vector");
- }
-
- // See how many rows are true
- int N = std::accumulate(e.begin(), e.end(), (int) 0);
-
- // declare and form output Matrix
- Matrix<T> temp(N, A.cols(), false);
- int cnt = 0;
- for (int i = 0; i < e.size(); ++i) {
- if (e[i]) {
- copy(A.vec(i), A.vec(i + 1), temp.vec(cnt++));
- }
- }
-
- return temp;
- }
-
- /* Find unique elements in a matrix and return a sorted row vector */
- template <class T>
- Matrix<T>
- unique(const Matrix<T> &A)
- {
- std::set<T> u(A.begin(), A.end());
- Matrix<T> temp(1, u.size(), false);
-
- copy(u.begin(), u.end(), temp.begin());
-
- return temp;
- }
-
- /* Reshape a matrix */
- template <class T>
- Matrix<T>
- reshape(const Matrix<T> &A, const int &r, const int &c)
- {
- if (A.size() != r * c)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- std::string("Input dimensions (") & r & "," & c & ") not" &
- " consistent with size of input matrix (" & A.size() & ")");
-
- Matrix<T> temp(r, c, A.getArray());
- return temp;
- }
-
- /* Make vector out of unique elements of a symmetric Matrix.
- * NOTE: DOES NOT CHECK FOR SYMMETRY!!!
- */
- template <class T>
- Matrix<T>
- vech(const Matrix<T> &A)
- {
- if (! A.isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix not square");
- }
- Matrix<T> temp ((int) (0.5 * (A.size() - A.rows())) + A.rows(), 1,
- false);
- typename Matrix<T>::row_major_iterator iter = temp.begin();
-
- for (int i = 0; i < A.rows(); ++i)
- iter = copy(A.vecc(i) + i, A.vecc(i + 1), iter);
-
-
- return temp;
- }
-
- /* Expand xpnd(A) == B from A = vech(B) */
- template <class T>
- Matrix<T>
- xpnd(const Matrix<T> &A)
- {
- double newrowsize_d = -.5 + .5 * ::sqrt(1 + 8 * A.size());
- if (std::fmod(newrowsize_d, 1.0) != 0.0)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Can't turn input vector into a square matrix");
-
- int newrowsize = (int) newrowsize_d;
- Matrix<T> temp(newrowsize, newrowsize, false);
- int cnt = 0;
-
- for (int i = 0; i < newrowsize; ++i) {
- for (int j = i; j < newrowsize; ++j)
- temp(i, j) = temp(j, i) = A[cnt++];
- }
-
- return temp;
- }
-
- /* Get the diagonal of a Matrix. */
- template <class T>
- Matrix<T>
- diag(const Matrix<T> &A)
- {
- if (A.rows() != A.cols())
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix not square");
-
- Matrix<T> temp(A.rows(), 1, false);
- for (int i = 0; i < A.rows(); ++i)
- temp[i] = A(i, i);
-
- return temp;
- }
-
- template <class T>
- Matrix<T>
- gaxpy (const Matrix<T> &A, const Matrix<T> &B, const Matrix<T> &C)
- {
- Matrix<T> temp;
-
- if (A.isScalar() && B.rows() == C.rows() && B.cols() == C.cols()) {
- // Case 1: 1 x 1 * n x k + n x k
- temp = Matrix<T> (B.rows(), B.cols(), false);
-
- for (int i = 0; i < B.size(); ++i)
- temp[i] = A[0] * B[i] + C[i];
-
- } else if (B.isScalar() && A.rows() == C.rows() &&
- A.cols() == C.cols()) {
- // Case 2: m x n * 1 x 1 + m x n
- temp = Matrix<T> (A.rows(), A.cols(), false);
-
- for (int i = 0; i < A.size(); ++i)
- temp[i] = A[i] * B[0] + C[i];
-
- } else if (A.cols() == B.rows() && A.rows() == C.rows() &&
- B.cols() == C.cols()) {
- // Case 3: m x n * n x k + m x n
- temp = Matrix<T> (A.rows(), B.cols(), false);
-
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < B.cols(); ++j) {
- temp[i * B.cols() + j] = C[i * B.cols() +j];
- for (int k = 0; k < B.rows(); ++k)
- temp[i * B.cols() + j] += A[i * A.cols() + k] *
- B[k * B.cols() + j];
- }
- }
-
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("Expects (m x n * 1 x 1 + m x n)") &
- "or (1 x 1 * n x k + n x k) or (m x n * n x k +" &
- " m x k");
- }
-
- return temp;
- }
-
- /* Fast calculation of A'A */
- template <class T>
- Matrix<T>
- crossprod (const Matrix<T> &A)
- {
- int rows = A.rows();
- int cols = A.cols();
- Matrix<T> result(cols, cols, true);
- T tmp;
-
- if (rows == 1) {
- for (int k = 0; k < rows; ++k) {
- for (int i = 0; i < cols; ++i) {
- tmp = A[k * cols + i];
- for (int j = i; j < cols; ++j) {
- result[j * cols +i] =
- result[i * cols + j] += tmp * A[k * cols + j];
- }
- }
- }
- } else {
- for (int k = 0; k < rows; ++k) {
- for (int i = 0; i < cols; ++i) {
- tmp = A[k * cols + i];
- for (int j = i; j < cols; ++j) {
- result[i * cols + j] += tmp * A[k * cols + j];
- }
- }
- }
-
- for (int i = 0; i < cols; ++i)
- for (int j = i + 1; j < cols; ++j)
- result[j * cols + i] = result[i * cols + j];
- }
-
- return result;
- }
-
-} // end namespace SCYTHE
-
-#ifndef SCYTHE_COMPILE_DIRECT
-#include "scythestat/eti/la.t"
-#endif
-
-#endif /* SCYTHE_LA_CC */
diff --git a/src/la.h b/src/la.h
index 16209d5..579ea14 100644
--- a/src/la.h
+++ b/src/la.h
@@ -1,21 +1,34 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * scythestat/la.h
+ * scythestat/la.h
*
- * Provides definitions for functions that perform common
- * linear algebra manipulations on Scythe matrices.
- *
+ */
+
+/*!
+ * \file la.h
+ * \brief Definitions and implementations for functions that perform
+ * common linear algebra manipulations on Scythe Matrix objects.
+ *
+ * This file provides a number of common linear algebraic functions
+ * for use with the Matrix class. These functions include common
+ * operations such as transposition, a number of utility functions for
+ * creating useful matrices like the identity matrix, and efficient
+ * implementations for common operations like the cross-product.
+ *
+ * \note As is the case throughout the library, we provide both
+ * general and default template definitions of the Matrix-returning
+ * functions in this file, explicitly providing documentation for only
+ * the general template versions.
*/
#ifndef SCYTHE_LA_H
@@ -23,124 +36,956 @@
#ifdef SCYTHE_COMPILE_DIRECT
#include "matrix.h"
+#include "algorithm.h"
+#include "error.h"
+#ifdef SCYTHE_LAPACK
+#include "lapack.h"
+#endif
#else
#include "scythestat/matrix.h"
+#include "scythestat/algorithm.h"
+#include "scythestat/error.h"
+#ifdef SCYTHE_LAPACK
+#include "scythestat/lapack.h"
+#endif
#endif
-namespace SCYTHE {
-
- /* Transpose - computes the transpose of a Matrix */
- template <class T>
- Matrix<T> t (const Matrix<T> &);
+#include <numeric>
+#include <algorithm>
+#include <set>
- /* Ones - creates a Matrix of ones */
- template <class T>
- Matrix<T> ones (const int &, const int &);
+namespace scythe {
- /* Eye - creates an Identity Matrix of size k x k */
- template <class T>
- Matrix<T> eye (const int &);
+ namespace {
+ typedef unsigned int uint;
+ }
- /* Seqa - creates a vector additive sequence Matrix (size x 1) */
- template <class T>
- Matrix<T> seqa (T, const T &, const int &);
+ /* Matrix transposition */
- /* sort - sorts all elements of a Matrix in row_major order. This
- * function is DEPRECATED. It is simply a wrapper to the STL sort
- * algorithm which you should use instead.
- * To sort with the STL in row_major simply do
- * sort(M.begin(), M.end());
- * To sort with the STL in col_major simply do
- * sort(M.beginc(), M.endc());
+ /*!\brief Transpose a Matrix.
+ *
+ * This function transposes \a M, returning a Matrix \a R where each
+ * element of \a M, \f$M_ij\f$ is placed in position \f$R_ji\f$.
+ * Naturally, the returned Matrix has M.cols() rows and M.rows()
+ * columns.
+ *
+ * \param M The Matrix to transpose.
+ *
+ * \throw scythe_alloc_error (Level 1)
*
- * Version two takes a compare function object while the first uses
- * primitive comparison operators.
*/
- template <class T>
- Matrix<T> sort (Matrix<T>);
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ t (const Matrix<T,PO,PS>& M)
+ {
+ uint rows = M.rows();
+ uint cols = M.cols();
+ Matrix<T,RO,Concrete> ret(cols, rows, false);
+ if (PO == Col)
+ copy<Col,Row>(M, ret);
+ else
+ copy<Row,Col>(M, ret);
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, ret)
+ }
- /* sortc - sorts all columns of a Matrix using the STL sort
- * algorithm. The second version takes a compare function object
- * while the first uses primitive comparison operators
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ t (const Matrix<T,O,S>& M)
+ {
+ return t<O,Concrete>(M);
+ }
+
+ /* Ones matrix generation */
+
+ /*!
+ * \brief Create a matrix of ones.
+ *
+ * This function creates a matrix of ones, with the given dimensions
+ * \a rows and \a cols.
+ *
+ * \param rows The number of rows in the resulting Matrix.
+ * \param cols The number of columns in the resulting Matrix.
+ *
+ * \see eye (unsigned int k)
*
- * Unlike sort, this function is not deprecated
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T,O,S>
+ ones (unsigned int rows, unsigned int cols)
+ {
+ return Matrix<T,O,S> (rows, cols, true, (T) 1);
+ }
+
+ template <typename T, matrix_order O>
+ Matrix<T, O, Concrete>
+ ones (unsigned int rows, unsigned int cols)
+ {
+ return ones<T, O, Concrete>(rows, cols);
+ }
+
+ template <typename T>
+ Matrix<T, Col, Concrete>
+ ones (unsigned int rows, unsigned int cols)
+ {
+ return ones<T, Col, Concrete>(rows, cols);
+ }
+
+ inline Matrix<double, Col, Concrete>
+ ones (unsigned int rows, unsigned int cols)
+ {
+ return ones<double, Col, Concrete>(rows, cols);
+ }
+
+ /* Identity Matrix generation */
+
+ // This functor contains the working parts of the eye algorithm.
+ namespace {
+ template <class T> struct eye_alg {
+ T operator() (uint i, uint j) {
+ if (i == j)
+ return (T) 1.0;
+ return (T) 0.0;
+ }
+ };
+ }
+
+ /*!\brief Create a \a k by \a k identity Matrix.
+ *
+ * This function creates a \a k by \a k Matrix with 1s along the
+ * diagonal and 0s on the off-diagonal. This template is overloaded
+ * multiple times to provide default type, matrix_order, and
+ * matrix_style. The default call to eye returns a Concrete Matrix
+ * containing double precision floating point numbers, in
+ * column-major order. The user can write explicit template calls
+ * to generate matrices with other orders and/or styles.
+ *
+ * \param k The dimension of the identity Matrix.
+ *
+ * \see diag(const Matrix<T,O,S>& M)
+ * \see ones(unsigned int rows, unsigned int cols)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
*/
- template <class T>
- Matrix<T> sortc (Matrix<T> A);
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T,O,S>
+ eye (unsigned int k)
+ {
+ Matrix<T,O,Concrete> ret(k, k, false);
+ for_each_ij_set(ret, eye_alg<T>());
+ SCYTHE_VIEW_RETURN(T, O, S, ret)
+ }
- /* Cbind - Column bind 2 matrices */
- template <class T>
- Matrix<T> cbind (const Matrix<T> &, const Matrix<T> &);
+ template <typename T, matrix_order O>
+ Matrix<T, O, Concrete>
+ eye (uint k)
+ {
+ return eye<T, O, Concrete>(k);
+ }
- /* FUNCTION: Rbind - Row bind 2 matrices */
- template <class T>
- Matrix<T> rbind (const Matrix<T> &, const Matrix<T> &);
+ template <typename T>
+ Matrix<T, Col, Concrete>
+ eye (uint k)
+ {
+ return eye<T, Col, Concrete>(k);
+ }
- /* Order - Calculates the order of each element in a Matrix */
- // XXX - ask Quinn about this one
- template <class T>
- Matrix<int> order(const Matrix<T> &);
+ inline Matrix<double, Col, Concrete>
+ eye (uint k)
+ {
+ return eye<double, Col, Concrete>(k);
+ }
- /* Selif - Selects all the rows of Matrix A for which the col vector
- * has an element equal to 1 */
- template <class T>
- Matrix<T> selif(const Matrix<T> &, const Matrix<bool> &);
+ /* Create a k x 1 vector-additive sequence matrix */
- /* Unique - Finds unique elements in a Matrix */
- template <class T>
- Matrix<T> unique(const Matrix<T> &);
+ // The seqa algorithm
+ namespace {
+ template <typename T> struct seqa_alg {
+ T cur_; T inc_;
+ seqa_alg(T start, T inc) : cur_ (start), inc_ (inc) {}
+ T operator() () { T ret = cur_; cur_ += inc_; return ret; }
+ };
+ }
+
+ /*!
+ * \brief Create a \a rows x 1 vector-additive sequence Matrix.
+ *
+ * This function creates a \a rows x 1 Matrix \f$v\f$, where
+ * \f$v_i = \mbox{start} + i \cdot \mbox{incr}\f$.
+ *
+ * This function is defined by a series of templates. This template
+ * is the most general, requiring the user to explicitly instantiate
+ * the template in terms of element type, matrix_order and
+ * matrix_style. Further versions allow for explicit instantiation
+ * based just on type and matrix_order (with matrix_style defaulting
+ * to Concrete) and just on type (with matrix_style defaulting to
+ * Col). Finally, the default version of th function generates
+ * column-major concrete Matrix of doubles.
+ *
+ * \param start Desired start value.
+ * \param incr Amount to add in each step of the sequence.
+ * \param rows Total number of rows in the Matrix.
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
- /* Vecr - Turn Matrix into Column vector by stacking rows */
- template <class T>
- inline Matrix<T> vecr(const Matrix<T> &A)
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T,O,S>
+ seqa (T start, T incr, uint rows)
{
- return (Matrix<T> (A.size(), 1, A.getArray()));
+ Matrix<T,O,Concrete> ret(rows, 1, false);
+ generate(ret.begin_f(), ret.end_f(), seqa_alg<T>(start, incr));
+ SCYTHE_VIEW_RETURN(T, O, S, ret)
}
- /* Vecc - Turn Matrix into Column vector by stacking columns */
- template <class T>
- inline Matrix<T> vecc(const Matrix<T> &A)
+ template <typename T, matrix_order O>
+ Matrix<T, O, Concrete>
+ seqa (T start, T incr, uint rows)
{
- Matrix<T> temp(A.size(), 1, false);
+ return seqa<T, O, Concrete>(start, incr, rows);
+ }
- // Note we can use a row_major_iterator to write because we are
- // writing to a vector. RMIs are a bit faster than CMIs.
- copy(A.beginc(), A.endc(), temp.begin());
+ template <typename T>
+ Matrix<T, Col, Concrete>
+ seqa (T start, T incr, uint rows)
+ {
+ return seqa<T, Col, Concrete>(start, incr, rows);
+ }
- return temp;
+ inline Matrix<double, Col, Concrete>
+ seqa (double start, double incr, uint rows)
+ {
+ return seqa<double, Col, Concrete>(start, incr, rows);
}
- /* Reshape - Reshapes a row major order Matrix or Vector */
- template <class T>
- Matrix<T> reshape(const Matrix<T> &, const int &, const int &);
+ /* Uses the STL sort to sort a Matrix in ascending row-major order */
+
+ /*!
+ * \brief Sort a Matrix.
+ *
+ * This function returns a copy of \a M, sorted in ascending order.
+ * The sorting order is determined by the template parameter
+ * SORT_ORDER or, by default, to matrix_order of \a M.
+ *
+ * \param M The Matrix to sort.
+ *
+ * \see sortc
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order SORT_ORDER,
+ matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ sort (const Matrix<T, PO, PS>& M)
+ {
+ Matrix<T,RO,Concrete> ret = M;
+
+ std::sort(ret.template begin<SORT_ORDER>(),
+ ret.template end<SORT_ORDER>());
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, ret)
+ }
+
+ template <matrix_order SORT_ORDER,
+ typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ sort (const Matrix<T,O,S>& M)
+ {
+ return sort<SORT_ORDER, O, Concrete>(M);
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ sort (const Matrix<T,O,S>& M)
+ {
+ return sort<O, O, Concrete>(M);
+ }
+
+ /*!\brief Sort the columns of a Matrix.
+ *
+ * This function returns a copy of \a M, with each column sorted in
+ * ascending order.
+ *
+ * \param M The Matrix to sort.
+ *
+ * \see sort
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ sortc (const Matrix<T, PO, PS>& M)
+ {
+ Matrix<T,RO,Concrete> ret = M;
- /* Vech - Make vector out of unique elements of a symmetric */
- template <class T>
- Matrix<T> vech(const Matrix<T> &);
+ // TODO need to figure out a way to do fully optimized
+ // vector iteration
+ for (uint col = 0; col < ret.cols(); ++col) {
+ Matrix<T,PO,View> column = ret(_, col);
+ std::sort(column.begin(), column.end());
+ }
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, ret)
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ sortc(const Matrix<T,O,S>& M)
+ {
+ return sortc<O,Concrete>(M);
+ }
- /* Xpnd - Get symmetric Matrix B back from A = vech(B) */
- template <class T>
- Matrix<T> xpnd(const Matrix<T> &);
+ /* Column bind two matrices */
- /* Diag - get the diagonal of a Matrix */
- template <class T>
- Matrix<T> diag(const Matrix<T> &);
+ /*!
+ * \brief Column bind two matrices.
+ *
+ * This function column binds two matrices, \a A and \a B.
+ *
+ * \param A The left-hand Matrix.
+ * \param B The right-hand Matrix.
+ *
+ * \see rbind(const Matrix<T,PO1,PS1>& A,
+ * const Matrix<T,PO2,PS2>& B)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ cbind (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& B)
+ {
+ SCYTHE_CHECK_10(A.rows() != B.rows(), scythe_conformation_error,
+ "Matrices have different numbers of rows");
+
+ Matrix<T,RO,Concrete> ret(A.rows(), A.cols() + B.cols(), false);
+ std::copy(B.template begin_f<Col>(), B.template end_f<Col>(),
+ std::copy(A.template begin_f<Col>(),
+ A.template end_f<Col>(),
+ ret.template begin_f<Col>()));
+ SCYTHE_VIEW_RETURN(T, RO, RS, ret)
+ }
+
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ cbind (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& B)
+ {
+ return cbind<PO1,Concrete>(A, B);
+ }
+
+ /* Row bind two matrices */
- /* Gaxpy - Fast calculation of A*B + C */
- template <class T>
- Matrix<T> gaxpy(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &);
+ /*!
+ * \brief Row bind two matrices.
+ *
+ * This function row binds two matrices, \a A and \a B.
+ *
+ * \param A The upper Matrix.
+ * \param B The lower Matrix.
+ *
+ * \see cbind(const Matrix<T,PO1,PS1>& A,
+ * const Matrix<T,PO2,PS2>& B)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ */
+
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ rbind (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& B)
+ {
+ SCYTHE_CHECK_10(A.cols() != B.cols(), scythe_conformation_error,
+ "Matrices have different numbers of columns");
+
+ Matrix<T,RO,Concrete> ret(A.rows() + B.rows(), A.cols(), false);
+ std::copy(B.template begin_f<Row>(), B.template end_f<Row>(),
+ std::copy(A.template begin_f<Row>(),
+ A.template end_f<Row>(),
+ ret.template begin_f<Row>()));
+ SCYTHE_VIEW_RETURN(T, RO, RS, ret)
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ rbind (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& B)
+ {
+ return rbind<PO1,Concrete>(A, B);
+ }
+
+ /* Calculates the order of each element in a Matrix */
+
+ // Functor encapsulating the meat of the algorithm
+ namespace {
+ template <class T,matrix_order O,matrix_style S> struct order_alg {
+ Matrix<T,O> M_;
+ order_alg (const Matrix<T,O,S>& M) : M_ (M) {}
+ uint operator() (T x) {
+ Matrix<bool,O> diff = (M_ < x);
+ return std::accumulate(diff.begin_f(), diff.end_f(), (uint) 0);
+ }
+ };
+ }
+
+ /*!
+ * \brief Calculate the rank-order of each element in a Matrix.
+ *
+ * This function calculates the rank-order of each element in a
+ * Matrix, returning a Matrix in which the \e i'th element
+ * indicates the order position of the \e i'th element of \a M.
+ * The returned Matrix contains unsigned integers.
+ *
+ * \param M A column vector.
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ /* NOTE This function used to only work on column vectors. I see no
+ * reason to maintain this restriction.
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<unsigned int, RO, RS>
+ order (const Matrix<T, PO, PS>& M)
+ {
+ Matrix<uint, RO, Concrete> ranks(M.rows(), M.cols(), false);
+ std::transform(M.begin_f(), M.end_f(), ranks.template begin_f<PO>(),
+ order_alg<T, PO, PS>(M));
+ SCYTHE_VIEW_RETURN(uint, RO, RS, ranks)
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<unsigned int, O, Concrete>
+ order (const Matrix<T,O,S>& M)
+ {
+ return order<O,Concrete>(M);
+ }
- /* Crossprod - Fast calculation of A'A */
- template <class T>
- Matrix<T> crossprod(const Matrix<T> &);
+ /* Selects all the rows of Matrix A for which binary column vector e
+ * has an element equal to 1
+ */
+
+ /*!
+ * \brief Locate rows for which a binary column vector equals 1
+
+ * This function identifies all the rows of a Matrix \a M for which
+ * the binary column vector \a e has an element equal to 1,
+ * returning a Matrix
+
+ * \param M The Matrix of interest.
+ * \param e A boolean column vector.
+ *
+ * \see unique(const Matrix<T>& M)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ selif (const Matrix<T,PO1,PS1>& M, const Matrix<bool,PO2,PS2>& e)
+ {
+ SCYTHE_CHECK_10(M.rows() != e.rows(), scythe_conformation_error,
+ "Data matrix and selection vector have different number of rows");
+ SCYTHE_CHECK_10(! e.isColVector(), scythe_dimension_error,
+ "Selection matrix is not a column vector");
+
+ uint N = std::accumulate(e.begin_f(), e.end_f(), (uint) 0);
+ Matrix<T,RO,Concrete> res(N, M.cols(), false);
+ int cnt = 0;
+ for (uint i = 0; i < e.size(); ++i) {
+ if (e[i]) {
+ Matrix<T,RO,View> Mvec = M(i, _);
+ // TODO again, need optimized vector iteration
+ std::copy(Mvec.begin_f(), Mvec.end_f(),
+ res(cnt++, _).begin_f());
+ }
+ }
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, res)
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ selif (const Matrix<T,PO1,PS1>& M, const Matrix<bool,PO2,PS2>& e)
+ {
+ return selif<PO1,Concrete>(M, e);
+ }
+
+ /* Find unique elements in a matrix and return a sorted row vector */
+ /*!
+ * \brief Find unique elements in a Matrix.
+ *
+ * This function identifies all of the unique elements in a Matrix,
+ * and returns them in a sorted row vector.
+ *
+ * \param M The Matrix to search.
+ *
+ * \see selif(const Matrix<T>& M, const Matrix<bool>& e)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ unique (const Matrix<T, PO, PS>& M)
+ {
+ std::set<T> u(M.begin_f(), M.end_f());
+ Matrix<T,RO,Concrete> res(1, u.size(), false);
+ std::copy(u.begin(), u.end(), res.begin_f());
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, res)
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ unique (const Matrix<T,O,S>& M)
+ {
+ return unique<O,Concrete>(M);
+ }
+
+ /* NOTE I killed reshape. It seems redundant with resize. DBP */
+
+
+ /* Make vector out of unique elements of a symmetric Matrix.
+ */
+
+ /*!
+ * \brief Vectorize a symmetric Matrix.
+ *
+ * This function returns a column vector containing only those
+ * elements necessary to reconstruct the symmetric Matrix, \a M. In
+ * practice, this means extracting one triangle of \a M and
+ * returning it as a vector.
+ *
+ * Note that the symmetry check in this function (active at error
+ * level 3) is quite costly.
+ *
+ * \param M A symmetric Matrix.
+ *
+ * \throw scythe_dimension_error (Level 3)
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \see xpnd(const Matrix<T,PO,PS>& v)
+ */
+
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ vech (const Matrix<T, PO, PS>& M)
+ {
+ SCYTHE_CHECK_20(! M.isSymmetric(), scythe_dimension_error,
+ "Matrix not symmetric");
+
+ Matrix<T,RO,Concrete>
+ res((uint) (0.5 * (M.size() - M.rows())) + M.rows(), 1, false);
+ typename Matrix<T,RO,Concrete>::forward_iterator it = res.begin_f();
+
+ /* We want to traverse M in storage order if possible so we take
+ * the upper triangle of row-order matrices and the lower triangle
+ * of column-order matrices.
+ */
+ if (M.storeorder() == Col) {
+ for (uint i = 0; i < M.rows(); ++i) {
+ Matrix<T,PO,View> strip = M(i, i, M.rows() - 1, i);
+ it = std::copy(strip.begin_f(), strip.end_f(), it);
+ }
+ } else {
+ for (uint j = 0; j < M.cols(); ++j) {
+ Matrix<T,PO,View> strip = M(j, j, j, M.cols() - 1);
+ it = std::copy(strip.begin_f(), strip.end_f(), it);
+ }
+ }
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, res)
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ vech (const Matrix<T,O,S>& M)
+ {
+ return vech<O,Concrete>(M);
+ }
+
+ /*! Expand a vector into a symmetric Matrix.
+ *
+ * This function takes the vector \a v and returns a symmetric
+ * Matrix containing the elements of \a v within each triangle.
+ *
+ * \param \a v The vector expand.
+ *
+ * \see vech(const Matrix<T,PO,PS>& M)
+ *
+ * \throw scythe_dimensions_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ xpnd (const Matrix<T, PO, PS>& v)
+ {
+ double size_d = -.5 + .5 * ::sqrt(1 + 8 * v.size());
+ SCYTHE_CHECK_10(std::fmod(size_d, 1.) != 0.,
+ scythe_dimension_error,
+ "Input vector can't generate square matrix");
+
+ uint size = (uint) size_d;
+ Matrix<T,RO,Concrete> res(size, size, false);
+
+ /* It doesn't matter if we travel in order here.
+ * TODO Might want to use iterators.
+ */
+ uint cnt = 0;
+ for (uint i = 0; i < size; ++i)
+ for (uint j = i; j < size; ++j)
+ res(i, j) = res(j, i) = v[cnt++];
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, res)
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ xpnd (const Matrix<T,O,S>& v)
+ {
+ return xpnd<O,Concrete>(v);
+ }
+
+ /* Get the diagonal of a Matrix. */
+
+ /*!
+ * \brief Return the diagonal of a Matrix.
+ *
+ * This function returns the diagonal of a Matrix in a row vector.
+ *
+ * \param M The Matrix one wishes to extract the diagonal of.
+ *
+ * \see crossprod (const Matrix<T,PO,PS> &M)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ diag (const Matrix<T, PO, PS>& M)
+ {
+ Matrix<T,RO,Concrete> res(std::min(M.rows(), M.cols()), 1, false);
+
+ /* We want to use iterators to maximize speed for both concretes
+ * and views, but we always want to tranvers M in order to avoid
+ * slowing down concretes.
+ */
+ uint incr = 1;
+ if (PO == Col)
+ incr += M.rows();
+ else
+ incr += M.cols();
+
+ typename Matrix<T,PO,PS>::const_iterator pit;
+ typename Matrix<T,RO,Concrete>::forward_iterator rit
+ = res.begin_f();
+ for (pit = M.begin(); pit < M.end(); pit += incr)
+ *rit++ = *pit;
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, res)
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ diag (const Matrix<T,O,S>& M)
+ {
+ return diag<O,Concrete>(M);
+ }
+
+ /* Fast calculation of A*B+C. */
+
+ namespace {
+ // Algorithm when one matrix is 1x1
+ template <matrix_order RO, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ void
+ gaxpy_alg(Matrix<T,RO,Concrete>& res, const Matrix<T,PO1,PS1>& X,
+ const Matrix<T,PO2,PS2>& B, T constant)
+ {
+ res = Matrix<T,RO,Concrete>(X.rows(), X.cols(), false);
+ if (maj_col<RO,PO1,PO2>())
+ std::transform(X.template begin_f<Col>(),
+ X.template end_f<Col>(),
+ B.template begin_f<Col>(),
+ res.template begin_f<Col>(),
+ ax_plus_b<T>(constant));
+ else
+ std::transform(X.template begin_f<Row>(),
+ X.template end_f<Row>(),
+ B.template begin_f<Row>(),
+ res.template begin_f<Row>(),
+ ax_plus_b<T>(constant));
+ }
+ }
+
+ /*! Fast caclulation of \f$AB + C\f$.
+ *
+ * This function calculates \f$AB + C\f$ efficiently, traversing the
+ * matrices in storage order where possible, and avoiding the use of
+ * extra temporary matrix objects.
+ *
+ * Matrices conform when \a A, \a B, and \a C are chosen with
+ * dimensions
+ * \f$((m \times n), (1 \times 1), (m \times n))\f$,
+ * \f$((1 \times 1), (n \times k), (n \times k))\f$, or
+ * \f$((m \times n), (n \times k), (m \times k))\f$.
+ *
+ * Scythe will use LAPACK/BLAS routines to compute \f$AB+C\f$
+ * with column-major matrices of double-precision floating point
+ * numbers if LAPACK/BLAS is available and you compile your program
+ * with the SCYTHE_LAPACK flag enabled.
+ *
+ * \param A A \f$1 \times 1\f$ or \f$m \times n\f$ Matrix.
+ * \param B A \f$1 \times 1\f$ or \f$n \times k\f$ Matrix.
+ * \param C A \f$m \times n\f$ or \f$n \times k\f$ or
+ * \f$m \times k\f$ Matrix.
+ *
+ * \throw scythe_conformation_error (Level 0)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3>
+ Matrix<T,RO,RS>
+ gaxpy (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& B,
+ const Matrix<T,PO3,PS3>& C)
+ {
+
+ Matrix<T, RO, Concrete> res;
+
+ if (A.isScalar() && B.rows() == C.rows() && B.cols() == C.cols()) {
+ // Case 1: 1x1 * nXk + nXk
+ gaxpy_alg(res, B, C, A[0]);
+ } else if (B.isScalar() && A.rows() == C.rows() &&
+ A.cols() == C.cols()) {
+ // Case 2: m x n * 1 x 1 + m x n
+ gaxpy_alg(res, A, C, B[0]);
+ } else if (A.cols() == B.rows() && A.rows() == C.rows() &&
+ B.cols() == C.cols()) {
+ // Case 3: m x n * n x k + m x k
+
+ res = Matrix<T,RO,Concrete> (A.rows(), B.cols(), false);
+
+ /* These are identical to matrix mult, one optimized for
+ * row-major and one for col-major.
+ */
+
+ T tmp;
+ if (RO == Col) { // col-major optimized
+ for (uint j = 0; j < B.cols(); ++j) {
+ for (uint i = 0; i < A.rows(); ++i)
+ res(i, j) = C(i, j);
+ for (uint l = 0; l < A.cols(); ++l) {
+ tmp = B(l, j);
+ for (uint i = 0; i < A.rows(); ++i)
+ res(i, j) += tmp * A(i, l);
+ }
+ }
+ } else { // row-major optimized
+ for (uint i = 0; i < A.rows(); ++i) {
+ for (uint j = 0; j < B.cols(); ++j)
+ res(i, j) = C(i, j);
+ for (uint l = 0; l < B.rows(); ++l) {
+ tmp = A(i, l);
+ for (uint j = 0; j < B.cols(); ++j)
+ res(i, j) += tmp * B(l,j);
+ }
+ }
+ }
+
+ } else {
+ SCYTHE_THROW(scythe_conformation_error,
+ "Expects (m x n * 1 x 1 + m x n)"
+ << "or (1 x 1 * n x k + n x k)"
+ << "or (m x n * n x k + m x k)");
+ }
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, res)
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2,
+ matrix_order PO3, matrix_style PS3>
+ Matrix<T,PO1,Concrete>
+ gaxpy (const Matrix<T,PO1,PS1>& A, const Matrix<T,PO2,PS2>& B,
+ const Matrix<T,PO3,PS3>& C)
+ {
+ return gaxpy<PO1,Concrete>(A,B,C);
+ }
+
+ /*! Fast caclulation of \f$A'A\f$.
+ *
+ * This function calculates \f$A'A\f$ efficiently, traversing the
+ * matrices in storage order where possible, and avoiding the use of
+ * the temporary matrix objects.
+ *
+ * Scythe will use LAPACK/BLAS routines to compute the cross-product
+ * of column-major matrices of double-precision floating point
+ * numbers if LAPACK/BLAS is available and you compile your program
+ * with the SCYTHE_LAPACK flag enabled.
+ *
+ * \param A The Matrix to return the cross product of.
+ *
+ * \see diag (const Matrix<T, PO, PS>& M)
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS>
+ Matrix<T, RO, RS>
+ crossprod (const Matrix<T, PO, PS>& A)
+ {
+ /* When rows > 1, we provide differing implementations of the
+ * algorithm depending on A's ordering to maximize strided access.
+ *
+ * The non-vector version of the algorithm fills in a triangle and
+ * then copies it over.
+ */
+ Matrix<T, RO, Concrete> res;
+ T tmp;
+ if (A.rows() == 1) {
+ res = Matrix<T,RO,Concrete>(A.cols(), A.cols(), true);
+ for (uint k = 0; k < A.rows(); ++k) {
+ for (uint i = 0; i < A.cols(); ++i) {
+ tmp = A(k, i);
+ for (uint j = i; j < A.cols(); ++j) {
+ res(j, i) =
+ res(i, j) += tmp * A(k, j);
+ }
+ }
+ }
+ } else {
+ if (PO == Row) { // row-major optimized
+ /* TODO: This is a little slower than the col-major. Improve.
+ */
+ res = Matrix<T,RO,Concrete>(A.cols(), A.cols(), true);
+ for (uint k = 0; k < A.rows(); ++k) {
+ for (uint i = 0; i < A.cols(); ++i) {
+ tmp = A(k, i);
+ for (uint j = i; j < A.cols(); ++j) {
+ res(i, j) += tmp * A(k, j);
+ }
+ }
+ }
+ for (uint i = 0; i < A.cols(); ++i)
+ for (uint j = i + 1; j < A.cols(); ++j)
+ res(j, i) = res(i, j);
+ } else { // col-major optimized
+ res = Matrix<T,RO,Concrete>(A.cols(), A.cols(), false);
+ for (uint j = 0; j < A.cols(); ++j) {
+ for (uint i = j; i < A.cols(); ++i) {
+ tmp = (T) 0;
+ for (uint k = 0; k < A.rows(); ++k)
+ tmp += A(k, i) * A(k, j);
+ res(i, j) = tmp;
+ }
+ }
+ for (uint i = 0; i < A.cols(); ++i)
+ for (uint j = i + 1; j < A.cols(); ++j)
+ res(i, j) = res(j, i);
+ }
+ }
+
+ SCYTHE_VIEW_RETURN(T, RO, RS, res)
+ }
+
+ template <typename T, matrix_order O, matrix_style S>
+ Matrix<T, O, Concrete>
+ crossprod (const Matrix<T,O,S>& M)
+ {
+ return crossprod<O,Concrete>(M);
+ }
+
+#ifdef SCYTHE_LAPACK
+ /* Template specializations of for col-major, concrete
+ * matrices of doubles that are only available when a lapack library
+ * is available.
+ */
+
+ template<>
+ Matrix<>
+ gaxpy<Col,Concrete,double,Col,Concrete,Col,Concrete,Col,Concrete>
+ (const Matrix<>& A, const Matrix<>& B, const Matrix<>& C)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for gaxpy");
+ Matrix<> res;
+
+ if (A.isScalar() && B.rows() == C.rows() && B.cols() == C.cols()) {
+ // Case 1: 1x1 * nXk + nXk
+ gaxpy_alg(res, B, C, A[0]);
+ } else if (B.isScalar() && A.rows() == C.rows() &&
+ A.cols() == C.cols()) {
+ // Case 2: m x n * 1 x 1 + m x n
+ gaxpy_alg(res, A, C, B[0]);
+ } else if (A.cols() == B.rows() && A.rows() == C.rows() &&
+ B.cols() == C.cols()) {
+ res = C; // NOTE: this copy may eat up speed gains, but can't be
+ // avoided.
+
+ // Case 3: m x n * n x k + m x k
+ double* Apnt = A.getArray();
+ double* Bpnt = B.getArray();
+ double* respnt = res.getArray();
+ const double one(1.0);
+ int rows = (int) res.rows();
+ int cols = (int) res.cols();
+ int innerDim = A.cols();
+
+ lapack::dgemm_("N", "N", &rows, &cols, &innerDim, &one, Apnt,
+ &rows, Bpnt, &innerDim, &one, respnt, &rows);
+
+ }
+ return res;
+ }
+
+ template<>
+ Matrix<>
+ crossprod(const Matrix<>& A)
+ {
+ SCYTHE_DEBUG_MSG("Using lapack/blas for crossprod");
+ // Set up some constants
+ const double zero = 0.0;
+ const double one = 1.0;
+
+ // Set up return value and arrays
+ Matrix<> res(A.cols(), A.cols(), false);
+ double* Apnt = A.getArray();
+ double* respnt = res.getArray();
+ int rows = (int) A.rows();
+ int cols = (int) A.cols();
+
+ lapack::dsyrk_("L", "T", &cols, &rows, &one, Apnt, &rows, &zero, respnt,
+ &cols);
+ lapack::make_symmetric(respnt, cols);
+
+ return res;
+ }
+
+#endif
+
-} // end namespace SCYTHE
+} // end namespace scythe
-#if defined (SCYTHE_COMPILE_DIRECT) && \
- (defined (__GNUG__) || defined (__MWERKS__) || \
- defined (_MSC_VER) || defined (EXPLICIT_TEMPLATE_INSTANTIATION))
-#include "la.cc"
-#endif /* EXPLICIT_TEMPLATE_INSTANTIATION */
#endif /* SCYTHE_LA_H */
diff --git a/src/lapack.h b/src/lapack.h
new file mode 100644
index 0000000..a21fb5b
--- /dev/null
+++ b/src/lapack.h
@@ -0,0 +1,131 @@
+/*
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
+ * information.
+ * --------------------------------------------------------------------
+ * scythe/lapack.h
+ *
+ */
+
+/*!
+ * \file lapack.h
+ * \brief Definitions that provide access to LAPACK/BLAS fortran
+ * routines for internal library functions.
+ *
+ * This file provides function definitions that help provide
+ * LAPACK/BLAS support to Scythe functions. These definitions are not
+ * part of Scythe's public interface and are used exclusively from
+ * within the library.
+ *
+ */
+
+
+#ifndef SCYTHE_LAPACK_H
+#define SCYTHE_LAPACK_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#endif
+
+namespace scythe {
+
+ namespace lapack {
+ inline void
+ make_symmetric(double* matrix, int rows)
+ {
+ for (int i = 1; i < rows; ++i)
+ for (int j = 0; j < i; ++j)
+ matrix[i * rows + j] = matrix[j * rows + i];
+ }
+
+ extern "C" {
+
+ /* Matrix multiplication and gaxpy */
+ void dgemm_ (char* transa, char* transb, const int* m,
+ const int* n, const int* k, const double* alpha,
+ const double* a, const int* lda, const double* b,
+ const int* ldb, const double* beta, double* c,
+ const int* ldc);
+
+ /* Matrix cross product A'A */
+ void dsyrk_(const char* uplo, const char* trans, const int* n,
+ const int* k, const double* alpha, const double* a,
+ const int* lda, const double* beta, double* c,
+ const int* ldc);
+
+ /* LU decomposition */
+ void dgetrf_ (const int* rows, const int* cols, double* a,
+ const int* lda, int* ipiv, int *info);
+
+ /* General inversion (given LU decomposion)*/
+ void dgetri_ (const int* n, double* a, const int* lda,
+ const int* ipiv, double* work, const int* lwork,
+ int* info);
+
+ /* Cholesky decomposition */
+ void dpotrf_(const char* uplo, const int* n, double* a,
+ const int* lda, int* info);
+
+ /* chol_solve give cholesky */
+ void dpotrs_ (const char* uplo, const int* n, const int* nrhs,
+ const double* a, const int* lda, double *b,
+ const int* ldb, int* info);
+
+ /* chol_solve from A and b */
+ void dposv_ (const char* uplo, const int* n, const int* nrhs,
+ double* a, const int* lda, double* b, const int* ldb,
+ int* info);
+
+ /* Positive Definite Inversion (given LU decomposition) */
+ void dpotri_(const char* uplo, const int* n, double* a,
+ const int* lda, int* info);
+
+ /* Eigenvalues/vectors for general (nonsymmetric) square matrices
+ void dgeev_(const char* jobvl, const char* jobvr, const int* n,
+ double* a, const int* lda, double* wr, double* wi,
+ double* vl, const int* ldvl, double* vr, const int* ldvr,
+ double* work, const int* lwork, int* info);
+ */
+
+ /* Eigenvalues/vectors for symmetric matrices */
+ void dsyevr_ (const char* jobz, const char* range, const char* uplo,
+ const int* n, double* a, const int* lda, double* vl,
+ double* vu, const int* il, const int* iu,
+ const double* abstol, const int* m, double* w,
+ double* z, const int* ldz, int* isuppz, double*
+ work, int* lwork, int* iwork, const int* liwork,
+ int* info);
+
+ /* QR decomposition */
+ void dgeqp3_ (const int* m, const int* n, double* a, const int* lda,
+ int* jpvt, double* tau, double* work, const int* lwork,
+ int* info);
+
+ /* QR solve routines */
+ void dormqr_ (const char* side, const char* trans, const int* m,
+ const int* n, const int* k, const double* a,
+ const int* lda, const double* tau, double* c,
+ const int* ldc, double* work, const int* lwork,
+ int* info);
+
+ void dtrtrs_ (const char* uplo, const char* trans, const char* diag,
+ const int* n, const int* nrhs, const double* a,
+ const int* lda, double* b, const int* ldb, int* info);
+
+ /* SVD */
+ void dgesdd_ (const char* jobz, const int* m, const int* n, double* a,
+ const int* lda, double* s, double* u, const int* ldu,
+ double* vt, const int* ldvt, double* work,
+ const int* lwork, int* iwork, int* info);
+
+ } // end extern
+ } // end namespace lapack
+} // end namespace scythe
+
+#endif /* SCYTHE_LAPACK_H */
diff --git a/src/lecuyer.cc b/src/lecuyer.cc
index 59f10ac..e35408d 100644
--- a/src/lecuyer.cc
+++ b/src/lecuyer.cc
@@ -1,689 +1,14 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/rng/lecuyer.cc
- *
- * Implemenation of the L'Ecuyer rng. See lecuyer.h for further
- * copyright information.
- *
- */
-
#ifndef SCYTHE_LECUYER_CC
#define SCYTHE_LECUYER_CC
-#include <cstdlib>
-#include <iostream>
-
-#ifdef SCYTHE_COMPILE_DIRECT
#include "lecuyer.h"
-#include "error.h"
-#else
-#include "scythestat/rng/lecuyer.h"
-#include "scythestat/error.h"
-#endif
-
-namespace SCYTHE {
-
-#ifdef __MINGW32__
- static const double m1 = 4294967087.0;
- static const double m2 = 4294944443.0;
- static const double norm = 1.0 / (m1 + 1.0);
- static const double a12 = 1403580.0;
- static const double a13n = 810728.0;
- static const double a21 = 527612.0;
- static const double a23n = 1370589.0;
- static const double two17 = 131072.0;
- static const double two53 = 9007199254740992.0;
- static const double fact = 5.9604644775390625e-8; /* 1/2^24 */
-
- // The following are the transition matrices of the two MRG
- // components (in matrix form), raised to the powers -1, 1, 2^76,
- // and 2^127, resp.
-
- static const double InvA1[3][3] = { // Inverse of A1p0
- { 184888585.0, 0.0, 1945170933.0 },
- { 1.0, 0.0, 0.0 },
- { 0.0, 1.0, 0.0 }
- };
-
- static const double InvA2[3][3] = { // Inverse of A2p0
- { 0.0, 360363334.0, 4225571728.0 },
- { 1.0, 0.0, 0.0 },
- { 0.0, 1.0, 0.0 }
- };
-
- static const double A1p0[3][3] = {
- { 0.0, 1.0, 0.0 },
- { 0.0, 0.0, 1.0 },
- { -810728.0, 1403580.0, 0.0 }
- };
-
- static const double A2p0[3][3] = {
- { 0.0, 1.0, 0.0 },
- { 0.0, 0.0, 1.0 },
- { -1370589.0, 0.0, 527612.0 }
- };
-
- static const double A1p76[3][3] = {
- { 82758667.0, 1871391091.0, 4127413238.0 },
- { 3672831523.0, 69195019.0, 1871391091.0 },
- { 3672091415.0, 3528743235.0, 69195019.0 }
- };
-
- static const double A2p76[3][3] = {
- { 1511326704.0, 3759209742.0, 1610795712.0 },
- { 4292754251.0, 1511326704.0, 3889917532.0 },
- { 3859662829.0, 4292754251.0, 3708466080.0 }
- };
-
- static const double A1p127[3][3] = {
- { 2427906178.0, 3580155704.0, 949770784.0 },
- { 226153695.0, 1230515664.0, 3580155704.0 },
- { 1988835001.0, 986791581.0, 1230515664.0 }
- };
-
- static const double A2p127[3][3] = {
- { 1464411153.0, 277697599.0, 1610723613.0 },
- { 32183930.0, 1464411153.0, 1022607788.0 },
- { 2824425944.0, 32183930.0, 2093834863.0 }
- };
-
- // Return (a*s + c) MOD m; a, s, c and m must be < 2^35
- static double
- MultModM (double a, double s, double c, double m)
- {
- double v;
- long a1;
-
- v = a * s + c;
-
- if (v >= two53 || v <= -two53) {
- a1 = static_cast<long> (a / two17); a -= a1 * two17;
- v = a1 * s;
- a1 = static_cast<long> (v / m); v -= a1 * m;
- v = v * two17 + a * s + c;
- }
-
- a1 = static_cast<long> (v / m);
- /* in case v < 0)*/
- if ((v -= a1 * m) < 0.0) return v += m; else return v;
- }
-
- // Compute the vector v = A*s MOD m. Assume that -m < s[i] < m.
- // Works also when v = s.
- static void
- MatVecModM (const double A[3][3], const double s[3],
- double v[3], double m)
- {
- int i;
- double x[3]; // Necessary if v = s
-
- for (i = 0; i < 3; ++i) {
- x[i] = MultModM (A[i][0], s[0], 0.0, m);
- x[i] = MultModM (A[i][1], s[1], x[i], m);
- x[i] = MultModM (A[i][2], s[2], x[i], m);
- }
- for (i = 0; i < 3; ++i)
- v[i] = x[i];
- }
-
- // Compute the matrix C = A*B MOD m. Assume that -m < s[i] < m.
- // Note: works also if A = C or B = C or A = B = C.
- static void
- MatMatModM (const double A[3][3], const double B[3][3],
- double C[3][3], double m)
- {
- int i, j;
- double V[3], W[3][3];
-
- for (i = 0; i < 3; ++i) {
- for (j = 0; j < 3; ++j)
- V[j] = B[j][i];
- MatVecModM (A, V, V, m);
- for (j = 0; j < 3; ++j)
- W[j][i] = V[j];
- }
- for (i = 0; i < 3; ++i)
- for (j = 0; j < 3; ++j)
- C[i][j] = W[i][j];
- }
-
- // Compute the matrix B = (A^(2^e) Mod m); works also if A = B.
- static void
- MatTwoPowModM(const double A[3][3], double B[3][3],
- double m, long e)
- {
- int i, j;
-
- /* initialize: B = A */
- if (A != B) {
- for (i = 0; i < 3; ++i)
- for (j = 0; j < 3; ++j)
- B[i][j] = A[i][j];
- }
- /* Compute B = A^(2^e) mod m */
- for (i = 0; i < e; i++)
- MatMatModM (B, B, B, m);
- }
-
- // Compute the matrix B = (A^n Mod m); works even if A = B.
- static void
- MatPowModM (const double A[3][3], double B[3][3], double m,
- long n)
- {
- int i, j;
- double W[3][3];
-
- /* initialize: W = A; B = I */
- for (i = 0; i < 3; ++i)
- for (j = 0; j < 3; ++j) {
- W[i][j] = A[i][j];
- B[i][j] = 0.0;
- }
- for (j = 0; j < 3; ++j)
- B[j][j] = 1.0;
-
- /* Compute B = A^n mod m using the binary decomposition of n */
- while (n > 0) {
- if (n % 2) MatMatModM (W, B, B, m);
- MatMatModM (W, W, W, m);
- n /= 2;
- }
- }
-
- // Check that the seeds are legitimate values. Returns 0 if legal
- // seeds, -1 otherwise.
- static int
- CheckSeed (const unsigned long seed[6])
- {
- int i;
-
- for (i = 0; i < 3; ++i) {
- if (seed[i] >= m1) {
- throw scythe_randseed_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("Seed[") & i
- & "] >= 4294967087, Seed is not set.");
- return -1;
- }
- }
- for (i = 3; i < 6; ++i) {
- if (seed[i] >= m2) {
- throw scythe_randseed_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("Seed[") & i
- & "] >= 4294944443, Seed is not set.");
- return -1;
- }
- }
- if (seed[0] == 0 && seed[1] == 0 && seed[2] == 0) {
- throw scythe_randseed_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "First 3 seeds = 0.\n\n");
- return -1;
- }
- if (seed[3] == 0 && seed[4] == 0 && seed[5] == 0) {
- throw scythe_randseed_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Last 3 seeds = 0.\n\n");
- return -1;
- }
-
- return 0;
- }
-#else
- namespace {
- const double m1 = 4294967087.0;
- const double m2 = 4294944443.0;
- const double norm = 1.0 / (m1 + 1.0);
- const double a12 = 1403580.0;
- const double a13n = 810728.0;
- const double a21 = 527612.0;
- const double a23n = 1370589.0;
- const double two17 = 131072.0;
- const double two53 = 9007199254740992.0;
- const double fact = 5.9604644775390625e-8; /* 1 / 2^24 */
-
- // The following are the transition matrices of the two MRG
- // components (in matrix form), raised to the powers -1, 1, 2^76,
- // and 2^127, resp.
-
- const double InvA1[3][3] = { // Inverse of A1p0
- { 184888585.0, 0.0, 1945170933.0 },
- { 1.0, 0.0, 0.0 },
- { 0.0, 1.0, 0.0 }
- };
-
- const double InvA2[3][3] = { // Inverse of A2p0
- { 0.0, 360363334.0, 4225571728.0 },
- { 1.0, 0.0, 0.0 },
- { 0.0, 1.0, 0.0 }
- };
-
- const double A1p0[3][3] = {
- { 0.0, 1.0, 0.0 },
- { 0.0, 0.0, 1.0 },
- { -810728.0, 1403580.0, 0.0 }
- };
-
- const double A2p0[3][3] = {
- { 0.0, 1.0, 0.0 },
- { 0.0, 0.0, 1.0 },
- { -1370589.0, 0.0, 527612.0 }
- };
-
- const double A1p76[3][3] = {
- { 82758667.0, 1871391091.0, 4127413238.0 },
- { 3672831523.0, 69195019.0, 1871391091.0 },
- { 3672091415.0, 3528743235.0, 69195019.0 }
- };
-
- const double A2p76[3][3] = {
- { 1511326704.0, 3759209742.0, 1610795712.0 },
- { 4292754251.0, 1511326704.0, 3889917532.0 },
- { 3859662829.0, 4292754251.0, 3708466080.0 }
- };
-
- const double A1p127[3][3] = {
- { 2427906178.0, 3580155704.0, 949770784.0 },
- { 226153695.0, 1230515664.0, 3580155704.0 },
- { 1988835001.0, 986791581.0, 1230515664.0 }
- };
-
- const double A2p127[3][3] = {
- { 1464411153.0, 277697599.0, 1610723613.0 },
- { 32183930.0, 1464411153.0, 1022607788.0 },
- { 2824425944.0, 32183930.0, 2093834863.0 }
- };
-
- // Return (a*s + c) MOD m; a, s, c and m must be < 2^35
- double
- MultModM (double a, double s, double c, double m)
- {
- double v;
- long a1;
-
- v = a * s + c;
-
- if (v >= two53 || v <= -two53) {
- a1 = static_cast<long> (a / two17); a -= a1 * two17;
- v = a1 * s;
- a1 = static_cast<long> (v / m); v -= a1 * m;
- v = v * two17 + a * s + c;
- }
-
- a1 = static_cast<long> (v / m);
- /* in case v < 0)*/
- if ((v -= a1 * m) < 0.0) return v += m; else return v;
- }
-
- // Compute the vector v = A*s MOD m. Assume that -m < s[i] < m.
- // Works also when v = s.
- void
- MatVecModM (const double A[3][3], const double s[3],
- double v[3], double m)
- {
- int i;
- double x[3]; // Necessary if v = s
-
- for (i = 0; i < 3; ++i) {
- x[i] = MultModM (A[i][0], s[0], 0.0, m);
- x[i] = MultModM (A[i][1], s[1], x[i], m);
- x[i] = MultModM (A[i][2], s[2], x[i], m);
- }
- for (i = 0; i < 3; ++i)
- v[i] = x[i];
- }
-
- // Compute the matrix C = A*B MOD m. Assume that -m < s[i] < m.
- // Note: works also if A = C or B = C or A = B = C.
- void
- MatMatModM (const double A[3][3], const double B[3][3],
- double C[3][3], double m)
- {
- int i, j;
- double V[3], W[3][3];
-
- for (i = 0; i < 3; ++i) {
- for (j = 0; j < 3; ++j)
- V[j] = B[j][i];
- MatVecModM (A, V, V, m);
- for (j = 0; j < 3; ++j)
- W[j][i] = V[j];
- }
- for (i = 0; i < 3; ++i)
- for (j = 0; j < 3; ++j)
- C[i][j] = W[i][j];
- }
- // Compute the matrix B = (A^(2^e) Mod m); works also if A = B.
- void
- MatTwoPowModM(const double A[3][3], double B[3][3],
- double m, long e)
- {
- int i, j;
-
- /* initialize: B = A */
- if (A != B) {
- for (i = 0; i < 3; ++i)
- for (j = 0; j < 3; ++j)
- B[i][j] = A[i][j];
- }
- /* Compute B = A^(2^e) mod m */
- for (i = 0; i < e; i++)
- MatMatModM (B, B, B, m);
- }
-
- // Compute the matrix B = (A^n Mod m); works even if A = B.
- void
- MatPowModM (const double A[3][3], double B[3][3], double m,
- long n)
- {
- int i, j;
- double W[3][3];
-
- /* initialize: W = A; B = I */
- for (i = 0; i < 3; ++i)
- for (j = 0; j < 3; ++j) {
- W[i][j] = A[i][j];
- B[i][j] = 0.0;
- }
- for (j = 0; j < 3; ++j)
- B[j][j] = 1.0;
-
- /* Compute B = A^n mod m using the binary decomposition of n */
- while (n > 0) {
- if (n % 2) MatMatModM (W, B, B, m);
- MatMatModM (W, W, W, m);
- n /= 2;
- }
- }
-
-
- // Check that the seeds are legitimate values. Returns 0 if legal
- // seeds, -1 otherwise.
- int
- CheckSeed (const unsigned long seed[6])
- {
- int i;
-
- for (i = 0; i < 3; ++i) {
- if (seed[i] >= m1) {
- throw scythe_randseed_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("Seed[") & i
- & "] >= 4294967087, Seed is not set.");
- return -1;
- }
- }
- for (i = 3; i < 6; ++i) {
- if (seed[i] >= m2) {
- throw scythe_randseed_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("Seed[") & i
- & "] >= 4294944443, Seed is not set.");
- return -1;
- }
- }
- if (seed[0] == 0 && seed[1] == 0 && seed[2] == 0) {
- throw scythe_randseed_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "First 3 seeds = 0.\n\n");
- return -1;
- }
- if (seed[3] == 0 && seed[4] == 0 && seed[5] == 0) {
- throw scythe_randseed_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Last 3 seeds = 0.\n\n");
- return -1;
- }
-
- return 0;
- }
-
- } // end of anonymous namespace
-#endif
-
- // Generate the next random number.
- //
- double
- lecuyer::U01 ()
- {
- long k;
- double p1, p2, u;
-
- /* Component 1 */
- p1 = a12 * Cg[1] - a13n * Cg[0];
- k = static_cast<long> (p1 / m1);
- p1 -= k * m1;
- if (p1 < 0.0) p1 += m1;
- Cg[0] = Cg[1]; Cg[1] = Cg[2]; Cg[2] = p1;
-
- /* Component 2 */
- p2 = a21 * Cg[5] - a23n * Cg[3];
- k = static_cast<long> (p2 / m2);
- p2 -= k * m2;
- if (p2 < 0.0) p2 += m2;
- Cg[3] = Cg[4]; Cg[4] = Cg[5]; Cg[5] = p2;
-
- /* Combination */
- u = ((p1 > p2) ? (p1 - p2) * norm : (p1 - p2 + m1) * norm);
-
- return (anti == false) ? u : (1 - u);
- }
-
- // Generate the next random number with extended (53 bits) precision.
- double
- lecuyer::U01d ()
- {
- double u;
- u = U01();
- if (anti) {
- // Don't forget that U01() returns 1 - u in the antithetic case
- u += (U01() - 1.0) * fact;
- return (u < 0.0) ? u + 1.0 : u;
- } else {
- u += U01() * fact;
- return (u < 1.0) ? u : (u - 1.0);
- }
- }
-
-
- // Public members of the class start here
-
- // The default seed of the package; will be the seed of the first
- // declared RngStream, unless SetPackageSeed is called.
- double
- lecuyer::nextSeed[6] =
- {
- 12345.0, 12345.0, 12345.0, 12345.0, 12345.0, 12345.0
- };
-
-
- // constructor
- lecuyer::lecuyer (const char *s) : name (s)
- {
- anti = false;
- incPrec = false;
-
- /* Information on a stream. The arrays {Cg, Bg, Ig} contain the
- * current state of the stream, the starting state of the current
- * SubStream, and the starting state of the stream. This stream
- * generates antithetic variates if anti = true. It also
- * generates numbers with extended precision (53 bits if machine
- * follows IEEE 754 standard) if incPrec = true. nextSeed will be
- * the seed of the next declared RngStream.
- */
-
- for (int i = 0; i < 6; ++i) {
- Bg[i] = Cg[i] = Ig[i] = nextSeed[i];
- }
-
- MatVecModM (A1p127, nextSeed, nextSeed, m1);
- MatVecModM (A2p127, &nextSeed[3], &nextSeed[3], m2);
- }
-
- // Reset Stream to beginning of Stream.
- void
- lecuyer::ResetStartStream ()
- {
- for (int i = 0; i < 6; ++i)
- Cg[i] = Bg[i] = Ig[i];
- }
-
- // Reset Stream to beginning of SubStream.
- void
- lecuyer::ResetStartSubstream ()
- {
- for (int i = 0; i < 6; ++i)
- Cg[i] = Bg[i];
- }
-
- // Reset Stream to NextSubStream.
- void
- lecuyer::ResetNextSubstream ()
- {
- MatVecModM(A1p76, Bg, Bg, m1);
- MatVecModM(A2p76, &Bg[3], &Bg[3], m2);
- for (int i = 0; i < 6; ++i)
- Cg[i] = Bg[i];
- }
-
- void
- lecuyer::SetPackageSeed (const unsigned long seed[6])
- {
- if (CheckSeed (seed)) return;
- for (int i = 0; i < 6; ++i)
- nextSeed[i] = seed[i];
- }
-
- void
- lecuyer::SetSeed (const unsigned long seed[6])
- {
- if (CheckSeed (seed)) return;
- for (int i = 0; i < 6; ++i)
- Cg[i] = Bg[i] = Ig[i] = seed[i];
- }
-
- // if e > 0, let n = 2^e + c;
- // if e < 0, let n = -2^(-e) + c;
- // if e = 0, let n = c.
- // Jump n steps forward if n > 0, backwards if n < 0.
- void
- lecuyer::AdvanceState (long e, long c)
- {
- double B1[3][3], C1[3][3], B2[3][3], C2[3][3];
-
- if (e > 0) {
- MatTwoPowModM (A1p0, B1, m1, e);
- MatTwoPowModM (A2p0, B2, m2, e);
- } else if (e < 0) {
- MatTwoPowModM (InvA1, B1, m1, -e);
- MatTwoPowModM (InvA2, B2, m2, -e);
- }
-
- if (c >= 0) {
- MatPowModM (A1p0, C1, m1, c);
- MatPowModM (A2p0, C2, m2, c);
- } else {
- MatPowModM (InvA1, C1, m1, -c);
- MatPowModM (InvA2, C2, m2, -c);
- }
-
- if (e) {
- MatMatModM (B1, C1, C1, m1);
- MatMatModM (B2, C2, C2, m2);
- }
-
- MatVecModM (C1, Cg, Cg, m1);
- MatVecModM (C2, &Cg[3], &Cg[3], m2);
- }
-
- void
- lecuyer::GetState (unsigned long seed[6]) const
- {
- for (int i = 0; i < 6; ++i)
- seed[i] = static_cast<unsigned long> (Cg[i]);
- }
-
-
- void
- lecuyer::WriteState () const
- {
- std::cout << "The current state of the Rngstream";
- if (name.size() > 0)
- std::cout << " " << name;
- std::cout << ":\n Cg = { ";
-
- for (int i = 0; i < 5; i++) {
- std::cout << static_cast<unsigned long> (Cg [i]) << ", ";
- }
- std::cout << static_cast<unsigned long> (Cg [5]) << " }\n\n";
- }
-
- void
- lecuyer::WriteStateFull () const
- {
- int i;
-
- std::cout << "The RngStream";
- if (name.size() > 0)
- std::cout << " " << name;
- std::cout << ":\n anti = " << (anti ? "true" : "false") << "\n";
- std::cout << " incPrec = " << (incPrec ? "true" : "false") << "\n";
-
- std::cout << " Ig = { ";
- for (i = 0; i < 5; i++) {
- std::cout << static_cast<unsigned long> (Ig [i]) << ", ";
- }
- std::cout << static_cast<unsigned long> (Ig [5]) << " }\n";
-
- std::cout << " Bg = { ";
- for (i = 0; i < 5; i++) {
- std::cout << static_cast<unsigned long> (Bg [i]) << ", ";
- }
- std::cout << static_cast<unsigned long> (Bg [5]) << " }\n";
-
- std::cout << " Cg = { ";
- for (i = 0; i < 5; i++) {
- std::cout << static_cast<unsigned long> (Cg [i]) << ", ";
- }
- std::cout << static_cast<unsigned long> (Cg [5]) << " }\n\n";
- }
-
- void
- lecuyer::IncreasedPrecis (bool incp)
- {
- incPrec = incp;
- }
-
- void
- lecuyer::SetAntithetic (bool a)
- {
- anti = a;
- }
-
- // Generate the next random number.
- //
- double
- lecuyer::runif ()
- {
- if (incPrec)
- return U01d();
- else
- return U01();
- }
-
- // Generate the next random integer.
- //
- long
- lecuyer::RandInt (long low, long high)
- {
- return low + static_cast<long> ((high - low + 1) * runif ());
- }
-
+namespace scythe {
+ /* Default seed definition */
+ double lecuyer::nextSeed[6] =
+ {
+ 12345.0, 12345.0, 12345.0, 12345.0, 12345.0, 12345.0
+ };
}
-#endif /* SCYTHE_LECUYER_CC */
+#endif
diff --git a/src/lecuyer.h b/src/lecuyer.h
index f1cb79a..a0feb01 100644
--- a/src/lecuyer.h
+++ b/src/lecuyer.h
@@ -1,7 +1,7 @@
/*
* Scythe Statistical Library
* Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
+ * 2002-present Andrew D. Martin, Kevin M. Quinn, and Daniel
* Pemstein. All Rights Reserved.
*
* This program is free software; you can redistribute it and/or modify
@@ -16,8 +16,8 @@
* Provides the class definition for the L'Ecuyer random number
* generator, a rng capable of generating many independent substreams.
* This class extends the abstract rng class by implementing runif().
- * Based on RngStream.cpp.
- *
+ * Based on RngStream.cpp, by Pierre L'Ecuyer.
+ *
* Pierre L'Ecuyer agreed to the following dual-licensing terms in an
* email received 7 August 2004. This dual-license was prompted by
* the Debian maintainers of R and MCMCpack.
@@ -42,94 +42,689 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
* USA.
- *
+ *
+ */
+/*! \file lecuyer.h
+ * \brief The L'Ecuyer random number generator.
+ *
+ * This file contains the lecuyer class, a class that extends Scythe's
+ * base random number generation class (scythe::rng) by providing an
+ * implementation of scythe::rng::runif(), using L'Ecuyer's algorithm.
+ *
*/
-
#ifndef SCYTHE_LECUYER_H
#define SCYTHE_LECUYER_H
+#include<cstdlib>
+#include<iostream>
+#include<string>
+
#ifdef SCYTHE_COMPILE_DIRECT
#include "rng.h"
#else
#include "scythestat/rng.h"
#endif
-namespace SCYTHE {
-
- class lecuyer : public rng
- {
- public:
-
- lecuyer (const char *name = "");
-
-
- static void SetPackageSeed (const unsigned long seed[6]);
-
-
- void ResetStartStream ();
-
-
- void ResetStartSubstream ();
-
-
- void ResetNextSubstream ();
-
-
- void SetAntithetic (bool);
-
-
- void IncreasedPrecis (bool);
-
-
- void SetSeed (const unsigned long seed[6]);
-
-
- void AdvanceState (long, long);
+/* We want to use an anonymous namespace to make the following consts
+ * and functions local to this file, but mingw doesn't play nice with
+ * anonymous namespaces so we do things differently when using the
+ * cross-compiler.
+ */
+#ifdef __MINGW32__
+#define SCYTHE_MINGW32_STATIC static
+#else
+#define SCYTHE_MINGW32_STATIC
+#endif
+namespace scythe {
+#ifndef __MINGW32__
+ namespace {
+#endif
- void GetState (unsigned long seed[6]) const;
+ SCYTHE_MINGW32_STATIC const double m1 = 4294967087.0;
+ SCYTHE_MINGW32_STATIC const double m2 = 4294944443.0;
+ SCYTHE_MINGW32_STATIC const double norm = 1.0 / (m1 + 1.0);
+ SCYTHE_MINGW32_STATIC const double a12 = 1403580.0;
+ SCYTHE_MINGW32_STATIC const double a13n = 810728.0;
+ SCYTHE_MINGW32_STATIC const double a21 = 527612.0;
+ SCYTHE_MINGW32_STATIC const double a23n = 1370589.0;
+ SCYTHE_MINGW32_STATIC const double two17 =131072.0;
+ SCYTHE_MINGW32_STATIC const double two53 =9007199254740992.0;
+ /* 1/2^24 */
+ SCYTHE_MINGW32_STATIC const double fact = 5.9604644775390625e-8;
+
+ // The following are the transition matrices of the two MRG
+ // components (in matrix form), raised to the powers -1, 1, 2^76,
+ // and 2^127, resp.
+
+ SCYTHE_MINGW32_STATIC const double InvA1[3][3] = { // Inverse of A1p0
+ { 184888585.0, 0.0, 1945170933.0 },
+ { 1.0, 0.0, 0.0 },
+ { 0.0, 1.0, 0.0 } };
+
+ SCYTHE_MINGW32_STATIC const double InvA2[3][3] = { // Inverse of A2p0
+ { 0.0, 360363334.0, 4225571728.0 },
+ { 1.0, 0.0, 0.0 },
+ { 0.0, 1.0, 0.0 } };
+
+ SCYTHE_MINGW32_STATIC const double A1p0[3][3] = {
+ { 0.0, 1.0, 0.0 },
+ { 0.0, 0.0, 1.0 },
+ { -810728.0, 1403580.0, 0.0 } };
+
+ SCYTHE_MINGW32_STATIC const double A2p0[3][3] = {
+ { 0.0, 1.0, 0.0 },
+ { 0.0, 0.0, 1.0 },
+ { -1370589.0, 0.0, 527612.0 } };
+
+ SCYTHE_MINGW32_STATIC const double A1p76[3][3] = {
+ { 82758667.0, 1871391091.0, 4127413238.0 },
+ { 3672831523.0, 69195019.0, 1871391091.0 },
+ { 3672091415.0, 3528743235.0, 69195019.0 } };
+
+ SCYTHE_MINGW32_STATIC const double A2p76[3][3] = {
+ { 1511326704.0, 3759209742.0, 1610795712.0 },
+ { 4292754251.0, 1511326704.0, 3889917532.0 },
+ { 3859662829.0, 4292754251.0, 3708466080.0 } };
+
+ SCYTHE_MINGW32_STATIC const double A1p127[3][3] = {
+ { 2427906178.0, 3580155704.0, 949770784.0 },
+ { 226153695.0, 1230515664.0, 3580155704.0 },
+ { 1988835001.0, 986791581.0, 1230515664.0 } };
+
+ SCYTHE_MINGW32_STATIC const double A2p127[3][3] = {
+ { 1464411153.0, 277697599.0, 1610723613.0 },
+ { 32183930.0, 1464411153.0, 1022607788.0 },
+ { 2824425944.0, 32183930.0, 2093834863.0 } };
+
+ // Return (a*s + c) MOD m; a, s, c and m must be < 2^35
+ SCYTHE_MINGW32_STATIC double
+ MultModM (double a, double s, double c, double m)
+ {
+ double v;
+ long a1;
+ v = a * s + c;
- void WriteState () const;
+ if (v >= two53 || v <= -two53) {
+ a1 = static_cast<long> (a / two17); a -= a1 * two17;
+ v = a1 * s;
+ a1 = static_cast<long> (v / m); v -= a1 * m;
+ v = v * two17 + a * s + c;
+ }
+ a1 = static_cast<long> (v / m);
+ /* in case v < 0)*/
+ if ((v -= a1 * m) < 0.0) return v += m; else return v;
+ }
- void WriteStateFull () const;
+ // Compute the vector v = A*s MOD m. Assume that -m < s[i] < m.
+ // Works also when v = s.
+ SCYTHE_MINGW32_STATIC void
+ MatVecModM (const double A[3][3], const double s[3],
+ double v[3], double m)
+ {
+ int i;
+ double x[3]; // Necessary if v = s
+
+ for (i = 0; i < 3; ++i) {
+ x[i] = MultModM (A[i][0], s[0], 0.0, m);
+ x[i] = MultModM (A[i][1], s[1], x[i], m);
+ x[i] = MultModM (A[i][2], s[2], x[i], m);
+ }
+ for (i = 0; i < 3; ++i)
+ v[i] = x[i];
+ }
+ // Compute the matrix C = A*B MOD m. Assume that -m < s[i] < m.
+ // Note: works also if A = C or B = C or A = B = C.
+ SCYTHE_MINGW32_STATIC void
+ MatMatModM (const double A[3][3], const double B[3][3],
+ double C[3][3], double m)
+ {
+ int i, j;
+ double V[3], W[3][3];
+
+ for (i = 0; i < 3; ++i) {
+ for (j = 0; j < 3; ++j)
+ V[j] = B[j][i];
+ MatVecModM (A, V, V, m);
+ for (j = 0; j < 3; ++j)
+ W[j][i] = V[j];
+ }
+ for (i = 0; i < 3; ++i)
+ for (j = 0; j < 3; ++j)
+ C[i][j] = W[i][j];
+ }
- double runif ();
+ // Compute the matrix B = (A^(2^e) Mod m); works also if A = B.
+ SCYTHE_MINGW32_STATIC void
+ MatTwoPowModM(const double A[3][3], double B[3][3],
+ double m, long e)
+ {
+ int i, j;
+
+ /* initialize: B = A */
+ if (A != B) {
+ for (i = 0; i < 3; ++i)
+ for (j = 0; j < 3; ++j)
+ B[i][j] = A[i][j];
+ }
+ /* Compute B = A^(2^e) mod m */
+ for (i = 0; i < e; i++)
+ MatMatModM (B, B, B, m);
+ }
- /* We have to override the overloaded form of runif because
- * overloading the no-arg runif() hides the base class
- * definition; C++ stops looking once it finds the above.
- */
- inline Matrix<double> runif(const int &rows, const int &cols)
- {
- return rng::runif(rows, cols);
+ // Compute the matrix B = (A^n Mod m); works even if A = B.
+ SCYTHE_MINGW32_STATIC void
+ MatPowModM (const double A[3][3], double B[3][3], double m,
+ long n)
+ {
+ int i, j;
+ double W[3][3];
+
+ /* initialize: W = A; B = I */
+ for (i = 0; i < 3; ++i)
+ for (j = 0; j < 3; ++j) {
+ W[i][j] = A[i][j];
+ B[i][j] = 0.0;
}
+ for (j = 0; j < 3; ++j)
+ B[j][j] = 1.0;
+
+ /* Compute B = A^n mod m using the binary decomposition of n */
+ while (n > 0) {
+ if (n % 2) MatMatModM (W, B, B, m);
+ MatMatModM (W, W, W, m);
+ n /= 2;
+ }
+ }
- long RandInt (long, long);
-
- protected:
-
- double Cg[6], Bg[6], Ig[6];
-
-
- bool anti, incPrec;
-
-
- std::string name;
-
-
- static double nextSeed[6];
-
-
- double U01 ();
-
-
- double U01d ();
-
- };
+ // Check that the seeds are legitimate values. Returns 0 if legal
+ // seeds, -1 otherwise.
+ SCYTHE_MINGW32_STATIC int
+ CheckSeed (const unsigned long seed[6])
+ {
+ int i;
+ for (i = 0; i < 3; ++i) {
+ if (seed[i] >= m1) {
+ SCYTHE_THROW(scythe_randseed_error,
+ "Seed[" << i << "] >= 4294967087, Seed is not set");
+ return -1;
+ }
+ }
+ for (i = 3; i < 6; ++i) {
+ if (seed[i] >= m2) {
+ SCYTHE_THROW(scythe_randseed_error,
+ "Seed[" << i << "] >= 4294944443, Seed is not set");
+ return -1;
+ }
+ }
+ if (seed[0] == 0 && seed[1] == 0 && seed[2] == 0) {
+ SCYTHE_THROW(scythe_randseed_error, "First 3 seeds = 0");
+ return -1;
+ }
+ if (seed[3] == 0 && seed[4] == 0 && seed[5] == 0) {
+ SCYTHE_THROW(scythe_randseed_error, "Last 3 seeds = 0");
+ return -1;
+ }
+
+ return 0;
}
+
+#ifndef __MINGW32__
+ } // end anonymous namespace
+#endif
+
+ /*! \brief The L'Ecuyer random number generator.
+ *
+ * This class defines a random number generator, using Pierre
+ * L'Ecuyer's algorithm (2000) and source code (2001) for
+ * generating multiple simultaneous streams of random uniform
+ * variates. The period of the underlying single-stream generator
+ * is approximately \f$3.1 \times 10^{57}\f$. Each individual
+ * stream is implemented in terms of a sequence of substreams (see
+ * L'Ecuyer et al (2000) for details).
+ *
+ * The lecuyer class extends Scythe's basic random number
+ * generating class, scythe::rng, implementing the interface that
+ * it defines.
+ *
+ * \see rng
+ * \see mersenne
+ *
+ */
+ class lecuyer : public rng<lecuyer>
+ {
+ public:
+
+ // Constructor
+ /*! \brief Constructor
+ *
+ * This constructor creates an object encapsulating a random
+ * number stream, with an optional name. It also sets the seed
+ * of the stream to the package (default or user-specified) seed
+ * if this is the first stream generated, or, otherwise, to a
+ * value \f$2^{127}\f$ steps ahead of the seed of the previously
+ * constructed stream.
+ *
+ * \param streamname The optional name for the stream.
+ *
+ * \see SetPackageSeed(unsigned long seed[6])
+ * \see SetSeed(unsigned long seed[6])
+ * \see SetAntithetic(bool)
+ * \see IncreasedPrecis(bool)
+ * \see name()
+ */
+ lecuyer (std::string streamname = "")
+ : rng<lecuyer> (),
+ streamname_ (streamname)
+ {
+ anti = false;
+ incPrec = false;
+
+ /* Information on a stream. The arrays {Cg, Bg, Ig} contain
+ * the current state of the stream, the starting state of the
+ * current SubStream, and the starting state of the stream.
+ * This stream generates antithetic variates if anti = true.
+ * It also generates numbers with extended precision (53 bits
+ * if machine follows IEEE 754 standard) if incPrec = true.
+ * nextSeed will be the seed of the next declared RngStream.
+ */
+
+ for (int i = 0; i < 6; ++i) {
+ Bg[i] = Cg[i] = Ig[i] = nextSeed[i];
+ }
+
+ MatVecModM (A1p127, nextSeed, nextSeed, m1);
+ MatVecModM (A2p127, &nextSeed[3], &nextSeed[3], m2);
+ }
+
+ /*! \brief Get the stream's name.
+ *
+ * This method returns a stream's name string.
+ *
+ * \see lecuyer(const char*)
+ */
+ std::string
+ name() const
+ {
+ return streamname_;
+ }
+
+ /*! \brief Reset the stream.
+ *
+ * This method resets the stream to its initial seeded state.
+ *
+ * \see ResetStartSubstream()
+ * \see ResetNextSubstream()
+ * \see SetSeed(unsigned long seed[6])
+ */
+ void
+ ResetStartStream ()
+ {
+ for (int i = 0; i < 6; ++i)
+ Cg[i] = Bg[i] = Ig[i];
+ }
+
+ /*! \brief Reset the current substream.
+ *
+ *
+ * This method resets the stream to the first state of its
+ * current substream.
+ *
+ * \see ResetStartStream()
+ * \see ResetNextSubstream()
+ * \see SetSeed(unsigned long seed[6])
+ *
+ */
+ void
+ ResetStartSubstream ()
+ {
+ for (int i = 0; i < 6; ++i)
+ Cg[i] = Bg[i];
+ }
+
+ /*! \brief Jump to the next substream.
+ *
+ * This method resets the stream to the first state of its next
+ * substream.
+ *
+ * \see ResetStartStream()
+ * \see ResetStartSubstream()
+ * \see SetSeed(unsigned long seed[6])
+ *
+ */
+ void
+ ResetNextSubstream ()
+ {
+ MatVecModM(A1p76, Bg, Bg, m1);
+ MatVecModM(A2p76, &Bg[3], &Bg[3], m2);
+ for (int i = 0; i < 6; ++i)
+ Cg[i] = Bg[i];
+ }
+
+ /*! \brief Set the package seed.
+ *
+ * This method sets the overall package seed. The default
+ * initial seed is (12345, 12345, 12345, 12345, 12345, 12345).
+ * The package seed is the seed used to initialize the first
+ * constructed random number stream in a given program.
+ *
+ * \param seed An array of six integers to seed the package.
+ * The first three values cannot all equal 0 and must all be
+ * less than 4294967087 while the second trio of integers must
+ * all be less than 4294944443 and not all 0.
+ *
+ * \see SetSeed(unsigned long seed[6])
+ *
+ * \throw scythe_randseed_error (Level 0)
+ */
+ static void
+ SetPackageSeed (unsigned long seed[6])
+ {
+ if (CheckSeed (seed)) return;
+ for (int i = 0; i < 6; ++i)
+ nextSeed[i] = seed[i];
+ }
+
+ /*! \brief Set the stream seed.
+ *
+ * This method sets the stream seed which is used to initialize
+ * the state of the given stream.
+ *
+ * \warning This method sets the stream seed in isolation and
+ * does not coordinate with any other streams. Therefore,
+ * using this method without care can result in multiple
+ * streams that overlap in the course of their runs.
+ *
+ * \param seed An array of six integers to seed the stream.
+ * The first three values cannot all equal 0 and must all be
+ * less than 4294967087 while the second trio of integers must
+ * all be less than 4294944443 and not all 0.
+ *
+ * \see SetPackageSeed(unsigned long seed[6])
+ * \see ResetStartStream()
+ * \see ResetStartSubstream()
+ * \see ResetNextSubstream()
+ *
+ * \throw scythe_randseed_error (Level 0)
+ */
+ void
+ SetSeed (unsigned long seed[6])
+ {
+ if (CheckSeed (seed)) return;
+ for (int i = 0; i < 6; ++i)
+ Cg[i] = Bg[i] = Ig[i] = seed[i];
+ }
+
+ // XXX: get the cases formula working!
+ /*! \brief Advances the state of the stream.
+ *
+ * This method advances the input \f$n\f$ steps, using the rule:
+ * \f[
+ * n =
+ * \begin{cases}
+ * 2^e + c \quad if~e > 0, \\
+ * -2^{-e} + c \quad if~e < 0, \\
+ * c \quad if~e = 0.
+ * \end{cases}
+ * \f]
+ *
+ * \param e This parameter controls state advancement.
+ * \param c This parameter also controls state advancement.
+ *
+ * \see GetState()
+ * \see ResetStartStream()
+ * \see ResetStartSubstream()
+ * \see ResetNextSubstream()
+ */
+ void
+ AdvanceState (long e, long c)
+ {
+ double B1[3][3], C1[3][3], B2[3][3], C2[3][3];
+
+ if (e > 0) {
+ MatTwoPowModM (A1p0, B1, m1, e);
+ MatTwoPowModM (A2p0, B2, m2, e);
+ } else if (e < 0) {
+ MatTwoPowModM (InvA1, B1, m1, -e);
+ MatTwoPowModM (InvA2, B2, m2, -e);
+ }
+
+ if (c >= 0) {
+ MatPowModM (A1p0, C1, m1, c);
+ MatPowModM (A2p0, C2, m2, c);
+ } else {
+ MatPowModM (InvA1, C1, m1, -c);
+ MatPowModM (InvA2, C2, m2, -c);
+ }
+
+ if (e) {
+ MatMatModM (B1, C1, C1, m1);
+ MatMatModM (B2, C2, C2, m2);
+ }
+
+ MatVecModM (C1, Cg, Cg, m1);
+ MatVecModM (C2, &Cg[3], &Cg[3], m2);
+ }
+
+ /*! \brief Get the current state.
+ *
+ * This method places the current state of the stream, as
+ * represented by six integers, into the array argument. This
+ * is useful for saving and restoring streams across program
+ * runs.
+ *
+ * \param seed An array of six integers that will hold the state values on return.
+ *
+ * \see AdvanceState()
+ */
+ void
+ GetState (unsigned long seed[6]) const
+ {
+ for (int i = 0; i < 6; ++i)
+ seed[i] = static_cast<unsigned long> (Cg[i]);
+ }
+
+ /*! \brief Toggle generator precision.
+ *
+ * This method sets the precision level of the given stream. By
+ * default, streams generate random numbers with 32 bit
+ * resolution. If the user invokes this method with \a incp =
+ * true, then the stream will begin to generate variates with
+ * greater precision (53 bits on machines following the IEEE 754
+ * standard). Calling this method again with \a incp = false
+ * will return the precision of generated numbers to 32 bits.
+ *
+ * \param incp A boolean value where true implies high (most
+ * likely 53 bit) precision and false implies low (32 bit)
+ * precision.
+ *
+ * \see SetAntithetic(bool)
+ */
+ void
+ IncreasedPrecis (bool incp)
+ {
+ incPrec = incp;
+ }
+
+ /*! \brief Toggle the orientation of generated random numbers.
+ *
+ * This methods causes the given stream to generate antithetic
+ * (1 - U, where U is the default number generated) when called
+ * with \a a = true. Calling this method with \a a = false will
+ * return generated numbers to their default orientation.
+ *
+ * \param a A boolean value that selects regular or antithetic
+ * variates.
+ *
+ * \see IncreasedPrecis(bool)
+ */
+ void
+ SetAntithetic (bool a)
+ {
+ anti = a;
+ }
+
+ /*! \brief Generate a random uniform variate on (0, 1).
+ *
+ * This routine returns a random double precision floating point
+ * number from the uniform distribution on the interval (0,
+ * 1). This method overloads the pure virtual method of the
+ * same name in the rng base class.
+ *
+ * \see runif(unsigned int, unsigned int)
+ * \see RandInt(long, long)
+ * \see rng
+ */
+ double
+ runif ()
+ {
+ if (incPrec)
+ return U01d();
+ else
+ return U01();
+ }
+
+ /* We have to override the overloaded form of runif because
+ * overloading the no-arg runif() hides the base class
+ * definition; C++ stops looking once it finds the above.
+ */
+ /*! \brief Generate a Matrix of random uniform variates.
+ *
+ * This routine returns a Matrix of double precision random
+ * uniform variates. on the interval (0, 1). This method
+ * overloads the virtual method of the same name in the rng base
+ * class.
+ *
+ * This is the general template version of this method and
+ * is called through explicit template instantiation.
+ *
+ * \param rows The number of rows in the returned Matrix.
+ * \param cols The number of columns in the returned Matrix.
+ *
+ * \see runif()
+ * \see rng
+ *
+ * \note We are forced to override this overloaded method
+ * because the 1-arg version of runif() hides the base class's
+ * definition of this method from the compiler, although it
+ * probably should not.
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix<double,O,S> runif(unsigned int rows, unsigned int cols)
+ {
+ return rng<lecuyer>::runif<O,S>(rows,cols);
+ }
+
+ /*! \brief Generate a Matrix of random uniform variates.
+ *
+ * This routine returns a Matrix of double precision random
+ * uniform variates on the interval (0, 1). This method
+ * overloads the virtual method of the same name in the rng base
+ * class.
+ *
+ * This is the default template version of this method and
+ * is called through implicit template instantiation.
+ *
+ * \param rows The number of rows in the returned Matrix.
+ * \param cols The number of columns in the returned Matrix.
+ *
+ * \see runif()
+ * \see rng
+ *
+ * \note We are forced to override this overloaded method
+ * because the 1-arg version of runif() hides the base class's
+ * definition of this method from the compiler, although it
+ * probably should not.
+ */
+ Matrix<double,Col,Concrete> runif(unsigned int rows,
+ unsigned int cols)
+ {
+ return rng<lecuyer>::runif<Col,Concrete>(rows, cols);
+ }
+
+ /*! \brief Generate the next random integer.
+ *
+ * This method generates a random integer from the discrete
+ * uniform distribution on the interval [\a low, \a high].
+ *
+ * \param low The lower bound of the interval to evaluate.
+ * \param high the upper bound of the interval to evaluate.
+ *
+ * \see runif()
+ */
+ long
+ RandInt (long low, long high)
+ {
+ return low + static_cast<long> ((high - low + 1) * runif ());
+ }
+
+ protected:
+ // Generate the next random number.
+ //
+ double
+ U01 ()
+ {
+ long k;
+ double p1, p2, u;
+
+ /* Component 1 */
+ p1 = a12 * Cg[1] - a13n * Cg[0];
+ k = static_cast<long> (p1 / m1);
+ p1 -= k * m1;
+ if (p1 < 0.0) p1 += m1;
+ Cg[0] = Cg[1]; Cg[1] = Cg[2]; Cg[2] = p1;
+
+ /* Component 2 */
+ p2 = a21 * Cg[5] - a23n * Cg[3];
+ k = static_cast<long> (p2 / m2);
+ p2 -= k * m2;
+ if (p2 < 0.0) p2 += m2;
+ Cg[3] = Cg[4]; Cg[4] = Cg[5]; Cg[5] = p2;
+
+ /* Combination */
+ u = ((p1 > p2) ? (p1 - p2) * norm : (p1 - p2 + m1) * norm);
+
+ return (anti == false) ? u : (1 - u);
+ }
+
+ // Generate the next random number with extended (53 bits) precision.
+ double
+ U01d ()
+ {
+ double u;
+ u = U01();
+ if (anti) {
+ // Don't forget that U01() returns 1 - u in the antithetic case
+ u += (U01() - 1.0) * fact;
+ return (u < 0.0) ? u + 1.0 : u;
+ } else {
+ u += U01() * fact;
+ return (u < 1.0) ? u : (u - 1.0);
+ }
+ }
+
+
+ // Public members of the class start here
+
+ // The default seed of the package; will be the seed of the first
+ // declared RngStream, unless SetPackageSeed is called.
+ static double nextSeed[6];
+
+ /* Instance variables */
+ double Cg[6], Bg[6], Ig[6];
+
+
+ bool anti, incPrec;
+
+
+ std::string streamname_;
+
+ };
+
+}
#endif /* SCYTHE_LECUYER_H */
diff --git a/src/matrix.h b/src/matrix.h
index 52827b1..ea4437b 100644
--- a/src/matrix.h
+++ b/src/matrix.h
@@ -1,2014 +1,5092 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * scythestat/matrix.h
+ * scythe's/matrix.h
*
- * Provides the class definition for the Matrix class; this
- * data structure sits at the core of the library. This class
- * behaves according to the Standard Template Library (STL)
- * standard for container classes and iterators for this class
- * are provided by include/Scythe_Matrix_Iterator.h
+ */
+
+/*!
+ * \file matrix.h
+ * \brief Definitions of Matrix and related classes and functions.
*
+ * This file contains the definitions of the Matrix, Matrix_base, and
+ * associated classes. It also contains a number of external
+ * functions that operate on Matrix objects, such as mathematical
+ * operators.
+ *
+ * Many of the arithmetic and logical operators in this file are
+ * implemented in terms of overloaded template definitions to provide
+ * both generic and default versions of each operation. Generic
+ * templates allow (and force) the user to fully specify the
+ * template type of the returned matrix object (row or column order,
+ * concrete or view) while default templates automatically return
+ * concrete matrices with the ordering of the first or only Matrix
+ * argument to the function. Furthermore, we overload binary
+ * functions to provide scalar by Matrix operations, in addition to
+ * basic Matrix by Matrix arithmetic and logic. Therefore,
+ * definitions for multiple versions appear in the functions list
+ * below. We adopt the convention of providing explicit documentation
+ * for only the most generic Matrix by Matrix version of each of these
+ * operators and describe the behavior of the various overloaded
+ * versions in these documents.
*/
+
#ifndef SCYTHE_MATRIX_H
#define SCYTHE_MATRIX_H
+//#include <climits>
#include <iostream>
#include <iomanip>
-#include <fstream>
-#include <sstream>
-#include <new>
-#include <numeric>
#include <string>
-#include <climits>
-#include <cmath>
+#include <sstream>
+#include <fstream>
+#include <iterator>
+#include <algorithm>
+//#include <numeric>
+#include <functional>
+#include <list>
#ifdef SCYTHE_COMPILE_DIRECT
+#include "defs.h"
+#include "algorithm.h"
#include "error.h"
-#include "util.h"
-#include "matrix_iterator.h"
+#include "datablock.h"
+#include "matrix_random_access_iterator.h"
+#include "matrix_forward_iterator.h"
+#include "matrix_bidirectional_iterator.h"
+#ifdef SCYTHE_LAPACK
+#include "lapack.h"
+#endif
#else
+#include "scythestat/defs.h"
+#include "scythestat/algorithm.h"
#include "scythestat/error.h"
-#include "scythestat/util.h"
-#include "scythestat/matrix_iterator.h"
+#include "scythestat/datablock.h"
+#include "scythestat/matrix_random_access_iterator.h"
+#include "scythestat/matrix_forward_iterator.h"
+#include "scythestat/matrix_bidirectional_iterator.h"
+#ifdef SCYTHE_LAPACK
+#include "scythestat/lapack.h"
+#endif
#endif
-namespace SCYTHE {
-
- struct all_elements{
- } const _ = {};
-
-
- enum IN_TYPE {NORMAL, REPEAT, DIAG, UTRIANG, LTRIANG, BLOCK};
+namespace scythe {
- template <class T>
- class Matrix
- {
- public:
- typedef T ttype;
-
- friend class matrix_iterator<ttype>;
- friend class const_matrix_iterator<ttype>;
- friend class row_major_iterator<ttype>;
- friend class const_row_major_iterator<ttype>;
- friend class col_major_iterator<ttype>;
- friend class const_col_major_iterator<ttype>;
- friend class reverse_row_major_iterator<ttype>;
- friend class const_reverse_row_major_iterator<ttype>;
- friend class reverse_col_major_iterator<ttype>;
- friend class const_reverse_col_major_iterator<ttype>;
+ namespace { // make the uint typedef local to this file
+ /* Convenience typedefs */
+ typedef unsigned int uint;
+ }
+
+ /* Forward declare the matrix multiplication functions for *= to use
+ * within Matrix proper .
+ */
+
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE,
+ matrix_order L_ORDER, matrix_style L_STYLE,
+ matrix_order R_ORDER, matrix_style R_STYLE>
+ Matrix<T_type, ORDER, STYLE>
+ operator* (const Matrix<T_type, L_ORDER, L_STYLE>& lhs,
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs);
+
+
+ template <matrix_order L_ORDER, matrix_style L_STYLE,
+ matrix_order R_ORDER, matrix_style R_STYLE, typename T_type>
+ Matrix<T_type, L_ORDER, Concrete>
+ operator* (const Matrix<T_type, L_ORDER, L_STYLE>& lhs,
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs);
+
+ /* forward declaration of the matrix class */
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE>
+ class Matrix;
+
+ /*! \brief A helper class for list-wise initialization.
+ *
+ * This class gets used behind the scenes to provide listwise
+ * initialization for Matrix objects. This documentation is mostly
+ * intended for developers.
+ *
+ * The Matrix class's assignment operator returns a ListInitializer
+ * object when passed a scalar. The assignment operator binds before
+ * the comma operator, so this happens first, no matter if there is
+ * one scalar, or a list of scalars on the right hand side of the
+ * assignment sign. The ListInitializer constructor keeps an iterator
+ * to the Matrix that created it and places the initial item at the
+ * head of a list. Then the ListInitializer comma operator gets
+ * called 0 or more times, appending items to the list. At this
+ * point the ListInitializer object gets destructed because the
+ * expression is done and it is just a temporary. All the action is
+ * in the destructor where the list is copied into the Matrix with
+ * R-style recycling.
+ *
+ * To handle chained assignments, such as A = B = C = 1.2 where A,
+ * B, and C are matrices, correctly, we encapsulate the Matrix
+ * population sequence that is typically called by the destructor in
+ * the private function populate, and make Matrix a friend of this
+ * class. The Matrix class contains an assignment operator for
+ * ListInitializer objects that calls this function. When a call
+ * like "A = B = C = 1.2" occurs the compiler first evaluates C =
+ * 1.2 and returns a ListInitializer object. Then, the
+ * ListInitializer assignment operator in the Matrix class (being
+ * called on B = (C = 1.2)) forces the ListInitializer object to
+ * populate C early (it would otherwise not occur until destruction
+ * at the end of th entire call) by calling the populate method and
+ * then does a simple Matrix assignment of B = C and the populated C
+ * and the chain of assignment proceeds from there in the usual
+ * fashion.
+ *
+ * Based on code in Blitz++ (http://www.oonumerics.org/blitz/) by
+ * Todd Veldhuizen. Blitz++ is distributed under the terms of the
+ * GNU GPL.
+ */
+
+ template<typename T_elem, typename T_iter,
+ matrix_order O, matrix_style S>
+ class ListInitializer {
+ // An unbound friend
+ template <class T, matrix_order OO, matrix_style SS>
+ friend class Matrix;
- typedef matrix_iterator<ttype> iterator;
- typedef const_matrix_iterator<ttype> const_iterator;
- typedef row_major_iterator<ttype> row_major_iterator;
- typedef const_row_major_iterator<ttype> const_row_major_iterator;
- typedef col_major_iterator<ttype> col_major_iterator;
- typedef const_col_major_iterator<ttype> const_col_major_iterator;
- typedef reverse_row_major_iterator<ttype>
- reverse_row_major_iterator;
- typedef const_reverse_row_major_iterator<ttype>
- const_reverse_row_major_iterator;
- typedef reverse_col_major_iterator<ttype>
- reverse_col_major_iterator;
- typedef const_reverse_col_major_iterator<ttype>
- const_reverse_col_major_iterator;
-
- /**** Constructors ****/
-
- /* Default Constructor: Creates a Matrix of size 0. This
- * Matrix cannot be used in operations but is useful when you
- * want to make arrays of matrices.
- */
- Matrix ()
- : rows_ (0),
- cols_ (0),
- size_ (0),
- alloc_ (0),
- data_ (0)
- {
- data_ = new (std::nothrow) T[alloc_];
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Failure allocating null Matrix");
- }
- }
+ public:
+ ListInitializer (T_elem val, T_iter begin, T_iter end,
+ Matrix<T_elem,O,S>* matrix)
+ : vals_ (),
+ iter_ (begin),
+ end_ (end),
+ matrix_ (matrix),
+ populated_ (false)
+ {
+ vals_.push_back(val);
+ }
- /* Parameterized Type Constructor: Create a 1x1 Matrix
- * containing one value. While this is really just a scalar,
- * it has its uses: Necessary for assignments such as Matrix A
- * = 3; or Matrix B = A[0];. Also means we only have to define
- * operators for Matrix objects.
- */
- Matrix (const T& e)
- : rows_ (1),
- cols_ (1),
- size_ (1),
- alloc_ (1),
- data_ (0)
- {
- data_ = new (std::nothrow) T[alloc_];
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Failure allocating Matrix of size 1");
- } else
- data_[0] = e;
- }
-
- /* Standard Constructor: Creates an n x m Matrix. By default
- * it fills the Matrix with zeroes but you can turn this off or
- * change the fill value
- */
- explicit
- Matrix (const int &n, const int &m, const bool &fill = true,
- const T &fill_value = 0)
- : rows_ (n),
- cols_ (m),
- size_ (n * m),
- alloc_ (1),
- data_ (0)
- {
- while (alloc_ < size_)
- alloc_ <<= 1;
- data_ = new (std::nothrow) T[alloc_];
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Failure allocating Matrix of size 1");
- }
+ ~ListInitializer ()
+ {
+ if (! populated_)
+ populate();
+ }
- if (fill) {
- for (register int i = 0; i < alloc_; ++i)
- data_[i] = fill_value;
- }
- }
-
- /* Array Constructor: Creates an n x m Matrix from an array of
- * type T. You may enter an IN_TYPE as enumerated above. If
- * NORMAL (the default), DIAG, UTRIANG, LTRIANG, the
- * a,b,c,d should not be entered. Doing so is not an error but
- * the values will be ignored. The array should simply be the
- * correct length. NORMAL requires n*m elements, DIAG n,
- * TRIDIAG 3n - 3, UTRIANG and LTRIANG require enough elements
- * to fill the upper and lower triangles of the matrix
- * respectively. If you choose UTRIANG or LTRIANG for a 1 x 1
- * matrix you should have 1 element(although this isn't
- * technically a triangular matrix), 1 x m and n x 1 vectors
- * produce equally strange but logical results. The equations
- * for required array sizes for UTRIANG and LTRIANG are,
- * respectively: (n * m) - ((m * (m - 1)) / 2) - ((max(0, m - n)
- * * (m - n - 1)) / 2 ) and (n * m) - (n * (n - 1)) / 2) -
- * ((max(0, n - m) * (n - m - 1)) / 2). (Nick you could try to
- * simplify these equations for the documentation if possible).
- * REPEAT takes a small array and repeats it throughout the
- * matrix with a defined as the length of the array s.t. 0 < a
- * <= n * m. We don't require that m * n is divisible by a but
- * one would expect this in most cases. BLOCK places a block
- * array in a matrix of 0s s.t (a, b), (c, d) deliminate the
- * corners of the block; 0 <= a <= c < n; 0 <= b <= d < m. The
- * array must be of size (c - a + 1) * (d - b + 1).
- */
- Matrix (const int &n, const int &m, const T* in,
- IN_TYPE type = NORMAL, const int &a = -1,
- const int &b = -1, const int &c = -1,
- const int &d = -1)
- : rows_ (n),
- cols_ (m),
- size_ (n * m),
- alloc_ (1),
- data_ (0)
- {
- /* This constructor is an interface weakness. There is no easy
- * way to ensure that the array is of the length required.
- * Incorrect arrays may cause a seg fault. Worse yet, if the
- * addresses reside on a page in this program's memory space,
- * corrupted data could enter the matrix. On the other hand, this
- * constructor has far higher utility than any other. We should
- * consider switching to a safe array type in the future.
+ ListInitializer &operator, (T_elem x)
+ {
+ vals_.push_back(x);
+ return *this;
+ }
+
+ private:
+ void populate ()
+ {
+ typename std::list<T_elem>::iterator vi = vals_.begin();
+
+ while (iter_ < end_) {
+ if (vi == vals_.end())
+ vi = vals_.begin();
+ *iter_ = *vi;
+ ++iter_; ++vi;
+ }
+
+ populated_ = true;
+ }
+
+ std::list<T_elem> vals_;
+ T_iter iter_;
+ T_iter end_;
+ Matrix<T_elem, O, S>* matrix_;
+ bool populated_;
+ };
+
+ /*! \brief Matrix superclass.
+ *
+ * The Matrix_base class handles Matrix functionality that doesn't
+ * need to be templatized with respect to data type. This helps
+ * reduce code bloat by reducing replication of code for member
+ * functions that don't rely on templating. Furthermore, it
+ * hides all of the implementation details of indexing. The
+ * constructors of this class are protected and end-users should
+ * always work with full-fledged Matrix objects.
+ *
+ * The public functions in this class generally provide Matrix
+ * metadata like information on dimensionality and size.
+ */
+
+ template <matrix_order ORDER = Col, matrix_style STYLE = Concrete>
+ class Matrix_base
+ {
+ protected:
+ /**** CONSTRUCTORS ****/
+
+ /* Default constructor */
+ Matrix_base ()
+ : rows_ (0),
+ cols_ (0),
+ rowstride_ (0),
+ colstride_ (0),
+ storeorder_ (ORDER)
+ {}
+
+ /* Standard constructor */
+ Matrix_base (uint rows, uint cols)
+ : rows_ (rows),
+ cols_ (cols),
+ storeorder_ (ORDER)
+ {
+ if (ORDER == Col) {
+ rowstride_ = 1;
+ colstride_ = rows;
+ } else {
+ rowstride_ = cols;
+ colstride_ = 1;
+ }
+ }
+
+ /* Copy constructors
+ *
+ * The first version handles matrices of the same order and
+ * style. The second handles matrices with different
+ * orders/styles. The same- templates are more specific,
+ * so they will always catch same- cases.
+ *
+ */
+
+ Matrix_base (const Matrix_base &m)
+ : rows_ (m.rows()),
+ cols_ (m.cols()),
+ rowstride_ (m.rowstride()),
+ colstride_ (m.colstride())
+ {
+ if (STYLE == View)
+ storeorder_ = m.storeorder();
+ else
+ storeorder_ = ORDER;
+ }
+
+ template <matrix_order O, matrix_style S>
+ Matrix_base (const Matrix_base<O, S> &m)
+ : rows_ (m.rows()),
+ cols_ (m.cols())
+ {
+ if (STYLE == View) {
+ storeorder_ = m.storeorder();
+ rowstride_ = m.rowstride();
+ colstride_ = m.colstride();
+ } else {
+ storeorder_ = ORDER;
+ if (ORDER == Col) {
+ rowstride_ = 1;
+ colstride_ = rows_;
+ } else {
+ rowstride_ = cols_;
+ colstride_ = 1;
+ }
+ }
+ }
+
+ /* Submatrix constructor */
+ template <matrix_order O, matrix_style S>
+ Matrix_base (const Matrix_base<O, S> &m,
+ uint x1, uint y1, uint x2, uint y2)
+ : rows_ (x2 - x1 + 1),
+ cols_ (y2 - y1 + 1),
+ rowstride_ (m.rowstride()),
+ colstride_ (m.colstride()),
+ storeorder_ (m.storeorder())
+ {
+ /* Submatrices always have to be views, but the whole
+ * concrete-view thing is just a policy maintained by the
+ * software. Therefore, we need to ensure this constructor
+ * only returns views. There's no neat way to do it but this
+ * is still a compile time check, even if it only reports at
+ * run-time. Of course, we should never get this far.
+ */
+ if (STYLE == Concrete) {
+ SCYTHE_THROW(scythe_style_error,
+ "Tried to construct a concrete submatrix (Matrix_base)!");
+ }
+ }
+
+
+ /**** DESTRUCTOR ****/
+
+ ~Matrix_base ()
+ {}
+
+ /**** OPERRATORS ****/
+
+ // I'm defining one just to make sure we don't get any subtle
+ // bugs from defaults being called.
+ Matrix_base& operator=(const Matrix_base& m)
+ {
+ SCYTHE_THROW(scythe_unexpected_default_error,
+ "Unexpected call to Matrix_base default assignment operator");
+ }
+
+ /**** MODIFIERS ****/
+
+ /* Make this Matrix_base an exact copy of the matrix passed in.
+ * Just like an assignment operator but can be called from a derived
+ * class w/out making the = optor public and doing something
+ * like
+ * *(dynamic_cast<Matrix_base *> (this)) = M;
+ * in the derived class.
+ *
+ * Works across styles, but should be used with care
*/
- while (alloc_ < size_)
- alloc_ <<= 1;
- data_ = new (std::nothrow) T[alloc_];
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- std::string("Failure allocating Matrix of size ") &
- (n * m));
- } else if (type == NORMAL) {
- for (register int i = 0; i < size_; ++i)
- data_[i] = in[i];
- } else if (type == REPEAT) {
- if (a <= 0 || a > n * m) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "REPEAT requires a s.t. 0 < a <= n * m ");
- } else {
- int cnt = -1;
- for (register int i = 0; i < size_; ++i) {
- if (cnt == a - 1)
- cnt = -1;
- data_[i] = in[++cnt];
- }
- }
- } else if (type == DIAG) {
- int cnt = -1;
- for (register int i = 0; i < rows_; ++i) {
- for (register int j = 0; j < cols_; ++j) {
- if (i == j)
- data_[i * cols_ + j] = in[++cnt];
- else
- data_[i * cols_ + j] = 0;
- }
- }
- } else if (type == UTRIANG) {
- int cnt = -1;
- for (register int i = 0; i < rows_; ++i) {
- for (register int j = 0; j < cols_; ++j) {
- if (i <= j)
- data_[i * cols_ + j] = in[++cnt];
- else
- data_[i * cols_ + j] = 0;
- }
- }
- } else if (type == LTRIANG) {
- int cnt = -1;
- for (register int i = 0; i < rows_; ++i) {
- for (register int j = 0; j < cols_; ++j) {
- if (i >= j)
- data_[i * cols_ + j] = in[++cnt];
- else
- data_[i * cols_ + j] = 0;
- }
- }
- } else if (type == BLOCK) {
- if (a < 0 || b < 0 || c < a || d < b || c >= n || d >= m) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- "BLOCK requires (a, b, c, d) s.t. 0 <= a <= c < n; \
- 0 <= b <= d < m");
- } else {
- int cnt = -1;
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < cols_; ++j) {
- if (i >= a && i <= c && j >= b && j <= d)
- data_[i * cols_ + j] = in[++cnt];
- else
- data_[i * cols_ + j] = 0;
- }
- }
- }
- } else { // undefined IN_TYPE
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Undefined IN_TYPE");
+ template <matrix_order O, matrix_style S>
+ inline void mimic (const Matrix_base<O, S> &m)
+ {
+ rows_ = m.rows();
+ cols_ = m.cols();
+ rowstride_ = m.rowstride();
+ colstride_ = m.colstride();
+ storeorder_ = m.storeorder();
}
- }
-
- /* Create a matrix from a file: first two elements should be
- * # row and # col. Followed by a list of elements. Limited
- * range-checking is done: if the constructor reaches eof before
- * extracting the expected number of elements, an error will be
- * thrown. Row/col <= 0 will be caught. If you
- * forget the row/col it will consider the first 2 numbers as
- * row and col. If your file is longer than expected, no error
- * will be thrown.
- */
- Matrix (const std::string &path)
- : rows_ (0),
- cols_ (0),
- size_ (0),
- alloc_(1),
- data_ (0)
- {
- std::ifstream file(path.c_str());
- if (! file) {
- throw scythe_file_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- std::string("Could not open ") & path);
- } else {
- file >> rows_ >> cols_;
- size_ = rows_ * cols_;
- if (file.eof() || rows_ <= 0 || cols_ <= 0) {
- throw scythe_file_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Bad file format");
- } else {
- while (alloc_ < size_)
- alloc_ <<= 1;
- data_ = new (std::nothrow) T[alloc_];
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- std::string("Failure allocating Matrix of size ")
- & size_);
- } else {
- for (int i = 0; i < size_; ++i) {
- if (file.eof())
- throw scythe_file_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, std::string("Reached end of file before ")
- & size_ & " values were read");
-
- file >> data_[i];
- }
- }
- }
- file.close();
+
+ /* Reset the dimensions of this Matrix_base.
+ *
+ * TODO This function is a bit of an interface weakness. It
+ * assumes a resize always means a fresh matrix (concrete or
+ * view) with no slack between dims and strides. This happens to
+ * always be the case when it is called, but it tightly couples
+ * Matrix_base and extending classes. Not a big issue (since
+ * Matrix is probably the only class that will ever extend this)
+ * but something to maybe fix down the road.
+ */
+ inline void resize (uint rows, uint cols)
+ {
+ rows_ = rows;
+ cols_ = cols;
+
+ if (ORDER == Col) {
+ rowstride_ = 1;
+ colstride_ = rows;
+ } else {
+ rowstride_ = cols;
+ colstride_ = 1;
+ }
+
+ storeorder_ = ORDER;
}
- }
-
- /* Copy Constructor: Create a copy of an existing Matrix */
- Matrix (const Matrix<T> &m, const bool &fill=true)
- : rows_ (m.rows_),
- cols_ (m.cols_),
- size_ (m.size_),
- alloc_ (m.alloc_),
- data_ (0)
- {
- data_ = new (std::nothrow) T[alloc_];
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- std::string("Failure allocating Matrix of size ") & size_);
- } else if (fill) {
- for (int i = 0; i < size_; ++i) {
- data_[i] = m.data_[i];
- }
+
+ public:
+ /**** ACCESSORS ****/
+
+ /*! \brief Returns the total number of elements in the Matrix.
+ *
+ * \see rows()
+ * \see cols()
+ * \see max_size()
+ */
+ inline uint size () const
+ {
+ return (rows() * cols());
}
- }
-
- template <class S>
- Matrix (const Matrix<S> &m)
- : rows_ (m.rows()),
- cols_ (m.cols()),
- size_ (m.size()),
- alloc_ (1),
- data_ (0)
- {
- while (alloc_ < size_)
- alloc_ <<= 1;
- data_ = new (std::nothrow) T[alloc_];
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- std::string("Failure allocating Matrix of size ") & size_);
- } else {
- S *mdata = m.getArray();
- for (int i = 0; i < size_; ++i) {
- data_[i] = (T) mdata[i];
- }
+
+ /*! \brief Returns the number of rows in the Matrix.
+ *
+ * \see size()
+ * \see cols()
+ */
+ inline uint rows() const
+ {
+ return rows_;
}
- }
-
- /**** Destructor ****/
- ~Matrix ()
- {
- delete[] data_;
- }
-
- /**** STL container modifiers ****/
- /* Swap operator (sort of a dual copy constructor) */
- void swap (Matrix<T> &M)
- {
- int trows = rows_;
- int tcols = cols_;
- int tsize = size_;
- int talloc = alloc_;
- T *tdata = data_;
-
- rows_ = M.rows_;
- cols_ = M.cols_;
- size_ = M.size_;
- alloc_ = M.alloc_;
- data_ = M.data_;
-
- M.rows_ = trows;
- M.cols_ = tcols;
- M.size_ = tsize;
- M.alloc_ = talloc;
- M.data_ = tdata;
- }
-
- inline void clear ()
- {
- resize(0, 0);
- }
- /**** Indexing Operators ****/
+ /*! \brief Returns the number of columns in the Matrix.
+ *
+ * \see size()
+ * \see rows()
+ */
+ inline uint cols () const
+ {
+ return cols_;
+ }
- /* Retrieve the ith element in row major order */
- inline T &operator[] (const int &i)
- {
-#ifndef SCYTHE_NO_RANGE
- if ( !inRange(i)) {
- throw scythe_out_of_range_error (__FILE__,__PRETTY_FUNCTION__,
- __LINE__, std::string("Index ") & i &
- " out of range");
+ /*! \brief Check matrix ordering.
+ *
+ * This method returns the matrix_order of this Matrix.
+ *
+ * \see style()
+ * \see storeorder()
+ */
+ inline matrix_order order() const
+ {
+ return ORDER;
}
-#endif
- return data_[i];
- }
- /* Retrieve the (i,j)th element */
- inline T &operator() (const int &i, const int &j)
- {
-#ifndef SCYTHE_NO_RANGE
- if (! inRange(i, j)) {
- throw scythe_out_of_range_error(__FILE__,__PRETTY_FUNCTION__,
- __LINE__, std::string("Index (") & i & "," & j &
- ") out of range");
+ /*! \brief Check matrix style.
+ *
+ * This method returns the matrix_style of this Matrix.
+ *
+ * \see order()
+ * \see storeorder()
+ */
+ inline matrix_style style() const
+ {
+ return STYLE;
}
-#endif
- return data_[i * cols_ + j];
- }
- /* Versions of the above two for const Matrix objects */
- inline T &operator[] (const int &i) const
- {
-#ifndef SCYTHE_NO_RANGE
- if (! inRange(i)) {
- throw scythe_out_of_range_error (__FILE__,__PRETTY_FUNCTION__,
- __LINE__, std::string("Index ") & i &
- " out of range");
- }
-#endif
- return data_[i];
- }
-
- inline T &operator() (const int &i, const int &j) const
- {
-#ifndef SCYTHE_NO_RANGE
- if (! inRange(i, j)) {
- throw scythe_out_of_range_error(__FILE__,__PRETTY_FUNCTION__,
- __LINE__, std::string("Index (") & i & "," & j &
- ") out of range");
+ /*! \brief Returns the storage order of the underlying
+ * DataBlock.
+ *
+ * In view matrices, the storage order of the data may not be the
+ * same as the template ORDER.
+ *
+ *
+ * \see rowstride()
+ * \see colstride()
+ * \see order()
+ * \see style()
+ */
+ inline matrix_order storeorder () const
+ {
+ return storeorder_;
}
-#endif
- return data_[i * cols_ + j];
- }
- /* SubMatrix operator: returns a new Matrix with a,b,c,d
- * defining the bounds of the block s.t 0 <= a <= c < rows_;
- * 0 <= b <= d < cols_.
- */
- Matrix<T> operator() (const int &a, const int &b, const int &c,
- const int &d) const
- {
-#ifndef SCYTHE_NO_RANGE
- if (c < a || d < b || !inRange(a,b) || !inRange(c,d)) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "() requires (a, b, c, d) s.t. 0 <= a <= c < \
- rows_; 0 <= b <= d < cols");
- return Matrix((c - a + 1), (d - b + 1));
+ /*! \brief Returns the in-memory distance between elements in
+ * successive rows of the matrix.
+ *
+ * \see colstride()
+ * \see storeorder()
+ */
+ inline uint rowstride () const
+ {
+ return rowstride_;
+ }
+
+ /*! \brief Returns the in-memory distance between elements in
+ * successive columns of the matrix.
+ *
+ * \see rowstride()
+ * \see storeorder()
+ */
+ inline uint colstride () const
+ {
+ return colstride_;
+ }
+
+ /*! \brief Returns the maximum possible matrix size.
+ *
+ * Maximum matrix size is simply the highest available unsigned
+ * int on your system.
+ *
+ * \see size()
+ */
+ inline uint max_size () const
+ {
+ return UINT_MAX;
}
-#endif
- int cnt = -1;
+ /*! \brief Returns true if this Matrix is 1x1.
+ *
+ * \see isNull()
+ */
+ inline bool isScalar () const
+ {
+ return (rows() == 1 && cols() == 1);
+ }
- Matrix<T> temp((c - a + 1), (d - b + 1), false);
- for (int i = a; i <= c; ++i)
- for (int j = b; j <= d; ++j)
- temp.data_[++cnt] = data_[i * cols_ + j];
+ /*! \brief Returns true if this Matrix is 1xm.
+ *
+ * \see isColVector()
+ * \see isVector()
+ */
+ inline bool isRowVector () const
+ {
+ return (rows() == 1);
+ }
- return temp;
- }
-
-
- /* function for extracting all rows with the _ struct
- */
- Matrix<T> operator() (const all_elements& a, const int& j) const
- {
-#ifndef SCYTHE_NO_RANGE
- if (j >= cols_ || j < 0) {
- throw scythe_out_of_range_error (__FILE__,__PRETTY_FUNCTION__,
- __LINE__, std::string("Index ") & j &
- " out of range");
+ /*! \brief Returns true if this Matrix is nx1.
+ *
+ * \see isRowVector()
+ * \see isVector()
+ */
+ inline bool isColVector () const
+ {
+ return (cols() == 1);
}
-#endif
- //XXX
- Matrix<T> temp(rows_, 1, false);
- int k = j;
- for (register int i=0; i<rows_; ++i){
- temp.data_[i] = data_[k];
- k += cols_;
+
+ /*! \brief Returns true if this Matrix is nx1 or 1xn.
+ *
+ * \see isRowVector()
+ * \see isColVector()
+ */
+ inline bool isVector () const
+ {
+ return (cols() == 1 || rows() == 1);
}
- return temp;
- }
+ /*! \brief Returns true if this Matrix is nxn.
+ *
+ * Null and scalar matrices are both considered square.
+ *
+ * \see isNull()
+ * \see isScalar()
+ */
+ inline bool isSquare () const
+ {
+ return (cols() == rows());
+ }
- /* function for extracting all columns with the _ struct
- */
- Matrix<T> operator() (const int& i, const all_elements& a) const
- {
-#ifndef SCYTHE_NO_RANGE
- if (i >= rows_ || i < 0) {
- throw scythe_out_of_range_error (__FILE__,__PRETTY_FUNCTION__,
- __LINE__, std::string("Index ") & i &
- " out of range");
+ /*! \brief Returns true if this Matrix has 0 elements.
+ *
+ * \see empty()
+ * \see isScalar()
+ */
+ inline bool isNull () const
+ {
+ return (rows() == 0);
}
-#endif
- //XXX
- Matrix<T> temp(1, cols_, false);
- int k = i * cols_ - 1;
- for (register int j=0; j<cols_; ++j){
- temp.data_[j] = data_[++k];
+
+ /*! \brief Returns true if this Matrix has 0 elements.
+ *
+ * This function is identical to isNull() but conforms to STL
+ * container class conventions.
+ *
+ * \see isNull()
+ */
+ inline bool empty () const
+ {
+ return (rows() == 0);
}
- return temp;
- }
-
- /**** Self-modifying arithmetic operators ****/
-
- /* Assignment operator */
- Matrix<T> &operator= (const Matrix<T> &m)
- {
- resize2Match(m);
- for (register int i = 0; i < size_; ++i)
- data_[i] = m.data_[i];
- return *this;
- }
-
- template <class S>
- Matrix<T> &operator= (const Matrix<S> &m)
- {
- resize(m.rows(), m.cols(), false);
- S *mdata = m.getArray();
- for (register int i = 0; i < size_; ++i)
- data_[i] = (T) mdata[i];
- return *this;
- }
-
- /* Matrix addition/assignment */
- Matrix<T> &operator+= (const Matrix<T> &m)
- {
- if (size_ == 1) {
- // Case 1: 1X1 += nXm
- T temp = data_[0];
- resize2Match(m);
- for (int i = 0; i < size_; ++i)
- data_[i] = temp + m.data_[i];
- } else if (m.size_ == 1) {
- // Case 2: nXm += 1X1
- for (int i = 0; i < size_; ++i)
- data_[i] += m.data_[0];
- } else if (rows_ == m.rows_ && cols_ == m.cols_) {
- // Case 3: nXm += nXm
- for (int i = 0; i < size_; ++i)
- data_[i] += m.data_[i];
- } else { // error
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices are not addition conformable");
+
+ /**** HELPERS ****/
+
+ /*! \brief Check if an index is in bounds.
+ *
+ * This function takes a single-argument index into a Matrix and
+ * returns true iff that index is within the bounds of the
+ * Matrix. This function is equivalent to the expression:
+ * \code
+ * i < M.size()
+ * \endcode
+ * for a given Matrix M.
+ *
+ * \param i The element index to check.
+ *
+ * \see inRange(uint, uint)
+ */
+ inline bool inRange (uint i) const
+ {
+ return (i < size());
}
- return *this;
- }
-
- /* Matrix subtraction/assignment */
- Matrix<T> &operator-= (const Matrix<T> &m)
- {
- if (size_ == 1) {
- // Case 1: 1X1 -= nXm
- T temp = data_[0];
- resize2Match(m);
- for (int i = 0; i < size_; ++i)
- data_[i] = temp - m.data_[i];
- } else if (m.size_ == 1) {
- // Case 2: nXm -= 1X1
- for (int i = 0; i < size_; ++i)
- data_[i] -= m.data_[0];
- } else if (rows_ == m.rows_ && cols_ == m.cols_) {
- // Case 3: nXm -= nXm
- for (int i = 0; i < size_; ++i)
- data_[i] -= m.data_[i];
- } else { // error
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices are not subtraction conformable");
+
+ /*! \brief Check if an index is in bounds.
+ *
+ * This function takes a two-argument index into a Matrix and
+ * returns true iff that index is within the bounds of the
+ * Matrix. This function is equivalent to the expression:
+ * \code
+ * i < M.rows() && j < M.cols()
+ * \endcode
+ * for a given Matrix M.
+ *
+ * \param i The row value of the index to check.
+ * \param j The column value of the index to check.
+ *
+ * \see inRange(uint)
+ */
+ inline bool inRange (uint i, uint j) const
+ {
+ return (i < rows() && j < cols());
}
- return *this;
- }
-
- /* Matrix multiplication/assignment */
- Matrix<T> &operator*= (const Matrix<T> &m)
- {
- if (size_ == 1) {
- // Case 1: 1X1 *= nXm
- T temp = data_[0];
- resize2Match(m);
- for (int i = 0; i < size_; ++i)
- data_[i] = temp * m.data_[i];
- } else if (m.size_ == 1) {
- // Case 2: nXm *= 1X1
- for (int i = 0; i < size_; ++i)
- data_[i] *= m.data_[0];
- } else if (cols_ == m.rows_) {
- // Case 4: nXm *= mXk
- alloc_ = 1;
- while (alloc_ < rows_ * m.cols_)
- alloc_ <<= 1;
- T* temp = new (std::nothrow) T[alloc_];
- if (temp == 0) {
- throw scythe_alloc_error(__FILE__,__PRETTY_FUNCTION__,
- __LINE__, "Failure allocating space for multiplication");
- return *this;
- }
- for (register int i = 0; i < rows_; ++i) {
- for (register int j = 0; j < m.cols_; ++j) {
- temp[i * m.cols_ + j] = (T) 0;
- for (register int k = 0; k < m.rows_; ++k) {
- temp[i * m.cols_ + j] += data_[i * cols_ + k] *
- m.data_[k * m.cols_ + j];
- }
- }
- }
- /*
- const_col_major_iterator cmi = m.beginc();
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < m.cols_; ++j) {
- temp[i * m.cols_ + j] = inner_product(&data_[i * cols_],
- &data_[i * cols_ + m.rows_], cmi + (m.rows_ * j), (T) 0);
- }
- }
- */
-
- cols_ = m.cols_;
- size_ = rows_;
- size_ *= cols_;
- delete[] data_;
- data_ = temp;
- } else { // error
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices are not multiplication conformable");
+
+ protected:
+ /* These methods take offsets into a matrix and convert them
+ * into that actual position in the referenced memory block,
+ * taking stride into account. Protection is debatable. They
+ * could be useful to outside functions in the library but most
+ * callers should rely on the public () operator in the derived
+ * class or iterators.
+ *
+ * Note that these are very fast for concrete matrices but not
+ * so great for views. Of course, the type checks are done at
+ * compile time.
+ */
+
+ /* Turn an index into a true offset into the data. */
+ inline uint index (uint i) const
+ {
+ if (STYLE == View) {
+ if (ORDER == Col) {
+ uint col = i / rows();
+ uint row = i % rows();
+ return (index(row, col));
+ } else {
+ uint row = i / cols();
+ uint col = i % cols();
+ return (index(row, col));
+ }
+ } else
+ return(i);
+ }
+
+ /* Turn an i, j into an index. */
+ inline uint index (uint row, uint col) const
+ {
+ if (STYLE == Concrete) {
+ if (ORDER == Col)
+ return (col * rows() + row);
+ else
+ return (row * cols() + col);
+ } else { // view
+ if (storeorder_ == Col)
+ return (col * colstride() + row);
+ else
+ return (row * rowstride() + col);
+ }
+ }
+
+
+ /**** INSTANCE VARIABLES ****/
+ protected:
+ uint rows_; // # of rows
+ uint cols_; // # of cols
+
+ private:
+ /* The derived class shouldn't have to worry about this
+ * implementation detail.
+ */
+ uint rowstride_; // the in-memory number of elements from the
+ uint colstride_; // beginning of one column(row) to the next
+ matrix_order storeorder_; // The in-memory storage order of this
+ // matrix. This will always be the
+ // same as ORDER for concrete
+ // matrices but views can look at
+ // matrices with storage orders that
+ // differ from their own.
+ // TODO storeorder is always known at
+ // compile time, so we could probably
+ // add a third template param to deal
+ // with this. That would speed up
+ // views a touch. Bit messy maybe.
+ };
+
+ /**** MATRIX CLASS ****/
+
+ /*! \brief An STL-compliant matrix container class.
+ *
+ * The Matrix class provides a matrix object with an interface similar
+ * to standard mathematical notation. The class provides a number
+ * of unary and binary operators for manipulating matrices.
+ * Operators provide such functionality as addition, multiplication,
+ * and access to specific elements within the Matrix. One can test
+ * two matrices for equality or use provided methods to test the
+ * size, shape, or symmetry of a given Matrix. In addition, we
+ * provide a number of facilities for saving, loading, and printing
+ * matrices. Other portions of the library provide functions for
+ * manipulating matrices. Most notably, la.h provides definitions
+ * of common linear algebra routines and ide.h defines functions
+ * that perform inversion and decomposition.
+ *
+ * This Matrix data structure sits at the core of the library. In
+ * addition to standard matrix operations, this class allows
+ * multiple matrices to view and modify the same underlying data.
+ * This ability provides an elegant way in which to access and
+ * modify submatrices such as isolated row vectors and greatly
+ * increases the overall flexibility of the class. In addition, we
+ * provide iterators (defined in matrix_random_access_iterator.h,
+ * matrix_forward_iterator.h, and matrix_bidirectional_iterator.h)
+ * that allow Matrix objects to interact seamlessly with the generic
+ * algorithms provided by the Standard Template Library (STL).
+ *
+ * The Matrix class uses template parameters to define multiple
+ * behaviors. Matrices are templated on data type, matrix_order,
+ * and matrix_style.
+ *
+ * Matrix objects can contain elements of any type. For the most
+ * part, uses will wish to fill their matrices with single or double
+ * precision floating point numbers, but matrices of integers,
+ * boolean values, complex numbers, and user-defined types are all
+ * possible and useful. Although the basic book-keeping methods in
+ * the Matrix class will support virtually any type, certain
+ * operators require that one or more mathematical operator be
+ * defined for the given type and many of the functions in the wider
+ * Scythe library expect, or even demand, matrices containing floating
+ * point numbers.
+ *
+ * There are two possible Matrix element orderings, row- or
+ * column-major. Differences in matrix ordering will be most
+ * noticeable at construction time. Constructors that build matrices
+ * from streams or other list-like structures will place elements
+ * into the matrix in its given order. In general, any method that
+ * processes a matrix in order will use the given matrix_order. For
+ * the most part, matrices of both orderings should exhibit the same
+ * performance, but when a trade-off must be made, we err on the
+ * side of column-major ordering. In one respect, this bias is very
+ * strong. If you enable LAPACK/BLAS support in with the
+ * SCYTHE_LAPACK compiler flag, the library will use these optimized
+ * fortran routines to perform a number of operations on column
+ * major matrices; we provide no LAPACK/BLAS support for row-major
+ * matrices. Operations on matrices with mismatched ordering are
+ * legal and supported, but not guaranteed to be as fast as
+ * same-order operations, especially when SCYTHE_LAPACK is enabled.
+ *
+ * There are also two possible styles of Matrix template, concrete
+ * and view. These two types of matrix provide distinct ways in
+ * which to interact with an underlying block of data.
+ *
+ * Concrete matrices behave like matrices in previous
+ * Scythe releases. They directly encapsulate a block of data and
+ * always process it in the same order as it is stored (their
+ * matrix_order always matches the underlying storage order).
+ * All copy constructions and assignments on
+ * concrete matrices make deep copies and it is not possible to use
+ * the reference() method to make a concrete Matrix a view of
+ * another Matrix. Furthermore, concrete matrices are guaranteed to
+ * have unit stride (That is, adjacent Matrix elements are stored
+ * adjacently in memory).
+ *
+ * Views, on the other hand, provide references to data blocks.
+ * More than one view can look at the same underlying block of data,
+ * possibly at different portions of the data at the same time.
+ * Furthermore, a view may look at the data block of a concrete
+ * matrix, perhaps accessing a single row vector or a small
+ * submatrix of a larger matrix. When you copy construct
+ * a view a deep copy is not made, rather the view simply provides
+ * access to the extant block of data underlying the copied object.
+ * Furthermore, when
+ * you assign to a view, you overwrite the data the view is
+ * currently pointing to, rather than generating a new data block.
+ * Together, these behaviors allow
+ * for matrices that view portions of other matrices
+ * (submatrices) and submatrix assignment. Views do not guarantee
+ * unit stride and may even logically access their elements in a
+ * different order than they are stored in memory. Copying between
+ * concretes and views is fully supported and often transparent to
+ * the user.
+ *
+ * There is a fundamental trade-off between concrete matrices and
+ * views. Concrete matrices are simpler to work with, but not
+ * as flexible as views. Because they always have unit stride,
+ * concrete matrices
+ * have fast iterators and access operators but, because they must
+ * always be copied deeply, they provide slow copies (for example,
+ * copy construction of a Matrix returned from a function wastes
+ * cycles). Views are more flexible but also somewhat more
+ * complicated to program with. Furthermore, because they cannot
+ * guarantee unit stride, their iterators and access operations are
+ * somewhat slower than those for concrete matrices. On the other
+ * hand, they provide very fast copies. The average Scythe user may
+ * find that she virtually never works with views directly (although
+ * they can be quite useful in certain situations) but they provide
+ * a variety of functionality underneath the hood of the library and
+ * underpin many common operations.
+ *
+ * \note
+ * The Matrix interface is split between two classes: this Matrix
+ * class and Matrix_base, which Matrix extends. Matrix_base
+ * includes a range of accessors that provide the programmer with
+ * information about such things as the dimensionality of Matrix
+ * objects.
+ */
+
+ template <typename T_type = double, matrix_order ORDER = Col,
+ matrix_style STYLE = Concrete>
+ class Matrix : public Matrix_base<ORDER, STYLE>,
+ public DataBlockReference<T_type>
+ {
+ public:
+ /**** TYPEDEFS ****/
+
+ /* Iterator types */
+
+ /*! \brief Random Access Iterator type.
+ *
+ * This typedef for matrix_random_access_iterator provides a
+ * convenient shorthand for the default, and most general,
+ * Matrix iterator type.
+ *
+ * \see const_iterator
+ * \see reverse_iterator
+ * \see const_reverse_iterator
+ * \see forward_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see const_bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef matrix_random_access_iterator<T_type, ORDER, ORDER, STYLE>
+ iterator;
+
+ /*! \brief Const Random Access Iterator type.
+ *
+ * This typedef for const_matrix_random_access_iterator provides
+ * a convenient shorthand for the default, and most general,
+ * Matrix const iterator type.
+ *
+ * \see iterator
+ * \see reverse_iterator
+ * \see const_reverse_iterator
+ * \see forward_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see const_bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef const_matrix_random_access_iterator<T_type, ORDER, ORDER,
+ STYLE> const_iterator;
+
+ /*! \brief Reverse Random Access Iterator type.
+ *
+ * This typedef uses std::reverse_iterator to describe a
+ * reversed matrix_random_access_iterator type. This is the
+ * reverse of iterator.
+ *
+ * \see iterator
+ * \see const_iterator
+ * \see const_reverse_iterator
+ * \see forward_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see const_bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef typename
+ std::reverse_iterator<matrix_random_access_iterator<T_type,
+ ORDER, ORDER, STYLE> > reverse_iterator;
+
+ /*! \brief Reverse Const Random Access Iterator type.
+ *
+ * This typedef uses std::reverse_iterator to describe a
+ * reversed const_matrix_random_access_iterator type. This is
+ * the reverse of const_iterator.
+ *
+ * \see iterator
+ * \see const_iterator
+ * \see reverse_iterator
+ * \see forward_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see const_bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef typename
+ std::reverse_iterator<const_matrix_random_access_iterator
+ <T_type, ORDER, ORDER, STYLE> >
+ const_reverse_iterator;
+
+ /*! \brief Forward Iterator type.
+ *
+ * This typedef for matrix_forward_iterator provides
+ * a convenient shorthand for a fast (when compared to
+ * matrix_random_access_iterator) Matrix iterator type.
+ *
+ * \see iterator
+ * \see const_iterator
+ * \see reverse_iterator
+ * \see const_reverse_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see const_bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef matrix_forward_iterator<T_type, ORDER, ORDER, STYLE>
+ forward_iterator;
+
+ /*! \brief Const Forward Iterator type.
+ *
+ * This typedef for const_matrix_forward_iterator provides a
+ * convenient shorthand for a fast (when compared to
+ * const_matrix_random_access_iterator) const Matrix iterator
+ * type.
+ *
+ * \see iterator
+ * \see const_iterator
+ * \see reverse_iterator
+ * \see const_reverse_iterator
+ * \see forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see const_bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef const_matrix_forward_iterator<T_type, ORDER, ORDER, STYLE>
+ const_forward_iterator;
+
+ /*! \brief Bidirectional Iterator type.
+ *
+ * This typedef for matrix_bidirectional_iterator provides
+ * a convenient shorthand for a compromise (with speed and
+ * flexibility between matrix_random_access_iterator and
+ * matrix_forward_iterator) Matrix iterator type.
+ *
+ * \see iterator
+ * \see const_iterator
+ * \see reverse_iterator
+ * \see const_reverse_iterator
+ * \see forward_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see const_bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef matrix_bidirectional_iterator<T_type, ORDER, ORDER, STYLE>
+ bidirectional_iterator;
+
+ /*! \brief Const Bidirectional Iterator type.
+ *
+ * This typedef for const_matrix_bidirectional_iterator provides
+ * a convenient shorthand for a compromise (with speed and
+ * flexibility between const_matrix_random_access_iterator and
+ * const_matrix_forward_iterator) const Matrix iterator type.
+ *
+ * \see iterator
+ * \see const_iterator
+ * \see reverse_iterator
+ * \see const_reverse_iterator
+ * \see forward_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef const_matrix_bidirectional_iterator<T_type, ORDER, ORDER,
+ STYLE> const_bidirectional_iterator;
+
+ /*! \brief Const Bidirectional Iterator type.
+ *
+ * This typedef uses std::reverse_iterator to describe a
+ * reversed matrix_bidirectional_iterator type. This is
+ * the reverse of bidirectional_iterator.
+ *
+ * \see iterator
+ * \see const_iterator
+ * \see reverse_iterator
+ * \see const_reverse_iterator
+ * \see forward_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see const_bidirectional_iterator
+ * \see const_reverse_bidirectional_iterator
+ */
+ typedef typename
+ std::reverse_iterator<matrix_bidirectional_iterator<T_type,
+ ORDER, ORDER, STYLE> > reverse_bidirectional_iterator;
+
+ /*! \brief Reverse Const Bidirectional Iterator type.
+ *
+ * This typedef uses std::reverse_iterator to describe a
+ * reversed const_matrix_bidirectional_iterator type. This is
+ * the reverse of const_bidirectional_iterator.
+ *
+ * \see iterator
+ * \see const_iterator
+ * \see reverse_iterator
+ * \see const_reverse_iterator
+ * \see forward_iterator
+ * \see const_forward_iterator
+ * \see reverse_forward_iterator
+ * \see const_reverse_forward_iterator
+ * \see bidirectional_iterator
+ * \see const_bidirectional_iterator
+ * \see reverse_bidirectional_iterator
+ */
+ typedef typename
+ std::reverse_iterator<const_matrix_bidirectional_iterator
+ <T_type, ORDER, ORDER, STYLE> >
+ const_reverse_bidirectional_iterator;
+
+ /*!\brief The Matrix' element type.
+ *
+ * This typedef describes the element type (T_type) of this
+ * Matrix.
+ */
+ typedef T_type ttype;
+
+ private:
+ /* Some convenience typedefs */
+ typedef DataBlockReference<T_type> DBRef;
+ typedef Matrix_base<ORDER, STYLE> Base;
+
+ public:
+ /**** CONSTRUCTORS ****/
+
+ /*! \brief Default constructor.
+ *
+ * The default constructor creates an empty/null matrix. Using
+ * null matrices in operations will typically cause errors; this
+ * constructor exists primarily for initialization within
+ * aggregate types.
+ *
+ * \see Matrix(T_type)
+ * \see Matrix(uint, uint, bool, T_type)
+ * \see Matrix(uint, uint, T_iterator)
+ * \see Matrix(const std::string&)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see Matrix(const Matrix<T_type, O, S>&, uint, uint, uint, uint)
+ *
+ * \b Example:
+ * \include example.matrix.constructor.default.cc
+ */
+ Matrix ()
+ : Base (),
+ DBRef ()
+ {
}
- return *this;
- }
-
- /* Kronecker Multiplication/assignment */
- Matrix<T> &operator%= (const Matrix<T> &m)
- {
- grow(size_ * m.size_);
- int cnt = size_ * m.size_ - 1;
- for (int i = rows_ - 1; i >= 0; --i) {
- for (int j = m.rows_ - 1; j >= 0; --j) {
- for (int k = cols_ - 1; k >= 0; --k) {
- for (int n = m.cols_ - 1; n >= 0; --n)
- data_[cnt--] = data_[i * cols_ + k] *
- m.data_[j * m.cols_ + n];
- }
- }
+
+ /*! \brief Parameterized type constructor.
+ *
+ * Creates a 1x1 matrix (scalar).
+ *
+ * \param element The scalar value of the constructed Matrix.
+ *
+ * \see Matrix()
+ * \see Matrix(uint, uint, bool, T_type)
+ * \see Matrix(uint, uint, T_iterator)
+ * \see Matrix(const std::string&)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see Matrix(const Matrix<T_type, O, S>&, uint, uint, uint, uint)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.constructor.ptype.cc
+ */
+ Matrix (T_type element)
+ : Base (1, 1),
+ DBRef (1)
+ {
+ data_[Base::index(0)] = element; // ALWAYS use index()
}
- rows_ *= m.rows_;
- cols_ *= m.cols_;
- size_ = rows_ * cols_;
- return *this;
- }
-
- /* Element-by-element division/assignment */
- Matrix<T> &operator/= (const Matrix<T> &m)
- {
- if (size_ == 1) {
- T temp = data_[0];
- resize2Match(m);
- for (int i = 0; i < size_; ++i)
- data_[i] = temp / m.data_[i];
- } else if (m.size_ == 1) {
- for (int i = 0; i < size_; ++i)
- data_[i] /= m.data_[0];
- } else if (rows_ == m.rows_ && cols_ == m.cols_) {
- for (int i = 0; i < size_; ++i)
- data_[i] /= m.data_[i];
- } else { // error
- throw scythe_conformation_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices are not division conformable");
+
+ /*! \brief Standard constructor.
+ *
+ * The standard constructor creates a rowsXcols Matrix, filled
+ * with zeros by default. Optionally, you can leave the Matrix
+ * uninitialized, or choose a different fill value.
+ *
+ * \param rows The number of rows in the Matrix.
+ * \param cols The number of columns in the Matrix.
+ * \param fill Indicates whether or not the Matrix should be
+ * initialized.
+ * \param fill_value The scalar value to fill the Matrix with
+ * when fill == true.
+ *
+ * \see Matrix()
+ * \see Matrix(T_type)
+ * \see Matrix(uint, uint, T_iterator)
+ * \see Matrix(const std::string&)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see Matrix(const Matrix<T_type, O, S>&, uint, uint, uint, uint)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.constructor.standard.cc
+ */
+ Matrix (uint rows, uint cols, bool fill = true,
+ T_type fill_value = 0)
+ : Base (rows, cols),
+ DBRef (rows * cols)
+ {
+ // TODO Might use iterator here for abstraction.
+ if (fill)
+ for (uint i = 0; i < Base::size(); ++i)
+ data_[Base::index(i)] = fill_value; // we know data contig
}
- return *this;
- }
-
- /* Matrix power/assignment: ^ positive integer does matrix
- * power, ^0 returns an identity matrix of the input's size, ^-1
- * returns inverse via LU Decomposition. Input must be
- * square for ^posint and ^-1. You should use invpd in
- * Scythe_IDE instead of ^-1 if you know your matrix is positive
- * definite.
- */
- Matrix<T> &operator^= (const int &e)
- {
- if (e > 0) {
- if (! isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- std::string("Matrix must be square to raise it to the ")
- & e & " power");
- return *this;
- }
- Matrix<T> temp = *this;
- for (int i = 1; i < e; ++i)
- *(this) *= temp;
- } else if (e == 0) {
- // Case 3: A^0 == identity matrix of this size
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < cols_; ++j) {
- if (i == j)
- data_[ijIndex(i, j)] = 1.0;
- else
- data_[ijIndex(i, j)] = 0.0;
- }
- }
- } else if (e == -1) {
- // Case 3: A^-1 == inverse of this
- if (! isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix not square");
- return *this;
- }
- if (isNull()) {
- throw scythe_null_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__);
- return *this;
- }
- Matrix<T> b(rows_, 1);
- Matrix<T> A = *(this);
- Matrix<T> L, U;
- Matrix<int> perm_vec;
-
- // step 1: compute the LU factorization
- if (A.rows_ == 1) {
- L = Matrix<T>(1);
- U = *(this);
- perm_vec = Matrix<int>(1,1);
- } else {
- int pivot;
- L = U = Matrix<T>(A.rows_, A.rows_);
- perm_vec = Matrix<int>(A.rows_ - 1, 1, false);
-
- for (int k = 0; k < A.rows_ - 1; ++k) {
- pivot = k;
- // find pivot
- for (int i = k; i < A.rows_; ++i) {
- if (::fabs(A(pivot,k)) < ::fabs(A(i, k)))
- pivot = i;
- }
- // check for singularity
- if (A(pivot, k) == (T) 0) {
- throw scythe_type_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrix is singular");
- return *this;
- }
- // permute
- if (k != pivot) {
- for (int i = 0; i < A.rows_; ++i) {
- T temp = A(pivot, i);
- A(pivot,i) = A(k,i);
- A(k,i) = temp;
- }
- }
- perm_vec[k] = pivot;
-
- for (int i = k + 1; i < A.rows_; ++i) {
- A(i,k) = A(i,k) / A(k,k);
- for (int j = k + 1; j < A.rows_; ++j)
- A(i,j) = A(i,j) - A(i,k) * A(k,j);
- }
- }
-
- L = A;
- for (int i = 0; i < A.rows_; ++i) {
- for (int j = i; j < A.rows_; ++j) {
- U(i,j) = A(i,j);
- L(i,j) = (T) 0;
- L(i,i) = (T) 1;
- }
- }
- }
- // step 2: repeated solving of A*hold = b
- for (int j = 0; j < A.rows_; ++j) {
- b[j] = 1;
- // Matrix hold = lu_solve(A, b, L, U, p);
-
- // step 2.1: solve L*y = Pb via forward substitution
- // Do a row interchange
- Matrix<T> bb = b;
- for (int ci = 0; ci < bb.rows_ - 1; ++ci) {
- int swap_row = static_cast<int>(perm_vec[ci]);
- for (int cj = 0; cj < bb.cols_; ++cj) {
- T temp = bb(ci,cj);
- bb(ci,cj) = bb(swap_row,cj);
- bb(swap_row,cj) = temp;
- }
- }
- /*
- Matrix<T> bb = b;
- for (int i = 0; i < bb.rows() - 1; ++i) {
- swap_ranges(bb.vec(i), bb.vec(i+1), bb.vec(perm_vec[i]));
- }*/
-
- Matrix<T> y(A.rows_, 1);
- for (int i = 0; i < A.rows_; ++i) {
- T sum = 0;
- for (int j = 0; j < i; ++j) {
- sum += L(i,j) * y[j];
- }
- y[i] = (bb[i] - sum) / L(i,i);
- }
-
- // step 2.2: solve U*x = y via backsubstitution
- Matrix<T> x(A.rows_,1);
- for (int i = A.rows_ - 1; i >= 0; --i) {
- T sum = 0;
- for (int j = i + 1; j < A.rows_; ++j) {
- sum += U(i,j) * x[j];
- }
- x[i] = (y[i] - sum) / U(i,i);
- }
-
- // step 3: reset b and put the solution into this
- b[j] = 0;
- for (int k = 0; k < A.rows_; ++k)
- (*this)(k,j) = x[k];
+ /*! \brief Iterator constructor.
+ *
+ * Creates a \a rows X \a cols matrix, filling it sequentially
+ * (based on this template's matrix_order) with values
+ * referenced by the input iterator \a it. Pointers are a form
+ * of input iterator, so one can use this constructor to
+ * initialize a matrix object from a c-style array. The caller
+ * is responsible for supplying an iterator that won't be
+ * exhausted too soon.
+ *
+ * \param rows The number of rows in the Matrix.
+ * \param cols The number of columns in the Matrix.
+ * \param it The input iterator to read from.
+ *
+ * \see Matrix()
+ * \see Matrix(T_type)
+ * \see Matrix(uint, uint, bool, T_type)
+ * \see Matrix(const std::string&)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see Matrix(const Matrix<T_type, O, S>&, uint, uint, uint, uint)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.constructor.iterator.cc
+ */
+ template <typename T_iterator>
+ Matrix (uint rows, uint cols, T_iterator it)
+ : Base (rows, cols),
+ DBRef (rows * cols)
+ {
+ // TODO again, should probably use iterator
+ for (uint i = 0; i < Base::size(); ++i) {
+ data_[Base::index(i)] = *it; // we know data_ is contig
+ ++it;
}
- } else { // error A^=n not defined where n < -1
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Invalid argument: -1");
}
- return *this;
- }
- /**** Accessors ****/
+ /*! \brief File constructor.
+ *
+ * Constructs a matrix from the contents of a file. The
+ * standard input file format is a simple rectangular text file
+ * with one matrix row per line and spaces delimiting values in
+ * a row. Optionally, one can also use Scythe's old file format
+ * which is a space-delimited, row-major ordered, list of values
+ * with row and column lengths in the first two slots.
+ *
+ * \param path The path of the input file.
+ * \param oldstyle Whether or not to use Scythe's old file format.
+ *
+ * \see Matrix()
+ * \see Matrix(T_type)
+ * \see Matrix(uint, uint, bool, T_type)
+ * \see Matrix(uint, uint, T_iterator)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see Matrix(const Matrix<T_type, O, S>&, uint, uint, uint, uint)
+ * \see save(const std::string&)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ * \throw scythe_file_error (Level 1)
+ * \throw scythe_bounds_error (Level 3)
+ *
+ * \b Example:
+ * \include example.matrix.constructor.file.cc
+ */
+ Matrix (const std::string& path, bool oldstyle=false)
+ : Base (),
+ DBRef ()
+ {
+ std::ifstream file(path.c_str());
+ SCYTHE_CHECK_10(! file, scythe_file_error,
+ "Could not open file " << path);
- /* Return total length of the matrix */
- inline int size() const
- {
- return size_;
- }
+ if (oldstyle) {
+ uint rows, cols;
+ file >> rows >> cols;
+ resize(rows, cols);
+ std::copy(std::istream_iterator<T_type> (file),
+ std::istream_iterator<T_type>(), begin_f<Row>());
+ } else {
+ std::string row;
- /* Return number of rows */
- inline int rows() const
- {
- return rows_;
- }
+ unsigned int cols = -1;
+ std::vector<std::vector<T_type> > vals;
+ unsigned int rows = 0;
+ while (std::getline(file, row)) {
+ std::vector<T_type> column;
+ std::istringstream rowstream(row);
+ std::copy(std::istream_iterator<T_type> (rowstream),
+ std::istream_iterator<T_type>(),
+ std::back_inserter(column));
- /* Return number of columns */
- inline int cols() const
- {
- return cols_;
- }
+ if (cols == -1)
+ cols = (unsigned int) column.size();
- inline bool empty() const
- {
- // Equivalent to isNull but is the STL-compliant syntax
- return (rows_ == 0);
- }
+ SCYTHE_CHECK_10(cols != column.size(), scythe_file_error,
+ "Row " << (rows + 1) << " of input file has "
+ << column.size() << " elements, but should have " << cols);
- // Our max size is the biggest int or the limits of your mem
- inline int max_size () const {
- return INT_MAX;
- }
+ vals.push_back(column);
+ rows++;
+ }
- /* Is this Matrix 0X0 (such a matrix is for array defs only) */
- inline bool isNull() const
- {
- // If rows_ == 0 so will cols_
- return (rows_ == 0);
- }
+ resize(rows, cols);
+ for (unsigned int i = 0; i < rows; ++i)
+ operator()(i, _) = Matrix<T_type>(1, cols, vals[i].begin());
+ }
+ }
- /* Are all the elements in this Matrix == 0 */
- inline bool isZero() const
- {
- for (int i = 0; i < size_; ++i)
- if (data_[i] != 0)
- return false;
- return true;
- }
-
- /* 1X1 Matrix? */
- inline bool isScalar() const
- {
- return (rows_ == 1 && cols_ == 1);
- }
+ /* Copy constructors. Uses template args to set up correct
+ * behavior for both concrete and view matrices. The branches
+ * are no-ops and get optimized away at compile time.
+ *
+ * We have to define this twice because we must explicitly
+ * override the default copy constructor; otherwise it is the
+ * most specific template in a lot of cases and causes ugliness.
+ */
- /* 1Xm Matrix? */
- inline bool isRowVector() const
- {
- return (rows_ == 1);
- }
+ /*! \brief Default copy constructor.
+ *
+ * Copy constructing a concrete Matrix makes an exact copy of M
+ * in a new data block. On the other hand, copy constructing a
+ * view Matrix generates a new Matrix object that references (or
+ * views) M's existing data block.
+ *
+ * \param M The Matrix to copy or make a view of.
+ *
+ * \see Matrix()
+ * \see Matrix(T_type)
+ * \see Matrix(uint, uint, bool, T_type)
+ * \see Matrix(uint, uint, T_iterator)
+ * \see Matrix(const std::string&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see Matrix(const Matrix<T_type, O, S>&, uint, uint, uint, uint)
+ * \see copy()
+ * \see copy(const Matrix<T_type, O, S> &)
+ * \see reference(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.constructor.copy.cc
+ */
- /* nX1 Matrix? */
- inline bool isColVector() const
- {
- return (cols_ == 1);
- }
-
- /* nXn Matrix? Note that Null/Scalar Matrices are Square... */
- inline bool isSquare() const
- {
- return (rows_ == cols_);
- }
-
- /* M[i,j] == 0 when i != j */
- inline bool isDiagonal() const
- {
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < cols_; ++j) {
- if (i != j && data_[ijIndex(i,j)] != 0)
- return false;
- }
- }
- return true;
- }
-
- /* M[i,j] == 0 when i != j and 1 when i == j*/
- inline bool isIdentity() const
- {
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < cols_; ++j) {
- if (i != j) {
- if (data_[ijIndex(i,j)] != 0)
- return false;
- } else if (data_[ijIndex(i,j)] != 1)
- return false;
- }
+ Matrix (const Matrix& M)
+ : Base (M), // this call deals with concrete-view conversions
+ DBRef ()
+ {
+ if (STYLE == Concrete) {
+ referenceNew(M.size());
+ scythe::copy<ORDER,ORDER>(M, *this);
+ } else // STYLE == View
+ referenceOther(M);
}
- return true;
- }
-
- /* M[i.j] == 0 when i < j */
- inline bool isLowerTriangular() const
- {
- for (int i = 0; i < rows_; ++i) {
- for (int j = i + 1; j < cols_; ++j) {
- if (data_[ijIndex(i,j)] != 0)
- return false;
- }
+
+ /*! \brief Cross order and/or style copy constructor.
+ *
+ * Copy constructing a concrete Matrix makes an exact copy of M
+ * in a new data block. On the other hand, copy constructing a
+ * view Matrix generates a new Matrix object that references (or
+ * views) M's existing data block.
+ *
+ * This version of the copy constructor extends Matrix(const
+ * Matrix &) by allowing the user to make concrete copies and
+ * views of matrices that have matrix_order or matrix_style that
+ * does not match that of the constructed Matrix. That is, this
+ * constructor makes it possible to create views of concrete
+ * matrices and concrete copies of views, row-major copies of
+ * col-major matrices, and so on.
+ *
+ * \param M The Matrix to copy or make a view of.
+ *
+ * \see Matrix()
+ * \see Matrix(T_type)
+ * \see Matrix(uint, uint, bool, T_type)
+ * \see Matrix(uint, uint, T_iterator)
+ * \see Matrix(const std::string&)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see Matrix(const Matrix<T_type, O, S>&, uint, uint, uint, uint)
+ * \see copy()
+ * \see copy(const Matrix<T_type, O, S> &)
+ * \see reference(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.constructor.crosscopy.cc
+ */
+
+ template <matrix_order O, matrix_style S>
+ Matrix (const Matrix<T_type, O, S> &M)
+ : Base (M), // this call deals with concrete-view conversions
+ DBRef ()
+ {
+ if (STYLE == Concrete) {
+ referenceNew(M.size());
+ scythe::copy<ORDER,ORDER> (M, *this);
+ } else // STYLE == View
+ referenceOther(M);
}
- return true;
- }
-
- /*M[i,j] == 0 when i > j */
- inline bool isUpperTriangular() const
- {
- for (int j = 0; j < cols_; ++j) {
- for (int i = j + 1; i < rows_; ++i) {
- if (data_[ijIndex(i,j)] != 0)
- return false;
- }
+
+ /*! \brief Cross type copy constructor
+ *
+ * The type conversion copy constructor takes a reference to an
+ * existing matrix containing elements of a different type than
+ * the constructed matrix and creates a copy. This constructor
+ * will only work if it is possible to cast elements from the
+ * copied matrix to the type of elements in the constructed
+ * matrix.
+ *
+ * This constructor always creates a deep copy of the existing
+ * matrix, even if the constructed matrix is a view. It is
+ * impossible for a matrix view with one element type to
+ * reference the data block of a matrix containing elements of a
+ * different type.
+ *
+ * \param M The Matrix to copy.
+ *
+ * \see Matrix()
+ * \see Matrix(T_type)
+ * \see Matrix(uint, uint, bool, T_type)
+ * \see Matrix(uint, uint, T_iterator)
+ * \see Matrix(const std::string&)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<T_type, O, S>&, uint, uint, uint, uint)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.constructor.convcopy.cc
+ */
+ template <typename S_type, matrix_order O, matrix_style S>
+ Matrix (const Matrix<S_type, O, S> &M)
+ : Base(M), // this call deal with concrete-view conversions
+ DBRef (M.size())
+ {
+ scythe::copy<ORDER,ORDER> (M, *this);
}
- return true;
- }
-
- /* This matrix has no inverse (iff its determinant == 0) */
- inline bool isSingular() const
- {
- if (! isSquare() || isNull())
- return false;
- if ((~(*(this))) == (T) 0)
- return true;
- return false;
- }
-
- /* This matrix is square and t(M) == M (inv(M) * t(M) == I) */
- inline bool isSymmetric() const
- {
- if (! isSquare())
- return false;
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < cols_; ++j) {
- if (data_[ijIndex(i,j)] != data_[ijIndex(j,i)])
- return false;
- }
+
+ /*! \brief Submatrix constructor
+ *
+ * The submatrix constructor takes a reference to an existing
+ * matrix and a set of indices, and generates a new Matrix
+ * object referencing the submatrix described by the indices.
+ * One can only construct a submatrix with a view template and
+ * this constructor will throw an error if one tries to use it
+ * to construct a concrete matrix.
+ *
+ * \note
+ * The submatrix-returning operators provide the same
+ * functionality as this constructor with less obtuse syntax.
+ * Users should generally employ these methods instead of this
+ * constructor.
+ *
+ * \param M The Matrix to view.
+ * \param x1 The first row coordinate, \a x1 <= \a x2.
+ * \param y1 The first column coordinate, \a y1 <= \a y2.
+ * \param x2 The second row coordinate, \a x2 > \a x1.
+ * \param y2 The second column coordinate, \a y2 > \a y1.
+ *
+ * \see Matrix()
+ * \see Matrix(T_type)
+ * \see Matrix(uint, uint, bool, T_type)
+ * \see Matrix(uint, uint, T_iterator)
+ * \see Matrix(const std::string&)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see operator()(uint, uint, uint, uint)
+ * \see operator()(uint, uint, uint, uint) const
+ * \see operator()(all_elements, uint)
+ * \see operator()(all_elements, uint) const
+ * \see operator()(uint, all_elements)
+ * \see operator()(uint, all_elements) const
+ * \see reference(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_style_error (Level 0)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix (const Matrix<T_type, O, S> &M,
+ uint x1, uint y1, uint x2, uint y2)
+ : Base(M, x1, y1, x2, y2),
+ DBRef(M, Base::index(x1, y1))
+ {
+ /* Submatrices always have to be views, but the whole
+ * concrete-view thing is just a policy maintained by the
+ * software. Therefore, we need to ensure this constructor
+ * only returns views. There's no neat way to do it but this
+ * is still a compile time check, even if it only reports at
+ * run-time.
+ */
+ if (STYLE == Concrete) {
+ SCYTHE_THROW(scythe_style_error,
+ "Tried to construct a concrete submatrix (Matrix)!");
+ }
+ }
+
+ public:
+ /**** DESTRUCTOR ****/
+
+ /*!\brief Destructor.
+ */
+ ~Matrix() {}
+
+ /**** COPY/REFERENCE METHODS ****/
+
+ /* Make this matrix a view of another's data. If this matrix's
+ * previous datablock is not viewed by any other object it is
+ * deallocated. Concrete matrices cannot be turned into views
+ * at run-time! Therefore, we generate an error here if *this
+ * is concrete.
+ */
+
+ /*!\brief View another Matrix's data.
+ *
+ * This modifier makes this matrix a view of another's data.
+ * The action detaches the Matrix from its current view; if no
+ * other Matrix views the detached DataBlock, it will be
+ * deallocated.
+ *
+ * Concrete matrices cannot convert into views at
+ * run time. Therefore, it is an error to invoke this method on
+ * a concrete Matrix.
+ *
+ * \param M The Matrix to view.
+ *
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see copy()
+ * \see copy(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_style_error (Level 0)
+ *
+ * \b Example:
+ * \include example.matrix.reference.cc
+ */
+ template <matrix_order O, matrix_style S>
+ inline void reference (const Matrix<T_type, O, S> &M)
+ {
+ if (STYLE == Concrete) {
+ SCYTHE_THROW(scythe_style_error,
+ "Concrete matrices cannot reference other matrices");
+ } else {
+ referenceOther(M);
+ mimic(M);
+ }
}
- return true;
- }
-
- /* This matrix is square and t(A) = -A */
- inline bool isSkewSymmetric() const
- {
- if (! isSquare())
- return false;
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < cols_; ++j) {
- if (data_[ijIndex(i,j)] != 0 - data_[ijIndex(j,i)])
- return false;
- }
+
+ /*!\brief Create a copy of this matrix.
+ *
+ * Creates a deep copy of this Matrix. The returned concrete
+ * matrix references a newly created DataBlock that contains
+ * values that are identical to, but distinct from, the values
+ * contained in the original Matrix.
+ *
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see copy(const Matrix<T_type, O, S> &)
+ * \see reference(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.copy.cc
+ */
+ inline Matrix<T_type, ORDER, Concrete> copy () const
+ {
+ Matrix<T_type, ORDER> res (Base::rows(), Base::cols(), false);
+ std::copy(begin_f(), end_f(), res.begin_f());
+
+ return res;
}
- return true;
- }
- /**** Utilities ****/
+ /* Make this matrix a copy of another. The matrix retains its
+ * own order and style in this case, because that can't change
+ * at run time.
+ */
+ /*!\brief Make this Matrix a copy of another.
+ *
+ * Converts this Matrix into a deep copy of another Matrix.
+ * This Matrix retains its own matrix_order and matrix_style but
+ * contains copies of M's elements and becomes the same size and
+ * shape as M. Calling this method automatically detaches this
+ * Matrix from its previous DataBlock before copying.
+ *
+ * \param M The Matrix to copy.
+ *
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see copy()
+ * \see reference(const Matrix<T_type, O, S> &)
+ * \see detach()
+ *
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.copyother.cc
+ */
+ template <matrix_order O, matrix_style S>
+ inline void copy (const Matrix<T_type, O, S>& M)
+ {
+ resize2Match(M);
+ scythe::copy<ORDER,ORDER> (M, *this);
+ }
- /* Returns a pointer to the internal array. User is responsible
- * for not messing things up. This function should only be used
- * under special circumstances.
- */
- inline T *getArray() const
- {
- return data_;
- }
+ /**** INDEXING OPERATORS ****/
+
+ /*! \brief Access or modify an element in this Matrix.
+ *
+ * This indexing operator allows the caller to access or modify
+ * the ith (indexed in this Matrix's matrix_order) element of
+ * this Matrix, indexed from 0 to n - 1, where n is the number
+ * of elements in the Matrix.
+ *
+ * \param i The index of the element to access/modify.
+ *
+ * \see operator[](uint) const
+ * \see operator()(uint)
+ * \see operator()(uint) const
+ * \see operator()(uint, uint)
+ * \see operator()(uint, uint) const
+ *
+ * \throw scythe_bounds_error (Level 3)
+ */
+ inline T_type& operator[] (uint i)
+ {
+ SCYTHE_CHECK_30 (! Base::inRange(i), scythe_bounds_error,
+ "Index " << i << " out of range");
- /* Print matrix to a formatted string (very Java). Switched prec
- * and width from 0.1 cause prec is much more useful than width.
- * Also now can print out some internals. Returns c++-style
- * string
- */
- std::string toString (const unsigned int &prec= 5,
- const unsigned int &width = 0,
- const bool &dim = false,
- const bool &internal = false) const
- {
- std::ostringstream s;
- unsigned int mlen = width;
-
- /* 2 Passes so we can get things to line up nicely */
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < cols_; ++j) {
- s.str("");
- s << std::setw(width) << std::setprecision(prec)
- << std::setiosflags(std::ios::fixed)
- << data_[ijIndex(i,j)];
- if (s.str().length() > mlen)
- mlen = s.str().length();
- }
+ return data_[Base::index(i)];
}
- s.str("");
- if (dim) {
- s << "Size: " << size_ << " (" << rows_ << " x " << cols_
- << ")" << std::endl;
+ /*! \brief Access an element in this Matrix.
+ *
+ * This indexing operator allows the caller to access
+ * the ith (indexed in this Matrix's matrix_order) element of
+ * this Matrix, indexed from 0 to n - 1, where n is the number
+ * of elements in the Matrix.
+ *
+ * \param i The index of the element to access.
+ *
+ * \see operator[](uint)
+ * \see operator()(uint)
+ * \see operator()(uint) const
+ * \see operator()(uint, uint)
+ * \see operator()(uint, uint) const
+ *
+ * \throw scythe_bounds_error (Level 3)
+ */
+ inline T_type& operator[] (uint i) const
+ {
+ SCYTHE_CHECK_30 (! Base::inRange(i), scythe_bounds_error,
+ "Index " << i << " out of range");
+
+ return data_[Base::index(i)];
}
- if (internal) {
- s << "Object: " << this << ", Data: " << data_
- << ", Allocation: " << alloc_ << std::endl;
+
+ /*! \brief Access or modify an element in this Matrix.
+ *
+ * This indexing operator allows the caller to access or modify
+ * the ith (indexed in this Matrix's matrix_order) element of
+ * this Matrix, indexed from 0 to n - 1, where n is the number
+ * of elements in the Matrix.
+ *
+ * \param i The index of the element to access/modify.
+ *
+ * \see operator[](uint)
+ * \see operator[](uint) const
+ * \see operator()(uint) const
+ * \see operator()(uint, uint)
+ * \see operator()(uint, uint) const
+ *
+ * \throw scythe_bounds_error (Level 3)
+ */
+ inline T_type& operator() (uint i)
+ {
+ SCYTHE_CHECK_30 (! Base::inRange(i), scythe_bounds_error,
+ "Index " << i << " out of range");
+
+ return data_[Base::index(i)];
}
+
+ /*! \brief Access an element in this Matrix.
+ *
+ * This indexing operator allows the caller to access
+ * the ith (indexed in this Matrix's matrix_order) element of
+ * this Matrix, indexed from 0 to n - 1, where n is the number
+ * of elements in the Matrix.
+ *
+ * \param i The index of the element to access.
+ *
+ * \see operator[](uint)
+ * \see operator[](uint) const
+ * \see operator()(uint)
+ * \see operator()(uint, uint)
+ * \see operator()(uint, uint) const
+ *
+ * \throw scythe_bounds_error (Level 3)
+ */
+ inline T_type& operator() (uint i) const
+ {
+ SCYTHE_CHECK_30 (! Base::inRange(i), scythe_bounds_error,
+ "Index " << i << " out of range");
- for (int i = 0; i < rows_; ++i) {
- for (int j = 0; j < cols_; ++j) {
- s << std::setw(mlen) << std::setprecision(prec)
- << data_[ijIndex(i,j)];
- if (i < rows_ - 1 || j < cols_ - 1)
- s << " ";
- }
- s << std::endl;
+ return data_[Base::index(i)];
}
- return s.str();
- }
-
- /* Save matrix to a file. Flags can be "a":append,
- * "o":overwrite, "n":don't replace (all if file already
- * exists). If header == true then the first elements written
- * are row and col size, and the matrix is saved as a flat
- * list. Oherwise the matrix is written as a rectangular ascii
- * file.
- * NOTE: Load is now a new type of constructor */
- void save (const std::string &path, const char &flag = 'n',
- const bool &header = 0, const int &prec = 5,
- const int &width = 0) const
- {
- std::ofstream out;
- bool err = false;
- if (flag == 'n') {
- std::fstream temp(path.c_str(), std::ios::in);
- if (!temp) {
- out.open(path.c_str(), std::ios::out);
- } else {
- temp.close();
- err = true;
- }
+
+ /*! \brief Access or modify an element in this Matrix.
+ *
+ * This indexing operator allows the caller to access or modify
+ * the (i, j)th element of
+ * this Matrix, where i is an element of 0, 1, ..., rows - 1 and
+ * j is an element of 0, 1, ..., columns - 1.
+ *
+ * \param i The row index of the element to access/modify.
+ * \param j The column index of the element to access/modify.
+ *
+ * \see operator[](uint)
+ * \see operator[](uint) const
+ * \see operator()(uint)
+ * \see operator()(uint) const
+ * \see operator()(uint, uint) const
+ *
+ * \throw scythe_bounds_error (Level 3)
+ */
+ inline T_type& operator() (uint i, uint j)
+ {
+ SCYTHE_CHECK_30 (! Base::inRange(i, j), scythe_bounds_error,
+ "Index (" << i << ", " << j << ") out of range");
+
+ return data_[Base::index(i, j)];
}
- else if (flag == 'o')
- out.open(path.c_str(), std::ios::out | std::ios::trunc);
- else if (flag == 'a')
- out.open(path.c_str(), std::ios::out | std::ios::app);
- else {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- std::string("Incorrect flag ") & flag);
- return;
+
+ /*! \brief Access an element in this Matrix.
+ *
+ * This indexing operator allows the caller to access
+ * the (i, j)th element of
+ * this Matrix, where i is an element of 0, 1, ..., rows - 1 and
+ * j is an element of 0, 1, ..., columns - 1.
+ *
+ * \param i The row index of the element to access.
+ * \param j The column index of the element to access.
+ *
+ * \see operator[](uint)
+ * \see operator[](uint) const
+ * \see operator()(uint)
+ * \see operator()(uint) const
+ * \see operator() (uint, uint)
+ *
+ * \throw scythe_bounds_error (Level 3)
+ */
+ inline T_type& operator() (uint i, uint j) const
+ {
+ SCYTHE_CHECK_30 (! Base::inRange(i, j), scythe_bounds_error,
+ "Index (" << i << ", " << j << ") out of range");
+
+ return data_[Base::index(i, j)];
}
- if (! out || err) {
- throw scythe_file_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- std::string("Could not open file ") & path);
- return;
+
+ /**** SUBMATRIX OPERATORS ****/
+
+
+ /* Submatrices are always views. An extra (but relatively
+ * cheap) copy constructor call is made when mixing and matching
+ * orders like
+ *
+ * Matrix<> A;
+ * ...
+ * Matrix<double, Row> B = A(2, 2, 4, 4);
+ *
+ * It is technically possible to get around this, by providing
+ * templates of each function of the form
+ * template <matrix_order O>
+ * Matrix<T_type, O, View> operator() (...)
+ *
+ * but the syntax to call them (crappy return type inference):
+ *
+ * Matrix<double, Row> B = A.template operator()<Row>(2, 2, 4, 4)
+ *
+ * is such complete gibberish that I don't think this is worth
+ * the slight optimization.
+ */
+
+ /*! \brief Returns a view of a submatrix.
+ *
+ * This operator returns a rectangular submatrix view of this
+ * Matrix with its upper left corner at (x1, y1) and its lower
+ * right corner at (x2, y2).
+ *
+ * \param x1 The upper row of the submatrix.
+ * \param y1 The leftmost column of the submatrix.
+ * \param x2 The lowest row of the submatrix.
+ * \param y2 The rightmost column of the submatrix.
+ *
+ * \see operator()(uint, uint, uint, uint) const
+ * \see operator()(all_elements, uint)
+ * \see operator()(all_elements, uint) const
+ * \see operator()(uint, all_elements)
+ * \see operator()(uint, all_elements) const
+ *
+ * \throw scythe_bounds_error (Level 2)
+ *
+ * \b Example:
+ * \include example.matrix.submatrix.cc
+ */
+ inline Matrix<T_type, ORDER, View>
+ operator() (uint x1, uint y1, uint x2, uint y2)
+ {
+ SCYTHE_CHECK_20 (! Base::inRange(x1, y1)
+ || ! Base::inRange(x2, y2)
+ || x1 > x2 || y1 > y2,
+ scythe_bounds_error,
+ "Submatrix (" << x1 << ", " << y1 << ") ; ("
+ << x2 << ", " << y2 << ") out of range or ill-formed");
+
+ return (Matrix<T_type, ORDER, View>(*this, x1, y1, x2, y2));
}
- if (header) {
- out << rows_ << " " << cols_;
- for (int i = 0; i < rows_ * cols_; ++i) {
- out << std::setw(width) << std::setprecision(prec) << " "
- << data_[i];
- }
- out << std::endl;
- } else {
- out << toString(prec,width);
+
+ /*! \brief Returns a view of a submatrix.
+ *
+ * This operator returns a rectangular submatrix view of this
+ * Matrix with its upper left corner at (x1, y1) and its lower
+ * right corner at (x2, y2).
+ *
+ * \param x1 The upper row of the submatrix.
+ * \param y1 The leftmost column of the submatrix.
+ * \param x2 The lowest row of the submatrix.
+ * \param y2 The rightmost column of the submatrix.
+ *
+ * \see operator()(uint, uint, uint, uint)
+ * \see operator()(all_elements, uint)
+ * \see operator()(all_elements, uint) const
+ * \see operator()(uint, all_elements)
+ * \see operator()(uint, all_elements) const
+ *
+ * \throw scythe_bounds_error (Level 2)
+ */
+ inline Matrix<T_type, ORDER, View>
+ operator() (uint x1, uint y1, uint x2, uint y2) const
+ {
+ SCYTHE_CHECK_20 (! Base::inRange(x1, y1)
+ || ! Base::inRange(x2, y2)
+ || x1 > x2 || y1 > y2,
+ scythe_bounds_error,
+ "Submatrix (" << x1 << ", " << y1 << ") ; ("
+ << x2 << ", " << y2 << ") out of range or ill-formed");
+
+ return (Matrix<T_type, ORDER, View>(*this, x1, y1, x2, y2));
}
- out << std::endl;
- out.close();
- }
-
- inline bool inRange (const int &i) const
- {
- return (i > -1 && i < size_ ? true : false);
- }
-
- inline bool inRange (const int &i, const int &j) const
- {
- int index = i * cols_ + j;
- return (index > -1 && index < size_ ? true : false);
- }
- /* Resizes the matrix by the ^2 1/2 alg. */
- inline void resize (const int &rows, const int &cols,
- const bool &fill=true)
- {
- if (rows < 0 || cols < 0)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Rows or cols < 0");
-
- resize(rows * cols, fill);
- rows_ = rows;
- cols_ = cols;
- }
-
- /**** Iterator Stuff ****/
-
- inline row_major_iterator begin()
- {
- return row_major_iterator(*this);
- }
+ /*! \brief Returns a view of a column vector.
+ *
+ * This operator returns a vector view of column j in this Matrix.
+ *
+ * \param a An all_elements object signifying whole vector access.
+ * \param j The column to view.
+ *
+ * \see operator()(uint, uint, uint, uint)
+ * \see operator()(uint, uint, uint, uint) const
+ * \see operator()(all_elements, uint) const
+ * \see operator()(uint, all_elements)
+ * \see operator()(uint, all_elements) const
+ *
+ * \throw scythe_bounds_error (Level 2)
+ *
+ * \b Example:
+ * \include example.matrix.vector.cc
+ */
+ inline Matrix<T_type, ORDER, View>
+ operator() (const all_elements a, uint j)
+ {
+ SCYTHE_CHECK_20 (j >= Base::cols(), scythe_bounds_error,
+ "Column vector index " << j << " out of range");
- inline row_major_iterator end()
- {
- row_major_iterator temp(*this);
- return (temp + (size_));
- }
-
- inline row_major_iterator vec(const int &n)
- {
- return row_major_iterator(*this).next_vec(n);
- }
-
- inline const_row_major_iterator begin() const
- {
- return const_row_major_iterator(*this);
- }
+ return (Matrix<T_type, ORDER, View>
+ (*this, 0, j, Base::rows() - 1, j));
+ }
+
+ /*! \brief Returns a view of a column vector.
+ *
+ * This operator returns a vector view of column j in this Matrix.
+ *
+ * \param a An all_elements object signifying whole vector access.
+ * \param j The column to view.
+ *
+ * \see operator()(uint, uint, uint, uint)
+ * \see operator()(uint, uint, uint, uint) const
+ * \see operator()(all_elements, uint)
+ * \see operator()(uint, all_elements)
+ * \see operator()(uint, all_elements) const
+ *
+ * \throw scythe_bounds_error (Level 2)
+ */
+ inline Matrix<T_type, ORDER, View>
+ operator() (const all_elements a, uint j) const
+ {
+ SCYTHE_CHECK_20 (j >= Base::cols(), scythe_bounds_error,
+ "Column vector index " << j << " out of range");
- inline const_row_major_iterator end() const
- {
- const_row_major_iterator temp(*this);
- return (temp + (size_));
- }
-
- inline const_row_major_iterator vec(const int &n) const
- {
- return const_row_major_iterator(*this).next_vec(n);
- }
+ return (Matrix<T_type, ORDER, View>
+ (*this, 0, j, Base::rows() - 1, j));
+ }
- inline col_major_iterator beginc()
- {
- return col_major_iterator(*this);
- }
-
- inline col_major_iterator endc()
- {
- col_major_iterator temp(*this);
- return (temp + (size_));
- }
-
- inline col_major_iterator vecc(const int &n)
- {
- return col_major_iterator(*this).next_vec(n);
- }
-
- inline const_col_major_iterator beginc() const
- {
- return const_col_major_iterator(*this);
- }
-
- inline const_col_major_iterator endc() const
- {
- const_col_major_iterator temp(*this);
- return (temp + (size_));
- }
-
- inline const_col_major_iterator vecc(const int &n) const
- {
- return const_col_major_iterator(*this).next_vec(n);
- }
+ /*! \brief Returns a view of a row vector.
+ *
+ * This operator returns a vector view of row i in this Matrix.
+ *
+ * \param i The row to view.
+ * \param b An all_elements object signifying whole vector access.
+ *
+ * \see operator()(uint, uint, uint, uint)
+ * \see operator()(uint, uint, uint, uint) const
+ * \see operator()(all_elements, uint)
+ * \see operator()(all_elements, uint) const
+ * \see operator()(uint, all_elements) const
+ *
+ * \throw scythe_bounds_error (Level 2)
+ *
+ * \b Example:
+ * \include example.matrix.vector.cc
+ */
+ inline Matrix<T_type, ORDER, View>
+ operator() (uint i, const all_elements b)
+ {
+ SCYTHE_CHECK_20 (i >= Base::rows(), scythe_bounds_error,
+ "Row vector index " << i << " out of range");
- inline reverse_row_major_iterator rbegin ()
- {
- return reverse_row_major_iterator(*this);
- }
-
- inline reverse_row_major_iterator rend()
- {
- reverse_row_major_iterator temp(*this);
- return (temp + (size_));
- }
-
- inline reverse_row_major_iterator rvec(const int &n)
- {
- return reverse_row_major_iterator(*this).next_vec(n);
- }
-
- inline const_reverse_row_major_iterator rbegin() const
- {
- return const_reverse_row_major_iterator(*this);
- }
+ return (Matrix<T_type, ORDER, View>
+ (*this, i, 0, i, Base::cols() - 1));
+ }
+
+ /*! \brief Returns a view of a row vector.
+ *
+ * This operator returns a vector view of row i in this Matrix.
+ *
+ * \param i The row to view.
+ * \param b An all_elements object signifying whole vector access.
+ *
+ * \see operator()(uint, uint, uint, uint)
+ * \see operator()(uint, uint, uint, uint) const
+ * \see operator()(all_elements, uint)
+ * \see operator()(all_elements, uint) const
+ * \see operator()(uint, all_elements)
+ *
+ * \throw scythe_bounds_error (Level 2)
+ */
+ inline Matrix<T_type, ORDER, View>
+ operator() (uint i, const all_elements b) const
+ {
+ SCYTHE_CHECK_20 (i >= Base::rows(), scythe_bounds_error,
+ "Row vector index " << i << " out of range");
+ return (Matrix<T_type, ORDER, View>
+ (*this, i, 0, i, Base::cols() - 1));
+ }
- inline const_reverse_row_major_iterator rend() const
- {
- const_reverse_row_major_iterator temp(*this);
- return (temp + (size_));
- }
-
- inline const_reverse_row_major_iterator rvec(const int &n) const
- {
- return const_reverse_row_major_iterator(*this).next_vec(n);
- }
+ /**** ASSIGNMENT OPERATORS ****/
- inline reverse_col_major_iterator rbeginc()
- {
- return reverse_col_major_iterator(*this);
- }
-
- inline reverse_col_major_iterator rendc()
- {
- reverse_col_major_iterator temp(*this);
- return (temp + (size_));
- }
-
- inline reverse_col_major_iterator rvecc(const int &n)
- {
- return reverse_col_major_iterator(*this).next_vec(n);
- }
-
- inline const_reverse_col_major_iterator rbeginc() const
- {
- return const_reverse_col_major_iterator(*this);
- }
-
- inline const_reverse_col_major_iterator rendc() const
- {
- const_reverse_col_major_iterator temp(*this);
- return (temp + (size_));
- }
-
- inline const_reverse_col_major_iterator rvecc(const int &n) const
- {
- return const_reverse_col_major_iterator(*this).next_vec(n);
- }
+ /*
+ * As with the copy constructor, we need to
+ * explicitly define the same-order-same-style assignment
+ * operator or the default operator will take over.
+ *
+ * TODO With views, it may be desirable to auto-grow (and,
+ * technically, detach) views to the null matrix. This means
+ * you can write something like:
+ *
+ * Matrix<double, Col, View> X;
+ * X = ...
+ *
+ * and not run into trouble because you didn't presize. Still,
+ * not sure this won't encourage silly mistakes...need to think
+ * about it.
+ */
- private:
- /**** Helper Functions ****/
- inline int ijIndex(const int &i, const int &j) const
- {
- return (i * cols_ + j);
- }
+ /*! \brief Assign the contents of one Matrix to another.
+ *
+ * Like copy construction, assignment works differently for
+ * concrete matrices than it does for views. When you assign to
+ * a concrete Matrix it resizes itself to match the right hand
+ * side Matrix and copies over the values. Like all resizes,
+ * this causes this Matrix to detach() from its original
+ * DataBlock. This means that any views attached to this Matrix
+ * will no longer view this Matrix's data after the assignment;
+ * they will continue to view this Matrix's previous DataBlock.
+ * When you assign to a view it first checks that
+ * the right hand side conforms to its dimensions (by default,
+ * see below), and then copies the right hand side values over
+ * into its current DataBlock, overwriting the current contents.
+ *
+ * Scythe also supports a slightly different model of view
+ * assignment. If the user compiled her program with the
+ * SCYTHE_VIEW_ASSIGNMENT_RECYCLE flag set then it is possible
+ * to copy into a view that is not of the same size as the
+ * Matrix on the right hand side of the equation. In this case,
+ * the operator copies elements from the right hand side
+ * object into this matrix until either this matrix runs out of
+ * room, or the right hand side one does. In the latter case,
+ * the operator starts over at the beginning of the right hand
+ * side object, recycling its values as many times as necessary
+ * to fill the left hand side object. The
+ * SCYTHE_VIEW_ASSIGNMENT_RECYCLE flag does not affect the
+ * behavior of the concrete matrices in any way.
+ *
+ * \param M The Matrix to copy.
+ *
+ * \see operator=(const Matrix<T_type, O, S>&)
+ * \see operator=(T_type x)
+ * \see operator=(ListInitializer<T_type, ITERATOR, O, S>)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see copy()
+ * \see copy(const Matrix<T_type, O, S> &)
+ * \see reference(const Matrix<T_type, O, S> &)
+ * \see resize(uint, uint, bool)
+ * \see detach()
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.operator.assignment.cc
+ */
+ Matrix& operator= (const Matrix& M)
+ {
+ if (STYLE == Concrete) {
+ resize2Match(M);
+ scythe::copy<ORDER,ORDER> (M, *this);
+ } else {
+#ifndef SCYTHE_VIEW_ASSIGNMENT_RECYCLE
+ SCYTHE_CHECK_10 (Base::size() != M.size(),
+ scythe_conformation_error,
+ "LHS has dimensions (" << Base::rows()
+ << ", " << Base::cols()
+ << ") while RHS has dimensions (" << M.rows() << ", "
+ << M.cols() << ")");
+
+ scythe::copy<ORDER,ORDER> (M, *this);
+#else
+ copy_recycle<ORDER,ORDER>(M, *this);
+#endif
+ }
+
+ return *this;
+ }
- inline void resize2Match (const Matrix<T> &m)
- {
- resize(m.size_, false);
- rows_ = m.rows_;
- cols_ = m.cols_;
- }
+ /*! \brief Assign the contents of one Matrix to another.
+ *
+ * Like copy construction, assignment works differently for
+ * concrete matrices than it does for views. When you assign to
+ * a concrete Matrix it resizes itself to match the right hand
+ * side Matrix and copies over the values. Like all resizes,
+ * this causes this Matrix to detach() from its original
+ * DataBlock. When you assign to a view it first checks that
+ * the right hand side conforms to its dimensions, and then
+ * copies the right hand side values over into its current
+ * DataBlock, overwriting the current contents.
+ *
+ * Scythe also supports a slightly different model of view
+ * assignment. If the user compiled her program with the
+ * SCYTHE_VIEW_ASSIGNMENT_RECYCLE flag set then it is possible
+ * to copy into a view that is not of the same size as the
+ * Matrix on the right hand side of the equation. In this case,
+ * the operator copies elements from the right hand side
+ * object into this matrix until either this matrix runs out of
+ * room, or the right hand side one does. In the latter case,
+ * the operator starts over at the beginning of the right hand
+ * side object, recycling its values as many times as necessary
+ * to fill the left hand side object. The
+ * SCYTHE_VIEW_ASSIGNMENT_RECYCLE flag does not affect the
+ * behavior of the concrete matrices in any way.
+ *
+ * This version of the assignment operator handles assignments
+ * between matrices of different matrix_order and/or
+ * matrix_style.
+ *
+ * \param M The Matrix to copy.
+ *
+ * \see operator=(const Matrix&)
+ * \see operator=(T_type x)
+ * \see operator=(ListInitializer<T_type, ITERATOR, O, S>)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see copy()
+ * \see copy(const Matrix<T_type, O, S> &)
+ * \see reference(const Matrix<T_type, O, S> &)
+ * \see resize(uint, uint, bool)
+ * \see detach()
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ *
+ * \b Example:
+ * \include example.matrix.operator.assignment.cc
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix &operator= (const Matrix<T_type, O, S> &M)
+ {
+ if (STYLE == Concrete) {
+ resize2Match(M);
+ scythe::copy<ORDER,ORDER> (M, *this);
+ } else {
+#ifndef SCYTHE_VIEW_ASSIGNMENT_RECYCLE
+ SCYTHE_CHECK_10 (Base::size() != M.size(),
+ scythe_conformation_error,
+ "LHS has dimensions (" << Base::rows()
+ << ", " << Base::cols()
+ << ") while RHS has dimensions (" << M.rows() << ", "
+ << M.cols() << ")");
- inline void resize (const int &s, const bool &fill=true)
- {
- try {
- if (s > alloc_)
- grow(s, fill);
- else if (s < .25 * alloc_)
- shrink(fill);
- } catch (scythe_alloc_error &sae) {
- throw;
- }
- size_ = s;
- }
+ scythe::copy<ORDER,ORDER> (M, *this);
+#else
+ copy_recycle<ORDER,ORDER>(M, *this);
+#endif
+ }
+
+ return *this;
+ }
+
+ /* List-wise initialization behavior is a touch complicated.
+ * List needs to be less than or equal to matrix in size and it
+ * is copied into the matrix with R-style recycling.
+ *
+ * The one issue is that, if you want true assignment of a
+ * scalar to a concrete matrix (resize the matrix to a scalar)
+ * you need to be explicit:
+ *
+ * Matrix<> A(2, 2);
+ * double x = 3;
+ * ...
+ * A = Matrix<>(x); // -> 3
+ *
+ * A = x; // -> 3 3
+ * // 3 3
+ */
- inline void grow (const int &s, const bool &fill=true)
- {
- alloc_ = alloc_ ? alloc_ : 1;
- while (alloc_ < s)
- alloc_ <<= 1;
+ /*! \brief Copy values in a comma-separated list into this Matrix.
+ *
+ * This assignment operator allows the user to copy the values in
+ * a bare, comma-separated, list into this Matrix. The list
+ * should have no more elements in it than the Matrix has
+ * elements. If the list has fewer elements than the Matrix, it
+ * will be recycled until the Matrix is full.
+ *
+ * If you wish to convert a concrete Matrix to a scalar-valued
+ * Matrix object you need to explicitly promote the scalar to a
+ * Matrix, using the parameterized type constructor
+ * (Matrix(T_type)).
+ *
+ * \param x The first element in the list.
+ *
+ * \see operator=(const Matrix&)
+ * \see operator=(const Matrix<T_type, O, S>&)
+ * \see operator=(ListInitializer<T_type, ITERATOR, O, S>)
+ * \see Matrix(const Matrix&)
+ * \see Matrix(const Matrix<T_type, O, S> &)
+ * \see Matrix(const Matrix<S_type, O, S> &)
+ * \see copy()
+ * \see copy(const Matrix<T_type, O, S> &)
+ * \see reference(const Matrix<T_type, O, S> &)
+ * \see resize(uint, uint, bool)
+ * \see detach()
+ *
+ * \b Example:
+ * \include example.matrix.operator.assignment.cc
+ */
+ ListInitializer<T_type, iterator, ORDER, STYLE>
+ operator=(T_type x)
+ {
+ return (ListInitializer<T_type, iterator, ORDER, STYLE>
+ (x, begin(),end(), this));
+ }
- T *temp = data_;
- data_ = new (std::nothrow) T[alloc_];
-
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Failed to reallocate internal array");
+ /*! \brief A special assignment operator.
+ *
+ * This assignment operator provides the necessary glue to allow
+ * chained assignments of matrices where the last assignment is
+ * achieved through list initialization. This allows users to
+ * write code like
+ * \code
+ * Matrix<> A, B, C;
+ * Matrix<> D(4, 4, false);
+ * A = B = C = (D = 1, 2, 3, 4);
+ * \endcode
+ * where the assignment in the parentheses technically returns a
+ * ListInitializer object, not a Matrix object. The details of
+ * this mechanism are not important for the average user and the
+ * distinction can safely be ignored.
+ *
+ * \note
+ * The parentheses in the code above are necessary because of
+ * the precedence of the assignment operator.
+ *
+ * \see operator=(const Matrix&)
+ * \see operator=(const Matrix<T_type, O, S>&)
+ * \see operator=(T_type x)
+ *
+ * \b Example:
+ * \include example.matrix.operator.assignment.cc
+ */
+ template <typename ITERATOR, matrix_order O, matrix_style S>
+ Matrix &operator=(ListInitializer<T_type, ITERATOR, O, S> li)
+ {
+ li.populate();
+ *this = *(li.matrix_);
+ return *this;
+ }
+
+ /**** ARITHMETIC OPERATORS ****/
+
+ private:
+ /* Reusable chunk of code for element-wise operator
+ * assignments. Updates are done in-place except for the 1x1 by
+ * nXm case, which forces a resize.
+ */
+ template <typename OP, matrix_order O, matrix_style S>
+ inline Matrix&
+ elementWiseOperatorAssignment (const Matrix<T_type, O, S>& M,
+ OP op)
+ {
+ SCYTHE_CHECK_10 (Base::size() != 1 && M.size() != 1 &&
+ (Base::rows () != M.rows() || Base::cols() != M.cols()),
+ scythe_conformation_error,
+ "Matrices with dimensions (" << Base::rows()
+ << ", " << Base::cols()
+ << ") and (" << M.rows() << ", " << M.cols()
+ << ") are not conformable");
+
+ if (Base::size() == 1) { // 1x1 += nXm
+ T_type tmp = (*this)(0);
+ resize2Match(M);
+ std::transform(M.begin_f<ORDER>(), M.end_f<ORDER>(),
+ begin_f(), std::bind1st(op, tmp));
+ } else if (M.size() == 1) { // nXm += 1x1
+ std::transform(begin_f(), end_f(), begin_f(),
+ std::bind2nd(op, M(0)));
+ } else { // nXm += nXm
+ std::transform(begin_f(), end_f(), M.begin_f<ORDER>(),
+ begin_f(), op);
+ }
+
+ return *this;
+ }
+
+ public:
+ /*! \brief Add another Matrix to this Matrix.
+ *
+ * This operator sums this Matrix with another and places the
+ * result into this Matrix. The two matrices must have the same
+ * dimensions or one of the matrices must be 1x1.
+ *
+ * \param M The Matrix to add to this one.
+ *
+ * \see operator+=(T_type)
+ * \see operator-=(const Matrix<T_type, O, S> &)
+ * \see operator%=(const Matrix<T_type, O, S> &)
+ * \see operator/=(const Matrix<T_type, O, S> &)
+ * \see operator^=(const Matrix<T_type, O, S> &)
+ * \see operator*=(const Matrix<T_type, O, S> &)
+ * \see kronecker(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ inline Matrix& operator+= (const Matrix<T_type, O, S> &M)
+ {
+ return elementWiseOperatorAssignment(M, std::plus<T_type> ());
+ }
+
+ /*! \brief Add a scalar to this Matrix.
+ *
+ * This operator sums each element of this Matrix with the
+ * scalar \a x and places the result into this Matrix.
+ *
+ * \param x The scalar to add to each element.
+ *
+ * \see operator+=(const Matrix<T_type, O, S> &)
+ * \see operator-=(T_type)
+ * \see operator%=(T_type)
+ * \see operator/=(T_type)
+ * \see operator^=(T_type)
+ * \see kronecker(T_type)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ */
+ inline Matrix& operator+= (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ std::plus<T_type> ());
+ }
+
+ /*! \brief Subtract another Matrix from this Matrix.
+ *
+ * This operator subtracts another Matrix from this one and
+ * places the result into this Matrix. The two matrices must
+ * have the same dimensions or one of the matrices must be 1x1.
+ *
+ * \param M The Matrix to subtract from this one.
+ *
+ * \see operator-=(T_type)
+ * \see operator+=(const Matrix<T_type, O, S> &)
+ * \see operator%=(const Matrix<T_type, O, S> &)
+ * \see operator/=(const Matrix<T_type, O, S> &)
+ * \see operator^=(const Matrix<T_type, O, S> &)
+ * \see operator*=(const Matrix<T_type, O, S> &)
+ * \see kronecker(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ inline Matrix& operator-= (const Matrix<T_type, O, S> &M)
+ {
+ return elementWiseOperatorAssignment(M, std::minus<T_type> ());
+ }
+
+ /*! \brief Subtract a scalar from this Matrix.
+ *
+ * This operator subtracts \a x from each element of this
+ * Matrix and places the result into this Matrix.
+ *
+ * \param x The scalar to subtract from each element.
+ *
+ * \see operator-=(const Matrix<T_type, O, S> &)
+ * \see operator+=(T_type)
+ * \see operator%=(T_type)
+ * \see operator/=(T_type)
+ * \see operator^=(T_type)
+ * \see kronecker(T_type)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ */
+ inline Matrix& operator-= (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ std::minus<T_type> ());
+ }
+
+ /*! \brief Multiply the elements of this Matrix with another's.
+ *
+ * This operator multiplies the elements of this Matrix with
+ * another's and places the result into this Matrix. The two
+ * matrices must have the same dimensions, or one of the
+ * matrices must be 1x1.
+ *
+ * This operator performs element-by-element multiplication
+ * (calculates the Hadamard product), not conventional matrix
+ * multiplication.
+ *
+ * \param M The Matrix to multiply with this one.
+ *
+ * \see operator%=(T_type)
+ * \see operator+=(const Matrix<T_type, O, S> &)
+ * \see operator-=(const Matrix<T_type, O, S> &)
+ * \see operator/=(const Matrix<T_type, O, S> &)
+ * \see operator^=(const Matrix<T_type, O, S> &)
+ * \see operator*=(const Matrix<T_type, O, S> &)
+ * \see kronecker(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ inline Matrix& operator%= (const Matrix<T_type, O, S> &M)
+ {
+ return elementWiseOperatorAssignment(M,
+ std::multiplies<T_type> ());
+ }
+
+ /*! \brief Multiply this Matrix by a scalar.
+ *
+ * This operator multiplies each element of this
+ * Matrix with \a x and places the result into this Matrix.
+ *
+ * \param x The scalar to multiply each element by.
+ *
+ * \see operator%=(const Matrix<T_type, O, S> &)
+ * \see operator+=(T_type)
+ * \see operator-=(T_type)
+ * \see operator/=(T_type)
+ * \see operator^=(T_type)
+ * \see kronecker(T_type)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ */
+ inline Matrix& operator%= (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ std::multiplies<T_type> ());
+ }
+
+ /*! \brief Divide the elements of this Matrix by another's.
+ *
+ * This operator divides the elements of this Matrix by
+ * another's and places the result into this Matrix. The two
+ * matrices must have the same dimensions, or one of the
+ * Matrices must be 1x1.
+ *
+ * \param M The Matrix to divide this one by.
+ *
+ * \see operator/=(T_type)
+ * \see operator+=(const Matrix<T_type, O, S> &)
+ * \see operator-=(const Matrix<T_type, O, S> &)
+ * \see operator%=(const Matrix<T_type, O, S> &)
+ * \see operator^=(const Matrix<T_type, O, S> &)
+ * \see operator*=(const Matrix<T_type, O, S> &)
+ * \see kronecker(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ inline Matrix& operator/= (const Matrix<T_type, O, S> &M)
+ {
+ return elementWiseOperatorAssignment(M, std::divides<T_type>());
+ }
+
+ /*! \brief Divide this Matrix by a scalar.
+ *
+ * This operator divides each element of this
+ * Matrix by \a x and places the result into this Matrix.
+ *
+ * \param x The scalar to divide each element by.
+ *
+ * \see operator/=(const Matrix<T_type, O, S> &)
+ * \see operator+=(T_type)
+ * \see operator-=(T_type)
+ * \see operator%=(T_type)
+ * \see operator^=(T_type)
+ * \see kronecker(T_type)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ */
+ inline Matrix& operator/= (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ std::divides<T_type> ());
+ }
+
+ /*! \brief Exponentiate the elements of this Matrix by another's.
+ *
+ * This operator exponentiates the elements of this Matrix by
+ * another's and places the result into this Matrix. The two
+ * matrices must have the same dimensions, or one of the
+ * Matrices must be 1x1.
+ *
+ * \param M The Matrix to exponentiate this one by.
+ *
+ * \see operator^=(T_type)
+ * \see operator+=(const Matrix<T_type, O, S> &)
+ * \see operator-=(const Matrix<T_type, O, S> &)
+ * \see operator%=(const Matrix<T_type, O, S> &)
+ * \see operator^=(const Matrix<T_type, O, S> &)
+ * \see operator*=(const Matrix<T_type, O, S> &)
+ * \see kronecker(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ inline Matrix& operator^= (const Matrix<T_type, O, S> &M)
+ {
+ return elementWiseOperatorAssignment(M,
+ exponentiate<T_type>());
+ }
+
+ /*! \brief Exponentiate this Matrix by a scalar.
+ *
+ * This operator exponentiates each element of this
+ * Matrix by \a x and places the result into this Matrix.
+ *
+ * \param x The scalar to exponentiate each element by.
+ *
+ * \see operator^=(const Matrix<T_type, O, S> &)
+ * \see operator+=(T_type)
+ * \see operator-=(T_type)
+ * \see operator%=(T_type)
+ * \see operator/=(T_type)
+ * \see kronecker(T_type)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ */
+ inline Matrix& operator^= (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ exponentiate<T_type> ());
+ }
+
+ /* Matrix mult always disengages views because it generally
+ * requires a resize. We force a disengage in the one place it
+ * isn't absolutely necessary(this->size()==1), for consistency.
+ */
+
+ /*! \brief Multiply this Matrix by another.
+ *
+ * This operator multiplies this Matrix by another and places
+ * the result into this Matrix. The two matrices must conform;
+ * this Matrix must have as many columns as the right hand side
+ * Matrix has rows.
+ *
+ * Matrix multiplication always causes a Matrix to detach() from
+ * its current view, because it generally requires a resize().
+ * Even when it is not absolutely necessary to detach() the
+ * Matrix, this function will do so to maintain consistency.
+ *
+ * Scythe will use LAPACK/BLAS routines to multiply concrete
+ * column-major matrices of double-precision floating point
+ * numbers if LAPACK/BLAS is available and you compile your
+ * program with the SCYTHE_LAPACK flag enabled.
+ *
+ * \param M The Matrix to multiply this one by.
+ *
+ * \see operator*=(T_type)
+ * \see operator+=(const Matrix<T_type, O, S> &)
+ * \see operator-=(const Matrix<T_type, O, S> &)
+ * \see operator%=(const Matrix<T_type, O, S> &)
+ * \see operator/=(const Matrix<T_type, O, S> &)
+ * \see operator^=(const Matrix<T_type, O, S> &)
+ * \see kronecker(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix& operator*= (const Matrix<T_type, O, S>& M)
+ {
+ /* Farm out the work to the plain old * operator and make this
+ * matrix a reference (the only reference) to the result. We
+ * always have to create a new matrix here, so there is no
+ * speed-up from using *=.
+ */
+
+ /* This saves a copy over
+ * *this = (*this) * M;
+ * if we're concrete
+ */
+ Matrix<T_type, ORDER> res = (*this) * M;
+ referenceOther(res);
+ mimic(res);
+
+ return *this;
+ }
+
+ /*! \brief Multiply this Matrix by a scalar.
+ *
+ * This operator multiplies each element of this
+ * Matrix with \a x and places the result into this Matrix.
+ *
+ * \note This method is identical in behavior to
+ * operator%=(T_type). It also slightly overgeneralizes matrix
+ * multiplication but makes life easy on the user by allowing
+ * the matrix multiplication operator to work for basic scaler
+ * multiplications.
+ *
+ * \param x The scalar to multiply each element by.
+ *
+ * \see operator*=(const Matrix<T_type, O, S> &)
+ * \see operator+=(T_type)
+ * \see operator-=(T_type)
+ * \see operator%=(T_type)
+ * \see operator/=(T_type)
+ * \see operator^=(T_type)
+ * \see kronecker(T_type)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ */
+ inline Matrix& operator*= (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ std::multiplies<T_type> ());
+ }
+
+ /*! \brief Kronecker multiply this Matrix by another.
+ *
+ * This method computes the Kronecker product of this Matrix and
+ * \a M, and sets the value of this Matrix to the result.
+ *
+ * Kronecker multiplication always causes a Matrix to detach()
+ * from its current view, because it generally requires a
+ * resize().
+ *
+ * \note This method would have been implemented as an operator
+ * if we had any reasonable operator choices left.
+ *
+ * \param M The Matrix to Kronecker multiply this one by.
+ *
+ * \see kronecker(T_type)
+ * \see operator+=(const Matrix<T_type, O, S> &)
+ * \see operator-=(const Matrix<T_type, O, S> &)
+ * \see operator%=(const Matrix<T_type, O, S> &)
+ * \see operator/=(const Matrix<T_type, O, S> &)
+ * \see operator^=(const Matrix<T_type, O, S> &)
+ * \see operator*=(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S> Matrix& kronecker
+ (const Matrix<T_type, O, S>& M) { uint totalrows =
+ Base::rows() * M.rows(); uint totalcols = Base::cols() *
+ M.cols();
+ // Even if we're a view, make this guy concrete.
+ Matrix<T_type,ORDER> res(totalrows, totalcols, false);
+
+ /* TODO: This the most natural way to write this in scythe
+ * (with a small optimization based on ordering) but probably
+ * not the fastest because it uses submatrix assignments.
+ * Optimizations should be considered.
+ */
+ forward_iterator it = begin_f();
+ if (ORDER == Row) {
+ for (uint row = 0; row < totalrows; row += M.rows()) {
+ for (uint col = 0; col < totalcols; col += M.cols()){
+ res(row, col, row + M.rows() - 1, col + M.cols() - 1)
+ = (*it) * M;
+ it++;
+ }
+ }
+ } else {
+ for (uint col = 0; col < totalcols; col += M.cols()) {
+ for (uint row = 0; row < totalrows; row += M.rows()){
+ res(row, col, row + M.rows() - 1, col + M.cols() - 1)
+ = (*it) * M;
+ it++;
+ }
+ }
+ }
+
+ referenceOther(res);
+ mimic(res);
+
+ return *this;
+ }
+
+ /*! \brief Kronecker multiply this Matrix by a scalar.
+ *
+ * This method Kronecker multiplies this Matrix with some scalar,
+ * \a x. This is a degenerate case of Kronecker
+ * multiplication, simply multiplying every element in the
+ * Matrix by \a x.
+ *
+ * \note This method is identical in behavior to
+ * operator%=(T_type) and operator*=(T_type).
+ *
+ * \param x The scalar to Kronecker multiply this Matrix by.
+ *
+ * \see kronecker(const Matrix<T_type, O, S> &)
+ * \see operator+=(T_type)
+ * \see operator-=(T_type)
+ * \see operator%=(T_type)
+ * \see operator/=(T_type)
+ * \see operator^=(T_type)
+ * \see operator*=(T_type)
+ *
+ */
+ inline Matrix& kronecker (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ std::multiplies<T_type> ());
+ }
+
+ /* Logical assignment operators */
+
+ /*! \brief Logically AND this Matrix with another.
+ *
+ * This operator computes the element-wise logical AND of this
+ * Matrix and another and places the result into this Matrix.
+ * That is, after the operation, an element in this Matrix will
+ * evaluate to true (or the type-specific analog of true,
+ * typically 1) iff the corresponding element previously
+ * residing in this Matrix and the corresponding element in \a M
+ * both evaluate to true. The two matrices must have the same
+ * dimensions, or one of the Matrices must be 1x1.
+ *
+ * \param M The Matrix to AND with this one.
+ *
+ * \see operator&=(T_type)
+ * \see operator|=(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ inline Matrix& operator&= (const Matrix<T_type, O, S> &M)
+ {
+ return elementWiseOperatorAssignment(M,
+ std::logical_and<T_type>());
+ }
+
+ /*! \brief Logically AND this Matrix with a scalar.
+ *
+ * This operator computes the element-wise logical AND of this
+ * Matrix and a scalar. That is, after the operation, an
+ * element in this Matrix will evaluate to true (or the
+ * type-specific analog of true, typically 1) iff the
+ * corresponding element previously residing in this Matrix and
+ * \a x both evaluate to true.
+ *
+ * \param x The scalar to AND with each element.
+ *
+ * \see operator&=(const Matrix<T_type, O, S> &)
+ * \see operator|=(T_type)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ */
+ inline Matrix& operator&= (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ std::logical_and<T_type> ());
+ }
+
+ /*! \brief Logically OR this Matrix with another.
+ *
+ * This operator computes the element-wise logical OR of this
+ * Matrix and another and places the result into this Matrix.
+ * That is, after the operation, an element in this Matrix will
+ * evaluate to true (or the type-specific analog of true,
+ * typically 1) if the corresponding element previously
+ * residing in this Matrix or the corresponding element in \a M
+ * evaluate to true. The two matrices must have the same
+ * dimensions, or one of the Matrices must be 1x1.
+ *
+ * \param M The Matrix to OR with this one.
+ *
+ * \see operator|=(T_type)
+ * \see operator&=(const Matrix<T_type, O, S> &)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ inline Matrix& operator|= (const Matrix<T_type, O, S> &M)
+ {
+ return elementWiseOperatorAssignment(M,
+ std::logical_or<T_type>());
+ }
+
+ /*! \brief Logically OR this Matrix with a scalar.
+ *
+ * This operator computes the element-wise logical OR of this
+ * Matrix and a scalar. That is, after the operation, an
+ * element in this Matrix will evaluate to true (or the
+ * type-specific analog of true, typically 1) if the
+ * corresponding element previously residing in this Matrix or
+ * \a x evaluate to true.
+ *
+ * \param x The scalar to OR with each element.
+ *
+ * \see operator|=(const Matrix<T_type, O, S> &)
+ * \see operator&=(T_type)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ */
+ inline Matrix& operator|= (T_type x)
+ {
+ return elementWiseOperatorAssignment(Matrix(x),
+ std::logical_or<T_type> ());
+ }
+
+ /**** MODIFIERS ****/
+
+ /* Resize a matrix view. resize() takes dimensions as
+ * parameters while resize2Match() takes a matrix reference and
+ * uses its dimensions.
+ */
+
+ /*! \brief Resize or reshape a Matrix.
+ *
+ * This modifier resizes this Matrix to the given dimensions.
+ * Matrix contents after a resize is undefined (junk) unless the
+ * preserve flag is set to true. In this case, the old contents
+ * of the Matrix remains at the same indices it occupied in the
+ * old Matrix. Any excess capacity is junk.
+ *
+ * Resizing a Matrix ALWAYS disengages it from its current view,
+ * even if the dimensions passed to resize are the same as the
+ * current Matrix's dimensions. Resized matrices point to new,
+ * uninitialized data blocks (technically, the Matrix might
+ * recycle its current block if it is the only Matrix viewing
+ * the block, but callers cannot rely on this). It is important
+ * to realize that concrete matrices behave just like views in
+ * this respect. Any views to a concrete Matrix will be
+ * pointing to a different underlying data block than the
+ * concrete Matrix after the concrete Matrix is resized.
+ *
+ * \param rows The number of rows in the resized Matrix.
+ * \param cols The number of columns in the resized Matrix.
+ * \param preserve Whether or not to retain the current contents
+ * of the Matrix.
+ *
+ * \see resize2Match(const Matrix<T_type, O, S>&, bool)
+ * \see detach()
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ void resize (uint rows, uint cols, bool preserve=false)
+ {
+ if (preserve) {
+ /* TODO Optimize this case. It is rather clunky. */
+ Matrix<T_type, ORDER, View> tmp(*this);
+ DBRef::referenceNew(rows * cols);
+ Base::resize(rows, cols);
+ uint min_cols = std::min(Base::cols(), tmp.cols());
+ uint min_rows = std::min(Base::rows(), tmp.rows());
+
+ // TODO use iterators here perhaps
+ if (ORDER == Col) {
+ for (uint j = 0; j < min_cols; ++j)
+ for (uint i = 0; i < min_rows; ++i)
+ (*this)(i, j) = tmp(i, j);
+ } else {
+ for (uint i = 0; i < min_rows; ++i)
+ for (uint j = 0; j < min_cols; ++j)
+ (*this)(i, j) = tmp(i, j);
+ }
+ } else {
+ DBRef::referenceNew(rows * cols);
+ Base::resize(rows, cols);
+ }
+ }
+
+ /*!\brief Resize a Matrix to match another.
+ *
+ * This modifier resizes this Matrix to match the dimensions of
+ * the argument. In all other respects, it behaves just like
+ * resize().
+ *
+ * \param M The Matrix providing the dimensions to mimic.
+ * \param preserve Whether or not to train the current contents
+ * of the Matrix.
+ *
+ * \see resize(uint, uint, bool)
+ * \see detach()
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <typename T, matrix_order O, matrix_style S>
+ inline void resize2Match(const Matrix<T, O, S> &M,
+ bool preserve=false)
+ {
+ resize(M.rows(), M.cols(), preserve);
+ }
+
+ /* Copy this matrix to a new datablock in contiguous storage */
+ /*! \brief Copy the contents of this Matrix to a new DataBlock.
+ *
+ * The detach method copies the data viewed by this Matrix to a
+ * fresh DataBlock, detaches this Matrix from its old block and
+ * attaches it to the new block. The old DataBlock will be
+ * deallocated if no other matrices view the block after this
+ * one detaches.
+ *
+ * This method can be used to ensure that this Matrix is the
+ * sole viewer of its DataBlock. It also ensures that the
+ * underlying data is stored contiguously in memory.
+ *
+ * \see copy()
+ * \see resize(uint, uint, bool)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ inline void detach ()
+ {
+ resize2Match(*this, true);
+ }
+
+ /* Swap operator: sort of a dual copy constructor. Part of the
+ * standard STL container interface. We only support swaps
+ * between matrices of like order and style because things get
+ * hairy otherwise. The behavior of this for concrete matrices
+ * is a little hairy in any case.
+ *
+ * Matrix<> A, B;
+ * ... // fill in A and B
+ * Matrix<double, Col, View> v1 = A(_, 1);
+ * A.swap(B);
+ * Matrix<double, Col, View> v2 = B(_, 1);
+ *
+ * v1 == v2; // evaluates to true
+ *
+ */
+
+ /*! \brief Swap this Matrix with another.
+ *
+ * This modifier is much like a dual copy constructor and is
+ * part of the Standard Template Library (STL)
+ * interface for container objects. It is only possible to swap
+ * two matrices of the same matrix_order and matrix_style. When
+ * two matrices are swapped, they trade their underlying
+ * DataBlock and dimensions. This behavior is perfectly natural
+ * for views, but my seem somewhat surprising for concrete
+ * matrices. When two concrete matrices are swapped, any views
+ * that referenced either matrices' DataBlock will reference the
+ * other matrices' DataBlock after the swap.
+ *
+ * \param M - The Matrix to swap with.
+ */
+ inline void swap (Matrix &M)
+ {
+ Matrix tmp = *this;
+
+ /* This are just reference() calls, but we do this explicitly
+ * here to avoid throwing errors on the concrete case. While
+ * having a concrete matrix reference another matrix is
+ * generally a bad idea, it is safe when the referenced matrix
+ * is concrete, has the same order, and gets deallocated (or
+ * redirected at another block) like here.
+ */
+
+ referenceOther(M);
+ mimic(M);
+
+ M.referenceOther(tmp);
+ M.mimic(tmp);
+ }
+
+ /**** ACCESSORS ****/
+
+ /* Accessors that don't access the data itself (that don't rely
+ * on T_type) are in Matrix_base
+ */
+
+ /* Are all the elements of this Matrix == 0 */
+
+ /*! \brief Returns true if every element in this Matrix equals 0.
+ *
+ * The return value of this method is undefined for null
+ * matrices.
+ *
+ * \see empty()
+ * \see isNull()
+ */
+ inline bool isZero () const
+ {
+ const_forward_iterator last = end_f();
+ return (last == std::find_if(begin_f(), last,
+ std::bind1st(std::not_equal_to<T_type> (), 0)));
+ }
+
+ /* M(i,j) == 0 when i != j */
+ /*! \brief Returns true if this Matrix is square and its
+ * off-diagonal elements are all 0.
+ *
+ * The return value of this method is undefined for null
+ * matrices.
+ *
+ * \see isSquare()
+ * \see isIdentity()
+ * \see isLowerTriangular()
+ * \see isUpperTriangular()
+ */
+ inline bool isDiagonal() const
+ {
+ if (! Base::isSquare())
+ return false;
+ /* Always travel in order. It would be nice to use iterators
+ * here, but we'd need to take views and their iterators are
+ * too slow at the moment.
+ * TODO redo with views and iterators if optimized.
+ */
+ if (ORDER == Row) {
+ for (uint i = 0; i < Base::rows(); ++i) {
+ for (uint j = 0; j < Base::cols(); ++j) {
+ if (i != j && (*this)(i, j) != 0)
+ return false;
+ }
+ }
+ } else { // ORDER == Col
+ for (uint j = 0; j < Base::cols(); ++j) {
+ for (uint i = 0; i < Base::rows(); ++i) {
+ if (i != j && (*this)(i, j) != 0)
+ return false;
+ }
+ }
+ }
+ return true;
+ }
+
+ /* M(I, j) == 0 when i!= j and 1 when i == j */
+ /*! \brief Returns true if this Matrix is diagonal and its
+ * diagonal elements are all 1s.
+ *
+ * The return value of this method is undefined for null
+ * matrices.
+ *
+ * \see isSquare()
+ * \see isDiagonal()
+ * \see isLowerTriangular()
+ * \see isUpperTriangular()
+ */
+ inline bool isIdentity () const
+ {
+ if (! Base::isSquare())
+ return false;
+ // TODO redo with views and iterator if optimized
+ if (ORDER == Row) {
+ for (uint i = 0; i < Base::rows(); ++i) {
+ for (uint j = 0; j < Base::cols(); ++j) {
+ if (i != j) {
+ if ((*this)(i,j) != 0)
+ return false;
+ } else if ((*this)(i,j) != 1)
+ return false;
+ }
+ }
+ } else { // ORDER == Col
+ for (uint j = 0; j < Base::rows(); ++j) {
+ for (uint i = 0; i < Base::cols(); ++i) {
+ if (i != j) {
+ if ((*this)(i,j) != 0)
+ return false;
+ } else if ((*this)(i,j) != 1)
+ return false;
+ }
+ }
+ }
+ return true;
+ }
+
+ /* M(i,j) == 0 when i < j */
+ /*! \brief Returns true if all of this Matrix's above-diagonal
+ * elements equal 0.
+ *
+ * The return value of this method is undefined for null
+ * matrices.
+ *
+ * \see isDiagonal()
+ * \see isUpperTriangular
+ */
+ inline bool isLowerTriangular () const
+ {
+ // TODO view+iterator if optimized
+ if (ORDER == Row) {
+ for (uint i = 0; i < Base::rows(); ++i)
+ for (uint j = i + 1; j < Base::cols(); ++j)
+ if ((*this)(i,j) != 0)
+ return false;
+ } else {
+ for (uint j = 0; j < Base::cols(); ++j)
+ for (uint i = 0; i < j; ++i)
+ if ((*this)(i,j) != 0)
+ return false;
+ }
+ return true;
+ }
+
+ /* M(i,j) == 0 when i > j */
+ /*! \brief Returns true if all of this Matrix's below-diagonal
+ * elements equal 0.
+ *
+ * The return value of this method is undefined for null
+ * matrices.
+ *
+ * \see isDiagonal()
+ * \see isLowerTriangular
+ */
+ inline bool isUpperTriangular () const
+ {
+ // TODO view+iterator if optimized
+ if (ORDER == Row) {
+ for (uint i = 0; i < Base::rows(); ++i)
+ for (uint j = 0; j < i; ++j)
+ if ((*this)(i,j) != 0)
+ return false;
+ } else {
+ for (uint j = 0; j < Base::cols(); ++j)
+ for (uint i = j + 1; i < Base::rows(); ++i)
+ if ((*this)(i,j) != 0)
+ return false;
+ }
+ return true;
+ }
+
+ /*! \brief Returns true if this Matrix is square and has no
+ * inverse.
+ *
+ * \see isSquare()
+ * \see operator~()
+ */
+ inline bool isSingular() const
+ {
+ if (! Base::isSquare() || Base::isNull())
+ return false;
+ if ((~(*this)) == (T_type) 0)
+ return true;
+ return false;
+ }
+
+ /* Square and t(M) = M(inv(M) * t(M) == I */
+ /*! Returns true if this Matrix is equal to its transpose.
+ *
+ * A Matrix is symmetric when \f$M^T = M\f$ or, equivalently,
+ * \f$M^{-1} M^T = I\f$. In simple terms, this means that the
+ * (i,j)th element of the Matrix is equal to the (j, i)th
+ * element for all i, j.
+ *
+ * \see isSkewSymmetric()
+ */
+ inline bool isSymmetric () const
+ {
+ if (! Base::isSquare())
+ return false;
+ // No point in order optimizing here
+ for (uint i = 1; i < Base::rows(); ++i)
+ for (uint j = 0; j < i; ++j)
+ if ((*this)(i, j) != (*this)(j, i))
+ return false;
+
+ return true;
+ }
+
+ /* The matrix is square and t(A) = -A */
+ /*! Returns true if this Matrix is equal to its negated
+ * transpose.
+ *
+ * A Matrix is skew symmetric when \f$-M^T = M\f$ or,
+ * equivalently, \f$-M^{-1} M^T = I\f$. In simple terms, this
+ * means that the (i, j)th element of the Matrix is equal to the
+ * negation of the (j, i)th element for all i, j.
+ *
+ * \see isSymmetric()
+ */
+ inline bool isSkewSymmetric () const
+ {
+ if (! Base::isSquare())
+ return false;
+ // No point in order optimizing here
+ for (uint i = 1; i < Base::rows(); ++i)
+ for (uint j = 0; j < i; ++j)
+ if ((*this)(i, j) != 0 - (*this)(j, i))
+ return false;
+
+ return true;
+ }
+
+ /*! \brief Test Matrix equality.
+ *
+ * This method returns true if all of \a M's elements are equal
+ * to those in this Matrix. To be equal, two matrices must
+ * be of the same dimension. Matrices with differing
+ * matrix_order or matrix_style may equal one another.
+ *
+ * \param M The Matrix to test equality with.
+ *
+ * \see equals(T_type x) const
+ * \see operator==(const Matrix<T_type, L_ORDER, L_STYLE>& lhs, const Matrix<T_type, R_ORDER, R_STYLE>& rhs)
+ */
+ template <matrix_order O, matrix_style S>
+ inline bool
+ equals(const Matrix<T_type, O, S>& M) const
+ {
+ if (data_ == M.data_ && STYLE == Concrete && S == Concrete)
+ return true;
+ else if (data_ == M.data_ && Base::rows() == M.rows()
+ && Base::cols() == M.cols()) {
+ return true;
+ } else if (this->isNull() && M.isNull())
+ return true;
+ else if (Base::rows() != M.rows() || Base::cols() != M.cols())
+ return false;
+
+ return std::equal(begin_f(), end_f(),
+ M.template begin_f<ORDER>());
+ }
+
+ /*! \brief Test Matrix equality.
+ *
+ * This method returns true if all of the elements in this
+ * Matrix are equal to \a x.
+ *
+ * \param x The scalar value to test equality with.
+ *
+ * \see equals(const Matrix<T_type, O, S>& M) const
+ * \see operator==(const Matrix<T_type, L_ORDER, L_STYLE>& lhs, const Matrix<T_type, R_ORDER, R_STYLE>& rhs)
+ */
+ inline bool
+ equals(T_type x) const
+ {
+ const_forward_iterator last = end_f();
+ return (last == std::find_if(begin_f(), last,
+ std::bind1st(std::not_equal_to<T_type> (), x)));
+ }
+
+
+ /**** OTHER UTILITIES ****/
+
+ /*! \brief Returns a pointer to this Matrix's internal data
+ * array.
+ *
+ * This method returns a pointer to the internal data array
+ * contained within the DataBlock that this Matrix references.
+ *
+ * \warning It is generally a bad idea to use this method. We
+ * provide it only for convenience. Please note that, when
+ * working with views, the internal data array may not even be
+ * stored in this Matrix's matrix_order. Furthermore, data
+ * encapsulated by a view will generally not be contiguous
+ * within the data array. It this is a concrete Matrix,
+ * getArray() will always return a pointer to a data array
+ * ordered like this Matrix and in contiguous storage.
+ */
+ inline T_type* getArray () const
+ {
+ return data_;
+ }
+
+ /*! \brief Saves a Matrix to disk.
+ *
+ * This method writes the contents of this Matrix to the file
+ * specified by \a path. The user can control file overwriting
+ * with \a flag. The parameter \a header controls the output
+ * style. When one sets \a header to true the Matrix is written
+ * as a space-separated list of values, with the number of rows
+ * and columns placed in the first two positions in the list.
+ * If header is set to false, the file is written as a space
+ * separated ascii block, with end-of-lines indicating ends of
+ * rows. The Matrix is always written out in row-major order.
+ *
+ * \param path The name of the file to write.
+ * \param flag Overwrite flag taking values 'a': append, 'o':
+ * overwrite, or 'n': do not replace.
+ * \param header Boolean value indicating whether to write as a
+ * flat list with dimension header or as a rectangular block.
+ *
+ * \see Matrix(const std::string& file)
+ * \see operator>>(std::istream& is, Matrix<T,O,S>& M)
+ *
+ * \throw scythe_invalid_arg (Level 0)
+ * \throw scythe_file_error (Level 0)
+ */
+ inline void
+ save (const std::string& path, const char flag = 'n',
+ const bool header = false)
+ {
+ std::ofstream out;
+ if (flag == 'n') {
+ std::fstream temp(path.c_str(), std::ios::in);
+ if (! temp)
+ out.open(path.c_str(), std::ios::out);
+ else {
+ temp.close();
+ SCYTHE_THROW(scythe_file_error, "Cannot overwrite file "
+ << path << " when flag = n");
+ }
+ } else if (flag == 'o')
+ out.open(path.c_str(), std::ios::out | std::ios::trunc);
+ else if (flag == 'a')
+ out.open(path.c_str(), std::ios::out | std::ios::app);
+ else
+ SCYTHE_THROW(scythe_invalid_arg, "Invalid flag: " << flag);
+
+ if (! out)
+ SCYTHE_THROW(scythe_file_error,
+ "Could not open file " << path);
+
+ if (header) {
+ out << Base::rows() << " " << Base::cols();
+ for (uint i = 0; i < Base::size(); ++i)
+ out << " " << (*this)[i];
+ out << std::endl;
+ } else {
+ for (uint i = 0; i < Base::rows(); ++i) {
+ for (uint j = 0; j < Base::cols(); ++j)
+ out << (*this)(i,j) << " ";
+ out << "\n";
+ }
+ }
+ out.close();
}
+
+
+ /**** ITERATOR FACTORIES ****/
+
+ /* TODO Write some cpp macro code to reduce this to something
+ * manageable.
+ */
+
+ /* Random Access Iterator Factories */
- if (fill) {
- for (int i =0; i < size_; ++i)
- data_[i] = temp[i];
+ /* Generalized versions */
+
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a random_access_iterator that
+ * points to the first element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ matrix_random_access_iterator<T_type, I_ORDER, ORDER, STYLE>
+ begin ()
+ {
+ return matrix_random_access_iterator<T_type, I_ORDER, ORDER,
+ STYLE>(*this);
}
- delete[] temp;
- }
-
- inline void shrink (const bool &fill=true)
- {
- alloc_ >>= 1;
- //data_ = (T *) realloc(data_, sizeof(T) * alloc_);
- T *temp = data_;
- data_ = new (std::nothrow) T[alloc_];
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * const_random_access_iterator that
+ * points to the first element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ const_matrix_random_access_iterator<T_type, I_ORDER, ORDER, STYLE>
+ begin() const
+ {
+ return const_matrix_random_access_iterator<T_type, I_ORDER,
+ ORDER, STYLE>
+ (*this);
+ }
+
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a
+ * matrix_random_access_iterator that
+ * points to just after the last element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ matrix_random_access_iterator<T_type, I_ORDER, ORDER, STYLE>
+ end ()
+ {
+ return (begin<I_ORDER>() + Base::size());
+ }
- if (data_ == 0) {
- throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Failed to reallocate internal array");
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an
+ * const_matrix_random_access_iterator that
+ * points to just after the last element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ const_matrix_random_access_iterator<T_type, I_ORDER, ORDER, STYLE>
+ end () const
+ {
+ return (begin<I_ORDER>() + Base::size());
}
+
+ /*! \brief Get a reverse iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a reverse
+ * matrix_random_access_iterator that
+ * points to the last element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline std::reverse_iterator<matrix_random_access_iterator<T_type,
+ I_ORDER, ORDER, STYLE> >
+ rbegin()
+ {
+ return std::reverse_iterator<matrix_random_access_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ (end<I_ORDER>());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a reverse
+ * const_matrix_random_access_iterator that points to the last
+ * element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ std::reverse_iterator<const_matrix_random_access_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ rbegin() const
+ {
+ return std::reverse_iterator<const_matrix_random_access_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ (end<I_ORDER>());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a reverse
+ * matrix_random_access_iterator
+ * that points to the just before the first element in the given
+ * Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline std::reverse_iterator<matrix_random_access_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ rend()
+ {
+ return std::reverse_iterator<matrix_random_access_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ (begin<I_ORDER>());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a reverse
+ * const_matrix_random_access_iterator that points to the just
+ * before the first element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ std::reverse_iterator<const_matrix_random_access_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ rend() const
+ {
+ return std::reverse_iterator<const_matrix_random_access_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ (begin<I_ORDER>());
+ }
+
+ /* Specific versions --- the generalized versions force you
+ * choose the ordering explicitly. These definitions set up
+ * in-order iteration as a default */
- if (fill) {
- for (int i =0; i < alloc_; ++i)
- data_[i] = temp[i];
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a Matrix::iterator that
+ * points to the first element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline iterator begin ()
+ {
+ return iterator(*this);
}
- delete[] temp;
- }
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a Matrix::const_iterator that
+ * points to the first element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline const_iterator begin() const
+ {
+ return const_iterator (*this);
+ }
+
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an Matrix::iterator that
+ * points to just after the last element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline iterator end ()
+ {
+ return (begin() + Base::size());
+ }
+
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an Matrix::const_iterator that
+ * points to just after the last element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline
+ const_iterator end () const
+ {
+ return (begin() + Base::size());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a Matrix::reverse_iterator that
+ * points to the last element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline reverse_iterator rbegin()
+ {
+ return reverse_iterator (end());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a
+ * Matrix::const_reverse_iterator that points to the last
+ * element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline const_reverse_iterator rbegin() const
+ {
+ return const_reverse_iterator (end());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a Matrix::reverse_iterator
+ * that points to the just before the first element in the given
+ * Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline reverse_iterator rend()
+ {
+ return reverse_iterator (begin());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a Matrix::const_reverse_iterator
+ * that points to the just before the first element in the given
+ * Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline const_reverse_iterator rend() const
+ {
+ return const_reverse_iterator (begin());
+ }
- /**** Instance Variables ****/
- int rows_; // # of rows
- int cols_; // # of cols
- int size_; // rows_ * cols_
- int alloc_; // Total allocated size
- T *data_; // The actual elements of the Matrix
+ /* Forward Iterator Factories */
- }; /* class Matrix */
+ /* Generalized versions */
+
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a matrix_forward_iterator that
+ * points to the first element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ matrix_forward_iterator<T_type, I_ORDER, ORDER, STYLE>
+ begin_f ()
+ {
+ return matrix_forward_iterator<T_type, I_ORDER, ORDER,
+ STYLE>(*this);
+ }
- /***** (In)Equality operators ****/
-
- /* Matrix (in)equality (size and each element equal; <, > <=, >=
- * deal purely with size)
- */
-
- template <class T>
- bool operator== (const Matrix<T> &A, const Matrix<T> &B)
- {
- if (&A == &B)
- return true;
- if (A.rows() != B.rows() || A.cols() != B.cols())
- return false;
- for (int i = 0; i < A.size(); ++i) {
- if (A[i] != B[i])
- return false;
- }
- return true;
- }
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * const_matrix_forward_iterator that
+ * points to the first element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ const_matrix_forward_iterator <T_type, I_ORDER, ORDER, STYLE>
+ begin_f () const
+ {
+ return const_matrix_forward_iterator <T_type, I_ORDER,
+ ORDER, STYLE>
+ (*this);
+ }
- template<class T>
- bool operator== (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A == Matrix<T>(b));
- }
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an matrix_forward_iterator that
+ * points to just after the last element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ matrix_forward_iterator<T_type, I_ORDER, ORDER, STYLE>
+ end_f ()
+ {
+ return (begin_f<I_ORDER>().set_end());
+ }
+
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an
+ * const_matrix_forward_iterator that points to just after the
+ * last element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ const_matrix_forward_iterator<T_type, I_ORDER, ORDER, STYLE>
+ end_f () const
+ {
+ return (begin_f<I_ORDER>().set_end());
+ }
- template <class T>
- bool operator== (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) == B);
- }
+ /* Default Versions */
+
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a Matrix::forward_iterator that
+ * points to the first element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline forward_iterator begin_f ()
+ {
+ return forward_iterator(*this);
+ }
+
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * Matrix::const_forward_iterator that points to the first
+ * element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline const_forward_iterator begin_f () const
+ {
+ return const_forward_iterator (*this);
+ }
- template <class T>
- bool operator!= (const Matrix<T> &A, const Matrix<T> &B)
- {
- return !(A == B);
- }
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an Matrix::forward_iterator that
+ * points to just after the last element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline forward_iterator end_f ()
+ {
+ return (begin_f().set_end());
+ }
+
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an
+ * Matrix::const_forward_iterator that points to just after the
+ * last element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline
+ const_forward_iterator end_f () const
+ {
+ return (begin_f().set_end());
+ }
- template<class T>
- bool operator!= (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return !(A == Matrix<T>(b));
- }
+ /* Bidirectional Iterator Factories */
- template <class T>
- bool operator!= (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return !(Matrix<T>(a) == B);
- }
+ /* Generalized versions */
+
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * matrix_bidirectional_iterator that
+ * points to the first element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ matrix_bidirectional_iterator<T_type, I_ORDER, ORDER, STYLE>
+ begin_bd ()
+ {
+ return matrix_bidirectional_iterator<T_type, I_ORDER, ORDER,
+ STYLE>(*this);
+ }
- template <class T>
- bool operator< (const Matrix<T> &A, const Matrix<T> &B)
- {
- if (A.size() < B.size())
- return true;
- return false;
- }
-
- template<class T>
- bool operator< (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A < Matrix<T>(b));
- }
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * const_matrix_bidirectional_iterator that points to the first
+ * element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ const_matrix_bidirectional_iterator<T_type, I_ORDER, ORDER, STYLE>
+ begin_bd () const
+ {
+ return const_matrix_bidirectional_iterator<T_type, I_ORDER,
+ ORDER, STYLE>
+ (*this);
+ }
- template <class T>
- bool operator< (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) < B);
- }
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an
+ * matrix_bidirectional_iterator that points to just after the
+ * last element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ matrix_bidirectional_iterator<T_type, I_ORDER, ORDER, STYLE>
+ end_bd ()
+ {
+ return (begin_bd<I_ORDER>().set_end());
+ }
- template <class T>
- bool operator> (const Matrix<T> &A, const Matrix<T> &B)
- {
- if (A.size() > B.size())
- return true;
- return false;
- }
-
- template<class T>
- bool operator> (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A > Matrix<T>(b));
- }
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an
+ * const_matrix_bidirectional_iterator that points to just after
+ * the last element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ const_matrix_bidirectional_iterator<T_type, I_ORDER, ORDER, STYLE>
+ end_bd () const
+ {
+ return (begin_bd<I_ORDER>.set_end());
+ }
- template <class T>
- bool operator> (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) > B);
- }
+ /*! \brief Get a reverse iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a reverse
+ * matrix_bidirectional_iterator that points to the last element
+ * in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline std::reverse_iterator<matrix_bidirectional_iterator<T_type,
+ I_ORDER, ORDER, STYLE> >
+ rbegin_bd ()
+ {
+ return std::reverse_iterator<matrix_bidirectional_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ (end_bd<I_ORDER>());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a reverse
+ * const_matrix_bidirectional_iterator that points to the last
+ * element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ std::reverse_iterator<const_matrix_bidirectional_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ rbegin_bd () const
+ {
+ return std::reverse_iterator<const_matrix_bidirectional_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ (end_bd<I_ORDER>());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a reverse
+ * matrix_bidirectional_iterator that points to the just before
+ * the first element in the given
+ * Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline std::reverse_iterator<matrix_bidirectional_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ rend_bd ()
+ {
+ return std::reverse_iterator<matrix_bidirectional_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ (begin_bd<I_ORDER>());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a reverse
+ * const_matrix_bidirectional_iterator that points to the just
+ * before the first element in the given Matrix.
+ *
+ * This is a general template of this function. It allows the
+ * user to generate iterators that iterate over the given Matrix
+ * in any order through an explicit template instantiation.
+ */
+ template <matrix_order I_ORDER>
+ inline
+ std::reverse_iterator<const_matrix_bidirectional_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ rend_bd () const
+ {
+ return std::reverse_iterator<const_matrix_bidirectional_iterator
+ <T_type, I_ORDER, ORDER, STYLE> >
+ (begin_bd<I_ORDER>());
+ }
+
+ /* Specific versions --- the generalized versions force you
+ * choose the ordering explicitly. These definitions set up
+ * in-order iteration as a default */
- template <class T>
- bool operator<= (const Matrix<T> &A, const Matrix<T> &B)
- {
- return (A.size() == B.size() || A < B );
- }
-
- template<class T>
- bool operator<= (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A <= Matrix<T>(b));
- }
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * Matrix::bidirectional_iterator that points to the first
+ * element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline bidirectional_iterator begin_bd ()
+ {
+ return bidirectional_iterator(*this);
+ }
+
+ /*! \brief Get an iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * Matrix::const_bidirectional_iterator that points to the first
+ * element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline const_bidirectional_iterator begin_bd() const
+ {
+ return const_bidirectional_iterator (*this);
+ }
- template <class T>
- bool operator<= (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) <= B);
- }
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an
+ * Matrix::bidirectional_iterator that points to just after the
+ * last element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline bidirectional_iterator end_bd ()
+ {
+ return (begin_bd().set_end());
+ }
- template <class T>
- bool operator>= (const Matrix<T> &A, const Matrix<T> &B)
- {
- return (A.size() == B.size() || A > B );
- }
-
- template<class T>
- bool operator>= (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A >= Matrix<T>(b));
- }
+ /*! \brief Get an iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns an Matrix::const_bidirectional
+ * iterator that points to just after the last element in the
+ * given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline
+ const_bidirectional_iterator end_bd () const
+ {
+ return (begin_bd().set_end());
+ }
- template <class T>
- bool operator>= (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) >= B);
- }
-
- /* Element-by-element (in)equality operators: return Matrices
- * filled with 0s and 1s. Ex: If we have A |= B, the matrix
- * returned is always of the same dimensions as A and A conforms
- * with B in 4 cases: B.isScalar() A.rows() == B.rows() &&
- * A.cols() == B.cols() A.rows() == B.rows() && B.cols() == 1
- * A.cols() == B.cols() && B.rows() == 1
- *
- * We define all three ((Matrix, Matrix), (Matrix, T), (T,
- * Matrix)) although, in most cases, the (T, Matrix) option
- * will throw an error. It would be nice to rule this
- * option out entirely and catch the problem at compile-time
- * but such comparisons are valid when the Matrix
- * passed in is 1x1
- */
+ /*! \brief Get a reverse iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a
+ * Matrix::reverse_bidirectional_iterator that points to the
+ * last element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline reverse_bidirectional_iterator rbegin_bd()
+ {
+ return reverse_bidirectional_iterator (end_bd());
+ }
- template <class T>
- Matrix<bool> operator|= (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<bool> C(A.rows(), A.cols(), false);
- if (A.isNull() || B.isNull()) {
- throw scythe_null_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Invalid use of NULL Matrix");
- } else if (B.isScalar()) {
- // Case 1: Compare every element in A to B[0]
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) == B[0]);
- }
- } else if (A.rows() == B.rows() && A.cols() == B.cols()) {
- // Case 2: equal size matrices
- for (int i = 0; i < A.size(); ++i)
- C[i] = (A[i] == B[i]);
- } else if (A.rows() == B.rows() && B.cols() == 1) {
- // Case 3: Matrix == col vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) == B[i]);
- }
- } else if (A.cols() == B.cols() && B.rows() == 1) {
- // Case 4: Matrix == row vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) == B[j]);
- }
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices not conformable");
- }
- return C;
- }
+ /*! \brief Get a reverse iterator pointing to the end of a Matrix.
+ *
+ * This is a factory that returns a
+ * Matrix::const_reverse_bidirectional_iterator that points to
+ * the last element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline const_reverse_bidirectional_iterator rbegin_bd () const
+ {
+ return const_reverse_bidirectional_iterator (end_bd());
+ }
- template <class T>
- Matrix<bool> operator|= (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A |= Matrix<T>(b));
- }
-
- template <class T>
- Matrix<bool> operator|= (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) |= B);
- }
-
- template <class T>
- Matrix<bool> operator| (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<bool> C(A.rows(), A.cols(), false);
- if (A.isNull() || B.isNull()) {
- throw scythe_null_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Invalid use of NULL Matrix");
- } else if (B.isScalar()) {
- // Case 1: Compare every element in A to B[0]
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) != B[0]);
- }
- } else if (A.rows() == B.rows() && A.cols() == B.cols()) {
- // Case 2: equal size matrices
- for (int i = 0; i < A.size(); ++i)
- C[i] = (A[i] != B[i]);
- } else if (A.rows() == B.rows() && B.cols() == 1) {
- // Case 3: Matrix == col vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) != B[i]);
- }
- } else if (A.cols() == B.cols() && B.rows() == 1) {
- // Case 4: Matrix == row vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) != B[j]);
- }
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices not conformable");
- }
- return C;
- }
-
- template <class T>
- Matrix<bool> operator| (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A | Matrix<T>(b));
- }
-
- template <class T>
- Matrix<bool> operator| (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) | B);
- }
-
- template <class T>
- Matrix<bool> operator<< (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<bool> C(A.rows(), A.cols(), false);
- if (A.isNull() || B.isNull()) {
- throw scythe_null_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Invalid use of NULL Matrix");
- } else if (B.isScalar()) {
- // Case 1: Compare every element in A to B[0]
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) < B[0]);
- }
- } else if (A.rows() == B.rows() && A.cols() == B.cols()) {
- // Case 2: equal size matrices
- for (int i = 0; i < A.size(); ++i)
- C[i] = (A[i] < B[i]);
- } else if (A.rows() == B.rows() && B.cols() == 1) {
- // Case 3: Matrix == col vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) < B[i]);
- }
- } else if (A.cols() == B.cols() && B.rows() == 1) {
- // Case 4: Matrix == row vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) < B[j]);
- }
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices not conformable");
- }
- return C;
- }
-
- template <class T>
- Matrix<bool> operator<< (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A << Matrix<T>(b));
- }
-
- template <class T>
- Matrix<bool> operator<<(const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) << B);
- }
-
- template <class T>
- Matrix<bool> operator>> (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<bool> C(A.rows(), A.cols(), false);
- if (A.isNull() || B.isNull()) {
- throw scythe_null_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Invalid use of NULL Matrix");
- } else if (B.isScalar()) {
- // Case 1: Compare every element in A to B[0]
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) > B[0]);
- }
- } else if (A.rows() == B.rows() && A.cols() == B.cols()) {
- // Case 2: equal size matrices
- for (int i = 0; i < A.size(); ++i)
- C[i] = (A[i] > B[i]);
- } else if (A.rows() == B.rows() && B.cols() == 1) {
- // Case 3: Matrix == col vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) > B[i]);
- }
- } else if (A.cols() == B.cols() && B.rows() == 1) {
- // Case 4: Matrix == row vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) > B[j]);
- }
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices not conformable");
- }
- return C;
+ /*! \brief Get a reverse iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * Matrix::reverse_bidirectional_iterator that points to the
+ * just before the first element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline reverse_bidirectional_iterator rend_bd ()
+ {
+ return reverse_bidirectional_iterator (begin_bd());
+ }
+
+ /*! \brief Get a reverse iterator pointing to the start of a Matrix.
+ *
+ * This is a factory that returns a
+ * Matrix::const_reverse_bidirectional_iterator that points to
+ * the just before the first element in the given Matrix.
+ *
+ * This is the default template of this function. It allows the
+ * user to generate iterators of a given Matrix without
+ * explicitly stating the order of iteration. The iterator
+ * returned by this function always iterates in the same order
+ * as the given Matrix' matrix_order.
+ */
+ inline const_reverse_iterator rend_bd () const
+ {
+ return const_reverse_bidirectiona_iterator (begin_bd());
+ }
+
+ protected:
+ /**** INSTANCE VARIABLES ****/
+
+ /* I know the point of C++ is to force you to write 20 times
+ * more code than should be necessary but "using" inherited ivs
+ * is just stupid.
+ */
+ using DBRef::data_; // refer to inherited data pointer directly
+ using Base::rows_; // " # of rows directly
+ using Base::cols_; // " # of cols directly
+
+ }; // end class Matrix
+
+ /**** EXTERNAL OPERATORS ****/
+
+ /* External operators include a range of binary matrix operations
+ * such as tests for equality, and arithmetic. Style
+ * (concrete/view) of the returned matrix is that of the left hand
+ * side parameter by default
+ *
+ * There is also a question of the ordering of the returned matrix.
+ * We adopt the convention of returning a matrix ordered like that
+ * of the left hand side argument, by default.
+ *
+ * Whenever there is only one matrix argument (lhs is scalar) we use
+ * its order and style as the default.
+ *
+ * A general template version of each operator also exists and users
+ * can coerce the return type to whatever they prefer using some
+ * ugly syntax; ex:
+ *
+ * Matrix<> A; ... Matrix<double, Row> B = operator*<Row,Concrete>
+ * (A, A);
+ *
+ * In general, the matrix class copy constructor will quietly
+ * convert whatever matrix template is returned to the type of the
+ * matrix it is being copied into on return, but one might want to
+ * specify the type for objects that only exist for a second (ex:
+ * (operator*<Row,Concrete>(A, A)).begin()). Also, note that the
+ * fact that we return concrete matrices by default does not
+ * preclude the user from taking advantage of fast view copies. It
+ * is the template type of the object being copy-constructed that
+ * matters---in terms of underlying implementation all matrices are
+ * views, concrete matrices just maintain a particular policy.
+ *
+ * TODO Consider the best type for scalar args to these functions.
+ * For the most part, these will be primitives---doubles mostly.
+ * Passing these by reference is probably less efficient than
+ * passing by value. But, for user-defined types pass-by-reference
+ * might be the way to go and the cost in this case will be much
+ * higher than the value-reference trade-off for primitives. Right
+ * now we use pass-by-reference but we might reconsider...
+ */
+
+ /**** ARITHMETIC OPERATORS ****/
+
+ /* These macros provide templates for the basic definitions required
+ * for all of the binary operators. Each operator requires 6
+ * definitions. First, a general matrix definition must be
+ * provided. This definition can return a matrix of a different
+ * style and order than its arguments but can only be called if its
+ * template type is explicitly specified. The actual logic of the
+ * operator should be specified within this function. The macros
+ * provide definitions for the other 5 required templates, one
+ * default matrix by matrix, general matrix by scalar, default
+ * matrix by scalar, general scalar by matrix, default scalar by
+ * matrix. The default versions call the more general versions with
+ * such that they will return concrete matrices with order equal to
+ * the left-hand (or only) matrix passed to the default version.
+ *
+ */
+
+#define SCYTHE_BINARY_OPERATOR_DMM(OP) \
+ template <matrix_order ORDER, matrix_style L_STYLE, \
+ matrix_order R_ORDER, matrix_style R_STYLE, \
+ typename T_type> \
+ inline Matrix<T_type, ORDER, Concrete> \
+ OP (const Matrix<T_type, ORDER, L_STYLE>& lhs, \
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs) \
+ { \
+ return OP <T_type, ORDER, Concrete>(lhs, rhs); \
}
-
- template <class T>
- Matrix<bool> operator>>(const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A >> Matrix<T>(b));
+
+#define SCYTHE_BINARY_OPERATOR_GMS(OP) \
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE, \
+ matrix_order L_ORDER, matrix_style L_STYLE> \
+ inline Matrix<T_type, ORDER, STYLE> \
+ OP (const Matrix<T_type, L_ORDER, L_STYLE>& lhs, \
+ const typename Matrix<T_type>::ttype &rhs) \
+ { \
+ return (OP <T_type, ORDER, STYLE> \
+ (lhs, Matrix<T_type, L_ORDER>(rhs))); \
}
-
- template <class T>
- Matrix<bool> operator>>(const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) >> B);
+
+#define SCYTHE_BINARY_OPERATOR_DMS(OP) \
+ template <matrix_order ORDER, matrix_style L_STYLE, \
+ typename T_type> \
+ inline Matrix<T_type, ORDER, Concrete> \
+ OP (const Matrix<T_type, ORDER, L_STYLE>& lhs, \
+ const typename Matrix<T_type>::ttype &rhs) \
+ { \
+ return (OP <T_type, ORDER, Concrete> (lhs, rhs)); \
}
- template <class T>
- Matrix<bool> operator<<= (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<bool> C(A.rows(), A.cols(), false);
- if (A.isNull() || B.isNull()) {
- throw scythe_null_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Invalid use of NULL Matrix");
- } else if (B.isScalar()) {
- // Case 1: Compare every element in A to B[0]
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) <= B[0]);
- }
- } else if (A.rows() == B.rows() && A.cols() == B.cols()) {
- // Case 2: equal size matrices
- for (int i = 0; i < A.size(); ++i)
- C[i] = (A[i] <= B[i]);
- } else if (A.rows() == B.rows() && B.cols() == 1) {
- // Case 3: Matrix == col vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) <= B[i]);
- }
- } else if (A.cols() == B.cols() && B.rows() == 1) {
- // Case 4: Matrix == row vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) <= B[j]);
- }
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices not conformable");
- }
- return C;
+#define SCYTHE_BINARY_OPERATOR_GSM(OP) \
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE, \
+ matrix_order R_ORDER, matrix_style R_STYLE> \
+ inline Matrix<T_type, ORDER, STYLE> \
+ OP (const typename Matrix<T_type>::ttype &lhs, \
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs) \
+ { \
+ return (OP <T_type, ORDER, STYLE> \
+ (Matrix<T_type, R_ORDER>(lhs), rhs)); \
}
-
- template <class T>
- Matrix<bool> operator<<= (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return (A <<= Matrix<T>(b));
+
+#define SCYTHE_BINARY_OPERATOR_DSM(OP) \
+ template <matrix_order ORDER, matrix_style R_STYLE, \
+ typename T_type> \
+ inline Matrix<T_type, ORDER, Concrete> \
+ OP (const typename Matrix<T_type>::ttype &lhs, \
+ const Matrix<T_type, ORDER, R_STYLE>& rhs) \
+ { \
+ return (OP <T_type, ORDER, Concrete> (lhs, rhs)); \
}
+
+#define SCYTHE_BINARY_OPERATOR_DEFS(OP) \
+ SCYTHE_BINARY_OPERATOR_DMM(OP) \
+ SCYTHE_BINARY_OPERATOR_GMS(OP) \
+ SCYTHE_BINARY_OPERATOR_DMS(OP) \
+ SCYTHE_BINARY_OPERATOR_GSM(OP) \
+ SCYTHE_BINARY_OPERATOR_DSM(OP)
+
+ /* Matrix multiplication */
- template <class T>
- Matrix<bool> operator<<= (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) <<= B);
- }
-
- template <class T>
- Matrix<bool> operator>>= (const Matrix<T> &A, const Matrix<T> &B)
+ /* General template version. Must be called with operator*<> syntax
+ */
+
+ /* We provide two symmetric algorithms for matrix multiplication,
+ * one for col-major and the other for row-major matrices. They are
+ * designed to minimize cache misses.The decision is based on the
+ * return type of the template so, when using matrices of multiple
+ * orders, this can get ugly. These optimizations only really start
+ * paying dividends as matrices get big, because cache misses are
+ * rare with smaller matrices.
+ */
+
+ /*! \brief Multiply two matrices.
+ *
+ * This operator multiplies the matrices \a lhs and \a rhs together,
+ * returning the result in a new Matrix object. This operator is
+ * overloaded to provide both Matrix by Matrix multiplication and
+ * Matrix by scalar multiplication. In the latter case, the scalar
+ * on the left- or right-hand side of the operator is promoted to a
+ * 1x1 Matrix and then multiplied with the Matrix on the other side
+ * of the operator. In either case, the matrices must conform; that
+ * is, the number of columns in the left-hand side argument must
+ * equal the number of rows in the right-hand side argument. The
+ * one exception is when one matrix is a scalar. In this case we
+ * allow Matrix by scalar multiplication with the "*" operator that
+ * is comparable to element-by-element multiplication of a Matrix by
+ * a scalar value, for convenience.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * Scythe will use LAPACK/BLAS routines to multiply concrete
+ * column-major matrices of double-precision floating point
+ * numbers if LAPACK/BLAS is available and you compile your
+ * program with the SCYTHE_LAPACK flag enabled.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \see operator*(const Matrix<T_type, L_ORDER, L_STYLE>& lhs, const Matrix<T_type, R_ORDER, R_STYLE>& rhs)
+ * \see operator*(const Matrix<T_type, ORDER, L_STYLE>& lhs, const Matrix<T_type, R_ORDER, R_STYLE>& rhs)
+ * \see operator*(const Matrix<T_type, L_ORDER, L_STYLE>& lhs, const T_type& rhs)
+ * \see operator*(const Matrix<T_type, ORDER, L_STYLE>& lhs, const T_type& rhs)
+ * \see operator*(const T_type& lhs, const Matrix<T_type, R_ORDER, R_STYLE>& rhs)
+ * \see operator*(const T_type& lhs, const Matrix<T_type, ORDER, R_STYLE>& rhs)
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE,
+ matrix_order L_ORDER, matrix_style L_STYLE,
+ matrix_order R_ORDER, matrix_style R_STYLE>
+ inline Matrix<T_type, ORDER, STYLE>
+ operator* (const Matrix<T_type, L_ORDER, L_STYLE>& lhs,
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs)
{
- Matrix<bool> C(A.rows(), A.cols());
- if (A.isNull() || B.isNull()) {
- throw scythe_null_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Invalid use of NULL Matrix");
- } else if (B.isScalar()) {
- // Case 1: Compare every element in A to B[0]
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) >= B[0]);
- }
- } else if (A.rows() == B.rows() && A.cols() == B.cols()) {
- // Case 2: equal size matrices
- for (int i = 0; i < A.size(); ++i)
- C[i] = (A[i] >= B[i]);
- } else if (A.rows() == B.rows() && B.cols() == 1) {
- // Case 3: Matrix == col vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) >= B[i]);
- }
- } else if (A.cols() == B.cols() && B.rows() == 1) {
- // Case 4: Matrix == row vector
- for (int i = 0; i < A.rows(); ++i) {
- for (int j = 0; j < A.cols(); ++j)
- C(i,j) = (A(i,j) >= B[j]);
- }
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Matrices not conformable");
+ if (lhs.size() == 1 || rhs.size() == 1)
+ return (lhs % rhs);
+
+ SCYTHE_CHECK_10 (lhs.cols() != rhs.rows(),
+ scythe_conformation_error,
+ "Matrices with dimensions (" << lhs.rows()
+ << ", " << lhs.cols()
+ << ") and (" << rhs.rows() << ", " << rhs.cols()
+ << ") are not multiplication-conformable");
+
+ Matrix<T_type, ORDER, Concrete> result (lhs.rows(), rhs.cols(), false);
+
+ T_type tmp;
+ if (ORDER == Col) { // col-major optimized
+ for (uint j = 0; j < rhs.cols(); ++j) {
+ for (uint i = 0; i < lhs.rows(); ++i)
+ result(i, j) = (T_type) 0;
+ for (uint l = 0; l < lhs.cols(); ++l) {
+ tmp = rhs(l, j);
+ for (uint i = 0; i < lhs.rows(); ++i)
+ result(i, j) += tmp * lhs(i, l);
+ }
+ }
+ } else { // row-major optimized
+ for (uint i = 0; i < lhs.rows(); ++i) {
+ for (uint j = 0; j < rhs.cols(); ++j)
+ result(i, j) = (T_type) 0;
+ for (uint l = 0; l < rhs.rows(); ++l) {
+ tmp = lhs(i, l);
+ for (uint j = 0; j < rhs.cols(); ++j)
+ result(i, j) += tmp * rhs(l,j);
+ }
+ }
}
- return C;
+
+ SCYTHE_VIEW_RETURN(T_type, ORDER, STYLE, result)
}
-
- template <class T>
- Matrix<bool> operator>>= (const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
+
+ SCYTHE_BINARY_OPERATOR_DEFS(operator*)
+
+ /*! \brief Kronecker multiply two matrices.
+ *
+ * This functions computes the Kronecker product of two Matrix
+ * objects. This function is overloaded to provide both Matrix by
+ * Matrix addition and Matrix by scalar addition. In the former
+ * case, the dimensions of the two matrices must be the same.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE,
+ matrix_order L_ORDER, matrix_style L_STYLE,
+ matrix_order R_ORDER, matrix_style R_STYLE>
+ inline Matrix<T_type, ORDER, STYLE>
+ kronecker (const Matrix<T_type, L_ORDER, L_STYLE>& lhs,
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs)
{
- return (A >>= Matrix<T>(b));
+ Matrix<T_type,ORDER,Concrete> res = lhs;
+ res.kronecker(rhs);
+ return (res);
}
-
- template <class T>
- Matrix<bool> operator>>= (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return (Matrix<T>(a) >>= B);
+
+ SCYTHE_BINARY_OPERATOR_DEFS(kronecker)
+
+ /* Macro definition for general return type templates of standard
+ * binary operators (this handles, +, -, %, /, but not *)
+ */
+
+#define SCYTHE_GENERAL_BINARY_OPERATOR(OP,FUNCTOR) \
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE, \
+ matrix_order L_ORDER, matrix_style L_STYLE, \
+ matrix_order R_ORDER, matrix_style R_STYLE> \
+ inline Matrix<T_type, ORDER, STYLE> \
+ OP (const Matrix<T_type, L_ORDER, L_STYLE>& lhs, \
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs) \
+ { \
+ SCYTHE_CHECK_10(lhs.size() != 1 && rhs.size() != 1 && \
+ (lhs.rows() != rhs.rows() || lhs.cols() != rhs.cols()), \
+ scythe_conformation_error, \
+ "Matrices with dimensions (" << lhs.rows() \
+ << ", " << lhs.cols() \
+ << ") and (" << rhs.rows() << ", " << rhs.cols() \
+ << ") are not conformable"); \
+ \
+ if (lhs.size() == 1) { \
+ Matrix<T_type,ORDER,Concrete> res(rhs.rows(),rhs.cols(),false); \
+ std::transform(rhs.begin_f(), rhs.end_f(), \
+ res.template begin_f<R_ORDER>(), \
+ std::bind1st(FUNCTOR <T_type>(), lhs(0))); \
+ SCYTHE_VIEW_RETURN(T_type, ORDER, STYLE, res) \
+ } \
+ \
+ Matrix<T_type,ORDER,Concrete> res(lhs.rows(), lhs.cols(), false); \
+ \
+ if (rhs.size() == 1) { \
+ std::transform(lhs.begin_f(), lhs.end_f(), \
+ res.template begin_f<L_ORDER> (), \
+ std::bind2nd(FUNCTOR <T_type>(), rhs(0))); \
+ } else { \
+ std::transform(lhs.begin_f(), lhs.end_f(), \
+ rhs.template begin_f<L_ORDER>(), \
+ res.template begin_f<L_ORDER>(), \
+ FUNCTOR <T_type> ()); \
+ } \
+ \
+ SCYTHE_VIEW_RETURN(T_type, ORDER, STYLE, res) \
}
- /**** Matrix arithmetic operators ****/
- /* When operations are commutative we pass both args in by reference
- * and check size before copying for (Matrix, Matrix) and always
- * copy the T where a T is involved. For non-commutative, we pass
- * the first arg by value. When possible, the user should try to
- * pass the smaller Matrix first although subsequent resizes may
- * make up for the time saved in copying in some cases.
+ /* Addition operators */
+
+ /*! \fn operator+(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Add two matrices.
+ *
+ * This operator adds the matrices \a lhs and \a rhs together,
+ * returning the result in a new Matrix object. This operator is
+ * overloaded to provide both Matrix by Matrix addition and
+ * Matrix by scalar addition. In the former case, the dimensions of
+ * the two matrices must be the same.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
*/
- /* Matrix addition */
- template <class T>
- Matrix<T> operator+ (const Matrix<T> &A, const Matrix<T> &B)
- {
- // If A or B is 1x1 this can save some time
- if (A.size() < B.size())
- return Matrix<T>(A) += B;
- return Matrix<T>(B) += A;
- }
-
- template <class T>
- Matrix<T> operator+(const Matrix<T> &A,
- const typename Matrix<T>::ttype &b)
- {
- return Matrix<T>(b) += A;
- }
-
- template <class T>
- Matrix<T> operator+(const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return Matrix<T>(a) += B;
- }
+ SCYTHE_GENERAL_BINARY_OPERATOR (operator+, std::plus)
+ SCYTHE_BINARY_OPERATOR_DEFS (operator+)
- /* Matrix subtraction */
- template <class T>
- Matrix<T> operator- (Matrix<T> A, const Matrix<T> &B)
- {
- return A -= B;
- }
-
- template <class T>
- Matrix<T> operator- (Matrix<T> A, const typename Matrix<T>::ttype &b)
+ /* Subtraction operators */
+
+ /*! \fn operator-(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Subtract two matrices.
+ *
+ * This operator subtracts the Matrix \a rhs from \a lhs, returning
+ * the result in a new Matrix object. This operator is overloaded
+ * to provide both Matrix by Matrix subtraction and Matrix by scalar
+ * subtraction. In the former case, the dimensions of the two
+ * matrices must be the same.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_OPERATOR (operator-, std::minus)
+ SCYTHE_BINARY_OPERATOR_DEFS (operator-)
+
+ /* Element-by-element multiplication operators */
+
+ /*! \fn operator%(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Element multiply two matrices.
+ *
+ * This operator multiplies the elements of the matrices \a lhs and
+ * \a rhs together, returning the result in a new Matrix object.
+ * This operator is overloaded to provide both Matrix by Matrix
+ * element-wise multiplication and Matrix by scalar element-wise
+ * multiplication. In the former case, the dimensions of the two
+ * matrices must be the same.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_OPERATOR (operator%, std::multiplies)
+ SCYTHE_BINARY_OPERATOR_DEFS(operator%)
+
+ /* Element-by-element division */
+
+ /*! \fn operator/(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Divide two matrices.
+ *
+ * This operator divides the Matrix \a lhs from \a rhs,
+ * returning the result in a new Matrix object. This operator is
+ * overloaded to provide both Matrix by Matrix division and
+ * Matrix by scalar division. In the former case, the dimensions of
+ * the two matrices must be the same.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_OPERATOR (operator/, std::divides)
+ SCYTHE_BINARY_OPERATOR_DEFS (operator/)
+
+ /* Element-by-element exponentiation */
+
+ /*! \fn operator^(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Exponentiate one Matrix by another.
+ *
+ * This operator exponentiates the elements of Matrix \a lhs by
+ * those in \a rhs, returning the result in a new Matrix object.
+ * This operator is overloaded to provide both Matrix by Matrix
+ * exponentiation and Matrix by scalar exponentiation. In the
+ * former case, the dimensions of the two matrices must be the same.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_OPERATOR (operator^, exponentiate)
+ SCYTHE_BINARY_OPERATOR_DEFS (operator^)
+
+ /* Negation operators */
+
+ // General return type version
+ /*! \brief Negate a Matrix.
+ *
+ * This unary operator returns the negation of \a M. This version
+ * of the operator is a general template and can provide a Matrix
+ * with any matrix_order or matrix_style as its return value.
+ *
+ * We also provide an overloaded default template that returns a
+ * concrete matrix with the same matrix_order as \a M.
+ *
+ * \param M The Matrix to negate.
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <typename T_type, matrix_order R_ORDER, matrix_style R_STYLE,
+ matrix_order ORDER, matrix_style STYLE>
+ inline Matrix<T_type, R_ORDER, R_STYLE>
+ operator- (const Matrix<T_type, ORDER, STYLE>& M)
{
- return A -= Matrix<T>(b);
+ Matrix<T_type, R_ORDER, Concrete> result(M.rows(), M.cols(), false);
+ std::transform(M.template begin_f<ORDER>(),
+ M.template end_f<ORDER>(),
+ result.template begin_f<R_ORDER>(),
+ std::negate<T_type> ());
+ SCYTHE_VIEW_RETURN(T_type, R_ORDER, R_STYLE, result)
}
- template <class T>
- Matrix<T> operator-(const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return Matrix<T>(a) -= B;
- }
-
- /* Negate all the elements in the matrix */
- template <class T>
- Matrix<T> operator- (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = -A[i];
- return A;
- }
-
- /* Matrix Multiplication */
- template <class T>
- Matrix<T> operator* (Matrix<T> A, const Matrix<T> &B)
+ // Default return type version
+ template <matrix_order ORDER, matrix_style P_STYLE, typename T_type>
+ inline Matrix<T_type, ORDER, Concrete>
+ operator- (const Matrix<T_type, ORDER, P_STYLE>& M)
{
- return A *= B;
+ return operator-<T_type, ORDER, Concrete> (M);
}
-
- // 1X1 * nXm is commutative but we'd grow anyway so don't bother
- template <class T>
- Matrix<T> operator* (Matrix<T> A, const typename Matrix<T>::ttype &b)
+
+ /* Unary not operators */
+
+ /*! \brief Logically NOT a Matrix.
+ *
+ * This unary operator returns NOT \a M. This version of the
+ * operator is a general template and can provide a boolean Matrix
+ * with any matrix_order or matrix_style as its return value.
+ *
+ * We also provide a default template for this function that returns
+ * a concrete boolean with the same matrix_order as \a M.
+ *
+ * \param M The Matrix to NOT.
+ *
+ * \see operator!(const Matrix<T_type, ORDER, P_STYLE>& M)
+ *
+ * \throw scythe_alloc_error (Level 1)
+ */
+ template <matrix_order R_ORDER, matrix_style R_STYLE, typename T_type,
+ matrix_order ORDER, matrix_style STYLE>
+ inline Matrix<bool, R_ORDER, R_STYLE>
+ operator! (const Matrix<T_type, ORDER, STYLE>& M)
{
- return A *= Matrix<T>(b);
+ Matrix<bool, R_ORDER, Concrete> result(M.rows(), M.cols(), false);
+ std::transform(M.template begin_f<ORDER>(),
+ M.template end_f<ORDER>(),
+ result.template begin_f<R_ORDER>(),
+ std::logical_not<T_type> ());
+ SCYTHE_VIEW_RETURN(T_type, R_ORDER, R_STYLE, result)
}
- template <class T>
- Matrix<T> operator*(const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
+ // Default return type version
+ template <typename T_type, matrix_order ORDER, matrix_style P_STYLE>
+ inline Matrix<bool, ORDER, Concrete>
+ operator! (const Matrix<T_type, ORDER, P_STYLE>& M)
{
- return Matrix<T>(a) *= B;
+ return (operator!<ORDER, Concrete> (M));
}
-
- /* Kronecker Multiplication */
- template <class T>
- Matrix<T> operator% (Matrix<T>A, const Matrix<T> &B)
- {
- return A %= B;
+ /**** COMPARISON OPERATORS ****/
+
+ /* These macros are analogous to those above, except they return
+ * only boolean matrices and use slightly different template
+ * parameter orderings. Kind of redundant, but less confusing than
+ * making omnibus macros that handle both cases.
+ */
+#define SCYTHE_GENERAL_BINARY_BOOL_OPERATOR(OP,FUNCTOR) \
+ template <matrix_order ORDER, matrix_style STYLE, typename T_type, \
+ matrix_order L_ORDER, matrix_style L_STYLE, \
+ matrix_order R_ORDER, matrix_style R_STYLE> \
+ inline Matrix<bool, ORDER, STYLE> \
+ OP (const Matrix<T_type, L_ORDER, L_STYLE>& lhs, \
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs) \
+ { \
+ SCYTHE_CHECK_10(lhs.size() != 1 && rhs.size() != 1 && \
+ (lhs.rows() != rhs.rows() || lhs.cols() != rhs.cols()), \
+ scythe_conformation_error, \
+ "Matrices with dimensions (" << lhs.rows() \
+ << ", " << lhs.cols() \
+ << ") and (" << rhs.rows() << ", " << rhs.cols() \
+ << ") are not conformable"); \
+ \
+ if (lhs.size() == 1) { \
+ Matrix<bool,ORDER,Concrete> res(rhs.rows(),rhs.cols(),false); \
+ std::transform(rhs.begin_f(), rhs.end_f(), \
+ res.template begin_f<R_ORDER>(), \
+ std::bind1st(FUNCTOR <T_type>(), lhs(0))); \
+ SCYTHE_VIEW_RETURN(T_type, ORDER, STYLE, res) \
+ } \
+ \
+ Matrix<bool,ORDER,Concrete> res(lhs.rows(), lhs.cols(), false); \
+ \
+ if (rhs.size() == 1) { \
+ std::transform(lhs.begin_f(), lhs.end_f(), \
+ res.template begin_f<L_ORDER> (), \
+ std::bind2nd(FUNCTOR <T_type>(), rhs(0))); \
+ } else { \
+ std::transform(lhs.begin_f(), lhs.end_f(), \
+ rhs.template begin_f<L_ORDER>(), \
+ res.template begin_f<L_ORDER>(), \
+ FUNCTOR <T_type> ()); \
+ } \
+ \
+ SCYTHE_VIEW_RETURN(T_type, ORDER, STYLE, res) \
}
-
- // commutative but we'd grow anyway
- template <class T>
- Matrix<T> operator% (Matrix<T> A, const typename Matrix<T>::ttype &b)
- {
- return A %= Matrix<T>(b);
+
+#define SCYTHE_BINARY_BOOL_OPERATOR_DMM(OP) \
+ template <typename T_type, matrix_order ORDER, matrix_style L_STYLE,\
+ matrix_order R_ORDER, matrix_style R_STYLE> \
+ inline Matrix<bool, ORDER, Concrete> \
+ OP (const Matrix<T_type, ORDER, L_STYLE>& lhs, \
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs) \
+ { \
+ return OP <ORDER, Concrete>(lhs, rhs); \
}
-
- template <class T>
- Matrix<T> operator%(const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return Matrix<T>(a) %= B;
+
+#define SCYTHE_BINARY_BOOL_OPERATOR_GMS(OP) \
+ template <matrix_order ORDER, matrix_style STYLE, typename T_type, \
+ matrix_order L_ORDER, matrix_style L_STYLE> \
+ inline Matrix<bool, ORDER, STYLE> \
+ OP (const Matrix<T_type, L_ORDER, L_STYLE>& lhs, \
+ const typename Matrix<T_type>::ttype &rhs) \
+ { \
+ return (OP <ORDER, STYLE> \
+ (lhs, Matrix<T_type, L_ORDER>(rhs))); \
}
-
- /* Element-by-element division */
- template <class T>
- Matrix<T> operator/ (Matrix<T> A, const Matrix<T> &B)
- {
- return A /= B;
+
+#define SCYTHE_BINARY_BOOL_OPERATOR_DMS(OP) \
+ template <typename T_type, matrix_order ORDER, matrix_style L_STYLE>\
+ inline Matrix<bool, ORDER, Concrete> \
+ OP (const Matrix<T_type, ORDER, L_STYLE>& lhs, \
+ const typename Matrix<T_type>::ttype &rhs) \
+ { \
+ return (OP <ORDER, Concrete> (lhs, rhs)); \
}
- template <class T>
- Matrix<T> operator/ (Matrix<T> A, const typename Matrix<T>::ttype &b)
- {
- return A /= Matrix<T>(b);
+#define SCYTHE_BINARY_BOOL_OPERATOR_GSM(OP) \
+ template <matrix_order ORDER, matrix_style STYLE, typename T_type, \
+ matrix_order R_ORDER, matrix_style R_STYLE> \
+ inline Matrix<bool, ORDER, STYLE> \
+ OP (const typename Matrix<T_type>::ttype &lhs, \
+ const Matrix<T_type, R_ORDER, R_STYLE>& rhs) \
+ { \
+ return (OP <ORDER, STYLE> \
+ (Matrix<T_type, R_ORDER>(lhs), rhs)); \
}
- template <class T>
- Matrix<T> operator/ (const typename Matrix<T>::ttype &a,
- const Matrix<T> &B)
- {
- return Matrix<T>(a) /= B;
+#define SCYTHE_BINARY_BOOL_OPERATOR_DSM(OP) \
+ template <typename T_type, matrix_order ORDER, matrix_style R_STYLE>\
+ inline Matrix<bool, ORDER, Concrete> \
+ OP (const typename Matrix<T_type>::ttype &lhs, \
+ const Matrix<T_type, ORDER, R_STYLE>& rhs) \
+ { \
+ return (OP <ORDER, Concrete> (lhs, rhs)); \
}
-
- /* Matrix power: ^0 returns identity matrix of this size, ^-1
- * returns inverse, otherwise must be a positive int
+
+#define SCYTHE_BINARY_BOOL_OPERATOR_DEFS(OP) \
+ SCYTHE_BINARY_BOOL_OPERATOR_DMM(OP) \
+ SCYTHE_BINARY_BOOL_OPERATOR_GMS(OP) \
+ SCYTHE_BINARY_BOOL_OPERATOR_DMS(OP) \
+ SCYTHE_BINARY_BOOL_OPERATOR_GSM(OP) \
+ SCYTHE_BINARY_BOOL_OPERATOR_DSM(OP)
+
+ /* Element-wise Equality operator
+ * See equals() method for straight equality checks
+ */
+
+ /*! \fn operator==(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Test Matrix equality.
+ *
+ * This operator compares the elements of \a lhs and \a rhs and
+ * returns a boolean Matrix of true and false values, indicating
+ * whether each pair of compared elements is equal. This operator
+ * is overloaded to provide both Matrix by Matrix equality testing
+ * and Matrix by scalar equality testing. In the former case, the
+ * dimensions of the two matrices must be the same. The boolean
+ * Matrix returned has the same dimensions as \a lhs and \a rhs, or
+ * matches the dimensionality of the larger Matrix object when one
+ * of the two parameters is a scalar or a 1x1 Matrix.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_BOOL_OPERATOR (operator==, std::equal_to)
+ SCYTHE_BINARY_BOOL_OPERATOR_DEFS (operator==)
+
+ /*! \fn operator!=(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Test Matrix equality.
+ *
+ * This operator compares the elements of \a lhs and \a rhs and
+ * returns a boolean Matrix of true and false values, indicating
+ * whether each pair of compared elements is not equal. This operator
+ * is overloaded to provide both Matrix by Matrix inequality testing
+ * and Matrix by scalar inequality testing. In the former case, the
+ * dimensions of the two matrices must be the same. The boolean
+ * Matrix returned has the same dimensions as \a lhs and \a rhs, or
+ * matches the dimensionality of the larger Matrix object when one
+ * of the two parameters is a scalar or a 1x1 Matrix.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_BOOL_OPERATOR (operator!=, std::not_equal_to)
+ SCYTHE_BINARY_BOOL_OPERATOR_DEFS (operator!=)
+
+ /*! \fn operator<(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Test Matrix inequality.
+ *
+ * This operator compares the elements of \a lhs and \a rhs and
+ * returns a boolean Matrix of true and false values, indicating
+ * whether each of the left-hand side elements is less than its
+ * corresponding right hand side element. This operator is
+ * overloaded to provide both Matrix by Matrix inequality testing
+ * and Matrix by scalar inequality testing. In the former case, the
+ * dimensions of the two matrices must be the same. The boolean
+ * Matrix returned has the same dimensions as \a lhs and \a rhs, or
+ * matches the dimensionality of the larger Matrix object when one
+ * of the two parameters is a scalar or a 1x1 Matrix.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_BOOL_OPERATOR (operator<, std::less)
+ SCYTHE_BINARY_BOOL_OPERATOR_DEFS (operator<)
+
+ /*! \fn operator<=(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Test Matrix inequality.
+ *
+ * This operator compares the elements of \a lhs and \a rhs and
+ * returns a boolean Matrix of true and false values, indicating
+ * whether each of the left-hand side elements is less than
+ * or equal to its
+ * corresponding right hand side element. This operator is
+ * overloaded to provide both Matrix by Matrix inequality testing
+ * and Matrix by scalar inequality testing. In the former case, the
+ * dimensions of the two matrices must be the same. The boolean
+ * Matrix returned has the same dimensions as \a lhs and \a rhs, or
+ * matches the dimensionality of the larger Matrix object when one
+ * of the two parameters is a scalar or a 1x1 Matrix.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_BOOL_OPERATOR (operator<=, std::less_equal)
+ SCYTHE_BINARY_BOOL_OPERATOR_DEFS (operator<=)
+
+ /*! \fn operator>(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Test Matrix inequality.
+ *
+ * This operator compares the elements of \a lhs and \a rhs and
+ * returns a boolean Matrix of true and false values, indicating
+ * whether each of the left-hand side elements is greater than its
+ * corresponding right hand side element. This operator is
+ * overloaded to provide both Matrix by Matrix inequality testing
+ * and Matrix by scalar inequality testing. In the former case, the
+ * dimensions of the two matrices must be the same. The boolean
+ * Matrix returned has the same dimensions as \a lhs and \a rhs, or
+ * matches the dimensionality of the larger Matrix object when one
+ * of the two parameters is a scalar or a 1x1 Matrix.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_BOOL_OPERATOR (operator>, std::greater)
+ SCYTHE_BINARY_BOOL_OPERATOR_DEFS (operator>)
+
+ /*! \fn operator>=(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Test Matrix inequality.
+ *
+ * This operator compares the elements of \a lhs and \a rhs and
+ * returns a boolean Matrix of true and false values, indicating
+ * whether each of the left-hand side elements is greater than
+ * or equal to its
+ * corresponding right hand side element. This operator is
+ * overloaded to provide both Matrix by Matrix inequality testing
+ * and Matrix by scalar inequality testing. In the former case, the
+ * dimensions of the two matrices must be the same. The boolean
+ * Matrix returned has the same dimensions as \a lhs and \a rhs, or
+ * matches the dimensionality of the larger Matrix object when one
+ * of the two parameters is a scalar or a 1x1 Matrix.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
*/
- template <class T>
- Matrix<T> operator^ (Matrix<T> A, const int &i)
+
+ SCYTHE_GENERAL_BINARY_BOOL_OPERATOR (operator>=, std::greater_equal)
+ SCYTHE_BINARY_BOOL_OPERATOR_DEFS (operator>=)
+
+ /*! \fn operator&(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Logically AND two matrices.
+ *
+ * This operator logically ANDs the elements of \a lhs and \a rhs
+ * and returns a boolean Matrix of true and false values, with true
+ * values in each position where both matrices' elements evaluate to
+ * true (or the type specific analog to true, typically any non-zero
+ * value). This operator is overloaded to provide both Matrix by
+ * Matrix AND and Matrix by scalar AND. In the former case, the
+ * dimensions of the two matrices must be the same. The boolean
+ * Matrix returned has the same dimensions as \a lhs and \a rhs, or
+ * matches the dimensionality of the larger Matrix object when one
+ * of the two parameters is a scalar or a 1x1 Matrix.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_BOOL_OPERATOR (operator&, std::logical_and)
+ SCYTHE_BINARY_BOOL_OPERATOR_DEFS (operator&)
+
+
+ /*! \fn operator|(const Matrix<T_type,L_ORDER,L_STYLE>&lhs,
+ * const Matrix<T_type,R_ORDER,R_STYLE>&rhs)
+ *
+ * \brief Logically OR two matrices.
+ *
+ * This operator logically ORs the elements of \a lhs and \a rhs
+ * and returns a boolean Matrix of true and false values, with true
+ * values in each position where either Matrix's elements evaluate to
+ * true (or the type specific analog to true, typically any non-zero
+ * value). This operator is overloaded to provide both Matrix by
+ * Matrix OR and Matrix by scalar OR. In the former case, the
+ * dimensions of the two matrices must be the same. The boolean
+ * Matrix returned has the same dimensions as \a lhs and \a rhs, or
+ * matches the dimensionality of the larger Matrix object when one
+ * of the two parameters is a scalar or a 1x1 Matrix.
+ *
+ * In addition, we define multiple templates of the overloaded
+ * operator to provide maximal flexibility when working with
+ * matrices with differing matrix_order and/or matrix_style. Each
+ * version of the overloaded operator (Matrix by Matrix, scalar by
+ * Matrix, and Matrix by scalar) provides both a default and
+ * general behavior, using templates. By default, the returned
+ * Matrix is concrete and has the same matrix_order as the
+ * left-hand (or only) Matrix argument. Alternatively, one may
+ * coerce the matrix_order and matrix_style of the returned Matrix
+ * to preferred values by using the full template declaration of
+ * the operator.
+ *
+ * \param lhs The left-hand-side Matrix or scalar.
+ * \param rhs The right-hand-side Matrix or scalar.
+ *
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_alloc_error (Level 1)
+ */
+
+ SCYTHE_GENERAL_BINARY_BOOL_OPERATOR (operator|, std::logical_or)
+ SCYTHE_BINARY_BOOL_OPERATOR_DEFS (operator|)
+
+ /**** INPUT-OUTPUT ****/
+
+
+ /* This function simply copies values from an input stream into a
+ * matrix. It relies on the iterators for bounds checking.
+ */
+
+ /*! \brief Populate a Matrix from a stream.
+ *
+ * This operator reads values from a stream and enters them into an
+ * existing Matrix in order.
+ *
+ * \param is The istream to read from.
+ * \param M The Matrix to populate.
+ *
+ * \see operator<<(std::ostream& os, const Matrix<T,O,S>& M)
+ * \see Matrix::Matrix(const std::string& file)
+ *
+ * \throw scythe_bounds_error (Level 3)
+ */
+ template <typename T, matrix_order O, matrix_style S>
+ std::istream& operator>> (std::istream& is, Matrix<T,O,S>& M)
{
- return A ^= i;
+ std::copy(std::istream_iterator<T> (is), std::istream_iterator<T>(),
+ M.begin_f());
+
+ return is;
}
-
- /* Return the transpose of this matrix */
- template <class T>
- Matrix<T> operator! (const Matrix<T> &M)
+
+ /* Writes a matrix to an ostream in readable format. This is
+ * intended to be used to pretty-print to the terminal.
+ */
+
+ /*!\brief Write a Matrix to a stream.
+ *
+ * Writes a matrix to an ostream in a column-aligned format. This
+ * operator is primarily intended for pretty-printing to the
+ * terminal and uses two passes in order to correctly align the
+ * output. If you wish to write a Matrix to disk, Matrix::save() is
+ * probably a better option.
+ *
+ * \param os The ostream to write to.
+ * \param M The Matrix to write out.
+ *
+ * \see operator>>(std::istream& is, Matrix<T,O,S>& M)
+ * \see Matrix::save()
+ */
+ template <typename T, matrix_order O, matrix_style S>
+ std::ostream& operator<< (std::ostream& os, const Matrix<T,O,S>& M)
{
- int rows = M.rows();
- int cols = M.cols();
- Matrix<T> ret(cols, rows, false);
- for (register int i = 0; i < rows; ++i) {
- for (register int j = 0; j < cols; ++j)
- //ret(j,i) = m(i,j);
- ret[j * rows + i] = M[i * cols + j];
- }
- return ret;
- }
+ /* This function take two passes to figure out appropriate field
+ * widths. Speed isn't really the point here.
+ */
+
+ // Store previous io settings
+ std::ios_base::fmtflags preop = os.flags();
+
+ uint mlen = os.width();
+ std::ostringstream oss;
+ oss.precision(os.precision());
+ oss << std::setiosflags(std::ios::fixed);
- /* Return the determinant of a SQUARE matrix vi LU decomposition*/
- template <class T>
- T operator~ (Matrix <T> A) //no reference because LU kills the matrix
- {
- if (! A.isSquare()) {
- throw scythe_dimension_error(__FILE__,__PRETTY_FUNCTION__,
- __LINE__, "Matrix not square");
- return 0;
- }
- if (A.isNull()) {
- throw scythe_null_error(__FILE__,__PRETTY_FUNCTION__,
- __LINE__, "Matrix is NULL");
- return 0;
+ typename Matrix<T,O,S>::const_forward_iterator last = M.end_f();
+ for (typename Matrix<T,O,S>::const_forward_iterator i = M.begin_f();
+ i != last; ++i) {
+ oss.str("");
+ oss << (*i);
+ if (oss.str().length() > mlen)
+ mlen = oss.str().length();
}
- Matrix<T> L(A.rows(), A.rows());
- Matrix<T> U = L;
- T sign = 1;
- int pivot;
- T temp;
-
- for (int k = 0; k < A.rows(); ++k) {
- pivot = k;
- // find pivot
- for (int i = k; i < A.rows(); ++i)
- if (A(pivot,k) < ::fabs(A(i,k)))
- pivot = i;
-
- if (A(pivot,k) == 0)
- return 0;
-
- // permute
- if (k != pivot) {
- sign *= -1;
- for (int i = k; i < A.rows(); ++i) {
- temp = A(pivot,i);
- A(pivot,i) = A(k,i);
- A(k,i) = temp;
- }
- }
- for (int i = k + 1; i < A.rows(); ++i) {
- A(i,k) = A(i,k) / A(k,k);
- for (int j = k + 1; j < A.rows(); ++j) {
- A(i,j) = A(i,j) - A(i,k) * A(k,j);
- }
+
+ /* Write the stream */
+ // Change to a fixed with format. Users should control precision
+ os << std::setiosflags(std::ios::fixed);
+
+
+ for (uint i = 0; i < M.rows(); ++i) {
+ Matrix<T, O, View> row = M(i, _);
+ //for (uint i = 0; i < row.size(); ++i)
+ // os << std::setw(mlen) << row[i] << " ";
+ typename Matrix<T,O,View>::const_forward_iterator row_last
+ = row.end_f();
+ for (typename
+ Matrix<T,O,View>::forward_iterator el = row.begin_f();
+ el != row_last; ++el) {
+ os << std::setw(mlen) << *el << " ";
}
+ os << std::endl;
}
+
+
+ // Restore pre-op flags
+ os.flags(preop);
- T det = 1;
- for (int i = 0; i < A.rows(); ++i)
- det *= A(i,i);
-
- return sign * det;
+ return os;
}
+#ifdef SCYTHE_LAPACK
+ /* A template specialization of operator* for col-major, concrete
+ * matrices of doubles that is only visible when a LAPACK library is
+ * available. This function is an analog of the above function and
+ * the above doxygen documentation serves for both.
+ *
+ * This needs to go below % so it can see the template definition
+ * (since it isn't actually in the template itself.
+ */
+
+ template<>
+ Matrix<>
+ operator*<double,Col,Concrete,Col,Concrete>
+ (const Matrix<>& lhs, const Matrix<>& rhs)
+ {
+ if (lhs.size() == 1 || rhs.size() == 1)
+ return (lhs % rhs);
+ SCYTHE_DEBUG_MSG("Using lapack/blas for matrix multiplication");
+ SCYTHE_CHECK_10 (lhs.cols() != rhs.rows(),
+ scythe_conformation_error,
+ "Matrices with dimensions (" << lhs.rows()
+ << ", " << lhs.cols()
+ << ") and (" << rhs.rows() << ", " << rhs.cols()
+ << ") are not multiplication-conformable");
- template <class T>
- inline Matrix<T>
- r2scythe (const int &rows, const int &cols, const T *data)
- {
- Matrix<T> M(rows, cols, false);
+ Matrix<> result (lhs.rows(), rhs.cols(), false);
- for (register int i = 0; i < cols; ++i) {
- for (register int j = 0; j < rows; ++j)
- M[j * cols + i] = data[i * rows + j];
- }
+ // Get pointers to the internal arrays and set up some vars
+ double* lhspnt = lhs.getArray();
+ double* rhspnt = rhs.getArray();
+ double* resultpnt = result.getArray();
+ const double one(1.0);
+ const double zero(0.0);
+ int rows = (int) lhs.rows();
+ int cols = (int) rhs.cols();
+ int innerDim = (int) rhs.rows();
- return M;
- }
+ // Call the lapack routine.
+ lapack::dgemm_("N", "N", &rows, &cols, &innerDim, &one, lhspnt,
+ &rows, rhspnt, &innerDim, &zero, resultpnt, &rows);
-
-} // end namespace SCYTHE
+ return result;
+ }
+#endif
+
+} // end namespace scythe
#endif /* SCYTHE_MATRIX_H */
diff --git a/src/matrix_bidirectional_iterator.h b/src/matrix_bidirectional_iterator.h
new file mode 100644
index 0000000..9fd9908
--- /dev/null
+++ b/src/matrix_bidirectional_iterator.h
@@ -0,0 +1,474 @@
+/*
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
+ * information.
+ * --------------------------------------------------------------------
+ * scythestat/matrix_bidirectional_iterator.h
+ *
+ * Bidirectional iterators for the matrix class.
+ *
+ */
+
+/*! \file matrix_bidirectional_iterator.h
+ * \brief Definitions of STL-compliant bidirectional iterators for the
+ * Matrix class.
+ *
+ * Contains definitions of const_matrix_bidirectional_iterator,
+ * matrix_bidirectional_iterator, and related operators. See a
+ * Standard Template Library reference, such as Josuttis (1999), for a
+ * full description of the capabilities of bidirectional iterators.
+ *
+ * These iterators are templated on the type, order and style of the
+ * Matrix they iterate over and their own order, which need not match
+ * the iterated-over matrix. Same-order iteration over concrete
+ * matrices is extremely fast. Cross-grain concrete and/or view
+ * iteration is slower.
+ */
+
+#ifndef SCYTHE_MATRIX_BIDIRECTIONAL_ITERATOR_H
+#define SCYTHE_MATRIX_BIDIRECTIONAL_ITERATOR_H
+
+#include <iterator>
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "defs.h"
+#include "error.h"
+#include "matrix.h"
+#else
+#include "scythestat/defs.h"
+#include "scythestat/error.h"
+#include "scythestat/matrix.h"
+#endif
+
+namespace scythe {
+ /* convenience typedefs */
+ namespace { // local to this file
+ typedef unsigned int uint;
+ }
+
+ /* forward declaration of the matrix class */
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE>
+ class Matrix;
+
+ /*! \brief An STL-compliant const bidirectional iterator for Matrix.
+ *
+ * Provides bidirectional iteration over const Matrix objects. See
+ * Josuttis (1999), or some other STL reference, for a full
+ * description of the bidirectional iterator interface.
+ *
+ * \see Matrix
+ * \see matrix_bidirectional_iterator
+ * \see const_matrix_forward_iterator
+ * \see matrix_forward_iterator
+ * \see const_matrix_random_access_iterator
+ * \see matrix_random_access_iterator
+ */
+
+ template <typename T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style M_STYLE>
+ class const_matrix_bidirectional_iterator
+ : public std::iterator<std::bidirectional_iterator_tag, T_type>
+ {
+ public:
+ /**** TYPEDEFS ***/
+ typedef const_matrix_bidirectional_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE> self;
+
+ /* These are a little formal, but useful */
+ typedef typename std::iterator_traits<self>::value_type
+ value_type;
+ typedef typename std::iterator_traits<self>::iterator_category
+ iterator_category;
+ typedef typename std::iterator_traits<self>::difference_type
+ difference_type;
+ typedef typename std::iterator_traits<self>::pointer pointer;
+ typedef typename std::iterator_traits<self>::reference reference;
+
+
+ /**** CONSTRUCTORS ****/
+
+ /* Default constructor */
+ const_matrix_bidirectional_iterator ()
+ {}
+
+ /* Standard constructor */
+ const_matrix_bidirectional_iterator
+ (const Matrix<value_type, M_ORDER, M_STYLE> &M)
+ : pos_ (M.getArray()),
+ matrix_ (&M)
+ {
+ SCYTHE_CHECK_30 (pos_ == 0, scythe_null_error,
+ "Requesting iterator to NULL matrix");
+
+ /* The basic story is: when M_STYLE == Concrete and ORDER ==
+ * M_ORDER, we only need pos_ and iteration will be as fast as
+ * possible. All other types of iteration need more variables
+ * to keep track of things and are slower.
+ */
+
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = 0;
+
+ if (ORDER == Col) {
+ lead_length_ = M.rows();
+ lead_inc_ = M.rowstride();
+ trail_inc_ = M.colstride();
+ } else {
+ lead_length_ = M.cols();
+ lead_inc_ = M.colstride();
+ trail_inc_ = M.rowstride();
+ }
+ jump_ = trail_inc_ + (1 - lead_length_) * lead_inc_;
+ vend_ = pos_ + (lead_length_ - 1) * lead_inc_;
+ vbegin_ = pos_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = M.size();
+ start_ = pos_;
+#endif
+
+ }
+
+ /* Copy constructor */
+ const_matrix_bidirectional_iterator (const self &mi)
+ : pos_ (mi.pos_),
+ matrix_ (mi.matrix_)
+ {
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ vend_ = mi.vend_;
+ vbegin_ = mi.vbegin_;
+ jump_ = mi.jump_;
+ }
+
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+ start_ = mi.start_;
+#endif
+ }
+
+ /**** EXTRA MODIFIER ****/
+
+ /* This function lets us grab an end iterator. It is cheap for
+ * Concrete matrices but somewhat more costly for views.
+ */
+ inline self& set_end ()
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ pos_ = matrix_->getArray() + matrix_->size();
+ } else {
+ if (ORDER == Col) {
+ vbegin_ += trail_inc_ * matrix_->cols();
+ vend_ += trail_inc_ * matrix_->cols();
+ } else { // ORDER == Rows
+ vbegin_ += trail_inc_ * matrix_->rows();
+ vend_ += trail_inc_ * matrix_->rows();
+ }
+
+ pos_ = vbegin_;
+ offset_ = matrix_->size();
+ }
+
+ return *this;
+ }
+
+ /**** FORWARD ITERATOR FACILITIES ****/
+
+ inline self& operator= (const self& mi)
+ {
+ pos_ = mi.pos_;
+ matrix_ = mi.matrix_;
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ vend_ = mi.vend_;
+ vbegin_ = mi.vbegin_;
+ jump_ = mi.jump_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+ start_ = mi.start_;
+#endif
+
+ return *this;
+ }
+
+ inline const reference operator* () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return *pos_;
+ }
+
+ inline const pointer operator-> () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return pos_;
+ }
+
+ inline self& operator++ ()
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER)
+ ++pos_;
+ else {
+ if (pos_ == vend_) {
+ vend_ += trail_inc_;
+ vbegin_ += trail_inc_;
+ pos_ += jump_;
+ } else {
+ pos_ += lead_inc_;
+ }
+ ++offset_;
+ }
+
+ return *this;
+ }
+
+ inline self operator++ (int)
+ {
+ self tmp = *this;
+ ++(*this);
+ return tmp;
+ }
+
+ /* == is only defined for iterators of the same template type
+ * that point to the same matrix. Behavior for any other
+ * comparison is undefined.
+ *
+ * Note that we have to be careful about iterator comparisons
+ * when working with views and cross-grain iterators.
+ * Specifically, we always have to rely on the offset value.
+ * Obviously, with <> checks pos_ can jump all over the place in
+ * cross-grain iterators, but also end iterators point to the
+ * value after the last in the matrix. In some cases, the
+ * equation in += and -= will actually put pos_ inside the
+ * matrix (often in an early position) in this case.
+ */
+ inline bool operator== (const self& x) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ return pos_ == x.pos_;
+ } else {
+ return offset_ == x.offset_;
+ }
+ }
+
+ /* Again, != is only officially defined for iterators over the
+ * same matrix although the test will be trivially true for
+ * matrices that don't view the same data, by implementation.
+ */
+ inline bool operator!= (const self &x) const
+ {
+ return !(*this == x);
+ }
+
+ /**** BIDIRECTIONAL ITERATOR FACILITES ****/
+ inline self& operator-- ()
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER)
+ --pos_;
+ else {
+ if (pos_ == vbegin_) {
+ vend_ -= trail_inc_;
+ vbegin_ -= trail_inc_;
+ pos_ -= jump_;
+ } else {
+ pos_ -= lead_inc_;
+ }
+ --offset_;
+ }
+
+ return *this;
+ }
+
+ inline self operator-- (int)
+ {
+ self tmp = *this;
+ --(*this);
+ return tmp;
+ }
+
+ protected:
+
+ /**** INSTANCE VARIABLES ****/
+ T_type* pos_; // pointer to current position in array
+ T_type *vend_; // pointer to end of current vector
+ T_type *vbegin_; // pointer to begin of current vector
+
+ uint offset_; // logical offset into matrix
+
+ // TODO Some of these can probably be uints
+ int lead_length_; // Logical length of leading dimension
+ int lead_inc_; // Memory distance between vectors in ldim
+ int trail_inc_; // Memory distance between vectors in tdim
+ int jump_; // Memory distance between end of one ldim vector and
+ // begin of next
+ // Pointer used only for set_end. TODO Cleaner impl.
+ const Matrix<T_type, M_ORDER, M_STYLE>* matrix_;
+ // Size variable for range checking
+#if SCYTHE_DEBUG > 2
+ uint size_; // Logical matrix size
+ T_type* start_; // only needed for bounds checking
+#endif
+ };
+
+ /*! \brief An STL-compliant bidirectional iterator for Matrix.
+ *
+ * Provides bidirectional iteration over Matrix objects. See
+ * Josuttis (1999), or some other STL reference, for a full
+ * description of the bidirectional iterator interface.
+ *
+ * \see Matrix
+ * \see const_matrix_bidirectional_iterator
+ * \see const_matrix_forward_iterator
+ * \see matrix_forward_iterator
+ * \see const_matrix_random_access_iterator
+ * \see matrix_random_access_iterator
+ */
+
+ template <typename T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style M_STYLE>
+ class matrix_bidirectional_iterator
+ : public const_matrix_bidirectional_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE>
+ {
+ /**** TYPEDEFS ***/
+ typedef matrix_bidirectional_iterator<T_type, ORDER, M_ORDER,
+ M_STYLE> self;
+ typedef const_matrix_bidirectional_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE> Base;
+
+ public:
+ /* These are a little formal, but useful */
+ typedef typename std::iterator_traits<Base>::value_type
+ value_type;
+ typedef typename std::iterator_traits<Base>::iterator_category
+ iterator_category;
+ typedef typename std::iterator_traits<Base>::difference_type
+ difference_type;
+ typedef typename std::iterator_traits<Base>::pointer pointer;
+ typedef typename std::iterator_traits<Base>::reference reference;
+
+
+ /**** CONSTRUCTORS ****/
+
+ /* Default constructor */
+ matrix_bidirectional_iterator ()
+ : Base ()
+ {}
+
+ /* Standard constructor */
+ matrix_bidirectional_iterator (const Matrix<value_type, M_ORDER,
+ M_STYLE> &M)
+ : Base(M)
+ {}
+
+ /* Copy constructor */
+ matrix_bidirectional_iterator (const self &mi)
+ : Base (mi)
+ {}
+
+ /**** EXTRA MODIFIER ****/
+ inline self& set_end ()
+ {
+ Base::set_end();
+ return *this;
+ }
+
+ /**** FORWARD ITERATOR FACILITIES ****/
+
+ /* We have to override a lot of these to get return values
+ * right.*/
+ inline self& operator= (const self& mi)
+ {
+ pos_ = mi.pos_;
+ matrix_ = mi.matrix_;
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ vend_ = mi.vend_;
+ vbegin_ = mi.vbegin_;
+ jump_ = mi.jump_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+ start_ = mi.start_;
+#endif
+
+ return *this;
+ }
+
+ inline reference operator* () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return *pos_;
+ }
+
+ inline pointer operator-> () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return pos_;
+ }
+
+ inline self& operator++ ()
+ {
+ Base::operator++();
+ return *this;
+ }
+
+ inline self operator++ (int)
+ {
+ self tmp = *this;
+ ++(*this);
+ return tmp;
+ }
+
+ inline self& operator-- ()
+ {
+ Base::operator--();
+ return *this;
+ }
+
+ inline self operator-- (int)
+ {
+ self tmp = *this;
+ --(*this);
+ return tmp;
+ }
+
+ private:
+ /* Get handles to base members. It boggles the mind */
+ using Base::pos_;
+ using Base::vend_;
+ using Base::vbegin_;
+ using Base::offset_;
+ using Base::lead_length_;
+ using Base::lead_inc_;
+ using Base::trail_inc_;
+ using Base::jump_;
+ using Base::matrix_;
+#if SCYTHE_DEBUG > 2
+ using Base::size_;
+ using Base::start_;
+#endif
+ };
+
+} // namespace scythe
+
+#endif /* SCYTHE_MATRIX_BIDIRECTIONAL_ITERATOR_H */
diff --git a/src/matrix_forward_iterator.h b/src/matrix_forward_iterator.h
new file mode 100644
index 0000000..fc1466e
--- /dev/null
+++ b/src/matrix_forward_iterator.h
@@ -0,0 +1,427 @@
+/*
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
+ * information.
+ * --------------------------------------------------------------------
+ * scythestat/matrix_forward_iterator.h
+ *
+ * Forward iterators for the matrix class.
+ *
+ */
+
+/*! \file matrix_forward_iterator.h
+ * \brief Definitions of STL-compliant forward iterators for the
+ * Matrix class.
+ *
+ * Contains definitions of const_matrix_forward_iterator,
+ * matrix_forward_iterator, and related operators. See a Standard
+ * Template Library reference, such as Josuttis (1999), for a full
+ * description of the capabilities of forward iterators.
+ *
+ * These iterators are templated on the type, order and style of the
+ * Matrix they iterate over and their own order, which need not match
+ * the iterated-over matrix. Same-order iteration over concrete
+ * matrices is extremely fast. Cross-grain concrete and/or view
+ * iteration is slower.
+ */
+
+#ifndef SCYTHE_MATRIX_FORWARD_ITERATOR_H
+#define SCYTHE_MATRIX_FORWARD_ITERATOR_H
+
+#include <iterator>
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "defs.h"
+#include "error.h"
+#include "matrix.h"
+#else
+#include "scythestat/defs.h"
+#include "scythestat/error.h"
+#include "scythestat/matrix.h"
+#endif
+
+namespace scythe {
+ /* convenience typedefs */
+ namespace { // local to this file
+ typedef unsigned int uint;
+ }
+
+ /* forward declaration of the matrix class */
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE>
+ class Matrix;
+
+ /*! \brief An STL-compliant const forward iterator for Matrix.
+ *
+ * Provides forward iteration over const Matrix objects. See
+ * Josuttis (1999), or some other STL reference, for a full
+ * description of the forward iterator interface.
+ *
+ * \see Matrix
+ * \see matrix_forward_iterator
+ * \see const_matrix_random_access_iterator
+ * \see matrix_random_access_iterator
+ * \see const_matrix_bidirectional_iterator
+ * \see matrix_bidirectional_iterator
+ */
+
+ template <typename T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style M_STYLE>
+ class const_matrix_forward_iterator
+ : public std::iterator<std::forward_iterator_tag, T_type>
+ {
+ public:
+ /**** TYPEDEFS ***/
+ typedef const_matrix_forward_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE> self;
+
+ /* These are a little formal, but useful */
+ typedef typename std::iterator_traits<self>::value_type
+ value_type;
+ typedef typename std::iterator_traits<self>::iterator_category
+ iterator_category;
+ typedef typename std::iterator_traits<self>::difference_type
+ difference_type;
+ typedef typename std::iterator_traits<self>::pointer pointer;
+ typedef typename std::iterator_traits<self>::reference reference;
+
+
+ /**** CONSTRUCTORS ****/
+
+ /* Default constructor */
+ const_matrix_forward_iterator ()
+ {}
+
+ /* Standard constructor */
+ const_matrix_forward_iterator
+ (const Matrix<value_type, M_ORDER, M_STYLE> &M)
+ : pos_ (M.getArray()),
+ matrix_ (&M)
+ {
+ SCYTHE_CHECK_30 (pos_ == 0, scythe_null_error,
+ "Requesting iterator to NULL matrix");
+
+ /* The basic story is: when M_STYLE == Concrete and ORDER ==
+ * M_ORDER, we only need pos_ and iteration will be as fast as
+ * possible. All other types of iteration need more variables
+ * to keep track of things and are slower.
+ */
+
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = 0;
+
+ if (ORDER == Col) {
+ lead_length_ = M.rows();
+ lead_inc_ = M.rowstride();
+ trail_inc_ = M.colstride();
+ } else {
+ lead_length_ = M.cols();
+ lead_inc_ = M.colstride();
+ trail_inc_ = M.rowstride();
+ }
+ jump_ = trail_inc_ + (1 - lead_length_) * lead_inc_;
+ vend_ = pos_ + (lead_length_ - 1) * lead_inc_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = M.size();
+ start_ = pos_;
+#endif
+ }
+
+ /* Copy constructor */
+ const_matrix_forward_iterator (const self &mi)
+ : pos_ (mi.pos_),
+ matrix_ (mi.matrix_)
+ {
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ vend_ = mi.vend_;
+ jump_ = mi.jump_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+ start_ = mi.start_;
+#endif
+ }
+
+ /**** EXTRA MODIFIER ****/
+
+ /* This function lets us grab an end iterator quickly, for both
+ * concrete and view matrices. The view code is a bit of a
+ * kludge, but it works.
+ */
+ inline self& set_end ()
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ pos_ = matrix_->getArray() + matrix_->size();
+ } else {
+ offset_ = matrix_->size();
+ }
+
+ return *this;
+ }
+
+ /* Returns the current index (in logical matrix terms) of the
+ * iterator.
+ */
+ unsigned int get_index () const
+ {
+ return offset_;
+ }
+
+ /**** FORWARD ITERATOR FACILITIES ****/
+
+ inline self& operator= (const self& mi)
+ {
+ pos_ = mi.pos_;
+ matrix_ = mi.matrix_;
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ vend_ = mi.vend_;
+ jump_ = mi.jump_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+ start_ = mi.start_;
+#endif
+
+ return *this;
+ }
+
+ inline const reference operator* () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return *pos_;
+ }
+
+ inline const pointer operator-> () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return pos_;
+ }
+
+ inline self& operator++ ()
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER)
+ ++pos_;
+ else {
+ if (pos_ == vend_) {
+ vend_ += trail_inc_;
+ pos_ += jump_;
+ } else {
+ pos_ += lead_inc_;
+ }
+ ++offset_;
+ }
+
+ return *this;
+ }
+
+ inline self operator++ (int)
+ {
+ self tmp = *this;
+ ++(*this);
+ return tmp;
+ }
+
+ /* == is only defined for iterators of the same template type
+ * that point to the same matrix. Behavior for any other
+ * comparison is undefined.
+ *
+ * Note that we have to be careful about iterator comparisons
+ * when working with views and cross-grain iterators.
+ * Specifically, we always have to rely on the offset value.
+ * Obviously, with <> checks pos_ can jump all over the place in
+ * cross-grain iterators, but also end iterators point to the
+ * value after the last in the matrix. In some cases, the
+ * equation in += and -= will actually put pos_ inside the
+ * matrix (often in an early position) in this case.
+ */
+ inline bool operator== (const self& x) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ return pos_ == x.pos_;
+ } else {
+ return offset_ == x.offset_;
+ }
+ }
+
+ /* Again, != is only officially defined for iterators over the
+ * same matrix although the test will be trivially true for
+ * matrices that don't view the same data, by implementation.
+ */
+ inline bool operator!= (const self &x) const
+ {
+ return !(*this == x);
+ }
+
+ protected:
+
+ /**** INSTANCE VARIABLES ****/
+ T_type* pos_; // pointer to current position in array
+ T_type *vend_; // pointer to end of current vector
+
+ uint offset_; // logical offset into matrix
+
+ // TODO Some of these can probably be uints
+ int lead_length_; // Logical length of leading dimension
+ int lead_inc_; // Memory distance between vectors in ldim
+ int trail_inc_; // Memory distance between vectors in tdim
+ int jump_; // Memory distance between end of one ldim vector and
+ // begin of next
+ // Pointer to the matrix we're iterating over. This is really
+ // only needed to get variables necessary to set the end.
+ // TODO Handle this more cleanly.
+ const Matrix<T_type, M_ORDER, M_STYLE>* matrix_;
+ // Size variable for range checking
+#if SCYTHE_DEBUG > 2
+ uint size_; // Logical matrix size
+ T_type* start_; // Not normally needed, but used for bound check
+#endif
+ };
+
+ /*! \brief An STL-compliant forward iterator for Matrix.
+ *
+ * Provides forward iteration over Matrix objects. See
+ * Josuttis (1999), or some other STL reference, for a full
+ * description of the forward iterator interface.
+ *
+ * \see Matrix
+ * \see const_matrix_forward_iterator
+ * \see const_matrix_random_access_iterator
+ * \see matrix_random_access_iterator
+ * \see const_matrix_bidirectional_iterator
+ * \see matrix_bidirectional_iterator
+ */
+ template <typename T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style M_STYLE>
+ class matrix_forward_iterator
+ : public const_matrix_forward_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE>
+ {
+ /**** TYPEDEFS ***/
+ typedef matrix_forward_iterator<T_type, ORDER, M_ORDER,
+ M_STYLE> self;
+ typedef const_matrix_forward_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE> Base;
+
+ public:
+ /* These are a little formal, but useful */
+ typedef typename std::iterator_traits<Base>::value_type
+ value_type;
+ typedef typename std::iterator_traits<Base>::iterator_category
+ iterator_category;
+ typedef typename std::iterator_traits<Base>::difference_type
+ difference_type;
+ typedef typename std::iterator_traits<Base>::pointer pointer;
+ typedef typename std::iterator_traits<Base>::reference reference;
+
+
+ /**** CONSTRUCTORS ****/
+
+ /* Default constructor */
+ matrix_forward_iterator ()
+ : Base ()
+ {}
+
+ /* Standard constructor */
+ matrix_forward_iterator (const Matrix<value_type, M_ORDER,
+ M_STYLE> &M)
+ : Base(M)
+ {}
+
+ /* Copy constructor */
+ matrix_forward_iterator (const self &mi)
+ : Base (mi)
+ {}
+
+ /**** EXTRA MODIFIER ****/
+ inline self& set_end ()
+ {
+ Base::set_end();
+ return *this;
+ }
+
+ /**** FORWARD ITERATOR FACILITIES ****/
+
+ /* We have to override a lot of these to get return values
+ * right.*/
+ inline self& operator= (const self& mi)
+ {
+ pos_ = mi.pos_;
+ matrix_ = mi.matrix_;
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ vend_ = mi.vend_;
+ jump_ = mi.jump_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+ start_ = mi.start_;
+#endif
+
+ return *this;
+ }
+
+ inline reference operator* () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return *pos_;
+ }
+
+ inline pointer operator-> () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return pos_;
+ }
+
+ inline self& operator++ ()
+ {
+ Base::operator++();
+ return *this;
+ }
+
+ inline self operator++ (int)
+ {
+ self tmp = *this;
+ ++(*this);
+ return tmp;
+ }
+
+ private:
+ /* Get handles to base members. It boggles the mind */
+ using Base::pos_;
+ using Base::vend_;
+ using Base::offset_;
+ using Base::lead_length_;
+ using Base::lead_inc_;
+ using Base::trail_inc_;
+ using Base::jump_;
+ using Base::matrix_;
+#if SCYTHE_DEBUG > 2
+ using Base::size_;
+ using Base::start_;
+#endif
+ };
+
+} // namespace scythe
+
+#endif /* SCYTHE_MATRIX_ITERATOR_H */
diff --git a/src/matrix_iterator.h b/src/matrix_iterator.h
deleted file mode 100644
index bd4205d..0000000
--- a/src/matrix_iterator.h
+++ /dev/null
@@ -1,1842 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/matrix_iterator.h
- *
- * Provides definitions and implementations of iterators for
- * the Matrix class. These iterators conform to the
- * expectations of functions from the C++ Standard Template
- * Library (STL) which operate over ranges within
- * container-type objects.
- *
- */
-
-#ifndef SCYTHE_MATRIX_ITERATOR_H
-#define SCYTHE_MATRIX_ITERATOR_H
-
-#include <iterator>
-#include <cmath>
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "error.h"
-#include "util.h"
-#include "matrix.h"
-#else
-#include "scythestat/error.h"
-#include "scythestat/util.h"
-#include "scythestat/matrix.h"
-#endif
-
-namespace SCYTHE {
-
- template <class T>
- class Matrix;
-
- template <class T>
- class const_matrix_iterator;
-
- template <class T>
- class matrix_iterator
- : public std::iterator<std::random_access_iterator_tag, T>
- {
- public:
- friend class const_matrix_iterator<T>;
-
- virtual ~matrix_iterator ()
- {
- }
-
- /**** Forward iterator Facilities ****/
-
- // You should define an equals operator of the form:
- // matrix_iterator<T> &operator=(const matrix_iterator &);
- // in extending classes
-
- // Provide read/write access to referent
- inline T &operator* () const
- {
- return matrix_->data_[current_];
- }
-
- // Provide read access to a member (if any) of referent
- inline T *operator-> () const
- {
- return &(matrix_->data_[current_]);
- }
-
- /* Pre and postfix operators: note that the postfix operators
- * return non-reference values and therefore aren't technically
- * part of the interface because only pointers or references may
- * be covariant return values.
- */
-
- virtual matrix_iterator<T> &operator++ () = 0;
-
- //virtual matrix_iterator<T> operator++ (int) = 0;
-
- /**** Bidirectional Iterator Facilities ****/
-
- virtual matrix_iterator<T> &operator-- () = 0;
-
- //virtual matrix_iterator<T> operator-- (int) = 0;
-
- /**** Random Access Iterator Facilities ****/
-
- virtual T &operator[] (const int &) const = 0;
-
- virtual matrix_iterator<T> &operator+= (const int &) = 0;
-
- virtual matrix_iterator<T> &operator-= (const int &) = 0;
-
- // Extending classes should provide a distance operator of the
- // form:
- // std::ptrdiff_t operator- (const matrix_iterator<T> &rmi)
-
-
- /**** Matrix Iterator Facilities ****/
-
- virtual matrix_iterator<T> &plus_vec () = 0;
-
- virtual matrix_iterator<T> &plus_vec (const int &) = 0;
-
- virtual matrix_iterator<T> &minus_vec () = 0;
-
- virtual matrix_iterator<T> &minus_vec (const int &) = 0;
-
- virtual matrix_iterator<T> &next_vec () = 0;
-
- virtual matrix_iterator<T> &next_vec (const int &) = 0;
-
- virtual matrix_iterator<T> &prev_vec () = 0;
-
- virtual matrix_iterator<T> &prev_vec (const int &) = 0;
-
- /**** Figure out our current index ****/
- int get_row() const
- {
- return (int) (current_ / matrix_->cols());
- }
-
- int get_col() const
- {
- int row = (int) (current_ / matrix_->cols());
- return (current_ - (row * matrix_->cols()));
- }
-
- int get_index () const
- {
- return current_;
- }
-
- protected:
- matrix_iterator()
- : matrix_ (0),
- current_ (0)
- {
- }
-
- explicit matrix_iterator (Matrix<T> &m)
- : matrix_ (&m),
- current_ (0)
- {
- }
-
- matrix_iterator (const matrix_iterator<T> &mi)
- : matrix_ (mi.matrix_),
- current_ (mi.current_)
- {
- }
-
- Matrix<T> *matrix_;
- int current_;
- };
-
- template <class T>
- class const_matrix_iterator
- : public std::iterator<std::random_access_iterator_tag, T>
- {
- public:
- virtual ~const_matrix_iterator ()
- {
- }
-
- /**** Forward iterator Facilities ****/
-
- // You should define an equals operator of the form:
- // matrix_iterator<T> &operator=(const matrix_iterator &);
- // in extending classes
-
- // Provide read/write access to referent
- inline const T &operator* () const
- {
- return matrix_->data_[current_];
- }
-
- // Provide read access to a member (if any) of referent
- inline const T *operator-> () const
- {
- return &(matrix_->data_[current_]);
- }
-
- /* Pre and postfix operators: note that the postfix operators
- * return non-reference values and therefore aren't technically
- * part of the interface because only pointers or references may
- * be covariant return values.
- */
-
- virtual const_matrix_iterator<T> &operator++ () = 0;
-
- //virtual const_matrix_iterator<T> operator++ (int) = 0;
-
- /**** Bidirectional Iterator Facilities ****/
-
- virtual const_matrix_iterator<T> &operator-- () = 0;
-
- //virtual const_matrix_iterator<T> operator-- (int) = 0;
-
- /**** Random Access Iterator Facilities ****/
-
- virtual const T &operator[] (const int &) const = 0;
-
- virtual const_matrix_iterator<T> &operator+= (const int &) = 0;
-
- virtual const_matrix_iterator<T> &operator-= (const int &) = 0;
-
- // Extending classes should provide a distance operator of the
- // form:
- // std::ptrdiff_t operator- (const const_matrix_iterator<T> &rmi)
-
-
- /**** Matrix Iterator Facilities ****/
-
- virtual const_matrix_iterator<T> &plus_vec () = 0;
-
- virtual const_matrix_iterator<T> &plus_vec (const int &) = 0;
-
- virtual const_matrix_iterator<T> &minus_vec () = 0;
-
- virtual const_matrix_iterator<T> &minus_vec (const int &) = 0;
-
- virtual const_matrix_iterator<T> &next_vec () = 0;
-
- virtual const_matrix_iterator<T> &next_vec (const int &) = 0;
-
- virtual const_matrix_iterator<T> &prev_vec () = 0;
-
- virtual const_matrix_iterator<T> &prev_vec (const int &) = 0;
-
- /**** Figure out our current index ****/
- int get_row() const
- {
- return (int) (current_ / matrix_->cols());
- }
-
- int get_col() const
- {
- int row = (int) (current_ / matrix_->cols());
- return (current_ - (row * matrix_->cols()));
- }
-
- int get_index () const
- {
- return current_;
- }
-
-
- protected:
- const_matrix_iterator()
- : matrix_ (0),
- current_ (0)
- {
- }
-
- explicit const_matrix_iterator (const Matrix<T> &m)
- : matrix_ (&m),
- current_ (0)
- {
- }
-
- const_matrix_iterator (const const_matrix_iterator<T> &mi)
- : matrix_ (mi.matrix_),
- current_ (mi.current_)
- {
- }
-
- const_matrix_iterator (const matrix_iterator<T> &mi)
- : matrix_ (mi.matrix_),
- current_ (mi.current_)
- {
- }
-
- const Matrix<T> *matrix_;
- int current_;
- };
-
- /**** An iterator that does ops in row-major order ****/
- template <class T>
- class row_major_iterator : public matrix_iterator<T>
- {
- public:
-
- /**** Constructors ****/
-
- row_major_iterator ()
- : matrix_iterator<T> ()
- {
- }
-
- explicit row_major_iterator (Matrix<T> &m)
- : matrix_iterator<T> (m)
- {
- }
-
- row_major_iterator (const row_major_iterator &rmi)
- : matrix_iterator<T> (rmi)
- {
- }
-
- virtual ~row_major_iterator ()
- {
- }
-
- /**** Forward Iterator Facilities ****/
-
- // Assignment operator
- inline row_major_iterator<T> &operator= (const
- row_major_iterator &rmi)
- {
- this->matrix_ = rmi.matrix_;
- this->current_ = rmi.current_;
-
- return *this;
- }
-
- // Step forward, return new position
- inline row_major_iterator<T> &operator++ ()
- {
- if (this->current_ < this->matrix_->size())
- ++this->current_;
-
- return *this;
- }
-
- // Step forward, return old position
- inline row_major_iterator<T> operator++ (int)
- {
- row_major_iterator<T> temp = *this;
- ++(*this);
-
- return temp;
- }
-
- /**** BiDirectional Iterator Facilities ****/
-
- // Step back, return new position
- inline row_major_iterator<T> &operator-- ()
- {
- if (this->current_ > 0)
- --this->current_;
-
- return *this;
- }
-
- // Step back, return old position
- inline row_major_iterator<T> operator-- (int)
- {
- row_major_iterator temp = *this;
- --(*this);
-
- return temp;
- }
-
- /**** Random Access Iterator Facilities ****/
-
- // Provide access to the [nth] element XXX int?
- inline T &operator[] (const int &n) const
- {
- return this->matrix_->data_[n];
- }
-
- // Step n elements
- inline row_major_iterator<T> &operator+= (const int &n)
- {
- if (this->current_ + n > this->matrix_->size())
- this->current_ = this->matrix_->size();
- else if (this->current_ + n < 0)
- this->current_ = 0;
- else
- this->current_ += n;
-
- return *this;
- }
-
- inline row_major_iterator<T> &operator-= (const int &n)
- {
- return (*this += -n);
- }
-
- /* Difference operators (for distance) */
-
- inline std::ptrdiff_t operator-
- (const row_major_iterator<T> &rmi) const
- {
- return this->current_ - rmi.current_;
- }
-
- /**** Matrix Iterator Facilities ****/
-
- // Jump forward the length of a row
- inline row_major_iterator<T> &plus_vec ()
- {
- return (*this += this->matrix_->cols());
- }
-
- // Jump forward the length of a row n times
- inline row_major_iterator<T> &plus_vec (const int &n)
- {
- return (*this += (n * this->matrix_->cols()));
- }
-
- // Jump backward the length of a row
- inline row_major_iterator<T> &minus_vec ()
- {
- return (*this -= this->matrix_->cols());
- }
-
- // Jump backward the length of a row n times
- inline row_major_iterator<T> &minus_vec (const int &n)
- {
- return (*this -= (n * this->matrix_->cols()));
- }
-
- // Jump to the beginnin of the next vector
- inline row_major_iterator<T> &next_vec ()
- {
- int cur_vec = (int) (this->current_ / this->matrix_->cols());
- if (cur_vec + 1 < this->matrix_->rows())
- this->current_ = (cur_vec + 1) * this->matrix_->cols();
- else
- this->current_ = this->matrix_->size();
-
- return *this;
- }
-
- // Jump to the beginning of the nth next vector
- inline row_major_iterator<T> &next_vec (const int &n)
- {
- int cur_vec = (int) (this->current_ / this->matrix_->cols());
- if (cur_vec + n >= this->matrix_->rows())
- this->current_ = this->matrix_->size();
- else if (cur_vec + n <= 0)
- this->current_ = 0;
- else
- this->current_ = (cur_vec + n) * this->matrix_->cols();
-
- return *this;
- }
-
- // Jump to the beginnin of the previous vector
- inline row_major_iterator<T> &prev_vec ()
- {
- int cur_vec = (int) (this->current_ / this->matrix_->cols());
- if (cur_vec > 0)
- this->current_ = (cur_vec - 1) * this->matrix_->cols();
- else
- this->current_ = 0;
-
- return *this;
- }
-
- // Jump to the beginning of the nth previous vector
- inline row_major_iterator<T> &prev_vec (const int &n)
- {
- return (this->next_vec(-n));
- }
-
- friend bool operator== (const row_major_iterator<T> &a,
- const row_major_iterator<T> &b)
- {
- if (a.current_ == b.current_ && a.matrix_ == b.matrix_)
- return true;
-
- return false;
- }
-
- friend bool operator<(const row_major_iterator &a,
- const row_major_iterator &b)
- {
- if (a.matrix_ != b.matrix_)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- "< Comparison on iterators to different matrices");
-
- if (a.current_ < b.current_)
- return true;
-
- return false;
- }
-
- };
-
- template <class T>
- class const_row_major_iterator : public const_matrix_iterator<T>
- {
- public:
-
- /**** Constructors ****/
-
- const_row_major_iterator ()
- : const_matrix_iterator<T> ()
- {
- }
-
- explicit const_row_major_iterator (const Matrix<T> &m)
- : const_matrix_iterator<T> (m)
- {
- }
-
- const_row_major_iterator (const const_row_major_iterator<T> &rmi)
- : const_matrix_iterator<T> (rmi)
- {
- }
-
- const_row_major_iterator (const row_major_iterator<T> &rmi)
- : const_matrix_iterator<T> (rmi)
- {
- }
-
- virtual ~const_row_major_iterator ()
- {
- }
-
- /**** Forward Iterator Facilities ****/
-
- // Assignment operator
- inline const_row_major_iterator<T> &operator= (const
- const_row_major_iterator &rmi)
- {
- this->matrix_ = rmi.matrix_;
- this->current_ = rmi.current_;
-
- return *this;
- }
-
- // Step forward, return new position
- inline const_row_major_iterator<T> &operator++ ()
- {
- if (this->current_ < this->matrix_->size())
- ++this->current_;
-
- return *this;
- }
-
- // Step forward, return old position
- inline const_row_major_iterator<T> operator++ (int)
- {
- row_major_iterator<T> temp = *this;
- ++(*this);
-
- return temp;
- }
-
- /**** BiDirectional Iterator Facilities ****/
-
- // Step back, return new position
- inline const_row_major_iterator<T> &operator-- ()
- {
- if (this->current_ > 0)
- --this->current_;
-
- return *this;
- }
-
- // Step back, return old position
- inline const_row_major_iterator<T> operator-- (int)
- {
- const_row_major_iterator temp = *this;
- --(*this);
-
- return temp;
- }
-
- /**** Random Access Iterator Facilities ****/
-
- // Provide access to the [nth] element XXX int?
- inline const T &operator[] (const int &n) const
- {
- return this->matrix_->data_[n];
- }
-
- // Step n elements
- inline const_row_major_iterator<T> &operator+= (const int &n)
- {
- if (this->current_ + n > this->matrix_->size())
- this->current_ = this->matrix_->size();
- else if (this->current_ + n < 0)
- this->current_ = 0;
- else
- this->current_ += n;
-
- return *this;
- }
-
- inline const_row_major_iterator<T> &operator-= (const int &n)
- {
- return (*this += -n);
- }
-
- /* Difference operators (for distance) */
-
- inline std::ptrdiff_t operator-
- (const const_row_major_iterator<T> &rmi) const
- {
- return this->current_ - rmi.current_;
- }
-
- /**** Matrix Iterator Facilities ****/
-
- // Jump forward the length of a row
- inline const_row_major_iterator<T> &plus_vec ()
- {
- return (*this += this->matrix_->cols());
- }
-
- // Jump forward the length of a row n times
- inline const_row_major_iterator<T> &plus_vec (const int &n)
- {
- return (*this += (n * this->matrix_->cols()));
- }
-
- // Jump backward the length of a row
- inline const_row_major_iterator<T> &minus_vec ()
- {
- return (*this -= this->matrix_->cols());
- }
-
- // Jump backward the length of a row n times
- inline const_row_major_iterator<T> &minus_vec (const int &n)
- {
- return (*this -= (n * this->matrix_->cols()));
- }
-
- // Jump to the beginnin of the next vector
- inline const_row_major_iterator<T> &next_vec ()
- {
- int cur_vec = (int) (this->current_ / this->matrix_->cols());
- if (cur_vec + 1 < this->matrix_->rows())
- this->current_ = (cur_vec + 1) * this->matrix_->cols();
- else
- this->current_ = this->matrix_->size();
-
- return *this;
- }
-
- // Jump to the beginning of the nth next vector
- inline const_row_major_iterator<T> &next_vec (const int &n)
- {
- int cur_vec = (int) (this->current_ / this->matrix_->cols());
- if (cur_vec + n >= this->matrix_->rows())
- this->current_ = this->matrix_->size();
- else if (cur_vec + n <= 0)
- this->current_ = 0;
- else
- this->current_ = (cur_vec + n) * this->matrix_->cols();
-
- return *this;
- }
-
- // Jump to the beginnin of the previous vector
- inline const_row_major_iterator<T> &prev_vec ()
- {
- int cur_vec = (int) (this->current_ / this->matrix_->cols());
- if (cur_vec > 0)
- this->current_ = (cur_vec - 1) * this->matrix_->cols();
- else
- this->current_ = 0;
-
- return *this;
- }
-
- // Jump to the beginning of the nth previous vector
- inline const_row_major_iterator<T> &prev_vec (const int &n)
- {
- return (this->next_vec(-n));
- }
-
- friend bool operator== (const const_row_major_iterator<T> &a,
- const const_row_major_iterator<T> &b)
- {
- if (a.current_ == b.current_ && a.matrix_ == b.matrix_)
- return true;
-
- return false;
- }
-
- friend bool operator<(const const_row_major_iterator &a,
- const const_row_major_iterator &b)
- {
- if (a.matrix_ != b.matrix_)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- "< Comparison on iterators to different matrices");
-
- if (a.current_ < b.current_)
- return true;
-
- return false;
- }
-
- };
-
- /**** An iterator that does ops in col-major order ****/
- template <class T>
- class col_major_iterator : public matrix_iterator<T>
- {
- public:
-
- /**** Constructors ****/
-
- col_major_iterator ()
- : matrix_iterator<T> ()
- {
- }
-
- explicit col_major_iterator (Matrix<T> &m)
- : matrix_iterator<T> (m)
- {
- }
-
- col_major_iterator (const col_major_iterator &cmi)
- : matrix_iterator<T> (cmi)
- {
- }
-
- virtual ~col_major_iterator ()
- {
- }
-
- /**** Forward Iterator Facilities ****/
-
- // Assignment operator
- inline col_major_iterator<T> &operator= (const
- col_major_iterator &cmi)
- {
- this->matrix_ = cmi.matrix_;
- this->current_ = cmi.current_;
-
- return *this;
- }
-
- // Step forward, return new position
- inline col_major_iterator<T> &operator++ ()
- {
- if (this->current_ >= this->matrix_->cols() * (this->matrix_->rows() - 1)) {
- if (this->current_ >= this->matrix_->size() - 1)
- this->current_ = this->matrix_->size();
- else
- this->current_ = (this->current_ + 1) -
- (this->matrix_->rows() - 1) * this->matrix_->cols();
- } else
- this->current_ += this->matrix_->cols();
-
- return *this;
- }
-
- // Step forward, return old position
- inline col_major_iterator<T> operator++ (int)
- {
- col_major_iterator<T> temp = *this;
- ++(*this);
- return temp;
- }
-
- /**** BiDirectional Iterator Facilities ****/
-
- // Step back, return new position
- inline col_major_iterator<T> &operator-- ()
- {
- if (this->current_ > 0) {
- if (this->current_ == this->matrix_->size())
- --this->current_;
- else if (this->current_ < this->matrix_->cols()) {
- this->current_ = (this->current_ - 1) +
- (this->matrix_->rows() - 1) * this->matrix_->cols();
- } else
- this->current_ -= this->matrix_->cols();
- }
-
- return *this;
- }
-
- // Step back, return old position
- inline col_major_iterator<T> operator-- (int)
- {
- col_major_iterator temp = *this;
- --(*this);
- return temp;
- }
-
- /**** Random Access Iterator Facilities ****/
-
- // Provide access to the [nth] element XXX int?
- inline T &operator[] (const int &n) const
- {
- int col = (int) (n / this->matrix_->rows());
- int row = n - (col * this->matrix_->rows());
-
- return this->matrix_->data_[row * this->matrix_->cols_ + col];
- }
-
- // Step n elements
- inline col_major_iterator<T> &operator+= (const int &n)
- {
- int cm;
-
- if (this->current_ == this->matrix_->size())
- cm = this->current_;
- else {
- int row = (int) (this->current_ / this->matrix_->cols());
- int col = this->current_ - (row * this->matrix_->cols());
- cm = col * this->matrix_->rows() + row;
- }
-
- cm += n;
-
- if (cm >= this->matrix_->size())
- this->current_ = this->matrix_->size();
- else if (cm <= 0)
- this->current_ = 0;
- else {
- int col = (int) (cm / this->matrix_->rows());
- int row = cm - (col * this->matrix_->rows());
- this->current_ = row * this->matrix_->cols() + col;
- }
-
- return *this;
- }
-
- inline col_major_iterator<T> &operator-= (const int &n)
- {
- return (*this += -n);
- }
-
- /* Difference operators (for distance) */
-
- inline std::ptrdiff_t operator-
- (const col_major_iterator<T> &cmi) const
- {
- int cm, bcm;
- if (this->current_ == this->matrix_->size())
- cm = this->current_;
- else {
- int row = (int) (this->current_ / this->matrix_->cols());
- int col = this->current_ - (row * this->matrix_->cols());
- cm = col * this->matrix_->rows() + row;
- }
-
- if (cmi.current_ == this->matrix_->size())
- bcm = cmi.current_;
- else {
- int brow = (int) (cmi.current_ / this->matrix_->cols());
- int bcol = cmi.current_ - (brow * this->matrix_->cols());
- bcm = bcol * this->matrix_->rows() + brow;
- }
-
- return cm - bcm;
- }
-
- /**** Matrix Iterator Facilities ****/
-
- // Jump forward the length of a row
- inline col_major_iterator<T> &plus_vec ()
- {
- return (*this += this->matrix_->rows());
- }
-
- // Jump forward the length of a row n times
- inline col_major_iterator<T> &plus_vec (const int &n)
- {
- return (*this += (n * this->matrix_->rows()));
- }
-
- // Jump backward the length of a row
- inline col_major_iterator<T> &minus_vec ()
- {
- return (*this -= this->matrix_->rows());
- }
-
- // Jump backward the length of a row n times
- inline col_major_iterator<T> &minus_vec (const int &n)
- {
- return (*this -= (n * this->matrix_->rows()));
- }
-
- // Jump to the beginnin of the next vector
- inline col_major_iterator<T> &next_vec ()
- {
- int col = (int) (this->current_ -
- ((int) (this->current_ / this->matrix_->cols()) * this->matrix_->cols()));
- if (col + 1 < this->matrix_->cols())
- this->current_ = col + 1;
- else
- this->current_ = this->matrix_->size();
-
- return *this;
- }
-
- // Jump to the beginning of the nth next vector
- inline col_major_iterator<T> &next_vec (const int &n)
- {
- int col = (int) (this->current_ -
- ((int) (this->current_ / this->matrix_->cols()) * this->matrix_->cols()));
- if (col + n >= this->matrix_->cols())
- this->current_ = this->matrix_->size();
- else if (col + n <= 0)
- this->current_ = 0;
- else
- this->current_ = col + n;
-
- return *this;
- }
-
- // Jump to the beginnin of the previous vector
- inline col_major_iterator<T> &prev_vec ()
- {
- int col = (int) (this->current_ -
- ((int) (this->current_ / this->matrix_->cols()) * this->matrix_->cols()));
- if (col - 1 > 0)
- this->current_ = col - 1;
- else
- this->current_ = 0;
-
- return *this;
- }
-
- // Jump to the beginning of the nth previous vector
- inline col_major_iterator<T> &prev_vec (const int &n)
- {
- return (this->next_vec(-n));
- }
-
- friend bool operator== (const col_major_iterator<T> &a,
- const col_major_iterator<T> &b)
- {
- if (a.current_ == b.current_ && a.matrix_ == b.matrix_)
- return true;
-
- return false;
- }
-
- friend bool operator<(const col_major_iterator &a,
- const col_major_iterator &b)
- {
- if (a.matrix_ != b.matrix_)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- "< Comparison on iterators to different matrices");
-
-
- int cm, bcm;
- if (a.current_ == a.matrix_->size())
- cm = a.current_;
- else {
- int row = (int) (a.current_ / a.matrix_->cols());
- int col = a.current_ - (row * a.matrix_->cols());
- cm = col * a.matrix_->rows() + row;
- }
-
- if (b.current_ == a.matrix_->size())
- bcm = b.current_;
- else {
- int brow = (int) (b.current_ / a.matrix_->cols());
- int bcol = b.current_ - (brow * a.matrix_->cols());
- bcm = bcol * a.matrix_->rows() + brow;
- }
-
- if (cm < bcm)
- return true;
-
- return false;
- }
-
- };
-
- template <class T>
- class const_col_major_iterator : public const_matrix_iterator<T>
- {
- public:
-
- /**** Constructors ****/
-
- const_col_major_iterator ()
- : const_matrix_iterator<T> ()
- {
- }
-
- explicit const_col_major_iterator (const Matrix<T> &m)
- : const_matrix_iterator<T> (m)
- {
- }
-
- const_col_major_iterator (const const_col_major_iterator<T> &cmi)
- : const_matrix_iterator<T> (cmi)
- {
- }
-
- const_col_major_iterator (const col_major_iterator<T> &cmi)
- : const_matrix_iterator<T> (cmi)
- {
- }
-
- virtual ~const_col_major_iterator ()
- {
- }
-
- /**** Forward Iterator Facilities ****/
-
- // Assignment operator
- inline const_col_major_iterator<T> &operator= (const
- const_col_major_iterator &cmi)
- {
- this->matrix_ = cmi.matrix_;
- this->current_ = cmi.current_;
-
- return *this;
- }
-
- // Step forward, return new position
- inline const_col_major_iterator<T> &operator++ ()
- {
- if (this->current_ >= this->matrix_->cols() * (this->matrix_->rows() - 1)) {
- if (this->current_ >= this->matrix_->size() - 1)
- this->current_ = this->matrix_->size();
- else
- this->current_ = (this->current_ + 1) -
- (this->matrix_->rows() - 1) * this->matrix_->cols();
- } else
- this->current_ += this->matrix_->cols();
-
- return *this;
- }
-
- // Step forward, return old position
- inline const_col_major_iterator<T> operator++ (int)
- {
- col_major_iterator<T> temp = *this;
- ++(*this);
- return temp;
- }
-
- /**** BiDirectional Iterator Facilities ****/
-
- // Step back, return new position
- inline const_col_major_iterator<T> &operator-- ()
- {
- if (this->current_ > 0) {
- if (this->current_ == this->matrix_->size())
- --this->current_;
- else if (this->current_ < this->matrix_->cols()) {
- this->current_ = (this->current_ - 1) +
- (this->matrix_->rows() - 1) * this->matrix_->cols();
- } else
- this->current_ -= this->matrix_->cols();
- }
-
- return *this;
- }
-
- // Step back, return old position
- inline const_col_major_iterator<T> operator-- (int)
- {
- const_col_major_iterator temp = *this;
- --(*this);
- return temp;
- }
-
- /**** Random Access Iterator Facilities ****/
-
- // Provide access to the [nth] element XXX int?
- inline const T &operator[] (const int &n) const
- {
- int col = (int) (n / this->matrix_->rows());
- int row = n - (col * this->matrix_->rows());
-
- return this->matrix_->data_[row * this->matrix_->cols_ + col];
- }
-
- // Step n elements
- inline const_col_major_iterator<T> &operator+= (const int &n)
- {
- int cm;
-
- if (this->current_ == this->matrix_->size())
- cm = this->current_;
- else {
- int row = (int) (this->current_ / this->matrix_->cols());
- int col = this->current_ - (row * this->matrix_->cols());
- cm = col * this->matrix_->rows() + row;
- }
-
- cm += n;
-
- if (cm >= this->matrix_->size())
- this->current_ = this->matrix_->size();
- else if (cm <= 0)
- this->current_ = 0;
- else {
- int col = (int) (cm / this->matrix_->rows());
- int row = cm - (col * this->matrix_->rows());
- this->current_ = row * this->matrix_->cols() + col;
- }
-
- return *this;
- }
-
- inline const_col_major_iterator<T> &operator-= (const int &n)
- {
- return (*this += -n);
- }
-
- /* Difference operators (for distance) */
-
- inline std::ptrdiff_t operator-
- (const const_col_major_iterator<T> &cmi) const
- {
- int cm, bcm;
- if (this->current_ == this->matrix_->size())
- cm = this->current_;
- else {
- int row = (int) (this->current_ / this->matrix_->cols());
- int col = this->current_ - (row * this->matrix_->cols());
- cm = col * this->matrix_->rows() + row;
- }
-
- if (cmi.current_ == this->matrix_->size())
- bcm = cmi.current_;
- else {
- int brow = (int) (cmi.current_ / this->matrix_->cols());
- int bcol = cmi.current_ - (brow * this->matrix_->cols());
- bcm = bcol * this->matrix_->rows() + brow;
- }
-
- return cm - bcm;
- }
-
- /**** Matrix Iterator Facilities ****/
-
- // Jump forward the length of a row
- inline const_col_major_iterator<T> &plus_vec ()
- {
- return (*this += this->matrix_->rows());
- }
-
- // Jump forward the length of a row n times
- inline const_col_major_iterator<T> &plus_vec (const int &n)
- {
- return (*this += (n * this->matrix_->rows()));
- }
-
- // Jump backward the length of a row
- inline const_col_major_iterator<T> &minus_vec ()
- {
- return (*this -= this->matrix_->rows());
- }
-
- // Jump backward the length of a row n times
- inline const_col_major_iterator<T> &minus_vec (const int &n)
- {
- return (*this -= (n * this->matrix_->rows()));
- }
-
- // Jump to the beginnin of the next vector
- inline const_col_major_iterator<T> &next_vec ()
- {
- int col = (int) (this->current_ -
- ((int)(this->current_ / this->matrix_->cols()) * this->matrix_->cols()));
- if (col + 1 < this->matrix_->cols())
- this->current_ = col + 1;
- else
- this->current_ = this->matrix_->size();
-
- return *this;
- }
-
- // Jump to the beginning of the nth next vector
- inline const_col_major_iterator<T> &next_vec (const int &n)
- {
- int col = (int) (this->current_ -
- ((int)(this->current_ / this->matrix_->cols()) * this->matrix_->cols()));
- if (col + n >= this->matrix_->cols())
- this->current_ = this->matrix_->size();
- else if (col + n <= 0)
- this->current_ = 0;
- else
- this->current_ = col + n;
-
- return *this;
- }
-
- // Jump to the beginnin of the previous vector
- inline const_col_major_iterator<T> &prev_vec ()
- {
- int col = (int) (this->current_ -
- ((int)(this->current_ / this->matrix_->cols()) * this->matrix_->cols()));
- if (col - 1 > 0)
- this->current_ = col - 1;
- else
- this->current_ = 0;
-
- return *this;
- }
-
- // Jump to the beginning of the nth previous vector
- inline const_col_major_iterator<T> &prev_vec (const int &n)
- {
- return (this->next_vec(-n));
- }
-
- friend bool operator== (const const_col_major_iterator<T> &a,
- const const_col_major_iterator<T> &b)
- {
- if (a.current_ == b.current_ && a.matrix_ == b.matrix_)
- return true;
-
- return false;
- }
-
- friend bool operator<(const const_col_major_iterator &a,
- const const_col_major_iterator &b)
- {
- if (a.matrix_ != b.matrix_)
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__,
- "< Comparison on iterators to different matrices");
-
-
- int cm, bcm;
- if (a.current_ == a.matrix_->size())
- cm = a.current_;
- else {
- int row = (int) (a.current_ / a.matrix_->cols());
- int col = a.current_ - (row * a.matrix_->cols());
- cm = col * a.matrix_->rows() + row;
- }
-
- if (b.current_ == a.matrix_->size())
- bcm = b.current_;
- else {
- int brow = (int) (b.current_ / a.matrix_->cols());
- int bcol = b.current_ - (brow * a.matrix_->cols());
- bcm = bcol * a.matrix_->rows() + brow;
- }
-
- if (cm < bcm)
- return true;
-
- return false;
- }
-
- };
-
- /* reverse iterator adapters */
- template <class T>
- class reverse_row_major_iterator : public row_major_iterator<T>
- {
- public:
-
- /**** Constructors ****/
- reverse_row_major_iterator ()
- : row_major_iterator<T> ()
- {
- }
- explicit reverse_row_major_iterator (Matrix<T> &m)
- : row_major_iterator<T> (m)
- {
- }
-
- reverse_row_major_iterator
- (const row_major_iterator<T> &rmi)
- : row_major_iterator<T> (rmi)
- {
- }
-
- virtual ~reverse_row_major_iterator ()
- {
- }
-
- /* Let people get a row_major_iterator by the standard */
- inline row_major_iterator<T> base () const
- {
- row_major_iterator<T> temp = *this;
- if (this->current_ == this->matrix_->size())
- temp -= this->matrix_->size();
- else if (this->current_ == 0)
- temp += this->matrix_->size();
- else {
- temp += this->matrix_->size();
- temp -= this->current_;
- }
-
- return temp;
- }
-
- /* Override these to get correct r-iter behavior */
- inline T &operator* () const
- {
- if (this->current_ == this->matrix_->size())
- return this->matrix_->data_[this->matrix_->size()];
-
- return this->matrix_->data_[this->matrix_->size() - this->current_ - 1];
- }
-
- inline T *operator-> () const
- {
- if (this->current_ == this->matrix_->size())
- return &(this->matrix_->data_[this->matrix_->size()]);
-
- return &(this->matrix_->data_[this->matrix_->size() - this->current_ - 1]);
- }
-
- /* These need overriding cause of the whole off-by-one issue
- * with reverse iterators
- */
- int get_row() const
- {
- if (this->current_ == 0)
- return (int) ((this->matrix_->size() - 1) / this->matrix_->cols());
- else if (this->current_ == this->matrix_->size())
- return 0;
-
- int cur = this->matrix_->size() - this->current_ - 1;
-
- return (int) (cur / this->matrix_->cols());
- }
-
- int get_col() const
- {
- if (this->current_ == 0)
- return (int) ((this->matrix_->size() - 1) / this->matrix_->rows());
- else if (this->current_ == this->matrix_->size())
- return 0;
-
- int cur = this->matrix_->size() - this->current_ - 1;
- int row = (int) (cur / this->matrix_->cols());
- return (cur - (row * this->matrix_->cols()));
- }
-
- int get_index () const
- {
- if (this->current_ == 0)
- return this->matrix_->size() - 1;
-
- return this->matrix_->size() - this->current_ - 1;
- }
- };
-
- template <class T>
- class const_reverse_row_major_iterator :
- public const_row_major_iterator<T>
- {
- public:
-
- /**** Constructors ****/
- const_reverse_row_major_iterator ()
- : const_row_major_iterator<T> ()
- {
- }
- explicit const_reverse_row_major_iterator (const Matrix<T> &m)
- : const_row_major_iterator<T> (m)
- {
- }
-
- const_reverse_row_major_iterator
- (const const_row_major_iterator<T> &rmi)
- : const_row_major_iterator<T> (rmi)
- {
- }
-
- virtual ~const_reverse_row_major_iterator ()
- {
- }
-
- /* Let people get a row_major_iterator by the standard */
- inline const_row_major_iterator<T> base () const
- {
- const_row_major_iterator<T> temp = *this;
- if (this->current_ == this->matrix_->size())
- temp -= this->matrix_->size();
- else if (this->current_ == 0)
- temp += this->matrix_->size();
- else {
- temp += this->matrix_->size();
- temp -= this->current_;
- }
-
- return temp;
- }
-
- /* Override these to get correct r-iter behavior */
- inline T &operator* () const
- {
- if (this->current_ == this->matrix_->size())
- return this->matrix_->data_[this->matrix_->size()];
-
- return this->matrix_->data_[this->matrix_->size() - this->current_ - 1];
- }
-
- inline T *operator-> () const
- {
- if (this->current_ == this->matrix_->size())
- return &(this->matrix_->data_[this->matrix_->size()]);
-
- return &(this->matrix_->data_[this->matrix_->size() - this->current_ - 1]);
- }
-
- /* These need overriding cause of the whole off-by-one issue
- * with reverse iterators
- */
- int get_row() const
- {
- if (this->current_ == 0)
- return (int) ((this->matrix_->size() - 1) / this->matrix_->cols());
- else if (this->current_ == this->matrix_->size())
- return 0;
-
- int cur = this->matrix_->size() - this->current_ - 1;
-
- return (int) (cur / this->matrix_->cols());
- }
-
- int get_col() const
- {
- if (this->current_ == 0)
- return (int) ((this->matrix_->size() - 1) / this->matrix_->rows());
- else if (this->current_ == this->matrix_->size())
- return 0;
-
- int cur = this->matrix_->size() - this->current_ - 1;
- int row = (int) (cur / this->matrix_->cols());
- return (cur - (row * this->matrix_->cols()));
- }
-
- int get_index () const
- {
- if (this->current_ == 0)
- return this->matrix_->size() - 1;
-
- return this->matrix_->size() - this->current_ - 1;
- }
- };
-
- template <class T>
- class reverse_col_major_iterator : public col_major_iterator<T>
- {
- public:
-
- /**** Constructors ****/
- reverse_col_major_iterator ()
- : col_major_iterator<T> ()
- {
- }
- explicit reverse_col_major_iterator (Matrix<T> &m)
- : col_major_iterator<T> (m)
- {
- }
-
- reverse_col_major_iterator
- (const col_major_iterator<T> &rmi)
- : col_major_iterator<T> (rmi)
- {
- }
-
- virtual ~reverse_col_major_iterator ()
- {
- }
-
- /* Let people get a row_major_iterator by the standard */
- inline col_major_iterator<T> base () const
- {
- col_major_iterator<T> temp = *this;
- --temp;
- if (this->current_ == this->matrix_->size())
- temp -= this->matrix_->size();
- else if (this->current_ == 0)
- temp += this->matrix_->size();
- else {
- temp += this->matrix_->size();
- temp -= this->current_;
- }
-
- return temp;
- }
-
- /* Override these to get correct r-iter behavior */
- inline T &operator* () const
- {
- if (this->current_ == this->matrix_->size())
- return this->matrix_->data_[this->matrix_->size()];
-
- return this->matrix_->data_[this->matrix_->size() - this->current_ - 1];
- }
-
- inline T *operator-> () const
- {
- if (this->current_ == this->matrix_->size())
- return &(this->matrix_->data_[this->matrix_->size()]);
-
- return &(this->matrix_->data_[this->matrix_->size() - this->current_ - 1]);
- }
-
- /* These need overriding cause of the whole off-by-one issue
- * with reverse iterators
- */
- int get_row() const
- {
- if (this->current_ == 0)
- return (int) ((this->matrix_->size() - 1) / this->matrix_->cols());
- else if (this->current_ == this->matrix_->size())
- return 0;
-
- int cur = this->matrix_->size() - this->current_ - 1;
-
- return (int) (cur / this->matrix_->cols());
- }
-
- int get_col() const
- {
- if (this->current_ == 0)
- return (int) ((this->matrix_->size() - 1) / this->matrix_->rows());
- else if (this->current_ == this->matrix_->size())
- return 0;
-
- int cur = this->matrix_->size() - this->current_ - 1;
- int row = (int) (cur / this->matrix_->cols());
- return (cur - (row * this->matrix_->cols()));
- }
-
- int get_index () const
- {
- if (this->current_ == 0)
- return this->matrix_->size() - 1;
-
- return this->matrix_->size() - this->current_ - 1;
- }
- };
-
- template <class T>
- class const_reverse_col_major_iterator :
- public const_col_major_iterator<T>
- {
- public:
-
- /**** Constructors ****/
- const_reverse_col_major_iterator ()
- : const_col_major_iterator<T> ()
- {
- }
- explicit const_reverse_col_major_iterator (const Matrix<T> &m)
- : const_col_major_iterator<T> (m)
- {
- }
-
- const_reverse_col_major_iterator
- (const const_col_major_iterator<T> &rmi)
- : const_col_major_iterator<T> (rmi)
- {
- }
-
- virtual ~const_reverse_col_major_iterator ()
- {
- }
-
- /* Let people get a row_major_iterator by the standard */
- inline const_col_major_iterator<T> base () const
- {
- const_col_major_iterator<T> temp = *this;
- --temp;
- if (this->current_ == this->matrix_->size())
- temp -= this->matrix_->size();
- else if (this->current_ == 0)
- temp += this->matrix_->size();
- else {
- temp += this->matrix_->size();
- temp -= this->current_;
- }
-
- return temp;
- }
-
- inline T &operator* () const
- {
- if (this->current_ == this->matrix_->size())
- return this->matrix_->data_[this->matrix_->size()];
-
- return this->matrix_->data_[this->matrix_->size() - this->current_ - 1];
- }
-
- inline T *operator-> () const
- {
- if (this->current_ == this->matrix_->size())
- return &(this->matrix_->data_[this->matrix_->size()]);
-
- return &(this->matrix_->data_[this->matrix_->size() - this->current_ - 1]);
- }
-
- /* These need overriding cause of the whole off-by-one issue
- * with reverse iterators
- */
- int get_row() const
- {
- if (this->current_ == 0)
- return (int) ((this->matrix_->size() - 1) / this->matrix_->cols());
- else if (this->current_ == this->matrix_->size())
- return 0;
-
- int cur = this->matrix_->size() - this->current_ - 1;
-
- return (int) (cur / this->matrix_->cols());
- }
-
- int get_col() const
- {
- if (this->current_ == 0)
- return (int) ((this->matrix_->size() - 1) / this->matrix_->rows());
- else if (this->current_ == this->matrix_->size())
- return 0;
-
- int cur = this->matrix_->size() - this->current_ - 1;
- int row = (int) (cur / this->matrix_->cols());
- return (cur - (row * this->matrix_->cols()));
- }
-
- int get_index () const
- {
- if (this->current_ == 0)
- return this->matrix_->size() - 1;
-
- return this->matrix_->size() - this->current_ - 1;
- }
- };
-
- template <class T>
- inline bool operator!= (const const_row_major_iterator<T> &a,
- const const_row_major_iterator<T> &b)
- {
- return ! (a == b);
- }
-
- template <class T>
- inline bool operator!= (const const_col_major_iterator<T> &a,
- const const_col_major_iterator<T> &b)
- {
- return ! (a == b);
- }
-
- template <class T>
- inline bool operator!= (const row_major_iterator<T> &a,
- const row_major_iterator<T> &b)
- {
- return ! (a == b);
- }
-
- template <class T>
- inline bool operator!= (const col_major_iterator<T> &a,
- const col_major_iterator<T> &b)
- {
- return ! (a == b);
- }
-
- template <class T>
- inline bool operator>(const const_row_major_iterator<T> &a,
- const const_row_major_iterator<T> &b)
- {
- return ! (a < b);
- }
-
- template <class T>
- inline bool operator>(const const_col_major_iterator<T> &a,
- const const_col_major_iterator<T> &b)
- {
- return ! (a < b);
- }
-
- template <class T>
- inline bool operator>(const row_major_iterator<T> &a,
- const row_major_iterator<T> &b)
- {
- return ! (a < b);
- }
-
- template <class T>
- inline bool operator>(const col_major_iterator<T> &a,
- const col_major_iterator<T> &b)
- {
- return ! (a < b);
- }
-
- template <class T>
- inline bool operator<= (const const_row_major_iterator<T> &a,
- const const_row_major_iterator<T> &b)
- {
- return (a < b || a == b);
- }
-
- template <class T>
- inline bool operator<= (const const_col_major_iterator<T> &a,
- const const_col_major_iterator<T> &b)
- {
- return (a < b || a == b);
- }
-
- template <class T>
- inline bool operator<= (const row_major_iterator<T> &a,
- const row_major_iterator<T> &b)
- {
- return (a < b || a == b);
- }
-
- template <class T>
- inline bool operator<= (const col_major_iterator<T> &a,
- const col_major_iterator<T> &b)
- {
- return (a < b || a == b);
- }
-
- template <class T>
- inline bool operator>= (const const_row_major_iterator<T> &a,
- const const_row_major_iterator<T> &b)
- {
- return (a > b || a == b);
- }
-
- template <class T>
- inline bool operator>= (const const_col_major_iterator<T> &a,
- const const_col_major_iterator<T> &b)
- {
- return (a > b || a == b);
- }
-
- template <class T>
- inline bool operator>= (const row_major_iterator<T> &a,
- const row_major_iterator<T> &b)
- {
- return (a > b || a == b);
- }
-
- template <class T>
- inline bool operator>= (const col_major_iterator<T> &a,
- const col_major_iterator<T> &b)
- {
- return (a > b || a == b);
- }
-
- /* Non-member arithmetic operators for various iterators */
- template <class T>
- inline row_major_iterator<T> operator+ (row_major_iterator<T> rmi,
- const int &n)
- {
- rmi += n;
- return rmi;
- }
-
- template <class T>
- inline row_major_iterator<T> operator+ (const int &n,
- row_major_iterator<T> rmi)
- {
- rmi += n;
- return rmi;
- }
-
- template <class T>
- inline row_major_iterator<T> operator- (row_major_iterator<T> rmi,
- const int &n)
- {
- rmi -= n;
- return rmi;
- }
-
- template <class T>
- inline col_major_iterator<T> operator+ (col_major_iterator<T> cmi,
- const int &n)
- {
- cmi += n;
- return cmi;
- }
-
- template <class T>
- inline col_major_iterator<T> operator+ (const int &n,
- col_major_iterator<T> cmi)
- {
- cmi += n;
- return cmi;
- }
-
- template <class T>
- inline col_major_iterator<T> operator- (col_major_iterator<T> cmi,
- const int &n)
- {
- cmi -= n;
- return cmi;
- }
-
- template <class T>
- inline const_row_major_iterator<T> operator+
- (const_row_major_iterator<T> rmi, const int &n)
- {
- rmi += n;
- return rmi;
- }
-
- template <class T>
- inline const_row_major_iterator<T> operator+ (const int &n,
- const_row_major_iterator<T> rmi)
- {
- rmi += n;
- return rmi;
- }
-
- template <class T>
- inline const_row_major_iterator<T> operator-
- (const_row_major_iterator<T> rmi, const int &n)
- {
- rmi -= n;
- return rmi;
- }
-
- template <class T>
- inline const_col_major_iterator<T> operator+
- (const_col_major_iterator<T> cmi, const int &n)
- {
- cmi += n;
- return cmi;
- }
-
- template <class T>
- inline const col_major_iterator<T> operator+ (const int &n,
- const_col_major_iterator<T> cmi)
- {
- cmi += n;
- return cmi;
- }
-
- template <class T>
- inline const_col_major_iterator<T> operator-
- (const_col_major_iterator<T> cmi, const int &n)
- {
- cmi -= n;
- return cmi;
- }
-
-} // end namespace SCYTHE
-
-#endif
diff --git a/src/matrix_random_access_iterator.h b/src/matrix_random_access_iterator.h
new file mode 100644
index 0000000..7f5b6fc
--- /dev/null
+++ b/src/matrix_random_access_iterator.h
@@ -0,0 +1,626 @@
+/*
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
+ * information.
+ * --------------------------------------------------------------------
+ * scythestat/matrix_random_access_iterator.h
+ *
+ * Random access iterators for the matrix class.
+ *
+ */
+
+/*! \file matrix_random_access_iterator.h
+ * \brief Definitions of STL-compliant random access iterators for
+ * the Matrix class.
+ *
+ * Contains definitions of const_matrix_random_access_iterator,
+ * matrix_random_access_iterator, and related operators. See a
+ * Standard Template Library reference, such as Josuttis (1999), for a
+ * full description of the capabilities of random access iterators.
+ *
+ * These iterators are templated on the type, order and style of the
+ * Matrix they iterate over and their own order, which need not match
+ * the iterated-over matrix. Same-order iteration over concrete
+ * matrices is extremely fast. Cross-grain concrete and/or view
+ * iteration is slower.
+ */
+
+#ifndef SCYTHE_MATRIX_RANDOM_ACCESS_ITERATOR_H
+#define SCYTHE_MATRIX_RANDOM_ACCESS_ITERATOR_H
+
+#include <iterator>
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "defs.h"
+#include "error.h"
+#include "matrix.h"
+#else
+#include "scythestat/defs.h"
+#include "scythestat/error.h"
+#include "scythestat/matrix.h"
+#endif
+
+/* The const_matrix_iterator and matrix_iterator classes are
+ * essentially identical, except for the return types of the *, ->,
+ * and [] operators. matrix_iterator extends const_matrix_iterator,
+ * overriding most of its members. */
+
+/* TODO Current setup uses template argument based branches to
+ * handle views and cross-grained orderings differently than simple
+ * in-order concrete matrices. The work for this gets done at
+ * compile time, but we end with a few unused instance variables in
+ * the concrete case. It might be better to specialize the entire
+ * class, although this will lead to a lot of code duplication. We
+ * should bench the difference down the road and see if it is worth
+ * the maintenance hassle.
+ *
+ * At the moment this is looking like it won't be worth it.
+ * Iterator-based operations on concretes provide comparable
+ * performance to element-access based routines in previous versions
+ * of the library, indicating little performance penalty.
+ */
+
+namespace scythe {
+ /* convenience typedefs */
+ namespace { // local to this file
+ typedef unsigned int uint;
+ }
+
+ /* forward declaration of the matrix class */
+ template <typename T_type, matrix_order ORDER, matrix_style STYLE>
+ class Matrix;
+
+ /*! \brief An STL-compliant const random access iterator for Matrix.
+ *
+ * Provides random access iteration over const Matrix objects. See
+ * Josuttis (1999), or some other STL reference, for a full
+ * description of the random access iterator interface.
+ *
+ * \see Matrix
+ * \see matrix_random_access_iterator
+ * \see const_matrix_forward_iterator
+ * \see matrix_forward_iterator
+ * \see const_matrix_bidirectional_iterator
+ * \see matrix_bidirectional_iterator
+ */
+
+ template <typename T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style M_STYLE>
+ class const_matrix_random_access_iterator
+ : public std::iterator<std::random_access_iterator_tag, T_type>
+ {
+ public:
+ /**** TYPEDEFS ***/
+ typedef const_matrix_random_access_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE> self;
+
+ /* These are a little formal, but useful */
+ typedef typename std::iterator_traits<self>::value_type
+ value_type;
+ typedef typename std::iterator_traits<self>::iterator_category
+ iterator_category;
+ typedef typename std::iterator_traits<self>::difference_type
+ difference_type;
+ typedef typename std::iterator_traits<self>::pointer pointer;
+ typedef typename std::iterator_traits<self>::reference reference;
+
+
+ /**** CONSTRUCTORS ****/
+
+ /* Default constructor */
+ const_matrix_random_access_iterator ()
+ {}
+
+ /* Standard constructor */
+ const_matrix_random_access_iterator
+ ( const Matrix<value_type, M_ORDER, M_STYLE> &M)
+ : start_ (M.getArray())
+ {
+ SCYTHE_CHECK_30 (start_ == 0, scythe_null_error,
+ "Requesting iterator to NULL matrix");
+ pos_ = start_;
+
+ /* The basic story is: when M_STYLE == Concrete and ORDER ==
+ * M_ORDER, we only need pos_ and start_ and iteration will be
+ * as fast as possible. All other types of iteration need
+ * more variables to keep track of things and are slower.
+ */
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = 0;
+
+ if (ORDER == Col) {
+ lead_length_ = M.rows();
+ lead_inc_ = M.rowstride();
+ trail_inc_ = M.colstride();
+ } else {
+ lead_length_ = M.cols();
+ lead_inc_ = M.colstride();
+ trail_inc_ = M.rowstride();
+ }
+ jump_ = trail_inc_ + (1 - lead_length_) * lead_inc_;
+ }
+
+#if SCYTHE_DEBUG > 2
+ size_ = M.size();
+#endif
+ }
+
+ /* Copy constructor */
+ const_matrix_random_access_iterator (const self &mi)
+ : start_ (mi.start_),
+ pos_ (mi.pos_)
+ {
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ jump_ = mi.jump_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+#endif
+ }
+
+ /**** FORWARD ITERATOR FACILITIES ****/
+
+ inline self& operator= (const self& mi)
+ {
+ start_ = mi.start_;
+ pos_ = mi.pos_;
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ jump_ = mi.jump_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+#endif
+
+ return *this;
+ }
+
+ inline const reference operator* () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return *pos_;
+ }
+
+ inline const pointer operator-> () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return pos_;
+ }
+
+ inline self& operator++ ()
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER)
+ ++pos_;
+ else if (++offset_ % lead_length_ == 0)
+ pos_ += jump_;
+ else
+ pos_ += lead_inc_;
+
+ return *this;
+ }
+
+ inline self operator++ (int)
+ {
+ self tmp = *this;
+ ++(*this);
+ return tmp;
+ }
+
+ /* == is only defined for iterators of the same template type
+ * that point to the same matrix. Behavior for any other
+ * comparison is undefined.
+ *
+ * Note that we have to be careful about iterator comparisons
+ * when working with views and cross-grain iterators.
+ * Specifically, we always have to rely on the offset value.
+ * Obviously, with <> checks pos_ can jump all over the place in
+ * cross-grain iterators, but also end iterators point to the
+ * value after the last in the matrix. In some cases, the
+ * equation in += and -= will actually put pos_ inside the
+ * matrix (often in an early position) in this case.
+ */
+ inline bool operator== (const self& x) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ return pos_ == x.pos_;
+ } else {
+ return offset_ == x.offset_;
+ }
+ }
+
+ /* Again, != is only officially defined for iterators over the
+ * same matrix although the test will be trivially true for
+ * matrices that don't view the same data, by implementation.
+ */
+ inline bool operator!= (const self &x) const
+ {
+ return !(*this == x);
+ }
+
+ /**** BIDIRECTIONAL ITERATOR FACILITIES ****/
+
+ inline self& operator-- ()
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER)
+ --pos_;
+ else if (offset_-- % lead_length_ == 0)
+ pos_ -= jump_;
+ else
+ pos_ -= lead_inc_;
+
+ return *this;
+ }
+
+ inline self operator-- (int)
+ {
+ self tmp = *this;
+ --(*this);
+ return tmp;
+ }
+
+ /**** RANDOM ACCESS ITERATOR FACILITIES ****/
+
+ inline const reference operator[] (difference_type n) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ SCYTHE_ITER_CHECK_OFFSET_BOUNDS(start_ + n);
+ return *(start_ + n);
+ } else {
+ uint trailing = n / lead_length_;
+ uint leading = n % lead_length_;
+
+ T_type* place = start_ + leading * lead_inc_
+ + trailing * trail_inc_;
+
+ SCYTHE_ITER_CHECK_POINTER_BOUNDS(place);
+ return *place;
+ }
+ }
+
+ inline self& operator+= (difference_type n)
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ pos_ += n;
+ } else {
+ offset_ += n;
+ uint trailing = offset_ / lead_length_;
+ uint leading = offset_ % lead_length_;
+
+ pos_ = start_ + leading * lead_inc_
+ + trailing * trail_inc_;
+ }
+
+ return *this;
+ }
+
+ inline self& operator-= (difference_type n)
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ pos_ -= n;
+ } else {
+ offset_ -= n;
+ uint trailing = offset_ / lead_length_;
+ uint leading = offset_ % lead_length_;
+
+ pos_ = start_ + leading * lead_inc_
+ + trailing * trail_inc_;
+ }
+
+ return *this;
+ }
+
+ /* + and - difference operators are outside the class */
+
+ inline difference_type operator- (const self& x) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ return pos_ - x.pos_;
+ } else {
+ return offset_ - x.offset_;
+ }
+ }
+
+ inline difference_type operator< (const self& x) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ return pos_ < x.pos_;
+ } else {
+ return offset_ < x.offset_;
+ }
+ }
+
+ inline difference_type operator> (const self& x) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ return pos_ > x.pos_;
+ } else {
+ return offset_ > x.offset_;
+ }
+ }
+
+ inline difference_type operator<= (const self& x) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ return pos_ <= x.pos_;
+ } else {
+ return offset_ <= x.offset_;
+ }
+ }
+
+ inline difference_type operator>= (const self& x) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ return pos_ >= x.pos_;
+ } else {
+ return offset_ >= x.offset_;
+ }
+ }
+
+ protected:
+
+ /**** INSTANCE VARIABLES ****/
+ T_type* start_; // pointer to beginning of data array
+ T_type* pos_; // pointer to current position in array
+
+ uint offset_; // Logical offset into matrix
+
+ // TODO Some of these can probably be uints
+ int lead_length_; // Logical length of leading dimension
+ int lead_inc_; // Memory distance between vectors in ldim
+ int trail_inc_; // Memory distance between vectors in tdim
+ int jump_; // Memory distance between end of one ldim vector and
+ // begin of next
+
+ // Size variable for range checking
+#if SCYTHE_DEBUG > 2
+ uint size_; // Logical matrix size
+#endif
+
+ };
+
+ /*! \brief An STL-compliant random access iterator for Matrix.
+ *
+ * Provides random access iteration over Matrix objects. See
+ * Josuttis (1999), or some other STL reference, for a full
+ * description of the random access iterator interface.
+ *
+ * \see Matrix
+ * \see const_matrix_random_access_iterator
+ * \see const_matrix_forward_iterator
+ * \see matrix_forward_iterator
+ * \see const_matrix_bidirectional_iterator
+ * \see matrix_bidirectional_iterator
+ */
+ template <typename T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style M_STYLE>
+ class matrix_random_access_iterator
+ : public const_matrix_random_access_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE>
+ {
+ /**** TYPEDEFS ***/
+ typedef matrix_random_access_iterator<T_type, ORDER, M_ORDER,
+ M_STYLE> self;
+ typedef const_matrix_random_access_iterator<T_type, ORDER,
+ M_ORDER, M_STYLE> Base;
+
+ public:
+ /* These are a little formal, but useful */
+ typedef typename std::iterator_traits<Base>::value_type
+ value_type;
+ typedef typename std::iterator_traits<Base>::iterator_category
+ iterator_category;
+ typedef typename std::iterator_traits<Base>::difference_type
+ difference_type;
+ typedef typename std::iterator_traits<Base>::pointer pointer;
+ typedef typename std::iterator_traits<Base>::reference reference;
+
+
+ /**** CONSTRUCTORS ****/
+
+ /* Default constructor */
+ matrix_random_access_iterator ()
+ : Base ()
+ {}
+
+ /* Standard constructor */
+ matrix_random_access_iterator (const Matrix<value_type, M_ORDER,
+ M_STYLE> &M)
+ : Base(M)
+ {}
+
+ /* Copy constructor */
+ matrix_random_access_iterator (const self &mi)
+ : Base (mi)
+ {}
+
+ /**** FORWARD ITERATOR FACILITIES ****/
+
+ /* We have to override a lot of these to get return values
+ * right.*/
+ inline self& operator= (const self& mi)
+ {
+ start_ = mi.start_;
+ pos_ = mi.pos_;
+
+ if (M_STYLE != Concrete || M_ORDER != ORDER) {
+ offset_ = mi.offset_;
+ lead_length_ = mi.lead_length_;
+ lead_inc_ = mi.lead_inc_;
+ trail_inc_ = mi.trail_inc_;
+ jump_ = mi.jump_;
+ }
+#if SCYTHE_DEBUG > 2
+ size_ = mi.size_;
+#endif
+
+ return *this;
+ }
+
+ inline reference operator* () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return *pos_;
+ }
+
+ inline pointer operator-> () const
+ {
+ SCYTHE_ITER_CHECK_BOUNDS();
+ return pos_;
+ }
+
+ inline self& operator++ ()
+ {
+ Base::operator++();
+ return *this;
+ }
+
+ inline self operator++ (int)
+ {
+ self tmp = *this;
+ ++(*this);
+ return tmp;
+ }
+
+ /**** BIDIRECTIONAL ITERATOR FACILITIES ****/
+
+ inline self& operator-- ()
+ {
+ Base::operator--();
+ return *this;
+ }
+
+ inline self operator-- (int)
+ {
+ self tmp = *this;
+ --(*this);
+ return tmp;
+ }
+
+ /**** RANDOM ACCESS ITERATOR FACILITIES ****/
+
+ inline reference operator[] (difference_type n) const
+ {
+ if (M_STYLE == Concrete && ORDER == M_ORDER) {
+ SCYTHE_ITER_CHECK_POINTER_BOUNDS(start_ + n);
+ return *(start_ + n);
+ } else {
+ uint trailing = n / lead_length_;
+ uint leading = n % lead_length_;
+
+ T_type* place = start_ + leading * lead_inc_
+ + trailing * trail_inc_;
+
+ SCYTHE_ITER_CHECK_POINTER_BOUNDS(place);
+ return *place;
+ }
+ }
+
+ inline self& operator+= (difference_type n)
+ {
+ Base::operator+=(n);
+ return *this;
+ }
+
+ inline self& operator-= (difference_type n)
+ {
+ Base::operator-= (n);
+ return *this;
+ }
+
+ /* + and - difference_type operators are outside the class */
+
+ private:
+ /* Get handles to base members. It boggles the mind */
+ using Base::start_;
+ using Base::pos_;
+ using Base::offset_;
+ using Base::lead_length_;
+ using Base::lead_inc_;
+ using Base::trail_inc_;
+ using Base::jump_;
+#if SCYTHE_DEBUG > 2
+ using Base::size_;
+#endif
+ };
+
+ template <class T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style STYLE>
+ inline
+ const_matrix_random_access_iterator<T_type, ORDER, M_ORDER, STYLE>
+ operator+ (const_matrix_random_access_iterator<T_type, ORDER, M_ORDER, STYLE> x, int n)
+ {
+ x += n;
+ return x;
+ }
+
+ template <class T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style STYLE>
+ inline
+ const_matrix_random_access_iterator<T_type, ORDER, M_ORDER, STYLE>
+ operator+ (int n, const_matrix_random_access_iterator<T_type, ORDER,
+ M_ORDER,
+ STYLE> x)
+ {
+ x += n;
+ return x;
+ }
+
+ template <class T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style STYLE>
+ inline
+ const_matrix_random_access_iterator<T_type, ORDER, M_ORDER, STYLE>
+ operator- (const_matrix_random_access_iterator<T_type, ORDER, M_ORDER, STYLE> x, int n)
+ {
+ x -= n;
+ return x;
+ }
+
+ template <class T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style STYLE>
+ inline matrix_random_access_iterator<T_type, ORDER, M_ORDER, STYLE>
+ operator+ (matrix_random_access_iterator<T_type, ORDER, M_ORDER,
+ STYLE> x, int n)
+ {
+ x += n;
+ return x;
+ }
+
+ template <class T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style STYLE>
+ inline matrix_random_access_iterator<T_type, ORDER, M_ORDER, STYLE>
+ operator+ (int n, matrix_random_access_iterator<T_type, ORDER,
+ M_ORDER, STYLE> x)
+ {
+ x += n;
+ return x;
+ }
+
+ template <class T_type, matrix_order ORDER, matrix_order M_ORDER,
+ matrix_style STYLE>
+ inline matrix_random_access_iterator<T_type, ORDER, M_ORDER, STYLE>
+ operator- (matrix_random_access_iterator<T_type, ORDER, M_ORDER,
+ STYLE> x, int n)
+ {
+ x -= n;
+ return x;
+ }
+
+} // namespace scythe
+
+#endif /* SCYTHE_MATRIX_ITERATOR_H */
diff --git a/src/mersenne.cc b/src/mersenne.cc
deleted file mode 100644
index cd734d1..0000000
--- a/src/mersenne.cc
+++ /dev/null
@@ -1,125 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/rng/mersenne.cc
- *
- * Provides the implementation for the mersenne class. This is the
- * default random number generator in scythe. See mersenne.h for
- * additional copyright information.
- *
- */
-
-#ifndef SCYTHE_MERSENNE_CC
-#define SCYTHE_MERSENNE_CC
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "mersenne.h"
-#else
-#include "mersenne.h"
-#endif
-
-namespace SCYTHE {
-
-#ifdef __MINGW32__
- /* constant vector a */
- static const unsigned long MATRIX_A = 0x9908b0dfUL;
-
- /* most significant w-r bits */
- static const unsigned long UPPER_MASK = 0x80000000UL;
-
- /* least significant r bits */
- static const unsigned long LOWER_MASK = 0x7fffffffUL;
-#else
- namespace {
- /* constant vector a */
- const unsigned long MATRIX_A = 0x9908b0dfUL;
-
- /* most significant w-r bits */
- const unsigned long UPPER_MASK = 0x80000000UL;
-
- /* least significant r bits */
- const unsigned long LOWER_MASK = 0x7fffffffUL;
- }
-#endif
-
- mersenne::mersenne ()
- : mti (N + 1)
- {
- }
-
- mersenne::mersenne (const mersenne &m)
- : rng (),
- mti (m.mti)
- {
- }
-
- mersenne::~mersenne ()
- {
- }
-
- void
- mersenne::initialize (const unsigned long &s)
- {
- mt[0]= s & 0xffffffffUL;
- for (mti=1; mti<N; mti++) {
- mt[mti] = (1812433253UL * (mt[mti-1] ^ (mt[mti-1] >> 30)) + mti);
- /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
- /* In the previous versions, MSBs of the seed affect */
- /* only MSBs of the array mt[]. */
- /* 2002/01/09 modified by Makoto Matsumoto */
- mt[mti] &= 0xffffffffUL;
- /* for >32 bit machines */
- }
- }
-
- /* generates a random number on [0,0xffffffff]-interval */
- unsigned long
- mersenne::genrand_int32()
- {
- unsigned long y;
- static unsigned long mag01[2]={0x0UL, MATRIX_A};
- /* mag01[x] = x * MATRIX_A for x=0,1 */
-
- if (mti >= N) { /* generate N words at one time */
- int kk;
-
- if (mti == N+1) /* if init_genrand() has not been called, */
- this->initialize(5489UL); /* a default initial seed is used */
-
- for (kk=0;kk<N-M;kk++) {
- y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
- mt[kk] = mt[kk+M] ^ (y >> 1) ^ mag01[y & 0x1UL];
- }
- for (;kk<N-1;kk++) {
- y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
- mt[kk] = mt[kk+(M-N)] ^ (y >> 1) ^ mag01[y & 0x1UL];
- }
- y = (mt[N-1]&UPPER_MASK)|(mt[0]&LOWER_MASK);
- mt[N-1] = mt[M-1] ^ (y >> 1) ^ mag01[y & 0x1UL];
-
- mti = 0;
- }
-
- y = mt[mti++];
-
- /* Tempering */
- y ^= (y >> 11);
- y ^= (y << 7) & 0x9d2c5680UL;
- y ^= (y << 15) & 0xefc60000UL;
- y ^= (y >> 18);
-
- return y;
- }
-}
-
-#endif /* SCYTHE_MERSENNE_CC */
diff --git a/src/mersenne.h b/src/mersenne.h
index 0417cfd..1ff2f2e 100644
--- a/src/mersenne.h
+++ b/src/mersenne.h
@@ -1,7 +1,7 @@
/*
* Scythe Statistical Library
* Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
+ * 2002-present Andrew D. Martin, Kevin M. Quinn, and Daniel
* Pemstein. All Rights Reserved.
*
* This program is free software; you can redistribute it and/or modify
@@ -60,6 +60,15 @@
*
*/
+ /*! \file mersenne.h
+ * \brief The Mersenne Twister random number generator.
+ *
+ * This file contains the mersenne class, a class that extends
+ * Scythe's base random number generation class (scythe::rng) by
+ * providing an implementation of scythe::rng::runif() using the
+ * Mersenne Twister algorithm.
+ */
+
#ifndef SCYTHE_MERSENNE_H
#define SCYTHE_MERSENNE_H
@@ -69,36 +78,228 @@
#include "scythestat/rng.h"
#endif
-namespace SCYTHE {
+namespace scythe {
- class mersenne: public rng
+#ifdef __MINGW32__
+ /* constant vector a */
+ static const unsigned long MATRIX_A = 0x9908b0dfUL;
+
+ /* most significant w-r bits */
+ static const unsigned long UPPER_MASK = 0x80000000UL;
+
+ /* least significant r bits */
+ static const unsigned long LOWER_MASK = 0x7fffffffUL;
+#else
+ namespace {
+ /* constant vector a */
+ const unsigned long MATRIX_A = 0x9908b0dfUL;
+
+ /* most significant w-r bits */
+ const unsigned long UPPER_MASK = 0x80000000UL;
+
+ /* least significant r bits */
+ const unsigned long LOWER_MASK = 0x7fffffffUL;
+ }
+#endif
+
+ /*! \brief The Mersenne Twister random number generator.
+ *
+ * This class defines a random number generator, using the Mersenne
+ * Twister algorithm developed and implemented by Makoto Matsumoto
+ * and Takuji Nishimura (1997, 2002). The period of this random
+ * number generator is \f$2^{19937} - 1\f$.
+ *
+ * The mersenne class extends Scythe's basic random number
+ * generating class, scythe::rng, implementing the interface that it
+ * defines.
+ *
+ * \see rng
+ * \see lecuyer
+ *
+ */
+ class mersenne: public rng<mersenne>
{
public:
- mersenne ();
+ /*! \brief Default constructor
+ *
+ * This constructor generates an unseeded and uninitialized
+ * mersenne object. It is most useful for creating arrays of
+ * random number generators. An uninitialized mersenne object
+ * will be seeded with the default seed (5489UL) automatically
+ * upon use.
+ *
+ * \see mersenne(const mersenne &m)
+ * \see initialize(unsigned long s)
+ */
+ mersenne ()
+ : rng<mersenne> (),
+ mti (N + 1)
+ {}
- mersenne (const mersenne &);
+ /*! \brief Copy constructor
+ *
+ * This constructor makes a copy of an existing mersenne
+ * object, duplicating its seed and current state exactly.
+ *
+ * \param m An existing mersenne random number generator.
+ *
+ * \see mersenne()
+ */
+ mersenne (const mersenne &m)
+ : rng<mersenne> (),
+ mti (m.mti)
+ {
+ }
- ~mersenne ();
-
- void initialize (const unsigned long &);
+ /*! \brief Sets the seed.
+ *
+ * This method sets the seed of the random number generator and
+ * readies it to begin generating random numbers. Calling this
+ * function on a mersenne object that is already in use is
+ * supported, although not suggested unless you know what you
+ * are doing.
+ *
+ * \param s A long integer seed.
+ *
+ * \see mersenne()
+ */
+ void initialize (unsigned long s)
+ {
+ mt[0]= s & 0xffffffffUL;
+ for (mti=1; mti<N; mti++) {
+ mt[mti] = (1812433253UL * (mt[mti-1] ^ (mt[mti-1] >> 30))
+ + mti);
+ /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
+ /* In the previous versions, MSBs of the seed affect */
+ /* only MSBs of the array mt[]. */
+ /* 2002/01/09 modified by Makoto Matsumoto */
+ mt[mti] &= 0xffffffffUL;
+ /* for >32 bit machines */
+ }
+ }
- inline double runif()
+ /*! \brief Generate a random uniform variate on (0, 1).
+ *
+ * This routine returns a random double precision floating point
+ * number from the uniform distribution on the interval (0,
+ * 1). This method overloads the pure virtual method of the
+ * same name in the rng base class.
+ *
+ * \see runif(unsigned int, unsigned int)
+ * \see genrand_int32()
+ * \see rng
+ */
+ inline double runif()
{
return (((double) genrand_int32()) + 0.5) *
(1.0 / 4294967296.0);
}
- /* We have to override the overloaded form of runif because
+ /* We have to override the overloaded forms of runif because
* overloading the no-arg runif() hides the base class
* definition; C++ stops looking once it finds the above.
*/
- inline Matrix<double> runif(const int &rows, const int &cols)
+ /*! \brief Generate a Matrix of random uniform variates.
+ *
+ * This routine returns a Matrix of double precision random
+ * uniform variates. on the interval (0, 1). This method
+ * overloads the virtual method of the same name in the rng base
+ * class.
+ *
+ * This is the general template version of this method and
+ * is called through explicit template instantiation.
+ *
+ * \param rows The number of rows in the returned Matrix.
+ * \param cols The number of columns in the returned Matrix.
+ *
+ * \see runif()
+ * \see rng
+ *
+ * \note We are forced to override this overloaded method
+ * because the 1-arg version of runif() hides the base class's
+ * definition of this method from the compiler, although it
+ * probably should not.
+ */
+ template <matrix_order O, matrix_style S>
+ inline Matrix<double,O,S> runif(unsigned int rows,
+ unsigned int cols)
{
- return rng::runif(rows, cols);
+ return rng<mersenne>::runif<O,S>(rows, cols);
}
- unsigned long genrand_int32();
+ /*! \brief Generate a Matrix of random uniform variates.
+ *
+ * This routine returns a Matrix of double precision random
+ * uniform variates on the interval (0, 1). This method
+ * overloads the virtual method of the same name in the rng base
+ * class.
+ *
+ * This is the default template version of this method and
+ * is called through implicit template instantiation.
+ *
+ * \param rows The number of rows in the returned Matrix.
+ * \param cols The number of columns in the returned Matrix.
+ *
+ * \see runif()
+ * \see rng
+ *
+ * \note We are forced to override this overloaded method
+ * because the 1-arg version of runif() hides the base class's
+ * definition of this method from the compiler, although it
+ * probably should not.
+ */
+ Matrix<double,Col,Concrete> runif(unsigned int rows,
+ unsigned int cols)
+ {
+ return rng<mersenne>::runif<Col,Concrete>(rows, cols);
+ }
+
+ /* generates a random number on [0,0xffffffff]-interval */
+ /*! \brief Generate a random long integer.
+ *
+ * This method generates a random integer, drawn from the
+ * discrete uniform distribution on the interval [0,0xffffffff].
+ *
+ * \see runif()
+ * \see initialize(unsigned long s)
+ */
+ unsigned long genrand_int32()
+ {
+ unsigned long y;
+ static unsigned long mag01[2]={0x0UL, MATRIX_A};
+ /* mag01[x] = x * MATRIX_A for x=0,1 */
+
+ if (mti >= N) { /* generate N words at one time */
+ int kk;
+
+ if (mti == N+1) // if init_genrand() has not been called,
+ this->initialize(5489UL); // a default initial seed is used
+
+ for (kk=0;kk<N-M;kk++) {
+ y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
+ mt[kk] = mt[kk+M] ^ (y >> 1) ^ mag01[y & 0x1UL];
+ }
+ for (;kk<N-1;kk++) {
+ y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
+ mt[kk] = mt[kk+(M-N)] ^ (y >> 1) ^ mag01[y & 0x1UL];
+ }
+ y = (mt[N-1]&UPPER_MASK)|(mt[0]&LOWER_MASK);
+ mt[N-1] = mt[M-1] ^ (y >> 1) ^ mag01[y & 0x1UL];
+
+ mti = 0;
+ }
+
+ y = mt[mti++];
+
+ /* Tempering */
+ y ^= (y >> 11);
+ y ^= (y << 7) & 0x9d2c5680UL;
+ y ^= (y << 15) & 0xefc60000UL;
+ y ^= (y >> 18);
+
+ return y;
+ }
protected:
/* Period parameters */
diff --git a/src/optimize.cc b/src/optimize.cc
deleted file mode 100644
index fd6528c..0000000
--- a/src/optimize.cc
+++ /dev/null
@@ -1,642 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/optimize.cc
- *
- * Provides implementations of various numerical optimization
- * routines.
- *
- */
-
-#ifndef SCYTHE_OPTIMIZE_CC
-#define SCYTHE_OPTIMIZE_CC
-
-#include <cmath>
-#include <iostream>
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "optimize.h"
-#include "error.h"
-#include "util.h"
-#include "distributions.h"
-#include "la.h"
-#include "ide.h"
-#include "smath.h"
-#include "stat.h"
-#else
-#include "scythestat/optimize.h"
-#include "scythestat/error.h"
-#include "scythestat/util.h"
-#include "scythestat/distributions.h"
-#include "scythestat/la.h"
-#include "scythestat/ide.h"
-#include "scythestat/smath.h"
-#include "scythestat/stat.h"
-#endif
-
-// Avoid NameSpace Pollution
-namespace SCYTHE {
-
- /* Functions (private to this file) that do very little... */
-#ifdef __MINGW32__
- template <class T>
- static
- T
- donothing(const Matrix<T> &x) {return 0.0;}
-
- template <class T>
- static
- T
- donothing(const T &x) { return 0.0; }
-#else
- namespace {
- template <class T>
- T
- donothing(const Matrix<T> &x) {return 0.0;}
-
- template <class T>
- T
- donothing(const T &x) { return 0.0; }
- }
-#endif
-
-
- /* Return the machine epsilon
- * Notes: Algorithm taken from Sedgewick, Robert. 1992. Algorithms
- * in C++. Addison Wesley. pg. 561
- */
- template <class T>
- T
- epsilon()
- {
- T eps, del, neweps;
- del = (T) 0.5;
- eps = (T) 0.0;
- neweps = (T) 1.0;
-
- while ( del > 0 ) {
- if ( 1 + neweps > 1 ) { /* Then the value might be too large */
- eps = neweps; /* ...save the current value... */
- neweps -= del; /* ...and decrement a bit */
- } else { /* Then the value is too small */
- neweps += del; /* ...so increment it */
- }
- del *= 0.5; /* Reduce the adjustment by half */
- }
-
- return eps;
- }
-
- /* Calculate the definite integral of a function from a to b */
- template <class T>
- T
- intsimp(T (*fun)(const T &), const T &a, const T &b, const int &N)
- {
- if (a > b)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Lower limit larger than upper");
-
- if (N <= 0)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Number of subintervals negative");
-
- T I = (T) 0;
- T w = (b - a) / N;
- for (int i = 1; i <= N; i++)
- I += w * (fun(a +(i - 1) *w) + 4 * fun(a - w / 2 + i * w) +
- fun(a + i * w)) / 6;
-
- return I;
- }
-
- /* Calculate the definite integral of a function from a to b
- * Notes: Algorithm taken from Sedgewick, Robert. 1992. Algorithms
- * in C++. Addison Wesley. pg. 562
- */
- template <class T>
- T
- adaptsimp(T (*fun)(const T &), const T &a, const T &b, const int &N,
- const T &tol)
- {
- if (a > b)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Lower limit larger than upper");
-
- if (N <= 0)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "Number of subintervals negative");
-
- T I = intsimp(fun, a, b, N);
- if (::fabs(I - intsimp(fun, a, b, N / 2)) > tol)
- return adaptsimp(fun, a, (a + b) / 2, N, tol)
- + adaptsimp(fun, (a + b) / 2, b, N, tol);
-
- return I;
- }
-
-
- /* Numerically calculates the first derivative of a function
- * Notes: Algorithm taken from Nocedal and Wright. 1999. section 7.1
- * with some additional tricks from Press et al. NRC
- */
- template <class T>
- Matrix<T>
- gradfdif (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &theta,
- const Matrix<T> &y, const Matrix<T> &X)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
-
- int k = theta.size();
- // stepsize CAREFUL-- THIS IS MACHINE-SPECIFIC!!!
- T h = std::sqrt(epsilon<T>()); // 2.25e-16
- //T h = std::sqrt(2.25e-16);
-
-
- Matrix<T> grad(k,1);
-
- for (int i = 0; i < k; ++i){
- Matrix<T> e(k,1);
- e[i] = h;
- Matrix<T> temp = theta + e;
- donothing(temp);
- e = temp - theta;
- grad[i] = (fun(theta + e, y, X) - fun(theta, y, X)) / e[i];
- }
-
- return grad;
- }
-
-
- /* Numerically calculates the first derivative of a function
- * Notes: Algorithm taken from Nocedal and Wright. 1999. section 7.1
- * with some additional tricks from Press et al. NRC
- */
- template <class T>
- T
- gradfdifls (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const T &alpha,
- const Matrix<T> &theta, const Matrix<T> &p,
- const Matrix<T> &y, const Matrix<T> &X)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
- if (! p.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p not column vector");
-
- int k = theta.size();
- // stepsize CAREFUL-- THIS IS MACHINE-SPECIFIC!!!
- T h = std::sqrt(epsilon<T>()); //2.2e-16
- //T h = std::sqrt(2.2e-16);
-
- T deriv;
-
- for (int i = 0; i < k; ++i) {
- T temp = alpha + h;
- donothing(temp);
- T e = temp - alpha;
- deriv = (fun(theta + (alpha + e) * p, y, X)
- - fun(theta + alpha * p, y, X)) / e;
- }
-
- return deriv;
- }
-
-
-
- /* Numerically calculates the gradient of a function
- * Notes: Algorithm taken from Nocedal and Wright. 1999. section 7.1
- * with some additional tricks from Press et al. NRC
- */
- template <class T>
- Matrix<T>
- jacfdif(Matrix<T> (*fun)(const Matrix<T> &), const Matrix<T> &theta)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
-
- Matrix<T> fval = fun(theta);
-
- int k = theta.rows();
- int n = fval.rows();
- // stepsize CAREFUL -- THIS IS MACHINE-SPECIFIC!!!
- T h = std::sqrt(epsilon<T>()); //2.2e-16
- //T h = std::sqrt(2.2e-16);
- Matrix<T> J(n,k);
-
- for (int i = 0; i < k; ++i) {
- Matrix<T> e(k,1);
- e[i] = h;
- Matrix<T> temp = theta + e;
- donothing(temp);
- e = temp - theta;
- Matrix<T> fthetae = fun(theta + e);
- Matrix<T> ftheta = fun(theta);
- for (int j = 0; j < n; ++j) {
- J(j,i) = (fthetae[j] - ftheta[j]) / e[i];
- }
- }
-
- return J;
- }
-
- /* Numerically calculates the gradient of a function
- * Notes: Algorithm taken from Nocedal and Wright. 1999. section 7.1
- * with some additional tricks from Press et al. NRC
- */
- template <class T>
- Matrix<T>
- jacfdif(Matrix<T> (*fun)(const Matrix<T> &, const Matrix<T> &),
- const Matrix<T> &theta, const Matrix<T> &psi)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
-
- Matrix<T> fval = fun(theta, psi);
-
- int k = theta.rows();
- int n = fval.rows();
- // stepsize CAREFUL -- THIS IS MACHINE-SPECIFIC!!!
- //T h = std::sqrt(epsilon<T>()); //2.2e-16
- T h = std::sqrt(2.2e-16);
- Matrix<T> J(n, k);
-
- for (int i = 0; i < k; ++i) {
- Matrix<T> e(k,1);
- e[i] = h;
- Matrix<T> temp = theta + e;
- donothing(temp);
- e = temp - theta;
- Matrix<T> fthetae = fun(theta + e, psi);
- Matrix<T> ftheta = fun(theta, psi);
- for (int j = 0; j < n; ++j) {
- J(j,i) = (fthetae[j] - ftheta[j]) / e[i];
- }
- }
-
- return J;
- }
-
- /* Numerically calculates the Hessian of a function */
- template <class T>
- Matrix<T>
- hesscdif (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &theta,
- const Matrix<T> &y, const Matrix<T> &X)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
-
- T fval = fun(theta,y,X);
-
- int k = theta.rows();
-
- // stepsize CAREFUL -- THIS IS MACHINE-SPECIFIC!!!
- T h2 = (T) 1e-10;
- T h = ::sqrt(h2);
- Matrix<T> H(k,k);
-
- for (int i=0; i<k; ++i) {
- Matrix<T> ei(k, 1);
- ei[i] = h;
- Matrix<T> temp = theta + ei;
- donothing(temp);
- ei = temp - theta;
- for (int j = 0; j < k; ++j){
- Matrix<T> ej(k,1);
- ej[j] = h;
- temp = theta + ej;
- donothing(temp);
- ej = temp - theta;
-
- if (i==j){
- H(i,i) = ( -fun(theta + 2.0 * ei, y, X) + 16.0 *
- fun(theta+ei,y,X) - 30.0 * fval + 16.0 *
- fun(theta-ei,y,X) -
- fun(theta-2.0 * ei, y, X)) / (12.0 * h2);
- } else {
- H(i,j) = ( fun(theta + ei + ej, y, X) - fun(theta+ei-ej, y, X)
- - fun(theta - ei + ej, y, X) + fun(theta-ei-ej, y, X))
- / (4.0 * h2);
- }
- }
- }
-
- return H;
- }
-
- /* Performs a linesearch to find the step length (\a alpha)
- * Notes: Algorithm taken from Nocedal and Wright. 1999. Procedure
- * 3.1
- */
- template <class T>
- T
- linesearch1(T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &theta,
- const Matrix<T> &p, const Matrix<T> &y,
- const Matrix<T> &X)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
- if (! p.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p not column vector");
-
- T alpha_bar = (T) 1.0;
- T rho = (T) 0.9;
- T c = (T) 0.5;
- T alpha = alpha_bar;
- Matrix<T> fgrad = gradfdif(fun, theta, y, X);
-
- while (fun(theta + alpha * p, y, X) > (fun(theta, y, X) + c
- * alpha * t(fgrad) * p)[0]) {
- alpha = rho * alpha;
- }
-
- return alpha;
- }
-
- /* Performs a linesearch to find the step length (\a alpha)
- * Notes: Algorithm taken from Nocedal and Wright. 1999. Algorithm
- * 3.2
- */
- template <class T>
- T
- linesearch2(T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &theta,
- const Matrix<T> &p, const Matrix<T> &y,
- const Matrix<T> &X, rng *myrng)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
- if (! p.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p not column vector");
-
- T alpha_last = (T) 0.0;
- T alpha_cur = (T) 1.0;
- T alpha_max = (T) 10.0;
- T c1 = (T) 1e-4;
- T c2 = (T) 0.5;
- int max_iter = 50;
- T fgradalpha0 = gradfdifls(fun, (T) 0, theta, p, y, X);
-
- for (int i = 0; i < max_iter; ++i) {
- T phi_cur = fun(theta + alpha_cur * p, y, X);
- T phi_last = fun(theta + alpha_last * p, y, X);
-
- if ((phi_cur > (fun(theta, y, X) + c1 * alpha_cur * fgradalpha0))
- ||
- ((phi_cur >= phi_last) && (i > 0))) {
- T alphastar = zoom(fun, alpha_last, alpha_cur, theta, p, y, X);
- return alphastar;
- }
-
- T fgradalpha_cur = gradfdifls(fun, alpha_cur, theta, p, y, X);
- if ( ::fabs(fgradalpha_cur) <= -1 * c2 * fgradalpha0)
- return alpha_cur;
-
- if ( fgradalpha_cur >= (T) 0.0) {
- T alphastar = zoom(fun, alpha_cur, alpha_last, theta, p, y, X);
- return alphastar;
- }
-
- alpha_last = alpha_cur;
- alpha_cur = myrng->runif() * (alpha_max - alpha_cur) + alpha_cur;
- }
-
- return 0.001;
- }
-
-
- /* Finds the minimum of a function once bracketed (i.e. over a
- * closed interval).
- * Notes: Algorithm taken from Nocedal and Wright. 1999. Algorithm
- * 3.3
- */
- template <class T>
- T
- zoom (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const T &alo, const T &ahi,
- const Matrix<T> &theta, const Matrix<T> &p,
- const Matrix<T> &y, const Matrix<T> &X )
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
- if (! p.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p not column vector");
-
- T alpha_lo = alo;
- T alpha_hi = ahi;
- T alpha_j = (alo + ahi) / 2.0;
- T phi_0 = fun(theta, y, X);
- T c1 = (T) 1e-4;
- T c2 = (T) 0.5;
- T fgrad0 = gradfdifls(fun,(T) 0, theta, p, y, X);
-
- int count = 0;
- int maxit = 20;
- while(count < maxit) {
- T phi_j = fun(theta + alpha_j * p, y, X);
- T phi_lo = fun(theta + alpha_lo * p, y, X);
-
- if ((phi_j > (phi_0 + c1 * alpha_j * fgrad0))
- || (phi_j >= phi_lo)){
- alpha_hi = alpha_j;
- } else {
- T fgradj = gradfdifls(fun, alpha_j, theta, p, y, X);
- if (::fabs(fgradj) <= -1 * c2 * fgrad0){
- return alpha_j;
- }
- if ( fgradj * (alpha_hi - alpha_lo) >= 0){
- alpha_hi = alpha_lo;
- }
- alpha_lo = alpha_j;
- }
- ++count;
- }
-
- return alpha_j;
- }
-
-
-
- /* Find the minimum of a function using the BFGS algorithm
- * Notes: Algorithm taken from Nocedal and Wright. 1999. algorithm
- * 8.1
- */
- template <class T>
- Matrix<T>
- BFGS (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), rng *myrng,
- const Matrix<T> &theta,
- const Matrix<T> &y, const Matrix<T> &X,
- const int &maxit, const T &tolerance)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
-
- int n = theta.size();
-
- // H is initial inverse hessian
- Matrix<T> H = inv(hesscdif(fun, theta, y, X));
-
- // gradient at starting values
- Matrix<T> fgrad = gradfdif(fun, theta, y, X);
- Matrix<T> thetamin = theta;
- Matrix<T> fgrad_new = fgrad;
- Matrix<T> I = eye<T>(n);
-
- int count = 0;
- while( (t(fgrad_new)*fgrad_new)[0] > tolerance) {
- Matrix<T> p = -1 * H * fgrad;
- T alpha = linesearch2(fun, thetamin, p, y, X, myrng);
- Matrix<T> thetamin_new = thetamin + alpha*p;
- fgrad_new = gradfdif(fun, thetamin_new, y, X);
- Matrix<T> s = thetamin_new - thetamin;
- Matrix<T> y = fgrad_new - fgrad;
- T rho = 1.0 / (t(y) * s)[0];
- H = (I - rho * s * t(y)) * H *(I - rho * y * t(s))
- + rho * s * (!s);
-
- thetamin = thetamin_new;
- fgrad = fgrad_new;
- ++count;
-
- std::cout << "BFGS iteration = " << count << std::endl;
- std::cout << "thetamin = " << (!thetamin).toString() << std::endl;
- std::cout << "gradient = " << (!fgrad).toString() << std::endl;
- std::cout << "t(gradient) * gradient = " <<
- ((!fgrad) * fgrad).toString() << std::endl;
-
- if (count > maxit)
- throw scythe_convergence_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Failed to converge. Try better starting values");
- }
-
- return thetamin;
- }
-
-
- /* Zero a function using Broyen's Method
- * Notes: Algorithm taken from Nocedal and Wright. 1999. algorithm 11
- * line search is not used to determine alpha (this should probably
- * be changed at some point.
- */
- template <class T>
- Matrix<T>
- nls_broyden(Matrix<T> (*fun)(const Matrix<T> &),
- const Matrix<T> &theta, const int &maxit = 5000,
- const T &tolerance = 1e-6)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
-
- Matrix<T> thetastar = theta;
- Matrix<T> B = jacfdif(fun, thetastar);
-
- Matrix<T> fthetastar;
- Matrix<T> p;
- Matrix<T> thetastar_new;
- Matrix<T> fthetastar_new;
- Matrix<T> s;
- Matrix<T> y;
-
- for (int i = 0; i < maxit; ++i) {
- fthetastar = fun(thetastar);
- p = lu_solve(B, -1 * fthetastar);
- T alpha = (T) 1.0;
- thetastar_new = thetastar + alpha*p;
- fthetastar_new = fun(thetastar_new);
- s = thetastar_new - thetastar;
- y = fthetastar_new - fthetastar;
- B = B + ((y - B * s) * (!s)) / ((!s) * s);
- thetastar = thetastar_new;
- if (max(fabs(fthetastar_new)) < tolerance)
- return thetastar;
- }
-
- throw scythe_convergence_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__,std::string("Failed to converge. Try better starting") &
- " values or increase maxit");
- }
-
-
- /* Zero a function using Broyen's Method
- * Notes: Algorithm taken from Nocedal and Wright. 1999. algorithm
- * 11.3
- * line search is not used to determine alpha (this should probably
- * be changed at some point.
- */
- template <class T>
- Matrix<T>
- nls_broyden(Matrix<T> (*fun)(const Matrix<T> &, const Matrix<T> &),
- const Matrix<T> &theta, const Matrix<T> &psi,
- const int &maxit=5000, const T &tolerance=1e-6)
- {
- if (! theta.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Theta not column vector");
- if (! psi.isColVector())
- throw scythe_dimension_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Psi not column vector");
-
- Matrix<T> thetastar = theta;
- Matrix<T> B = jacfdif(fun, thetastar, psi);
-
- Matrix<T> fthetastar;
- Matrix<T> p;
- Matrix<T> thetastar_new;
- Matrix<T> fthetastar_new;
- Matrix<T> s;
- Matrix<T> y;
-
- for (int i = 0; i < maxit; ++i) {
- fthetastar = fun(thetastar, psi);
- p = lu_solve(B, -1 * fthetastar);
- T alpha = (T) 1.0;
- thetastar_new = thetastar + alpha*p;
- fthetastar_new = fun(thetastar_new, psi);
- s = thetastar_new - thetastar;
- y = fthetastar_new - fthetastar;
- B = B + ((y - B * s) * (!s)) / ((!s) * s);
- thetastar = thetastar_new;
- if (max(fabs(fthetastar_new)) < tolerance)
- return thetastar;
- }
-
- throw scythe_convergence_error (__FILE__, __PRETTY_FUNCTION__,
- __LINE__,std::string("Failed to converge. Try better starting") &
- " values or increase maxit");
- }
-
-} // namespace dec
-
-#ifndef SCYTHE_COMPILE_DIRECT
-#include "scythestat/eti/optimize.t"
-#endif
-
-#endif /* SCYTHE_OPTIMIZE_CC */
diff --git a/src/optimize.h b/src/optimize.h
index 1f51ab7..6e9881d 100644
--- a/src/optimize.h
+++ b/src/optimize.h
@@ -1,20 +1,47 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * sythestat/optimization.h
+ * scythestat/optimize.h
*
- * Provides definitions for various numerical optimization
- * routines.
+ */
+
+/*!
+ * \file optimize.h
+ * \brief Definitions of functions for doing numerical optimization
+ * and related operations.
+ *
+ * This file contains a number of functions that are useful for
+ * numerical optimization and maximum likelihood estimation. In
+ * addition, it contains some basic facilities for evaluating definite
+ * integrals.
+ *
+ * As is the case across Scythe, we provide both general and default
+ * template definitions for the functions in this file that return
+ * Matrix objects. The general definitions allow the user to
+ * customize the matrix_order and matrix_style of the returned Matrix,
+ * while the default versions return concrete matrices of the same
+ * matrix_order as the first (or only) Matrix argument to the
+ * function. In cases where we supply these two types of definitions,
+ * we explicitly document only the general version, although the
+ * default definition will typically appear in the function list
+ * below.
+ *
+ * \note
+ * Doxygen has some difficulty dealing with overloaded templates.
+ * Under certain circumstances it does not correctly process the
+ * definitions of default templates. In these cases, the definition
+ * for the default template will not even appear in the function list.
+ * We provide default templates for all of the Matrix-returning
+ * functions in this file.
*
*/
@@ -23,149 +50,856 @@
#ifdef SCYTHE_COMPILE_DIRECT
#include "matrix.h"
+#include "algorithm.h"
+#include "error.h"
#include "rng.h"
+#include "distributions.h"
+#include "la.h"
+#include "ide.h"
+#include "smath.h"
+#include "stat.h"
#else
#include "scythestat/matrix.h"
+#include "scythestat/algorithm.h"
+#include "scythestat/error.h"
#include "scythestat/rng.h"
+#include "scythestat/distributions.h"
+#include "scythestat/la.h"
+#include "scythestat/ide.h"
+#include "scythestat/smath.h"
+#include "scythestat/stat.h"
#endif
-// Avoid NameSpace Pollution
-namespace SCYTHE {
-
- /* returns the machine epsilon (float, double, or long double) */
- template <class T>
- T epsilon();
-
- /* Caculates the definite integral of a function from a to b, given
- * the function, a, b, and the number of subintervals
- */
- template <class T>
- T intsimp(T (*fun)(const T &), const T &, const T &, const int &);
-
- /* Calculates the definite integral of a function from a to b, given
- * the function, a, b, the of subintervals, and a tolerance
- */
- template <class T>
- T adaptsimp(T (*fun)(const T &), const T &, const T &, const int &,
- const T &tol = 1e-5);
-
- /* Numerically calculates the gradient of a function at theta using
- * a forward difference formula, given the function, theta (col
- * vector), and two matrix args to be sent to the function. (The
- * function takes three matrices)
- */
- template <class T>
- Matrix<T> gradfdif (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &,
- const Matrix<T> &, const Matrix<T> &);
-
- /* Numerically calculates the first deriv.of a function wrt alpha at
- * (theta + alpha *p) using a forward difference formula, given the
- * function, alpha, theta, p, and two matrices describing the
- * function. (Primarily useful in linesearches)
- */
- template <class T>
- T gradfdifls (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const T &,
- const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &, const Matrix<T> &);
-
- /* Numerically calculates the jacobian of a function at theta using
- * a forward difference formula, given the function and theta
- */
- template <class T>
- Matrix<T> jacfdif(Matrix<T> (*fun)(const Matrix<T> &),
- const Matrix<T> &);
-
- /* Numerically calculates the Jacobian of a function a theta using a
- * forward difference formula given the function, theta, and psi ( a
- * column vector of parameter values at which to calculate the
- * jacobian)
- */
- template <class T>
- Matrix<T> jacfdif(Matrix<T> (*fun)(const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &,
- const Matrix<T> &);
-
- /* Numerically calculates the Hessian of a function at theta using a
- * central difference formula given the function, theta, and two
- * matrix arguments for the function
- */
- template <class T>
- Matrix<T> hesscdif (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &,
- const Matrix<T> &, const Matrix<T> &);
-
- /* Performs a line search to find the step length alpha that
- * approximately minimizes an implied 1d function, given the
- * function to minimize, col-vector theta, and two matrix arguments
- * for the function
- */
- template <class T>
- T linesearch1(T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &,
- const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &);
-
- /* Performs a line search to find the step length alpha that
- * approximately minimizes an implied 1d function, given the
- * function, theta, direction vec p, and two matrix args
+/* We want to use an anonymous namespace to make the following consts
+ * and functions local to this file, but mingw doesn't play nice with
+ * anonymous namespaces so we do things differently when using the
+ * cross-compiler.
+ */
+#ifdef __MINGW32__
+#define SCYTHE_MINGW32_STATIC static
+#else
+#define SCYTHE_MINGW32_STATIC
+#endif
+
+namespace scythe {
+#ifndef __MINGW32__
+ namespace {
+#endif
+
+ /* Functions (private to this file) that do very little... */
+ template <typename T, matrix_order O, matrix_style S>
+ SCYTHE_MINGW32_STATIC T donothing (const Matrix<T,O,S>& x)
+ {
+ return (T) 0.0;
+ }
+
+ template <typename T>
+ SCYTHE_MINGW32_STATIC T donothing (T& x)
+ {
+ return (T) 0.0;
+ }
+#ifndef __MINGW32__
+ }
+#endif
+
+
+ /* Return the machine epsilon
+ * Notes: Algorithm taken from Sedgewick, Robert. 1992. Algorithms
+ * in C++. Addison Wesley. pg. 561
*/
- template <class T>
- T linesearch2(T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &,
- const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &, rng *);
+ /*! \brief Compute the machine epsilon.
+ *
+ * The epsilon function returns the machine epsilon: the smallest
+ * number that, when summed with 1, produces a value greater than
+ * one.
+ */
+ template <typename T>
+ T
+ epsilon()
+ {
+ T eps, del, neweps;
+ del = (T) 0.5;
+ eps = (T) 0.0;
+ neweps = (T) 1.0;
- /* Finds minimum of a function once bracketed, given the function,
- * lower bracket, upper bracket, theta, direction vector p, and to
- * matrix arguments
- */
- template <class T>
- T zoom (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), const T &, const T &, const Matrix<T> &,
- const Matrix<T> &, const Matrix<T> &, const Matrix<T> &);
+ while ( del > 0 ) {
+ if ( 1 + neweps > 1 ) { /* Then the value might be too large */
+ eps = neweps; /* ...save the current value... */
+ neweps -= del; /* ...and decrement a bit */
+ } else { /* Then the value is too small */
+ neweps += del; /* ...so increment it */
+ }
+ del *= 0.5; /* Reduce the adjustment by half */
+ }
+
+ return eps;
+ }
+ /*! \brief Calculate the definite integral of a function from a to b.
+ *
+ * This function calculates the definite integral of a univariate
+ * function on the interval \f$[a,b]\f$.
+ *
+ * \param fun The function (or functor) whose definite integral is
+ * to be calculated. This function should both take and return a
+ * single argument of type T.
+ * \param a The starting value of the interval.
+ * \param b The ending value of the interval.
+ * \param N The number of subintervals to calculate. Increasing
+ * this number will improve the accuracy of the estimate but will
+ * also increase run-time.
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ *
+ * \see adaptsimp(FUNCTOR fun, T a, T b, unsigned int& N, double tol = 1e-5)
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <typename T, typename FUNCTOR>
+ T intsimp (FUNCTOR fun, T a, T b, unsigned int N)
+ {
+ SCYTHE_CHECK_10(a > b, scythe_invalid_arg,
+ "Lower limit larger than upper");
+
+ T I = (T) 0;
+ T w = (b - a) / N;
+ for (unsigned int i = 1; i <= N; ++i)
+ I += w * (fun(a +(i - 1) *w) + 4 * fun(a - w / 2 + i * w) +
+ fun(a + i * w)) / 6;
+
+ return I;
+ }
- /* Numerically finds the minimum of a function using the BFGS
- * algorithm, given the function, theta, and two matrix args
- */
- template <class T>
- Matrix<T> BFGS (T (*fun)(const Matrix<T> &, const Matrix<T> &,
- const Matrix<T> &), rng *, const Matrix<T> &,
- const Matrix<T> &y = Matrix<T>(1,1),
- const Matrix<T> & X = Matrix<T>(1,1),
- const int &maxit=1000, const T &tolerance=1e-4);
+ /*! \brief Calculate the definite integral of a function from a to b.
+ *
+ * This function calculates the definite integral of a univariate
+ * function on the interval \f$[a,b]\f$.
+ *
+ * \param fun The function (or functor) whose definite integral is
+ * to be calculated. This function should both take and return a
+ * single argument of type T.
+ * \param a The starting value of the interval.
+ * \param b The ending value of the interval.
+ * \param N The number of subintervals to calculate. Increasing
+ * this number will improve the accuracy of the estimate but will
+ * also increase run-time.
+ * \param tol The accuracy required. Both accuracy and run-time
+ * decrease as this number increases.
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ *
+ * \see intsimp(FUNCTOR fun, T a, T b, unsigned int& N)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <typename T, typename FUNCTOR>
+ T adaptsimp(FUNCTOR fun, T a, T b, unsigned int N, double tol = 1e-5)
+ {
+ SCYTHE_CHECK_10(a > b, scythe_invalid_arg,
+ "Lower limit larger than upper");
+
+ T I = intsimp(fun, a, b, N);
+ if (std::fabs(I - intsimp(fun, a, b, N / 2)) > tol)
+ return adaptsimp(fun, a, (a + b) / 2, N, tol)
+ + adaptsimp(fun, (a + b) / 2, b, N, tol);
+
+ return I;
+ }
+
+ /*! \brief Calculate gradient of a function using a forward
+ * difference formula.
+ *
+ * This function numerically calculates the gradient of a
+ * vector-valued function at \a theta using a forward difference
+ * formula.
+ *
+ * \param fun The function to calculate the gradient of. This
+ * function should both take and return a single Matrix (vector) of
+ * type T.
+ * \param theta The column vector of values at which to calculate
+ * the gradient of the function.
+ *
+ * \see gradfdifls(FUNCTOR fun, T alpha, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ * \see jacfdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ * \see hesscdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS, typename FUNCTOR>
+ Matrix<T, RO, RS>
+ gradfdif (FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+
+ unsigned int k = theta.size();
+ T h = std::sqrt(epsilon<T>());
+ h = std::sqrt(h);
+
+ Matrix<T,RO,RS> grad(k, 1);
+ Matrix<T,RO> e;
+ Matrix<T,RO> temp;
+ for (unsigned int i = 0; i < k; ++i) {
+ e = Matrix<T,RO>(k, 1);
+ e[i] = h;
+ temp = theta + e;
+ donothing(temp); // XXX I don't understand this
+ e = temp - theta;
+ grad[i] = (fun(theta + e) - fun(theta)) / e[i];
+ }
+
+ return grad;
+ }
+
+ // Default template version
+ template <typename T, matrix_order O, matrix_style S,
+ typename FUNCTOR>
+ Matrix<T, O, Concrete>
+ gradfdif (FUNCTOR fun, const Matrix<T,O,S>& theta)
+ {
+ return gradfdif<O,Concrete>(fun, theta);
+ }
+
+ /*! \brief Calculate the first derivative of the function using
+ * a forward difference formula.
+ *
+ * This function numerically calculates the first derivative of a
+ * function with respect to \a alpha at \f$theta + alpha \cdot p\f$
+ * using a forward difference formula. This function is primarily
+ * useful for linesearches.
+ *
+ * \param fun The function to calculate the first derivative of.
+ * This function should take a single Matrix<T> argument and return
+ * a value of type T.
+ * \param alpha Double the step length.
+ * \param theta A Matrix (vector) of parameter values at which to
+ * calculate the gradient.
+ * \param p A direction vector.
+ *
+ * \see gradfdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ * \see jacfdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ * \see hesscdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2, typename FUNCTOR>
+ T
+ gradfdifls (FUNCTOR fun, T alpha, const Matrix<T,PO1,PS1>& theta,
+ const Matrix<T,PO2,PS2>& p)
+
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+ SCYTHE_CHECK_10(! p.isColVector(), scythe_dimension_error,
+ "p not column vector");
+
+ unsigned int k = theta.size();
+ T h = std::sqrt(epsilon<T>());
+ h = std::sqrt(h);
+ //T h = std::sqrt(2.2e-16);
+
+ T deriv;
+
+ for (unsigned int i = 0; i < k; ++i) {
+ T temp = alpha + h;
+ donothing(temp);
+ T e = temp - alpha;
+ deriv = (fun(theta + (alpha + e) * p) - fun(theta + alpha * p))
+ / e;
+ }
+
+ return deriv;
+ }
+
+ /*! \brief Calculate the Jacobian of a function using a forward
+ * difference formula.
+ *
+ * This function numerically calculates the Jacobian of a
+ * vector-valued function using a forward difference formula.
+ *
+ * \param fun The function to calculate the Jacobian of. This
+ * function should both take and return a Matrix (vector) of type
+ * T.
+ * \param theta The column vector of parameter values at which to
+ * take the Jacobian of \a fun.
+ *
+ * \see gradfdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ * \see gradfdifls(FUNCTOR fun, T alpha, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ * \see hesscdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS, typename FUNCTOR>
+ Matrix<T,RO,RS>
+ jacfdif (FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+
+ Matrix<T,RO> fval = fun(theta);
+ unsigned int k = theta.rows();
+ unsigned int n = fval.rows();
+
+ T h = std::sqrt(epsilon<T>()); //2.2e-16
+ h = std::sqrt(h);
+
+ Matrix<T,RO,RS> J(n,k);
+ Matrix<T,RO> e;
+ Matrix<T,RO> temp;
+ Matrix<T,RO> fthetae;
+ Matrix<T,RO> ftheta;
+
+ for (int i = 0; i < k; ++i) {
+ e = Matrix<T,RO>(k,1);
+ e[i] = h;
+ temp = theta + e;
+ donothing(temp); /// XXX ??
+ e = temp - theta;
+ fthetae = fun(theta + e);
+ ftheta = fun(theta);
+ for (unsigned int j = 0; j < n; ++j) {
+ J(j,i) = (fthetae[j] - ftheta[j]) / e[i];
+ }
+ }
+
+ return J;
+ }
+
+ // default template
+ template <typename T, matrix_order PO, matrix_style PS,
+ typename FUNCTOR>
+ Matrix<T,PO,PS>
+ jacfdif (FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ {
+ return jacfdif<PO,Concrete>(fun, theta);
+ }
+
+
+ /*! \brief Calculate the Hessian of a function using a central
+ * difference formula.
+ *
+ * This function numerically calculates the Hessian of a
+ * vector-valued function using a central difference formula.
+ *
+ * \param fun The function to calculate the Hessian of. This
+ * function should take a Matrix (vector) of type T and return a
+ * single value of type T.
+ * \param theta The column vector of parameter values at which to
+ * calculate the Hessian.
+ *
+ * \see gradfdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ * \see gradfdifls(FUNCTOR fun, T alpha, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ * \see jacfdif(FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ *
+ * \throw scythe_dimension_error
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS, typename FUNCTOR>
+ Matrix<T, RO, RS>
+ hesscdif (FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+
+ T fval = fun(theta);
+
+ //std::cout << std::endl;
+ //std::cout << "hesscdif theta = " << theta << "\n";
+ //std::cout << "hesscdif fun(theta) = " << fval << std::endl;
+
+ unsigned int k = theta.rows();
+
+ // stepsize CAREFUL -- THIS IS MACHINE SPECIFIC !!!!
+ T h2 = std::sqrt(epsilon<T>());
+ //T h2 = (T) 1e-10;
+ T h = std::sqrt(h2);
+
+ Matrix<T, RO, RS> H(k,k);
+
+ //std::cout << "h2 = " << h2 << " h = " << h << std::endl;
+
+ Matrix<T,RO> ei;
+ Matrix<T,RO> ej;
+ Matrix<T,RO> temp;
+
+ for (unsigned int i = 0; i < k; ++i) {
+ ei = Matrix<T,RO>(k, 1);
+ ei[i] = h;
+ temp = theta + ei;
+ donothing(temp); // XXX Again, I'm baffled
+ ei = temp - theta;
+ for (unsigned int j = 0; j < k; ++j){
+ ej = Matrix<T,RO>(k,1);
+ ej[j] = h;
+ temp = theta + ej;
+ donothing(temp); // XXX and again
+ ej = temp - theta;
+
+ if (i == j) {
+ H(i,i) = ( -fun(theta + 2.0 * ei) + 16.0 *
+ fun(theta + ei) - 30.0 * fval + 16.0 *
+ fun(theta - ei) -
+ fun(theta - 2.0 * ei)) / (12.0 * h2);
+ } else {
+ H(i,j) = ( fun(theta + ei + ej) - fun(theta + ei - ej)
+ - fun(theta - ei + ej) + fun(theta - ei - ej))
+ / (4.0 * h2);
+ }
+ }
+ }
+
+ //std::cout << "end of hesscdif, H = " << H << "\n";
+ return H;
+ }
+
+ // default template
+ template <typename T, matrix_order PO, matrix_style PS,
+ typename FUNCTOR>
+ Matrix<T,PO,PS>
+ hesscdif (FUNCTOR fun, const Matrix<T,PO,PS>& theta)
+ {
+ return hesscdif<PO,Concrete>(fun, theta);
+ }
+
+ /*! \brief Find the step length that minimizes an implied 1-dimensional function.
+ *
+ * This function performs a line search to find the step length
+ * that approximately minimizes an implied one dimensional
+ * function.
+ *
+ * \param fun The function to minimize. This function should take
+ * one Matrix (vector) argument of type T and return a single value
+ * of type T.
+ * \param theta A column vector of parameter values that anchor the
+ * 1-dimensional function.
+ * \param p A direction vector that creates the 1-dimensional
+ * function.
+ *
+ * \see linesearch2(FUNCTOR fun, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p, rng<RNGTYPE>& runif)
+ * \see zoom(FUNCTOR fun, T alpha_lo, T alpha_hi, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ * \see BFGS(FUNCTOR fun, const Matrix<T,PO,PS>& theta, rng<RNGTYPE>& runif, unsigned int maxit, T tolerance, bool trace = false)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2, typename FUNCTOR>
+ T linesearch1 (FUNCTOR fun, const Matrix<T,PO1,PS1>& theta,
+ const Matrix<T,PO2,PS2>& p)
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+ SCYTHE_CHECK_10(! p.isColVector(), scythe_dimension_error,
+ "p not column vector");
+
+ T alpha_bar = (T) 1.0;
+ T rho = (T) 0.9;
+ T c = (T) 0.5;
+ T alpha = alpha_bar;
+ Matrix<T,PO1> fgrad = gradfdif(fun, theta);
+
+ while (fun(theta + alpha * p) >
+ (fun(theta) + c * alpha * t(fgrad) * p)[0]) {
+ alpha = rho * alpha;
+ }
+
+ return alpha;
+ }
+
+ /*! \brief Find the step length that minimizes an implied 1-dimensional function.
+ *
+ * This function performs a line search to find the step length
+ * that approximately minimizes an implied one dimensional
+ * function.
+ *
+ * \param fun The function to minimize. This function should take
+ * one Matrix (vector) argument of type T and return a single value
+ * of type T.
+ * \param theta A column vector of parameter values that anchor the
+ * 1-dimensional function.
+ * \param p A direction vector that creates the 1-dimensional
+ * function.
+ * \param runif A random uniform number generator function object
+ * (an object that returns a random uniform variate on (0,1) when
+ * its () operator is invoked).
+ *
+ * \see linesearch1(FUNCTOR fun, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ * \see zoom(FUNCTOR fun, T alpha_lo, T alpha_hi, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ * \see BFGS(FUNCTOR fun, const Matrix<T,PO,PS>& theta, rng<RNGTYPE>& runif, unsigned int maxit, T tolerance, bool trace = false)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2, typename FUNCTOR,
+ typename RNGTYPE>
+ T linesearch2 (FUNCTOR fun, const Matrix<T,PO1,PS1>& theta,
+ const Matrix<T,PO2,PS2>& p, rng<RNGTYPE>& runif)
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+ SCYTHE_CHECK_10(! p.isColVector(), scythe_dimension_error,
+ "p not column vector");
+
+ T alpha_last = (T) 0.0;
+ T alpha_cur = (T) 1.0;
+ T alpha_max = (T) 10.0;
+ T c1 = (T) 1e-4;
+ T c2 = (T) 0.5;
+ unsigned int max_iter = 50;
+ T fgradalpha0 = gradfdifls(fun, (T) 0, theta, p);
+
+ for (unsigned int i = 0; i < max_iter; ++i) {
+ T phi_cur = fun(theta + alpha_cur * p);
+ T phi_last = fun(theta + alpha_last * p);
+
+ if ((phi_cur > (fun(theta) + c1 * alpha_cur * fgradalpha0))
+ || ((phi_cur >= phi_last) && (i > 0))) {
+ T alphastar = zoom(fun, alpha_last, alpha_cur, theta, p);
+ return alphastar;
+ }
+
+ T fgradalpha_cur = gradfdifls(fun, alpha_cur, theta, p);
+ if (std::fabs(fgradalpha_cur) <= -1 * c2 * fgradalpha0)
+ return alpha_cur;
+
+ if ( fgradalpha_cur >= (T) 0.0) {
+ T alphastar = zoom(fun, alpha_cur, alpha_last, theta, p);
+ return alphastar;
+ }
+
+ alpha_last = alpha_cur;
+ // runif stuff below is probably not correc KQ 12/08/2006
+ // I think it should work now DBP 01/02/2007
+ alpha_cur = runif() * (alpha_max - alpha_cur) + alpha_cur;
+ }
+
+ return 0.001;
+ }
+
+ /*! \brief Find minimum of a function once bracketed.
+ *
+ * This function finds the minimum of a function, once bracketed.
+ *
+ * \param fun The function to minimize. This function should take
+ * one Matrix (vector) argument of type T and return a single value
+ * of type T.
+ * \param alpha_lo The lower bracket.
+ * \param alpha_hi The upper bracket.
+ * \param theta A column vector of parameter values that anchor the
+ * 1-dimensional function.
+ * \param p A direction vector that creates the 1-dimensional
+ *
+ * \see linesearch1(FUNCTOR fun, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ * \see linesearch2(FUNCTOR fun, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p, rng<RNGTYPE>& runif)
+ * \see BFGS(FUNCTOR fun, const Matrix<T,PO,PS>& theta, rng<RNGTYPE>& runif, unsigned int maxit, T tolerance, bool trace = false)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ *
+ */
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2, typename FUNCTOR>
+ T zoom (FUNCTOR fun, T alpha_lo, T alpha_hi,
+ const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+ SCYTHE_CHECK_10(! p.isColVector(), scythe_dimension_error,
+ "p not column vector");
+
+ T alpha_j = (alpha_lo + alpha_hi) / 2.0;
+ T phi_0 = fun(theta);
+ T c1 = (T) 1e-4;
+ T c2 = (T) 0.5;
+ T fgrad0 = gradfdifls(fun, (T) 0, theta, p);
+
+ unsigned int count = 0;
+ unsigned int maxit = 20;
+ while(count < maxit) {
+ T phi_j = fun(theta + alpha_j * p);
+ T phi_lo = fun(theta + alpha_lo * p);
+
+ if ((phi_j > (phi_0 + c1 * alpha_j * fgrad0))
+ || (phi_j >= phi_lo)){
+ alpha_hi = alpha_j;
+ } else {
+ T fgradj = gradfdifls(fun, alpha_j, theta, p);
+ if (std::fabs(fgradj) <= -1 * c2 * fgrad0){
+ return alpha_j;
+ }
+ if ( fgradj * (alpha_hi - alpha_lo) >= 0){
+ alpha_hi = alpha_lo;
+ }
+ alpha_lo = alpha_j;
+ }
+ ++count;
+ }
+
+ return alpha_j;
+ }
+
+
+ /*! \brief Find function minimum using the BFGS algorithm.
+ *
+ * Numerically find the minimum of a function using the BFGS
+ * algorithm.
+ *
+ * \param fun The function to minimize. This function should take
+ * one Matrix (vector) argument of type T and return a single value
+ * of type T.
+ * \param theta A column vector of parameter values that anchor the
+ * 1-dimensional function.
+ * \param runif A random uniform number generator function object
+ * (an object that returns a random uniform variate on (0,1) when
+ * its () operator is invoked).
+ * \param maxit The maximum number of iterations.
+ * \param tolerance The convergence tolerance.
+ * \param trace Boolean value determining whether BFGS should print
+ * to stdout (defaults to false).
+ *
+ * \see linesearch1(FUNCTOR fun, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ * \see linesearch2(FUNCTOR fun, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p, rng<RNGTYPE>& runif)
+ * \see zoom(FUNCTOR fun, T alpha_lo, T alpha_hi, const Matrix<T,PO1,PS1>& theta, const Matrix<T,PO2,PS2>& p)
+ *
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_convergence_error (Level 0)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ // there were 2 versions of linesearch1-- the latter was what we
+ // had been calling linesearch2
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS,
+ typename FUNCTOR, typename RNGTYPE>
+ Matrix<T,RO,RS>
+ BFGS (FUNCTOR fun, const Matrix<T,PO,PS>& theta, rng<RNGTYPE>& runif,
+ unsigned int maxit, T tolerance, bool trace = false)
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+
+ unsigned int n = theta.size();
+
+ // H is initial inverse hessian
+ Matrix<T,RO> H = inv(hesscdif(fun, theta));
+
+ // gradient at starting values
+ Matrix<T,RO> fgrad = gradfdif(fun, theta);
+ Matrix<T,RO> thetamin = theta;
+ Matrix<T,RO> fgrad_new = fgrad;
+ Matrix<T,RO> I = eye<T,RO>(n);
+ Matrix<T,RO> s;
+ Matrix<T,RO> y;
+
+ unsigned int count = 0;
+ while( (t(fgrad_new)*fgrad_new)[0] > tolerance) {
+ Matrix<T> p = -1.0 * H * fgrad;
+ //std::cout << "initial H * fgrad = " << H * fgrad << "\n";
+ //std::cout << "initial p = " << p << "\n";
+
+ T alpha = linesearch2(fun, thetamin, p, runif);
+ //T alpha = linesearch1(fun, thetamin, p);
+
+ //std::cout << "after linesearch p = " << p << "\n";
+
+
+ Matrix<T> thetamin_new = thetamin + alpha * p;
+ fgrad_new = gradfdif(fun, thetamin_new);
+ s = thetamin_new - thetamin;
+ y = fgrad_new - fgrad;
+ T rho = 1.0 / (t(y) * s)[0];
+ H = (I - rho * s * t(y)) * H *(I - rho * y * t(s))
+ + rho * s * t(s);
+
+ thetamin = thetamin_new;
+ fgrad = fgrad_new;
+ ++count;
+
+ if (trace){
+ std::cout << "BFGS iteration = " << count << std::endl;
+ std::cout << "thetamin = " << (t(thetamin)) ;
+ std::cout << "gradient = " << (t(fgrad)) ;
+ std::cout << "t(gradient) * gradient = " <<
+ (t(fgrad) * fgrad) ;
+ std::cout << "function value = " << fun(thetamin) <<
+ std::endl << std::endl;
+ }
+ //std::cout << "Hessian = " << hesscdif(fun, theta) << "\n";
+ //std::cout << "H = " << H << "\n";
+ //std::cout << "alpha = " << alpha << std::endl;
+ //std::cout << "p = " << p << "\n";
+ //std::cout << "-1 * H * fgrad = " << -1.0 * H * fgrad << "\n";
+
+ SCYTHE_CHECK(count > maxit, scythe_convergence_error,
+ "Failed to converge. Try better starting values");
+ }
+
+ return thetamin;
+ }
+
+ // Default template
+ template <typename T, matrix_order O, matrix_style S,
+ typename FUNCTOR, typename RNGTYPE>
+ Matrix<T,O,Concrete>
+ BFGS (FUNCTOR fun, const Matrix<T,O,S>& theta, rng<RNGTYPE>& runif,
+ unsigned int maxit, T tolerance, bool trace = false)
+ {
+ return BFGS<O,Concrete> (fun, theta, runif, maxit, tolerance, trace);
+ }
+
/* Solves a system of n nonlinear equations in n unknowns of the form
* fun(thetastar) = 0 for thetastar given the function, starting
* value theta, max number of iterations, and tolerance.
* Uses Broyden's method.
*/
- template <class T>
- Matrix<T> nls_broyden(Matrix<T> (*fun)(const Matrix<T> &),
- const Matrix<T> &, const int &maxit=5000,
- const T &tolerance=1e-6);
-
- /* Nls_broyden - Solves a system of n nonlinear equations in n
- * unknowns of the form:
- * fun(thetastar) = 0
- * for thetastar given, the function, the starting value theta,
- * matrix of fixed parameters psi, max iteration, and tolerance.
- * Uses Broyden's method.
- */
- template <class T>
- Matrix<T> nls_broyden(Matrix<T> (*fun)(const Matrix<T> &,
- const Matrix<T> &), const Matrix<T> &,
- const Matrix<T> &, const int &maxit = 5000,
- const T& tolerance = 1e-6);
-
-} // namespace dec
+ /*! \brief Solve a system of nonlinear equations.
+ *
+ * Solves a system of n nonlinear equations in n unknowns of the form
+ * \f$fun(\theta^*) = 0\f$ for \f$\theta^*\f$.
+ *
+ * \param fun The function to solve. The function should both take
+ * and return a Matrix of type T.
+ * \param theta A column vector of parameter values at which to
+ * start the solve procedure.
+ * \param maxit The maximum number of iterations.
+ * \param tolerance The convergence tolerance.
+ *
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_convergence_error (Level 1)
+ *
+ * \note
+ * Users will typically wish to implement \a fun in terms of a
+ * functor. Using a functor provides a generic way in which to
+ * evaluate functions with more than one parameter. Furthermore,
+ * although one can pass a function pointer to this routine,
+ * the compiler cannot inline and fully optimize code
+ * referenced by function pointers.
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO, matrix_style PS, typename FUNCTOR>
+ Matrix<T,RO,RS>
+ nls_broyden(FUNCTOR fun, const Matrix<T,PO,PS>& theta,
+ unsigned int maxit = 5000, T tolerance = 1e-6)
+ {
+ SCYTHE_CHECK_10(! theta.isColVector(), scythe_dimension_error,
+ "Theta not column vector");
+
+
+ Matrix<T,RO> thetastar = theta;
+ Matrix<T,RO> B = jacfdif(fun, thetastar);
+
+ Matrix<T,RO> fthetastar;
+ Matrix<T,RO> p;
+ Matrix<T,RO> thetastar_new;
+ Matrix<T,RO> fthetastar_new;
+ Matrix<T,RO> s;
+ Matrix<T,RO> y;
+
+ for (unsigned int i = 0; i < maxit; ++i) {
+ fthetastar = fun(thetastar);
+ p = lu_solve(B, -1 * fthetastar);
+ T alpha = (T) 1.0;
+ thetastar_new = thetastar + alpha*p;
+ fthetastar_new = fun(thetastar_new);
+ s = thetastar_new - thetastar;
+ y = fthetastar_new - fthetastar;
+ B = B + ((y - B * s) * t(s)) / (t(s) * s);
+ thetastar = thetastar_new;
+ if (max(fabs(fthetastar_new)) < tolerance)
+ return thetastar;
+ }
+
+ SCYTHE_THROW_10(scythe_convergence_error, "Failed to converge. Try better starting values or increase maxit");
+
+ return thetastar;
+ }
+
+ // default template
+ template <typename T, matrix_order O, matrix_style S,
+ typename FUNCTOR>
+ Matrix<T,O,Concrete>
+ nls_broyden (FUNCTOR fun, const Matrix<T,O,S>& theta,
+ unsigned int maxit = 5000, T tolerance = 1e-6)
+ {
+ return nls_broyden<O,Concrete>(fun, theta, maxit, tolerance);
+ }
-#if defined (SCYTHE_COMPILE_DIRECT) && \
- (defined (__GNUG__) || defined (__MWERKS__) || \
- defined (_MSC_VER) || defined (EXPLICIT_TEMPLATE_INSTANTIATION))
-#include "optimize.cc"
-#endif /* EXPLICIT_TEMPLATE_INSTANTIATION */
+} // namespace scythe
#endif /* SCYTHE_OPTIMIZE_H */
diff --git a/src/rng.cc b/src/rng.cc
deleted file mode 100644
index 4a2aa97..0000000
--- a/src/rng.cc
+++ /dev/null
@@ -1,1161 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/rng.h
- *
- * Provides the implementation for the rng class. This abstract
- * class forms the foundation of random number generation in Scythe.
- *
- */
-
-#ifndef SCYTHE_RNG_CC
-#define SCYTHE_RNG_CC
-
-#include <iostream>
-#include <cmath>
-
-#ifdef HAVE_IEEEFP_H
-#include <ieeefp.h>
-#endif
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "rng.h"
-#include "distributions.h"
-#include "util.h"
-#include "ide.h"
-#include "stat.h"
-#else
-#include "scythestat/rng.h"
-#include "scythestat/distributions.h"
-#include "scythestat/util.h"
-#include "scythestat/ide.h"
-#include "scythestat/stat.h"
-#endif
-
-namespace SCYTHE {
-
- /* Default constructor */
- rng::rng ()
- {
- }
-
- rng::~rng()
- {
- }
-
- /* Random Numbers */
- Matrix<double>
- rng::runif (const int &rows, const int &cols)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
-
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = runif();
-
- return temp;
- }
-
- double
- rng::rbeta (const double& alpha, const double& beta)
- {
- static double report;
- double xalpha, xbeta;
-
- // Check for allowable parameters
- if (alpha <= 0) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "alpha <= 0");
- }
- if (beta <= 0) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "beta <= 0");
- }
-
- xalpha = rchisq (2 * alpha);
- xbeta = rchisq (2 * beta);
- report = xalpha / (xalpha + xbeta);
-
- return (report);
- }
-
- Matrix<double>
- rng::rbeta (const int& rows, const int& cols, const double& alpha,
- const double& beta)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
-
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rbeta (alpha, beta);
-
- return temp;
- }
-
- /* Return a pseudo-random deviate from a non-cental hypergeometric
- * distribution
- */
- double
- rng::rnchypgeom(const double& m1, const double& n1,
- const double& n2, const double& psi,
- const double& delta)
- {
- // Calculate mode of mass function
- double a = psi - 1;
- double b = -1 * ((n1+m1+2)*psi + n2 - m1);
- double c = psi * (n1+1) * (m1+1);
- double q = -0.5 * ( b + sgn(b)* ::sqrt(::pow(b,2) - 4*a*c));
- double root1 = c/q;
- double root2 = q/a;
- double el = max(0.0, m1-n2);
- double u = min(n1,m1);
- double mode = floor(root1);
- int exactcheck = 0;
- if (u<mode || mode<el) {
- mode = floor(root2);
- exactcheck = 1;
- }
-
-
- int size = static_cast<int>(u+1);
-
- double *fvec = new double[size];
- fvec[static_cast<int>(mode)] = 1.0;
- double s;
- // compute the mass function at y
- if (delta <= 0 || exactcheck==1){ //exact evaluation
- // sum from mode to u
- double f = 1.0;
- s = 1.0;
- for (double i=(mode+1); i<=u; ++i){
- double r = ((n1-i+1)*(m1-i+1))/(i*(n2-m1+i)) * psi;
- f = f*r;
- s += f;
- fvec[static_cast<int>(i)] = f;
- }
-
- // sum from mode to el
- f = 1.0;
- for (double i=(mode-1); i>=el; --i){
- double r = ((n1-i)*(m1-i))/((i+1)*(n2-m1+i+1)) * psi;
- f = f/r;
- s += f;
- fvec[static_cast<int>(i)] = f;
- }
- } else { // approximation
- double epsilon = delta/10.0;
- // sum from mode to ustar
- double f = 1.0;
- s = 1.0;
- double i = mode+1;
- double r;
- do {
- if (i>u) break;
- r = ((n1-i+1)*(m1-i+1))/(i*(n2-m1+i)) * psi;
- f = f*r;
- s += f;
- fvec[static_cast<int>(i)] = f;
- ++i;
- } while(f>=epsilon || r>=5.0/6.0);
-
- // sum from mode to elstar
- f = 1.0;
- i = mode-1;
- do {
- if (i<el) break;
- r = ((n1-i)*(m1-i))/((i+1)*(n2-m1+i+1)) * psi;
- f = f/r;
- s += f;
- fvec[static_cast<int>(i)] = f;
- --i;
- } while(f>=epsilon || r <=6.0/5.0);
- }
-
- double udraw = runif();
- double psum = fvec[static_cast<int>(mode)]/s;
- if (udraw<=psum)
- return mode;
- double lower = mode-1;
- double upper = mode+1;
-
- do{
- double fl;
- double fu;
- if (lower >= el)
- fl = fvec[static_cast<int>(lower)];
- else
- fl = 0.0;
-
- if (upper <= u)
- fu = fvec[static_cast<int>(upper)];
- else
- fu = 0.0;
-
- if (fl > fu) {
- psum += fl/s;
- if (udraw<=psum)
- return lower;
- --lower;
- } else {
- psum += fu/s;
- if (udraw<=psum)
- return upper;
- ++upper;
- }
- } while(udraw>psum);
-
- delete [] fvec;
- exit(500000);
- }
-
- Matrix<double>
- rng::rnchypgeom(const int &rows, const int &cols, const double &m1,
- const double &n1, const double &n2,
- const double &psi, const double &delta)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
-
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rnchypgeom (m1, n1, n2, psi, delta);
-
- return temp;
- }
-
- /* Random Numbers */
- int
- rng::rbinom (const int& n, const double& p)
- {
- static int report;
- int count = 0;
- double hold;
-
- // Check for allowable parameters
- if (n <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "n <= 0");
- }
- if (p < 0 || p > 1) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p not in [0,1]");
- }
-
- // Loop and count successes
- for (int i = 0; i < n; i++) {
- hold = runif ();
- if (hold < p)
- count++;
- }
- report = count;
-
- return (report);
- }
-
- Matrix<double>
- rng::rbinom (const int& rows, const int& cols, const int& n,
- const double& p)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rbinom (n, p);
-
- return temp;
- }
-
- double
- rng::rchisq (const double &nu)
- {
- static double report;
-
- // Check for allowable paramter
- if (nu <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Degrees of freedom <= 0");
- }
-
- // Return Gamma(nu/2, 1/2) deviate
- report = rgamma (nu / 2, .5);
-
- return (report);
- }
-
- Matrix<double>
- rng::rchisq (const int &rows, const int &cols, const double &nu)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rchisq (nu);
-
- return temp;
- }
-
- double
- rng::rexp (const double &beta)
- {
- static double report;
-
- // Check for allowable parameter
- if (beta <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Inverse scale parameter beta <= 0");
- }
-
- report = -std::log (runif ()) / beta;
-
- return (report);
- }
-
- Matrix<double>
- rng::rexp (const int &rows, const int &cols, const double &beta)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rexp (beta);
-
- return temp;
- }
-
- double
- rng::rf (const double &n1, const double &n2)
- {
- if (n1 <= 0.0 || n2 <= 0.0)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "n1 or n2 <= 0");
-
- return ((rchisq(n1) / n1) / (rchisq(n2) / n2));
- }
-
- Matrix<double>
- rng::rf(const int &rows, const int &cols, const double &n1,
- const double &n2)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rf (n1, n2);
-
- return temp;
- }
-
- double
- rng::rgamma (const double &alpha, const double &beta)
- {
- static double report;
-
- // Check for allowable parameters
- if (alpha <= 0) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "alpha <= 0");
- }
- if (beta <= 0) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "beta <= 0");
- }
-
- if (alpha > 1)
- report = rgamma1 (alpha) / beta;
- else if (alpha == 1)
- report = -::log (runif ()) / beta;
- else if (alpha < 1)
- report = rgamma1 (alpha + 1) * ::pow (runif (), 1 / alpha) / beta;
-
- return (report);
- }
-
- Matrix<double>
- rng::rgamma(const int& rows, const int& cols, const double& alpha,
- const double& beta)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rgamma (alpha, beta);
-
- return temp;
- }
-
- double
- rng::rlogis (const double& alpha, const double& beta)
- {
- static double report;
- double unif;
-
- // Check for allowable paramters
- if (beta <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "beta <= 0");
- }
-
- unif = runif ();
- report = alpha + beta * std::log (unif / (1 - unif));
-
- return (report);
- }
-
- Matrix<double>
- rng::rlogis(const int& rows, const int& cols, const double& alpha,
- const double& beta)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rlogis (alpha, beta);
-
- return temp;
- }
-
- double
- rng::rlnorm (const double &logmean, const double &logsd)
- {
- if (logsd < 0.0)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "standard deviation < 0");
-
- return std::exp(rnorm(logmean, logsd));
- }
-
- Matrix<double>
- rng::rlnorm(const int &rows, const int &cols, const double &logmean,
- const double &logsd)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rlnorm (logmean, logsd);
-
- return temp;
- }
-
- double
- rng::rnbinom (const double &n, const double &p)
- {
- if (n <= 0 || p <= 0 || p > 1)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "n <= 0, p <= 0, or p > 1");
-
- return rpois(rgamma(n, (1 - p) / p));
- }
-
- Matrix<double>
- rng::rnbinom (const int &rows, const int &cols, const double &n,
- const double &p)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = rnbinom(n, p);
-
- return temp;
- }
-
- double
- rng::rnorm (const double &mu, const double &sigma)
- {
- if (sigma <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Negative variance");
- }
-
- return (mu + rnorm1 () * sigma);
- }
-
- Matrix<double>
- rng::rnorm (const int &rows, const int &cols, const double &mu,
- const double &sigma)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rnorm (mu, sigma);
-
- return temp;
- }
-
- int
- rng::rpois(const double &lambda)
- {
- if (lambda <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__, __LINE__,
- "lambda <= 0");
- }
- int n;
-
- if (lambda < 33){
- double cutoff = ::exp(-lambda);
- n = -1;
- double t = 1.0;
- do {
- ++n;
- t *= runif();
- } while (t > cutoff);
- } else{
- int accept = 0;
- double c = 0.767 - 3.36/lambda;
- double beta = M_PI/::sqrt(3*lambda);
- double alpha = lambda*beta;
- double k = ::log(c) - lambda - ::log(beta);
-
- while (accept == 0){
- double u1 = runif();
- double x = (alpha - ::log((1-u1)/u1))/beta;
- while (x <= -0.5){
- u1 = runif();
- x = (alpha - ::log((1-u1)/u1))/beta;
- }
- n = static_cast<int>(x + 0.5);
- double u2 = runif();
- double lhs = alpha - beta*x +
- ::log(u2/::pow(1+::exp(alpha-beta*x),2));
- double rhs = k + n*::log(lambda) - lnfactorial(n);
- if (lhs <= rhs)
- accept = 1;
- }
- }
-
- return n;
- }
-
- Matrix<int>
- rng::rpois (const int &rows, const int &cols, const double &lambda)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = rpois(lambda);
-
- return temp;
- }
-
- double
- rng::rt (const double& mu, const double& sigma2,
- const double& nu)
- {
- static double report;
- double x, z;
-
- // Check for allowable paramters
- if (sigma2 <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Variance parameter sigma2 <= 0");
- }
- if (nu <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "D.O.F parameter nu <= 0");
- }
-
- z = rnorm1 ();
- x = rchisq (nu);
- report = mu + ::sqrt (sigma2) * z * ::sqrt (nu) / ::sqrt (x);
-
- return (report);
- }
-
- Matrix<double>
- rng::rt (const int& rows, const int& cols, const double& mu,
- const double& sigma2, const double& nu)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rt (mu, sigma2, nu);
-
- return temp;
- }
-
-
- double
- rng::rweibull (const double &shape, const double &scale)
- {
- if (shape <= 0 || scale <= 0)
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "shape or scale <= 0");
-
- return scale * std::pow(-std::log(runif()), 1.0 / shape);
- }
-
- Matrix<double>
- rng::rweibull(const int& rows, const int& cols, const double& shape,
- const double& scale)
- {
- int size = rows * cols;
- if (size <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Tried to create matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; i++)
- temp[i] = rweibull(shape,scale);
-
- return temp;
- }
-
- double
- rng::richisq (const double &nu)
- {
- static double report;
-
- // Check for allowable parameter
- if (nu <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Degrees of freedom <= 0");
- }
-
- // Return Inverse-Gamma(nu/2, 1/2) deviate
- report = rigamma (nu / 2, .5);
- return (report);
- }
-
- Matrix<double>
- rng::richisq (const int& rows, const int& cols, const double& nu)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = richisq (nu);
-
- return temp;
- }
-
-
- double
- rng::rigamma (const double& alpha, const double& beta)
- {
- static double report;
-
- // Check for allowable parameters
- if (alpha <= 0) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "alpha <= 0");
- }
- if (beta <= 0) {
- throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "beta <= 0");
- }
- // Return reciprocal of gamma deviate
- report = ::pow (rgamma (alpha, beta), -1);
-
- return (report);
- }
-
- Matrix<double>
- rng::rigamma ( const int &rows, const int &cols, const double &alpha,
- const double &beta)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
-
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rigamma (alpha, beta);
-
- return temp;
- }
-
- Matrix<double>
- rng::rwish(const int &v, const Matrix<double> &S)
- {
- if (! S.isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "S not square");
- }
- if (v < S.rows()) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "v < S.rows()");
- }
-
- Matrix<double> A(S.rows(), S.rows()); //XXX init to 0?
- Matrix<double> C = cholesky(S);
- Matrix<double> alpha;
-
- for (int i = 0; i < v; ++i) {
- alpha = C * rnorm(S.rows(), 1);
- A = A + (alpha * (!alpha));
- }
-
- return(A);
- }
-
- /* Dirichlet generator */
- Matrix<double>
- rng::rdirich(const Matrix<double> &alpha)
- {
- // Check for allowable parameters
- if (min(alpha) <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "alpha has elements < 0");
- }
- if (alpha.cols() > 1) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "alpha not column vector");
- }
-
- int dim = alpha.rows();
- Matrix<double> y(dim, 1);
- double ysum = 0;
- for (int i=0; i<dim; ++i){
- y[i] = rgamma(alpha[i], 1);
- ysum += y[i];
- }
-
- Matrix<double> report = y;
- for (int i=0; i<dim; ++i)
- report[i] = y[i]/ysum;
- return(report);
- }
-
-
- /* Multivariate Normal */
- Matrix<double>
- rng::rmvnorm(const Matrix<double> &mu, const Matrix<double> &sigma)
- {
- int dim = mu.rows();
- if (mu.cols() != 1) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "mu not column vector");
- }
- if (! sigma.isSquare()) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "sigma not square");
- }
- if (sigma.rows() != dim) {
- throw scythe_dimension_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "mu and sigma not conformable");
- }
-
- Matrix<double> A = mu + cholesky(sigma) * rnorm(dim,1);
- return(A);
- }
-
- /* Multivariate t */
- Matrix<double>
- rng::rmvt (const Matrix<double> &sigma, const double &nu) {
- Matrix<double> result;
- if (nu <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "D.O.F parameter nu <= 0");
- }
- result = rmvnorm(Matrix<double>(sigma.rows(), 1, true, 0), sigma);
- return result / std::sqrt(rchisq(nu) / nu);
- }
-
- /* Bernoulli */
- int
- rng::rbern (const double &p)
- {
- static int report;
- double unif;
-
- // Check for allowable paramters
- if (p < 0 || p > 1) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "p parameter not in[0,1]");
- }
-
- unif = runif ();
- if (unif < p)
- report = 1;
- else
- report = 0;
-
- return (report);
- }
-
- Matrix<double>
- rng::rbern (const int& rows, const int& cols, const double& p)
- {
- int size = rows * cols;
- if (size <= 0) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Attempted to create Matrix of size <= 0");
- }
- Matrix<double> temp(rows, cols, false);
- for (int i = 0; i < size; ++i)
- temp[i] = rbern (p);
-
- return temp;
- }
-
- double
- rng::rtnorm(const double& m, const double& v, const double& below,
- const double& above)
- {
- if (below > above) {
- std::cout << "mean = " << m << " and var = " << v << std::endl <<
- "below = " << below << " and above = " << above << std::endl;
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, \
- "Truncation bound not logically consistent");
- }
-
- double FA = 0.0;
- double FB = 0.0;
- double sd = ::sqrt(v);
- if ((::fabs((above-m)/sd) < 8.2) && (::fabs((below-m)/sd) < 8.2)){
- FA = pnorm2((above-m)/sd, true, false);
- FB = pnorm2((below-m)/sd, true, false);
- }
- if ((((above-m)/sd) < 8.2) && (((below-m)/sd) <= -8.2) ){
- FA = pnorm2((above-m)/sd, true, false);
- FB = 0.0;
- }
- if ( (((above-m)/sd) >= 8.2) && (((below-m)/sd) > -8.2) ){
- FA = 1.0;
- FB = FB = pnorm2((below-m)/sd, true, false);
- }
- if ( (((above-m)/sd) >= 8.2) && (((below-m)/sd) <= -8.2)){
- FA = 1.0;
- FB = 0.0;
- }
- double term = runif()*(FA-FB)+FB;
- if (term < 5.6e-17)
- term = 5.6e-17;
- if (term > (1 - 5.6e-17))
- term = 1 - 5.6e-17;
- double draw = m + sd * qnorm1(term);
- if (draw > above)
- draw = above;
- if (draw < below)
- draw = below;
-
- return draw;
- }
-
- double
- rng::rtnorm_combo(const double& m, const double& v,
- const double& below, const double& above)
- {
- if (below >= above) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Truncation bound not logically consistent");
- }
- double s = ::sqrt(v);
-
- if (( ((above-m)/s > 0.5) && ((m-below)/s > 0.5)) ||
- ( ((above-m)/s > 2.0) && ((below-m)/s < 0.25)) ||
- ( ((m-below)/s > 2.0) && ((above-m)/s > -0.25)) ){
- double x = rnorm(m, s);
- while ((x > above) || (x < below))
- x = rnorm(m,s);
- return x;
- } else {
- // use the inverse cdf method
- double FA = 0.0;
- double FB = 0.0;
- if ((::fabs((above-m)/s) < 8.2) && (::fabs((below-m)/s) < 8.2)){
- FA = pnorm2((above-m)/s, true, false);
- FB = pnorm2((below-m)/s, true, false);
- }
- if ((((above-m)/s) < 8.2) && (((below-m)/s) <= -8.2) ){
- FA = pnorm2((above-m)/s, true, false);
- FB = 0.0;
- }
- if ( (((above-m)/s) >= 8.2) && (((below-m)/s) > -8.2) ){
- FA = 1.0;
- FB = FB = pnorm2((below-m)/s, true, false);
- }
- if ( (((above-m)/s) >= 8.2) && (((below-m)/s) <= -8.2)){
- FA = 1.0;
- FB = 0.0;
- }
- double term = runif()*(FA-FB)+FB;
- if (term < 5.6e-17)
- term = 5.6e-17;
- if (term > (1 - 5.6e-17))
- term = 1 - 5.6e-17;
- double x = m + s * qnorm1(term);
- if (x > above)
- x = above;
- if (x < below)
- x = below;
- return x;
- }
- }
-
- double
- rng::rtbnorm_slice (const double& m, const double& v,
- const double& below, const int& iter)
- {
- if (below < m) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Truncation point < mean");
- }
- if (v <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Variance non-positive");
- }
-
- double z = 0;
- double x = below + .00001;
-
- for (int i=0; i<iter; ++i){
- z = runif()*::exp(-1*::pow((x-m),2)/(2*v));
- x = runif()*( (m + ::sqrt(-2*v*::log(z))) - below) + below;
- }
- if (! finite(x)) {
- std::cerr << "WARNING in "
- << __FILE__ << ", " << __PRETTY_FUNCTION__ << ", "
- << __LINE__ << ": Mean extremely far from truncation point. "
- << "Returning truncation point" << std::endl;
- return below;
- }
- return x;
- }
-
- double
- rng::rtanorm_slice (const double& m, const double& v,
- const double& above, const int& iter)
- {
- if (above > m) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Truncation point > mean");
- }
- if (v <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Variance non-positive");
- }
-
- double below = -1*above;
- double newmu = -1*m;
- double z = 0;
- double x = below + .00001;
-
- for (int i=0; i<iter; ++i){
- z = runif()*::exp(-1*::pow((x-newmu),2)/(2*v));
- x = runif()*( (newmu + ::sqrt(-2*v*::log(z))) - below) + below;
- }
- if (! finite(x)) {
- std::cerr << "WARNING in "
- << __FILE__ << ", " << __PRETTY_FUNCTION__ << ", "
- << __LINE__ << ": Mean extremely far from truncation point. "
- << "Returning truncation point" << std::endl;
- return above;
- }
-
- return -1*x;
- }
-
- double
- rng::rtbnorm_combo (const double& m, const double& v,
- const double& below, const int& iter)
- {
- if (v <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Variance non-positive");
- }
-
- double s = ::sqrt(v);
- // do rejection sampling and return value
- //if (m >= below){
- if ((m/s - below/s ) > -0.5){
- double x = rnorm(m, s);
- while (x < below)
- x = rnorm(m,s);
- return x;
- } else if ((m/s - below/s ) > -5.0 ){
- // use the inverse cdf method
- double above = std::numeric_limits<double>::infinity();
- double x = rtnorm(m, v, below, above);
- return x;
- } else {
- // do slice sampling and return value
- double z = 0;
- double x = below + .00001;
- for (int i=0; i<iter; ++i){
- z = runif()*::exp(-1*::pow((x-m),2)/(2*v));
- x = runif()*( (m + ::sqrt(-2*v*::log(z))) - below) + below;
- }
- if (! finite(x)) {
- std::cerr << "WARNING in "
- << __FILE__ << ", " << __PRETTY_FUNCTION__ << ", "
- << __LINE__ << ": Mean extremely far from truncation point. "
- << "Returning truncation point" << std::endl;
- return below;
- }
- return x;
- }
- }
-
- double
- rng::rtanorm_combo (const double& m, const double& v,
- const double& above, const int& iter)
- {
- if (v <= 0){
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "Variance non-positive");
- }
- double s = ::sqrt(v);
- // do rejection sampling and return value
- if ((m/s - above/s ) < 0.5){
- double x = rnorm(m, s);
- while (x > above)
- x = rnorm(m,s);
- return x;
- } else if ((m/s - above/s ) < 5.0 ){
- // use the inverse cdf method
- double below = -std::numeric_limits<double>::infinity();
- double x = rtnorm(m, v, below, above);
- return x;
- } else {
- // do slice sampling and return value
- double below = -1*above;
- double newmu = -1*m;
- double z = 0;
- double x = below + .00001;
-
- for (int i=0; i<iter; ++i){
- z = runif()*::exp(-1*::pow((x-newmu),2)/(2*v));
- x = runif()*( (newmu + ::sqrt(-2*v*::log(z))) - below) + below;
- }
- if (! finite(x)) {
- std::cerr << "WARNING in "
- << __FILE__ << ", " << __PRETTY_FUNCTION__ << ", "
- << __LINE__ << ": Mean extremely far from truncation point. "
- << "Returning truncation point" << std::endl;
- return above;
- }
- return -1*x;
- }
- }
-
- double
- rng::rnorm1 ()
- {
- static int rnorm_count = 1;
- static double x2;
- double nu1, nu2, rsquared, sqrt_term;
- if (rnorm_count == 1){ // odd numbered passses
- do {
- nu1 = -1 +2*runif();
- nu2 = -1 +2*runif();
- rsquared = ::pow(nu1,2) + ::pow(nu2,2);
- } while (rsquared >= 1 || rsquared == 0.0);
- sqrt_term = ::sqrt(-2*::log(rsquared)/rsquared);
- x2 = nu2*sqrt_term;
- rnorm_count = 2;
- return nu1*sqrt_term;
- } else { // even numbered passes
- rnorm_count = 1;
- return x2;
- }
- }
-
- double
- rng::rgamma1 (const double &alpha)
- {
- int test;
- double u, v, w, x, y, z, b, c;
- static double accept;
-
- // Check for allowable parameters
- if (alpha <= 1) {
- throw scythe_invalid_arg (__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "alpha < 1");
- }
-
- // Implement Best's (1978) simulator
- b = alpha - 1;
- c = 3 * alpha - 0.75;
- test = 0;
- while (test == 0) {
- u = runif ();
- v = runif ();
-
- w = u * (1 - u);
- y = ::sqrt (c / w) * (u - .5);
- x = b + y;
-
- if (x > 0) {
- z = 64 * ::pow (v, 2) * ::pow (w, 3);
- if (z <= (1 - (2 * ::pow (y, 2) / x))) {
- test = 1;
- accept = x;
- } else if ((2 * (b * ::log (x / b) - y)) >= ::log (z)) {
- test = 1;
- accept = x;
- } else {
- test = 0;
- }
- }
- }
-
- return (accept);
- }
-}
-
-#endif /* SCYTHE_RNG_CC */
diff --git a/src/rng.h b/src/rng.h
index ced7623..11987ff 100644
--- a/src/rng.h
+++ b/src/rng.h
@@ -1,29 +1,16 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * scythestat/rng.h
- *
- * Provides the class definition for the rng class. This abstract
- * class forms the foundation of random number generation in Scythe.
- * Specific random number generators should extend this class and
- * implement the virtual void function runif(); this function should
- * take no arguments and return uniformly distributed random numbers
- * on the interval (0, 1). The rng class provides no interface for
- * seed-setting or intitialization, allowing for maximal flexibility
- * in underlying implementation. This class does provide
- * implementations of functions that return random numbers from a wide
- * variety of commonly (and not-so-commonly) used distributions by
- * manipulating the uniform deviates returned by runif().
+ * scythestat/rng.h
*
* The code for many of the RNGs defined in this file and implemented
* in rng.cc is based on that in the R project, version 1.6.0-1.7.1.
@@ -33,196 +20,1461 @@
* Copyright (C) 1998 Ross Ihaka
* Copyright (C) 2000-2002 The R Development Core Team
* Copyright (C) 2003 The R Foundation
+ */
+
+/*!
+ * \file rng.h
+ *
+ * \brief The definition of the random number generator base class.
*
*/
+/* Doxygen doesn't deal well with the macros that we use to make
+ * matrix versions of rngs easy to define.
+ */
+
#ifndef SCYTHE_RNG_H
#define SCYTHE_RNG_H
+#include <iostream>
+#include <cmath>
+
+#ifdef HAVE_IEEEFP_H
+#include <ieeefp.h>
+#endif
+
#ifdef SCYTHE_COMPILE_DIRECT
#include "matrix.h"
+#include "error.h"
+#include "algorithm.h"
+#include "distributions.h"
+#include "ide.h"
+#include "la.h"
#else
#include "scythestat/matrix.h"
+#include "scythestat/error.h"
+#include "scythestat/algorithm.h"
+#include "scythestat/distributions.h"
+#include "scythestat/ide.h"
+#include "scythestat/la.h"
#endif
-namespace SCYTHE {
+namespace scythe {
- class rng
- {
- public:
+/* Shorthand for the matrix versions of the various distributions'
+ * random number generators.
+ */
+
+#define SCYTHE_RNGMETH_MATRIX(NAME, RTYPE, ARGNAMES, ...) \
+ template <matrix_order O, matrix_style S> \
+ Matrix<RTYPE, O, S> \
+ NAME (unsigned int rows, unsigned int cols, __VA_ARGS__) \
+ { \
+ Matrix<RTYPE, O, Concrete> ret(rows, cols, false); \
+ typename Matrix<RTYPE,O,Concrete>::forward_iterator it; \
+ typename Matrix<RTYPE,O,Concrete>::forward_iterator last \
+ = ret.end_f(); \
+ for (it = ret.begin_f(); it != last; ++it) \
+ *it = NAME (ARGNAMES); \
+ SCYTHE_VIEW_RETURN(RTYPE, O, S, ret) \
+ } \
+ \
+ Matrix<RTYPE, Col, Concrete> \
+ NAME (unsigned int rows, unsigned int cols, __VA_ARGS__) \
+ { \
+ return NAME <Col,Concrete> (rows, cols, ARGNAMES); \
+ }
- /* Default (and only) constructor. */
- rng ();
+ /*! \brief Random number generator.
+ *
+ * This class provides objects capable of generating random numbers
+ * from a variety of probability distributions. This
+ * abstract class forms the foundation of random number generation in
+ * Scythe. Specific random number generators should extend this class
+ * and implement the virtual void function runif(); this function
+ * should take no arguments and return uniformly distributed random
+ * numbers on the interval (0, 1). The rng class provides no
+ * interface for seed-setting or initialization, allowing for maximal
+ * flexibility in underlying implementation. This class does provide
+ * implementations of functions that return random numbers from a wide
+ * variety of commonly (and not-so-commonly) used distributions, by
+ * manipulating the uniform variates returned by runif(). See
+ * rng/mersenne.h and rng/lecuyer.h for the rng implementations
+ * offered by Scythe.
+ *
+ * Each univariate distribution is represented by three overloaded
+ * versions of the same method. The first is a simple method
+ * returning a single value. The remaining method versions return
+ * Matrix values and are equivalent to calling the single-valued
+ * method multiple times to fill a Matrix object. They each take
+ * two arguments describing the number of rows and columns in the
+ * returned Matrix object and as many subsequent arguments as is
+ * necessary to describe the distribution. As is the case
+ * throughout the library, the Matrix-returning versions of the
+ * method include both a general and default template. We
+ * explicitly document only the single-valued versions of the
+ * univariate methods. For matrix-valued distributions we provide
+ * only a single method per distribution.
+ *
+ * \note Doxygen incorrectly parses the macros we use to
+ * automatically generate the Matrix returning versions of the
+ * various univariate methods in this class. Whenever you see the
+ * macro variable __VA_ARGS__ in the public member function list
+ * below, simply substitute in the arguments in the explicitly
+ * documented single-valued version of the method.
+ *
+ */
+ template <class RNGTYPE>
+ class rng
+ {
+ public:
- /* Destructor */
- virtual ~rng();
-
- /* Returns random uniform numbers on (0, 1). This function must
- * be implemented by extending classes */
- virtual double runif () = 0;
-
- virtual Matrix<double> runif (const int &, const int &);
-
- /**** Random deviates from various distributions */
-
- /* Beta distribution */
- double rbeta (const double &, const double &);
+ /* This declaration allows users to treat rng objects like
+ * functors that generate random uniform numbers. This can be
+ * quite convenient.
+ */
+ /*! \brief Generate uniformly distributed random variates.
+ *
+ * This operator acts as an alias for runif() and generates
+ * pseudo-random variates from the uniform distribution on the
+ * interval (0, 1). We include this operator to allow rng
+ * objects to behave as function objects.
+ */
+ double operator() ()
+ {
+ return runif();
+ }
- Matrix<double> rbeta (const int &, const int &,
- const double &, const double &);
-
- /* Non-central hypergeometric distribution */
- double rnchypgeom(const double& m1, const double& n1,
- const double& n2, const double& psi,
- const double& delta=1e-14);
-
- Matrix<double> rnchypgeom(const int &, const int &,
- const double&, const double&,
- const double&, const double&,
- const double& delta=1e-14);
+ /* Returns random uniform numbers on (0, 1). This function must
+ * be implemented by extending classes */
+ /*! \brief Generate uniformly distributed random variates.
+ *
+ * This method generates pseudo-random variates from the
+ * uniform distribution on the interval (0, 1).
+ *
+ * This function is pure virtual and is implemented by
+ * extending concrete classes, like scythe::mersenne and
+ * scythe::lecuyer.
+ */
+ double runif ()
+ {
+ return as_derived().runif();
+ }
- /* Binomial distribution */
- int rbinom (const int &, const double &);
-
- Matrix<double> rbinom ( const int &, const int &,
- const int &, const double &);
- /* Chi^2 distribution */
- double rchisq (const double &);
+ /* No point in declaring these virtual because we have to
+ * override them anyway because C++ isn't too bright. Also, it
+ * is illegal to make template methods virtual
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix<double,O,S> runif(unsigned int rows,
+ unsigned int cols)
+ {
+ Matrix<double, O, S> ret(rows, cols, false);
+ typename Matrix<double,O,S>::forward_iterator it;
+ typename Matrix<double,O,S>::forward_iterator last=ret.end_f();
+ for (it = ret.begin_f(); it != last; ++it)
+ *it = runif();
- Matrix<double> rchisq ( const int &, const int &,
- const double &);
+ return ret;
+ }
- /* Exponential distribution */
- double rexp (const double &);
+ Matrix<double,Col,Concrete> runif(unsigned int rows,
+ unsigned int cols)
+ {
+ return runif<Col,Concrete>(rows, cols);
+ }
- Matrix<double> rexp ( const int &rows, const int &cols,
- const double &);
+ /*! \brief Generate a beta distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * beta distribution described by the shape parameters \a a and
+ * \a b.
+ *
+ * \param alpha The first positive beta shape parameter.
+ * \param beta the second positive beta shape parameter.
+ *
+ * \see pbeta(double x, double a, double b)
+ * \see dbeta(double x, double a, double b)
+ * \see betafn(double a, double b)
+ * \see lnbetafn(double a, double b)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rbeta (double alpha, double beta)
+ {
+ double report;
+ double xalpha, xbeta;
+
+ // Check for allowable parameters
+ SCYTHE_CHECK_10(alpha <= 0, scythe_invalid_arg, "alpha <= 0");
+ SCYTHE_CHECK_10(beta <= 0, scythe_invalid_arg, "beta <= 0");
+
+ xalpha = rchisq (2 * alpha);
+ xbeta = rchisq (2 * beta);
+ report = xalpha / (xalpha + xbeta);
+
+ return (report);
+ }
- /* f distribution */
- double rf(const double &, const double &);
-
- Matrix<double> rf(const int &, const int &,
- const double &, const double &);
-
- /* Gamma distribution */
- double rgamma (const double &, const double &);
-
- Matrix<double> rgamma ( const int &, const int &,
- const double &, const double &);
+ SCYTHE_RNGMETH_MATRIX(rbeta, double, SCYTHE_ARGSET(alpha, beta),
+ double alpha, double beta);
- /* Logistic distribution */
- double rlogis (const double &, const double &);
+ /*! \brief Generate a non-central hypergeometric disributed
+ * random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * non-centrial hypergeometric distribution described by the
+ * number of positive outcomes \a m1, the two group size
+ * parameters \a n1 and \a n2, and the odds ratio \a psi.
+ *
+ * \param m1 The number of positive outcomes in both groups.
+ * \param n1 The size of group one.
+ * \param n2 The size of group two.
+ * \param psi The odds ratio
+ * \param delta The precision.
+ *
+ * \throw scythe_convergence_error (Level 0)
+ */
+ double
+ rnchypgeom(double m1, double n1, double n2, double psi,
+ double delta)
+ {
+ // Calculate mode of mass function
+ double a = psi - 1;
+ double b = -1 * ((n1+m1+2)*psi + n2 - m1);
+ double c = psi * (n1+1) * (m1+1);
+ double q = -0.5 * ( b + sgn(b) *
+ std::sqrt(std::pow(b,2) - 4*a*c));
+ double root1 = c/q;
+ double root2 = q/a;
+ double el = std::max(0.0, m1-n2);
+ double u = std::min(n1,m1);
+ double mode = std::floor(root1);
+ int exactcheck = 0;
+ if (u<mode || mode<el) {
+ mode = std::floor(root2);
+ exactcheck = 1;
+ }
+
- Matrix<double> rlogis ( const int &, const int &,
- const double &, const double &);
-
- /* Log Normal distribution */
- double rlnorm(const double &logmean = 0.0,
- const double &logsd = 1.0);
+ int size = static_cast<int>(u+1);
- Matrix<double> rlnorm(const int &, const int &,
- const double &logmean = 0.0,
- const double &logsd = 1.0);
-
- /* Negative Binomial distribution */
- double rnbinom(const double & , const double &);
+ double *fvec = new double[size];
+ fvec[static_cast<int>(mode)] = 1.0;
+ double s;
+ // compute the mass function at y
+ if (delta <= 0 || exactcheck==1){ //exact evaluation
+ // sum from mode to u
+ double f = 1.0;
+ s = 1.0;
+ for (double i=(mode+1); i<=u; ++i){
+ double r = ((n1-i+1)*(m1-i+1))/(i*(n2-m1+i)) * psi;
+ f = f*r;
+ s += f;
+ fvec[static_cast<int>(i)] = f;
+ }
+
+ // sum from mode to el
+ f = 1.0;
+ for (double i=(mode-1); i>=el; --i){
+ double r = ((n1-i)*(m1-i))/((i+1)*(n2-m1+i+1)) * psi;
+ f = f/r;
+ s += f;
+ fvec[static_cast<int>(i)] = f;
+ }
+ } else { // approximation
+ double epsilon = delta/10.0;
+ // sum from mode to ustar
+ double f = 1.0;
+ s = 1.0;
+ double i = mode+1;
+ double r;
+ do {
+ if (i>u) break;
+ r = ((n1-i+1)*(m1-i+1))/(i*(n2-m1+i)) * psi;
+ f = f*r;
+ s += f;
+ fvec[static_cast<int>(i)] = f;
+ ++i;
+ } while(f>=epsilon || r>=5.0/6.0);
+
+ // sum from mode to elstar
+ f = 1.0;
+ i = mode-1;
+ do {
+ if (i<el) break;
+ r = ((n1-i)*(m1-i))/((i+1)*(n2-m1+i+1)) * psi;
+ f = f/r;
+ s += f;
+ fvec[static_cast<int>(i)] = f;
+ --i;
+ } while(f>=epsilon || r <=6.0/5.0);
+ }
- Matrix<double> rnbinom(const int &, const int &, const double &,
- const double &);
+ double udraw = runif();
+ double psum = fvec[static_cast<int>(mode)]/s;
+ if (udraw<=psum)
+ return mode;
+ double lower = mode-1;
+ double upper = mode+1;
- /* Normal distribution */
- double rnorm (const double &mu=0.0, const double &sigma=1.0);
+ do{
+ double fl;
+ double fu;
+ if (lower >= el)
+ fl = fvec[static_cast<int>(lower)];
+ else
+ fl = 0.0;
- Matrix<double> rnorm (const int &rows, const int &cols,
- const double &mu=0.0,
- const double &sigma=1.0);
-
- /* Poisson distribution */
- int rpois(const double &);
+ if (upper <= u)
+ fu = fvec[static_cast<int>(upper)];
+ else
+ fu = 0.0;
- Matrix<int> rpois (const int &, const int &, const double &);
+ if (fl > fu) {
+ psum += fl/s;
+ if (udraw<=psum)
+ return lower;
+ --lower;
+ } else {
+ psum += fu/s;
+ if (udraw<=psum)
+ return upper;
+ ++upper;
+ }
+ } while(udraw>psum);
+
+ delete [] fvec;
+ SCYTHE_THROW(scythe_convergence_error,
+ "Algorithm did not converge");
+ }
- /* Student's t distribution */
- double rt (const double &, const double &, const double &);
+ SCYTHE_RNGMETH_MATRIX(rnchypgeom, double,
+ SCYTHE_ARGSET(m1, n1, n2, psi, delta), double m1, double n1,
+ double n2, double psi, double delta);
- Matrix<double> rt ( const int &, const int &,
- const double &, const double &,
- const double &);
+ /*! \brief Generate a Bernoulli distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * Bernoulli distribution with probability of success \a p.
+ *
+ * \param p The probability of success on a trial.
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ unsigned int
+ rbern (double p)
+ {
+ unsigned int report;
+ double unif;
+
+ // Check for allowable paramters
+ SCYTHE_CHECK_10(p < 0 || p > 1, scythe_invalid_arg,
+ "p parameter not in[0,1]");
+
+ unif = runif ();
+ if (unif < p)
+ report = 1;
+ else
+ report = 0;
+
+ return (report);
+ }
- /* Weibull distribution */
- double rweibull (const double &, const double &scale = 1.0);
+ SCYTHE_RNGMETH_MATRIX(rbern, unsigned int, p, double p);
+
+ /*! \brief Generate a binomial distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * binomial distribution with \a n trials and \p probability of
+ * success on each trial.
+ *
+ * \param n The number of trials.
+ * \param p The probability of success on each trial.
+ *
+ * \see pbinom(double x, unsigned int n, double p)
+ * \see dbinom(double x, unsigned int n, double p)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ unsigned int
+ rbinom (unsigned int n, double p)
+ {
+ unsigned int report;
+ unsigned int count = 0;
+ double hold;
+
+ // Check for allowable parameters
+ SCYTHE_CHECK_10(n == 0, scythe_invalid_arg, "n == 0");
+ SCYTHE_CHECK_10(p < 0 || p > 1, scythe_invalid_arg,
+ "p not in [0,1]");
+
+ // Loop and count successes
+ for (unsigned int i = 0; i < n; i++) {
+ hold = runif ();
+ if (hold < p)
+ ++count;
+ }
+ report = count;
+
+ return (report);
+ }
- Matrix<double> rweibull(const int &, const int &, const double &,
- const double &scale = 1.0);
-
- /* Inverse Chi^2 distribution */
- double richisq (const double &);
-
- Matrix<double> richisq (const int &, const int &,
- const double &);
-
- /* Inverse Gamma distribution */
- double rigamma (const double &, const double &);
+ SCYTHE_RNGMETH_MATRIX(rbinom, unsigned int, SCYTHE_ARGSET(n, p),
+ unsigned int n, double p);
- Matrix<double> rigamma( const int &, const int &,
- const double &, const double &);
+ /*! \brief Generate a \f$\chi^2\f$ distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * \f$\chi^2\f$distribution with \a df degress of freedom.
+ *
+ * \param df The degrees of freedom.
+ *
+ * \see pchisq(double x, double df)
+ * \see dchisq(double x, double df)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rchisq (double df)
+ {
+ double report;
+
+ // Check for allowable paramter
+ SCYTHE_CHECK_10(df <= 0, scythe_invalid_arg,
+ "Degrees of freedom <= 0");
+
+ // Return Gamma(nu/2, 1/2) variate
+ report = rgamma (df / 2, .5);
+
+ return (report);
+ }
- /* Wishart (Only for Matrix) distribution */
- Matrix<double> rwish(const int &, const Matrix<double> &);
+ SCYTHE_RNGMETH_MATRIX(rchisq, double, df, double df);
- /* Dirichlet distribution */
- Matrix<double> rdirich(const Matrix<double> &);
-
- /* Multivariate Normal distribution */
- Matrix<double> rmvnorm (const Matrix<double> &,
- const Matrix<double> &);
+ /*! \brief Generate an exponentially distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * exponential distribution described by the inverse scale
+ * parameter \a invscale.
+ *
+ * \param invscale The inverse scale parameter.
+ *
+ * \see pexp(double x, double scale)
+ * \see dexp(double x, double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rexp (double invscale)
+ {
+ double report;
+
+ // Check for allowable parameter
+ SCYTHE_CHECK_10(invscale <= 0, scythe_invalid_arg,
+ "Inverse scale parameter <= 0");
+
+ report = -std::log (runif ()) / invscale;
+
+ return (report);
+ }
- /* Multivariate t distribution */
- Matrix<double> rmvt (const Matrix<double> &, const double &);
+ SCYTHE_RNGMETH_MATRIX(rexp, double, invscale, double invscale);
+
+ /*! \brief Generate an F distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * F distribution with degress of freedom \a df1 and \a df2.
+ *
+ * \param df1 The positive degrees of freedom for the
+ * \f$chi^2\f$ variate in the nominator of the F statistic.
+ * \param df2 The positive degrees of freedom for the
+ * \f$chi^2\f$ variate in the denominator of the F statistic.
+ *
+ * \see pf(double x, double df1, double df2)
+ * \see df(double x, double df1, double df2)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rf (double df1, double df2)
+ {
+ SCYTHE_CHECK_10(df1 <= 0 || df2 <= 0, scythe_invalid_arg,
+ "n1 or n2 <= 0");
- /* Bernoulli distribution */
- int rbern (const double &);
+ return ((rchisq(df1) / df1) / (rchisq(df2) / df2));
+ }
- Matrix<double> rbern (const int &, const int &,
- const double &);
+ SCYTHE_RNGMETH_MATRIX(rf, double, SCYTHE_ARGSET(df1, df2),
+ double df1, double df2);
- /* Beta-Binomial distribution */
- int rbetabin (const int &, const double &, const double &);
+ /*! \brief Generate a gamma distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * gamma distribution with a given \a shape and \a scale.
+ *
+ * \param shape The strictly positive shape of the distribution.
+ * \param rate The inverse of the strictly positive scale of the distribution. That is, 1 / scale.
+ *
+ * \see pgamma(double x, double shape, double scale)
+ * \see dgamma(double x, double shape, double scale)
+ * \see gammafn(double x)
+ * \see lngammafn(double x)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rgamma (double shape, double rate)
+ {
+ double report;
- Matrix<double> rbetabin ( const int &, const int &,
- const int &, const double &,
- const double &);
+ // Check for allowable parameters
+ SCYTHE_CHECK_10(shape <= 0, scythe_invalid_arg, "shape <= 0");
+ SCYTHE_CHECK_10(rate <= 0, scythe_invalid_arg, "rate <= 0");
- /* Truncated Normal distribution */
-
- /* Truncated Normal distribution */
- double rtnorm(const double &, const double &, const double &,
- const double &);
-
- double rtnorm_combo(const double &, const double &,
- const double &, const double &);
+ if (shape > 1)
+ report = rgamma1 (shape) / rate;
+ else if (shape == 1)
+ report = -std::log (runif ()) / rate;
+ else
+ report = rgamma1 (shape + 1)
+ * std::pow (runif (), 1 / shape) / rate;
- double rtbnorm_slice( const double &, const double &,
- const double &, const int &iter = 10);
+ return (report);
+ }
- double rtanorm_slice( const double &, const double &,
- const double &, const int &iter = 10);
+ SCYTHE_RNGMETH_MATRIX(rgamma, double, SCYTHE_ARGSET(shape, rate),
+ double shape, double rate);
- double rtbnorm_combo( const double &, const double &,
- const double &, const int &iter=10);
+ /*! \brief Generate a logistically distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * logistic distribution described by the given \a location and
+ * \a scale variables.
+ *
+ * \param location The location of the distribution.
+ * \param scale The scale of the distribution.
+ *
+ * \see plogis(double x, double location, double scale)
+ * \see dlogis(double x, double location, double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rlogis (double location, double scale)
+ {
+ double report;
+ double unif;
+
+ // Check for allowable paramters
+ SCYTHE_CHECK_10(scale <= 0, scythe_invalid_arg, "scale <= 0");
+
+ unif = runif ();
+ report = location + scale * std::log (unif / (1 - unif));
+
+ return (report);
+ }
- double rtanorm_combo( const double &, const double &,
- const double &, const int &iter=10);
+ SCYTHE_RNGMETH_MATRIX(rlogis, double,
+ SCYTHE_ARGSET(location, scale),
+ double location, double scale);
- protected:
+ /*! \brief Generate a log-normal distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * log-normal distribution with given logged mean and standard
+ * deviation.
+ *
+ * \param logmean The logged mean of the distribtion.
+ * \param logsd The strictly positive logged standard deviation
+ * of the distribution.
+ *
+ * \see plnorm(double x, double logmean, double logsd)
+ * \see dlnorm(double x, double logmean, double logsd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rlnorm (double logmean, double logsd)
+ {
+ SCYTHE_CHECK_10(logsd < 0.0, scythe_invalid_arg,
+ "standard deviation < 0");
- double rgamma1 (const double &);
-
- double rnorm1();
+ return std::exp(rnorm(logmean, logsd));
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rlnorm, double,
+ SCYTHE_ARGSET(logmean, logsd),
+ double logmean, double logsd);
+
+ /*! \brief Generate a negative binomial distributed random
+ * variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * negative binomial distribution with given dispersion
+ * parameter and probability of success on each trial.
+ *
+ * \param n The strictly positive target number of successful
+ * trials (dispersion parameters).
+ * \param p The probability of success on each trial.
+ *
+ * \see pnbinom(unsigned int x, double n, double p)
+ * \see dnbinom(unsigned int x, double n, double p)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ unsigned int
+ rnbinom (double n, double p)
+ {
+ SCYTHE_CHECK_10(n == 0 || p <= 0 || p > 1, scythe_invalid_arg,
+ "n == 0, p <= 0, or p > 1");
+
+ return rpois(rgamma(n, (1 - p) / p));
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rnbinom, unsigned int,
+ SCYTHE_ARGSET(n, p), double n, double p);
+
+ /*! \brief Generate a normally distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * normal distribution with given \a mean and \a standard
+ * distribution.
+ *
+ * \param mean The mean of the distribution.
+ * \param sd The standard deviation of the distribution.
+ *
+ * \see pnorm(double x, double mean, double sd)
+ * \see dnorm(double x, double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rnorm (double mean = 0, double sd = 1)
+ {
+ SCYTHE_CHECK_10(sd <= 0, scythe_invalid_arg,
+ "Negative standard deviation");
+
+ return (mean + rnorm1 () * sd);
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rnorm, double, SCYTHE_ARGSET(mean, sd),
+ double mean, double sd);
+
+ /*! \brief Generate a Poisson distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * Poisson distribution with expected number of occurrences \a
+ * lambda.
+ *
+ * \param lambda The strictly positive expected number of
+ * occurrences.
+ *
+ * \see ppois(double x, double lambda)
+ * \see dpois(double x, double lambda)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ unsigned int
+ rpois(double lambda)
+ {
+ SCYTHE_CHECK_10(lambda <= 0, scythe_invalid_arg, "lambda <= 0");
+ unsigned int n;
+
+ if (lambda < 33) {
+ double cutoff = std::exp(-lambda);
+ n = -1;
+ double t = 1.0;
+ do {
+ ++n;
+ t *= runif();
+ } while (t > cutoff);
+ } else {
+ bool accept = false;
+ double c = 0.767 - 3.36/lambda;
+ double beta = M_PI/std::sqrt(3*lambda);
+ double alpha = lambda*beta;
+ double k = std::log(c) - lambda - std::log(beta);
+
+ while (! accept){
+ double u1 = runif();
+ double x = (alpha - std::log((1-u1)/u1))/beta;
+ while (x <= -0.5){
+ u1 = runif();
+ x = (alpha - std::log((1-u1)/u1))/beta;
+ }
+ n = static_cast<int>(x + 0.5);
+ double u2 = runif();
+ double lhs = alpha - beta*x +
+ std::log(u2/std::pow(1+std::exp(alpha-beta*x),2));
+ double rhs = k + n*std::log(lambda) - lnfactorial(n);
+ if (lhs <= rhs)
+ accept = true;
+ }
+ }
+
+ return n;
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rpois, unsigned int, lambda, double lambda);
+
+ /* There is a naming issue here, with respect to the p- and d-
+ * functions in distributions. This is really analagous to rt1-
+ * and dt1- XXX Clear up. Also, we should probably have a
+ * random number generator for both versions of the student t.
+ */
+
+ /*! \brief Generate a Student t distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * Student's t distribution with given mean \a mu, variance \a
+ * sigma2, and degrees of freedom \a nu
+ *
+ * \param mu The mean of the distribution.
+ * \param sigma2 The variance of the distribution.
+ * \param nu The degrees of freedom of the distribution.
+ *
+ * \see dt1(double x, double mu, double sigma2, double nu)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rt (double mu, double sigma2, double nu)
+ {
+ double report;
+ double x, z;
+
+ // Check for allowable paramters
+ SCYTHE_CHECK_10(sigma2 <= 0, scythe_invalid_arg,
+ "Variance parameter sigma2 <= 0");
+ SCYTHE_CHECK_10(nu <= 0, scythe_invalid_arg,
+ "D.O.F parameter nu <= 0");
+
+ z = rnorm1 ();
+ x = rchisq (nu);
+ report = mu + std::sqrt (sigma2) * z
+ * std::sqrt (nu) / std::sqrt (x);
+
+ return (report);
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rt1, double, SCYTHE_ARGSET(mu, sigma2, nu),
+ double mu, double sigma2, double nu);
+
+ /*! \brief Generate a Weibull distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * Weibull distribution with given \a shape and \a scale.
+ *
+ * \param shape The strictly positive shape of the distribution.
+ * \param scale The strictly positive scale of the distribution.
+ *
+ * \see pweibull(double x, double shape, double scale)
+ * \see dweibull(double x, double shape, double scale)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rweibull (double shape, double scale)
+ {
+ SCYTHE_CHECK_10(shape <= 0 || scale <= 0, scythe_invalid_arg,
+ "shape or scale <= 0");
+
+ return scale * std::pow(-std::log(runif()), 1.0 / shape);
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rweibull, double,
+ SCYTHE_ARGSET(shape, scale), double shape, double scale);
+
+ /*! \brief Generate an inverse \f$\chi^2\f$ distributed random
+ * variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * inverse \f$\chi^2\f$ distribution with \a nu degress of
+ * freedom.
+ *
+ * \param nu The degrees of freedom.
+ *
+ * \see rchisq(double df)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ richisq (double nu)
+ {
+ double report;
+
+ // Check for allowable parameter
+ SCYTHE_CHECK_10(nu <= 0, scythe_invalid_arg,
+ "Degrees of freedom <= 0");
+
+ // Return Inverse-Gamma(nu/2, 1/2) variate
+ report = rigamma (nu / 2, .5);
+ return (report);
+ }
+
+ SCYTHE_RNGMETH_MATRIX(richisq, double, nu, double nu);
+
+ /*! \brief Generate an inverse gamma distributed random variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * inverse gamma distribution with given \a shape and \a scale.
+ *
+ * \param shape The strictly positive shape of the distribution.
+ * \param scale The strictly positive scale of the distribution.
+ *
+ * \see rgamma(double alpha, double beta)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rigamma (double alpha, double beta)
+ {
+ double report;
+
+ // Check for allowable parameters
+ SCYTHE_CHECK_10(alpha <= 0, scythe_invalid_arg, "alpha <= 0");
+ SCYTHE_CHECK_10(beta <= 0, scythe_invalid_arg, "beta <= 0");
+
+ // Return reciprocal of gamma variate
+ report = std::pow (rgamma (alpha, beta), -1);
+
+ return (report);
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rigamma, double, SCYTHE_ARGSET(alpha, beta),
+ double alpha, double beta);
+
+ /* Truncated Distributions */
+
+ /*! \brief Generate a truncated normally distributed random
+ * variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * normal distribution with given \a mean and \a variance,
+ * truncated both above and below. It uses the inverse CDF
+ * method.
+ *
+ * \param mean The mean of the distribution.
+ * \param variance The variance of the distribution.
+ * \param below The lower truncation point of the distribution.
+ * \param above The upper truncation point of the distribution.
+ *
+ * \see rtnorm_combo(double mean, double variance, double below, double above)
+ * \see rtbnorm_slice(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtanorm_slice(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rtbnorm_combo(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtanorm_combo(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rnorm(double x, double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rtnorm(double mean, double variance, double below, double above)
+ {
+ SCYTHE_CHECK_10(below >= above, scythe_invalid_arg,
+ "Truncation bound not logically consistent");
+ SCYTHE_CHECK_10(variance <= 0, scythe_invalid_arg,
+ "Variance <= 0");
+
+ double sd = std::sqrt(variance);
+ double FA = 0.0;
+ double FB = 0.0;
+ if ((std::fabs((above-mean)/sd) < 8.2)
+ && (std::fabs((below-mean)/sd) < 8.2)){
+ FA = pnorm1((above-mean)/sd, true, false);
+ FB = pnorm1((below-mean)/sd, true, false);
+ }
+ if ((((above-mean)/sd) < 8.2) && (((below-mean)/sd) <= -8.2) ){
+ FA = pnorm1((above-mean)/sd, true, false);
+ FB = 0.0;
+ }
+ if ( (((above-mean)/sd) >= 8.2) && (((below-mean)/sd) > -8.2) ){
+ FA = 1.0;
+ FB = pnorm1((below-mean)/sd, true, false);
+ }
+ if ( (((above-mean)/sd) >= 8.2) && (((below-mean)/sd) <= -8.2)){
+ FA = 1.0;
+ FB = 0.0;
+ }
+ double term = runif()*(FA-FB)+FB;
+ if (term < 5.6e-17)
+ term = 5.6e-17;
+ if (term > (1 - 5.6e-17))
+ term = 1 - 5.6e-17;
+ double draw = mean + sd * qnorm1(term);
+ if (draw > above)
+ draw = above;
+ if (draw < below)
+ draw = below;
+
+ return draw;
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rtnorm, double,
+ SCYTHE_ARGSET(mean, variance, above, below), double mean,
+ double variance, double above, double below);
- };
+ /*! \brief Generate a truncated normally distributed random
+ * variate.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * normal distribution with given \a mean and \a variance,
+ * truncated both above and below. It uses a combination of
+ * rejection sampling (when \a below <= mean <= \a above)
+ * sampling method of Robert and Casella (1999), pp. 288-289
+ * (when \a meam < \a below or \a mean > \a above).
+ *
+ * \param mean The mean of the distribution.
+ * \param variance The variance of the distribution.
+ * \param below The lower truncation point of the distribution.
+ * \param above The upper truncation point of the distribution.
+ *
+ * \see rtnorm(double mean, double variance, double below, double above)
+ * \see rtbnorm_slice(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtanorm_slice(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rtbnorm_combo(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtanorm_combo(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rnorm(double x, double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rtnorm_combo(double mean, double variance, double below,
+ double above)
+ {
+ SCYTHE_CHECK_10(below >= above, scythe_invalid_arg,
+ "Truncation bound not logically consistent");
+ SCYTHE_CHECK_10(variance <= 0, scythe_invalid_arg,
+ "Variance <= 0");
+
+ double sd = std::sqrt(variance);
+ if ((((above-mean)/sd > 0.5) && ((mean-below)/sd > 0.5))
+ ||
+ (((above-mean)/sd > 2.0) && ((below-mean)/sd < 0.25))
+ ||
+ (((mean-below)/sd > 2.0) && ((above-mean)/sd > -0.25))) {
+ double x = rnorm(mean, sd);
+ while ((x > above) || (x < below))
+ x = rnorm(mean,sd);
+ return x;
+ } else {
+ // use the inverse cdf method
+ double FA = 0.0;
+ double FB = 0.0;
+ if ((std::fabs((above-mean)/sd) < 8.2)
+ && (std::fabs((below-mean)/sd) < 8.2)){
+ FA = pnorm1((above-mean)/sd, true, false);
+ FB = pnorm1((below-mean)/sd, true, false);
+ }
+ if ((((above-mean)/sd) < 8.2) && (((below-mean)/sd) <= -8.2) ){
+ FA = pnorm1((above-mean)/sd, true, false);
+ FB = 0.0;
+ }
+ if ( (((above-mean)/sd) >= 8.2) && (((below-mean)/sd) > -8.2) ){
+ FA = 1.0;
+ FB = pnorm1((below-mean)/sd, true, false);
+ }
+ if ( (((above-mean)/sd) >= 8.2) && (((below-mean)/sd) <= -8.2)){
+ FA = 1.0;
+ FB = 0.0;
+ }
+ double term = runif()*(FA-FB)+FB;
+ if (term < 5.6e-17)
+ term = 5.6e-17;
+ if (term > (1 - 5.6e-17))
+ term = 1 - 5.6e-17;
+ double x = mean + sd * qnorm1(term);
+ if (x > above)
+ x = above;
+ if (x < below)
+ x = below;
+ return x;
+ }
+ }
-}
+ SCYTHE_RNGMETH_MATRIX(rtnorm_combo, double,
+ SCYTHE_ARGSET(mean, variance, above, below), double mean,
+ double variance, double above, double below);
-#endif /* SCYTHE_RNG_H */
+ /*! \brief Generate a normally distributed random variate,
+ * truncated below.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * normal distribution with given \a mean and \a variance,
+ * truncated below. It uses the slice sampling method of
+ * Robert and Casella (1999), pp. 288-289.
+ *
+ * \param mean The mean of the distribution.
+ * \param variance The variance of the distribution.
+ * \param below The lower truncation point of the distribution.
+ * \param iter The number of iterations to use.
+ *
+ * \see rtnorm(double mean, double variance, double below, double above)
+ * \see rtnorm_combo(double mean, double variance, double below, double above)
+ * \see rtanorm_slice(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rtbnorm_combo(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtanorm_combo(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rnorm(double x, double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rtbnorm_slice (double mean, double variance, double below,
+ unsigned int iter = 10)
+ {
+ SCYTHE_CHECK_10(below < mean, scythe_invalid_arg,
+ "Truncation point < mean");
+ SCYTHE_CHECK_10(variance <= 0, scythe_invalid_arg,
+ "Variance <= 0");
+
+ double z = 0;
+ double x = below + .00001;
+
+ for (unsigned int i=0; i<iter; ++i){
+ z = runif()*std::exp(-1*std::pow((x-mean),2)/(2*variance));
+ x = runif()*
+ ((mean + std::sqrt(-2*variance*std::log(z))) - below) + below;
+ }
+
+ if (! finite(x)) {
+ SCYTHE_WARN("Mean extremely far from truncation point. "
+ << "Returning truncation point");
+ return below;
+ }
+
+ return x;
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rtbnorm_slice, double,
+ SCYTHE_ARGSET(mean, variance, below, iter), double mean,
+ double variance, double below, unsigned int iter = 10);
+
+ /*! \brief Generate a normally distributed random variate,
+ * truncated above.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * normal distribution with given \a mean and \a variance,
+ * truncated above. It uses the slice sampling method of Robert
+ * and Casella (1999), pp. 288-289.
+ *
+ * \param mean The mean of the distribution.
+ * \param variance The variance of the distribution.
+ * \param above The upper truncation point of the distribution.
+ * \param iter The number of iterations to use.
+ *
+ * \see rtnorm(double mean, double variance, double below, double above)
+ * \see rtnorm_combo(double mean, double variance, double below, double above)
+ * \see rtbnorm_slice(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtbnorm_combo(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtanorm_combo(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rnorm(double x, double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rtanorm_slice (double mean, double variance, double above,
+ unsigned int iter = 10)
+ {
+ SCYTHE_CHECK_10(above > mean, scythe_invalid_arg,
+ "Truncation point > mean");
+ SCYTHE_CHECK_10(variance <= 0, scythe_invalid_arg,
+ "Variance <= 0");
+
+ double below = -1*above;
+ double newmu = -1*mean;
+ double z = 0;
+ double x = below + .00001;
+
+ for (unsigned int i=0; i<iter; ++i){
+ z = runif()*std::exp(-1*std::pow((x-newmu),2)
+ /(2*variance));
+ x = runif()
+ *( (newmu + std::sqrt(-2*variance*std::log(z))) - below)
+ + below;
+ }
+ if (! finite(x)) {
+ SCYTHE_WARN("Mean extremely far from truncation point. "
+ << "Returning truncation point");
+ return above;
+ }
+
+ return -1*x;
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rtanorm_slice, double,
+ SCYTHE_ARGSET(mean, variance, above, iter), double mean,
+ double variance, double above, unsigned int iter = 10);
+
+ /*! \brief Generate a normally distributed random
+ * variate, truncated below.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * normal distribution with given \a mean and \a variance,
+ * truncated below. It uses a combination of
+ * rejection sampling (when \a mean >= \a below) and the slice
+ * sampling method of Robert and Casella (1999), pp. 288-289
+ * (when \a mean < \a below).
+ *
+ * \param mean The mean of the distribution.
+ * \param variance The variance of the distribution.
+ * \param below The lower truncation point of the distribution.
+ * \param iter The number of iterations to run the slice
+ * sampler.
+ *
+ * \see rtnorm(double mean, double variance, double below, double above)
+ * \see rtnorm_combo(double mean, double variance, double below, double above)
+ * \see rtbnorm_slice(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtanorm_slice(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rtanorm_combo(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rnorm(double x, double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rtbnorm_combo (double mean, double variance, double below,
+ unsigned int iter = 10)
+ {
+ SCYTHE_CHECK_10(variance <= 0, scythe_invalid_arg,
+ "Variance <= 0");
+
+ double s = std::sqrt(variance);
+ // do rejection sampling and return value
+ //if (m >= below){
+ if ((mean/s - below/s ) > -0.5){
+ double x = rnorm(mean, s);
+ while (x < below)
+ x = rnorm(mean,s);
+ return x;
+ } else if ((mean/s - below/s ) > -5.0 ){
+ // use the inverse cdf method
+ double above = std::numeric_limits<double>::infinity();
+ double x = rtnorm(mean, variance, below, above);
+ return x;
+ } else {
+ // do slice sampling and return value
+ double z = 0;
+ double x = below + .00001;
+ for (unsigned int i=0; i<iter; ++i){
+ z = runif() * std::exp(-1 * std::pow((x - mean), 2)
+ / (2 * variance));
+ x = runif()
+ * ((mean + std::sqrt(-2 * variance * std::log(z)))
+ - below) + below;
+ }
+ if (! finite(x)) {
+ SCYTHE_WARN("Mean extremely far from truncation point. "
+ << "Returning truncation point");
+ return below;
+ }
+ return x;
+ }
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rtbnorm_combo, double,
+ SCYTHE_ARGSET(mean, variance, below, iter), double mean,
+ double variance, double below, unsigned int iter = 10);
+
+ /*! \brief Generate a normally distributed random variate,
+ * truncated above.
+ *
+ * This function returns a pseudo-random variate drawn from the
+ * normal distribution with given \a mean and \a variance,
+ * truncated above. It uses a combination of rejection sampling
+ * (when \a mean <= \a above) and the slice sampling method of
+ * Robert and Casella (1999), pp. 288-289 (when \a mean > \a
+ * above).
+ *
+ * \param mean The mean of the distribution.
+ * \param variance The variance of the distribution.
+ * \param above The upper truncation point of the distribution.
+ * \param iter The number of iterations to run the slice sampler.
+ *
+ * \see rtnorm(double mean, double variance, double below, double above)
+ * \see rtnorm_combo(double mean, double variance, double below, double above)
+ * \see rtbnorm_slice(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rtanorm_slice(double mean, double variance, double above, unsigned int iter = 10)
+ * \see rtbnorm_combo(double mean, double variance, double below, unsigned int iter = 10)
+ * \see rnorm(double x, double mean, double sd)
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ */
+ double
+ rtanorm_combo (double mean, double variance, double above,
+ const unsigned int iter = 10)
+ {
+ SCYTHE_CHECK_10(variance <= 0, scythe_invalid_arg,
+ "Variance <= 0");
+
+ double s = std::sqrt(variance);
+ // do rejection sampling and return value
+ if ((mean/s - above/s ) < 0.5){
+ double x = rnorm(mean, s);
+ while (x > above)
+ x = rnorm(mean,s);
+ return x;
+ } else if ((mean/s - above/s ) < 5.0 ){
+ // use the inverse cdf method
+ double below = -std::numeric_limits<double>::infinity();
+ double x = rtnorm(mean, variance, below, above);
+ return x;
+ } else {
+ // do slice sampling and return value
+ double below = -1*above;
+ double newmu = -1*mean;
+ double z = 0;
+ double x = below + .00001;
+
+ for (unsigned int i=0; i<iter; ++i){
+ z = runif() * std::exp(-1 * std::pow((x-newmu), 2)
+ /(2 * variance));
+ x = runif()
+ * ((newmu + std::sqrt(-2 * variance * std::log(z)))
+ - below) + below;
+ }
+ if (! finite(x)) {
+ SCYTHE_WARN("Mean extremely far from truncation point. "
+ << "Returning truncation point");
+ return above;
+ }
+ return -1*x;
+ }
+ }
+
+ SCYTHE_RNGMETH_MATRIX(rtanorm_combo, double,
+ SCYTHE_ARGSET(mean, variance, above, iter), double mean,
+ double variance, double above, unsigned int iter = 10);
+
+ /* Multivariate Distributions */
+
+ /*! \brief Generate a Wishart distributed random variate Matrix.
+ *
+ * This function returns a pseudo-random matrix-valued variate
+ * drawn from the Wishart disribution described by the scale
+ * matrix \a Sigma, with \a v degrees of freedom.
+ *
+ * \param v The degrees of freedom of the distribution.
+ * \param Sigma The square scale matrix of the distribution.
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix<double, O, Concrete>
+ rwish(unsigned int v, const Matrix<double, O, S> &Sigma)
+ {
+ SCYTHE_CHECK_10(! Sigma.isSquare(), scythe_dimension_error,
+ "Sigma not square");
+ SCYTHE_CHECK_10(v < Sigma.rows(), scythe_invalid_arg,
+ "v < Sigma.rows()");
+
+ Matrix<double,O,Concrete>
+ A(Sigma.rows(), Sigma.rows());
+ Matrix<double,O,Concrete> C = cholesky<O,Concrete>(Sigma);
+ Matrix<double,O,Concrete> alpha;
+
+ for (unsigned int i = 0; i < v; ++i) {
+ alpha = C * rnorm(Sigma.rows(), 1, 0, 1);
+ A = A + (alpha * (t(alpha)));
+ }
+
+ return A;
+ }
+
+ /*! \brief Generate a Dirichlet distributed random variate Matrix.
+ *
+ * This function returns a pseudo-random matrix-valued variate
+ * drawn from the Dirichlet disribution described by the vector
+ * \a alpha.
+ *
+ * \param alpha A vector of non-negative reals.
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix<double, O, Concrete>
+ rdirich(const Matrix<double, O, S>& alpha)
+ {
+ // Check for allowable parameters
+ SCYTHE_CHECK_10(std::min(alpha) <= 0, scythe_invalid_arg,
+ "alpha has elements < 0");
+ SCYTHE_CHECK_10(! alpha.isColVector(), scythe_dimension_error,
+ "alpha not column vector");
+
+ Matrix<double, O, Concrete> y(alpha.rows(), 1);
+ double ysum = 0;
+
+ // We would use std::transform here but rgamma is a function
+ // and wouldn't get inlined.
+ const_matrix_forward_iterator<double,O,O,S> ait;
+ const_matrix_forward_iterator<double,O,O,S> alast
+ = alpha.template end_f();
+ typename Matrix<double,O,Concrete>::forward_iterator yit
+ = y.begin_f();
+ for (ait = alpha.begin_f(); ait != alast; ++ait) {
+ *yit = rgamma(*ait, 1);
+ ysum += *yit;
+ ++ait;
+ }
+
+ y /= ysum;
+
+ return y;
+ }
+
+ /*! \brief Generate a multivariate normal distributed random
+ * variate Matrix.
+ *
+ * This function returns a pseudo-random matrix-valued variate
+ * drawn from the multivariate normal disribution with means \mu
+ * and variance-covariance matrix \a sigma.
+ *
+ * \param mu A vector containing the distribution means.
+ * \param sigma The distribution variance-covariance matrix.
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ */
+ template <matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<double, PO1, Concrete>
+ rmvnorm(const Matrix<double, PO1, PS1>& mu,
+ const Matrix<double, PO2, PS2>& sigma)
+ {
+ unsigned int dim = mu.rows();
+ SCYTHE_CHECK_10(! mu.isColVector(), scythe_dimension_error,
+ "mu not column vector");
+ SCYTHE_CHECK_10(! sigma.isSquare(), scythe_dimension_error,
+ "sigma not square");
+ SCYTHE_CHECK_10(sigma.rows() != dim, scythe_conformation_error,
+ "mu and sigma not conformable");
+
+ return(mu + cholesky(sigma) * rnorm(dim, 1, 0, 1));
+ }
+
+ /*! \brief Generate a multivariate Student t distributed random
+ * variate Matrix.
+ *
+ * This function returns a pseudo-random matrix-valued variate
+ * drawn from the multivariate Student t disribution with
+ * and variance-covariance matrix \a sigma, and degrees of
+ * freedom \a nu
+ *
+ * \param sigma The distribution variance-covariance matrix.
+ * \param nu The strictly positive degrees of freedom.
+ *
+ * \throw scythe_invalid_arg (Level 1)
+ * \throw scythe_dimension_error (Level 1)
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix<double, O, Concrete>
+ rmvt (const Matrix<double, O, S>& sigma, double nu)
+ {
+ Matrix<double, O, Concrete> result;
+ SCYTHE_CHECK_10(nu <= 0, scythe_invalid_arg,
+ "D.O.F parameter nu <= 0");
+
+ result =
+ rmvnorm(Matrix<double, O>(sigma.rows(), 1, true, 0), sigma);
+ result /= std::sqrt(rchisq(nu) / nu);
+ return result;
+ }
+
+ protected:
+ /* Default (and only) constructor */
+ /*! \brief Default constructor
+ *
+ * Instantiate a random number generator
+ */
+ rng()
+ : rnorm_count_ (1) // Initialize the normal counter
+ {}
+
+ /* For Barton and Nackman trick. */
+ RNGTYPE& as_derived()
+ {
+ return static_cast<RNGTYPE&>(*this);
+ }
+
+
+ /* Generate Standard Normal variates */
+
+ /* These instance variables were static in the old
+ * implementation. Making them instance variables provides
+ * thread safety, as long as two threads don't access the same
+ * rng at the same time w/out precautions. Fixes possible
+ * previous issues with lecuyer. See the similar approach in
+ * rgamma1 below.
+ */
+ int rnorm_count_;
+ double x2_;
+
+ double
+ rnorm1 ()
+ {
+ double nu1, nu2, rsquared, sqrt_term;
+ if (rnorm_count_ == 1){ // odd numbered passses
+ do {
+ nu1 = -1 +2*runif();
+ nu2 = -1 +2*runif();
+ rsquared = ::pow(nu1,2) + ::pow(nu2,2);
+ } while (rsquared >= 1 || rsquared == 0.0);
+ sqrt_term = std::sqrt(-2*std::log(rsquared)/rsquared);
+ x2_ = nu2*sqrt_term;
+ rnorm_count_ = 2;
+ return nu1*sqrt_term;
+ } else { // even numbered passes
+ rnorm_count_ = 1;
+ return x2_;
+ }
+ }
+
+ /* Generate standard gamma variates */
+ double accept_;
+
+ double
+ rgamma1 (double alpha)
+ {
+ int test;
+ double u, v, w, x, y, z, b, c;
+
+ // Check for allowable parameters
+ SCYTHE_CHECK_10(alpha <= 1, scythe_invalid_arg, "alpha <= 1");
+
+ // Implement Best's (1978) simulator
+ b = alpha - 1;
+ c = 3 * alpha - 0.75;
+ test = 0;
+ while (test == 0) {
+ u = runif ();
+ v = runif ();
+
+ w = u * (1 - u);
+ y = std::sqrt (c / w) * (u - .5);
+ x = b + y;
+
+ if (x > 0) {
+ z = 64 * std::pow (v, 2) * std::pow (w, 3);
+ if (z <= (1 - (2 * std::pow (y, 2) / x))) {
+ test = 1;
+ accept_ = x;
+ } else if ((2 * (b * std::log (x / b) - y)) >= ::log (z)) {
+ test = 1;
+ accept_ = x;
+ } else {
+ test = 0;
+ }
+ }
+ }
+
+ return (accept_);
+ }
+
+ };
+
+
+} // end namespace scythe
+#endif /* RNG_H */
diff --git a/src/rtmvnorm.h b/src/rtmvnorm.h
new file mode 100644
index 0000000..c077c82
--- /dev/null
+++ b/src/rtmvnorm.h
@@ -0,0 +1,266 @@
+/*
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
+ * information.
+ * --------------------------------------------------------------------
+ * scythestat/rng/rtmvnorm.h
+ *
+ */
+
+/*!
+ * \file rng/rtmvnorm.h
+ *
+ * \brief A truncated multivariate normal random number generator.
+ *
+ * This file provides the class definition for the rtmvnorm class, a
+ * functor that generates random variates from truncated multivariate
+ * normal distributions.
+ *
+ */
+
+#ifndef SCYTHE_RTMVNORM_H
+#define SCYTHE_RTMVNORM_H
+
+#include <iostream>
+#include <cmath>
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "matrix.h"
+#include "rng.h"
+#include "error.h"
+#include "algorithm.h"
+#include "ide.h"
+#else
+#include "scythestat/matrix.h"
+#include "scythestat/rng.h"
+#include "scythestat/error.h"
+#include "scythestat/algorithm.h"
+#include "scythestat/ide.h"
+#endif
+namespace scythe
+{
+ /* Truncated Multivariate Normal Distribution by Gibbs sampling
+ * (Geweke 1991). This is a functor that allows one to
+ * initialize---and optionally burn in---a sampler for a given
+ * truncated multivariate normal distribution on construction
+ * and then make (optionally thinned) draws with calls to the ()
+ * operator.
+ *
+ */
+ /*! \brief Truncated multivariate normal distribution random number
+ * generator.
+ *
+ * This class is a functor that allows one to initialize, and
+ * optionally burn in, a Gibbs sampler (Geweke 1991) for a given
+ * truncated multivariate normal distribution on construction and
+ * then make optionally thinned draws from the distribution with
+ * calls to the () operator.
+ */
+
+ template <class RNGTYPE>
+ class rtmvnorm {
+ public:
+
+ /*! \brief Standard constructor.
+ *
+ * This method constructs a functor capable of generating
+ * linearly constrained variates of the form: \f$x \sim
+ * N_n(\mu, \Sigma), a \le Dx \le b\f$. That is, it generates
+ * an object capable of simulating random variables from an
+ * n-variate normal distribution defined by \a mu
+ * (\f$\mu\f$) and \a sigma (\f$\Sigma\f$) subject to fewer
+ * than \f$n\f$ linear constraints, defined by the Matrix \a D
+ * and the bounds vectors \a a and \a b.
+ *
+ * The user may pass optional burn in and thinning
+ * parameters to the constructor. The \a burnin parameter
+ * indicates the number of draws that the sampler should
+ * initially make and throw out on construction. The \a thin
+ * parameter controls the behavior of the functor's ()
+ * operator. A thinning parameter of 1 indicates that each
+ * call to operator()() should return the random variate
+ * generated by one iteration of the Gibbs sampler, while a
+ * value of 2 indicates that the sampler should throw every
+ * other variate out, a value of 3 causes operator()() to
+ * iterate the sampler three times before returning, and so on.
+ *
+ * Finally, this constructor inverts \a D before proceeding.
+ * If you have pre-inverted \a D, you can set the \a
+ * preinvertedD flag to true and the functor will not redo the
+ * operation. This helps optimize common cases; for example,
+ * when \a D is simply the identity matrix (and thus equal to
+ * its own inverse), there is no need to compute the inverse.
+ *
+ * \param mu An n x 1 vector of means. \param sigma An n x n
+ * variance-covariance matrix. \param D An n x n linear
+ * constraint definition matrix; should be of rank n. \param a
+ * An n x 1 lower bound vector (may contain infinity or
+ * negative infinity). \param b An n x 1 upper bound vector (may
+ * contain infinity or negative infinity). \param generator
+ * Reference to an rng object \param burnin Optional burnin
+ * parameter; default value is 0. \param thin Optional thinning
+ * parameter; default value is 1. \param preinvertedD Optional
+ * flag with default value of false; if set to true, functor
+ * will not invert \a D.
+ *
+ * \throw scythe_dimension_error (Level 1)
+ * \throw scythe_conformation_error (Level 1)
+ * \throw scythe_invalid_arg (Level 1)
+ *
+ * \see operator()()
+ * \see rng
+ */
+ template <matrix_order PO1, matrix_style PS1, matrix_order PO2,
+ matrix_style PS2, matrix_order PO3, matrix_style PS3,
+ matrix_order PO4, matrix_style PS5, matrix_order PO5,
+ matrix_style PS4>
+ rtmvnorm (const Matrix<double, PO1,PS1>& mu,
+ const Matrix<double, PO2, PS2>& sigma,
+ const Matrix<double, PO3, PS3>& D,
+ const Matrix<double, PO4, PS4>& a,
+ const Matrix<double, PO5, PS5>& b, rng<RNGTYPE>& generator,
+ unsigned int burnin = 0, unsigned int thin = 1,
+ bool preinvertedD = false)
+ : mu_ (mu), C_ (mu.rows(), mu.rows(), false),
+ h_ (mu.rows(), 1, false), z_ (mu.rows(), 1, true, 0),
+ generator_ (generator), n_ (mu.rows()), thin_ (thin), iter_ (0)
+ {
+ SCYTHE_CHECK_10(thin == 0, scythe_invalid_arg,
+ "thin must be >= 1");
+ SCYTHE_CHECK_10(! mu.isColVector(), scythe_dimension_error,
+ "mu not column vector");
+ SCYTHE_CHECK_10(! sigma.isSquare(), scythe_dimension_error,
+ "sigma not square");
+ SCYTHE_CHECK_10(! D.isSquare(), scythe_dimension_error,
+ "D not square");
+ SCYTHE_CHECK_10(! a.isColVector(), scythe_dimension_error,
+ "a not column vector");
+ SCYTHE_CHECK_10(! b.isColVector(), scythe_dimension_error,
+ "b not column vector");
+ SCYTHE_CHECK_10(sigma.rows() != n_ || D.rows() != n_ ||
+ a.rows() != n_ || b.rows() != n_, scythe_conformation_error,
+ "mu, sigma, D, a, and b not conformable");
+
+ // TODO will D * sigma * t(D) always be positive definite,
+ // allowing us to use the faster invpd?
+ if (preinvertedD)
+ Dinv_ = D;
+ else
+ Dinv_ = inv(D);
+ Matrix<> Tinv = inv(D * sigma * t(D));
+ alpha_ = a - D * mu;
+ beta_ = b - D * mu;
+
+ // Check truncation bounds
+ if (SCYTHE_DEBUG > 0) {
+ for (unsigned int i = 0; i < n_; ++i) {
+ SCYTHE_CHECK(alpha_(i) >= beta_(i), scythe_invalid_arg,
+ "Truncation bound " << i
+ << " not logically consistent");
+ }
+ }
+
+ // Precompute some stuff (see Geweke 1991 pg 7).
+ for (unsigned int i = 0; i < n_; ++i) {
+ C_(i, _) = -(1 / Tinv(i, i)) % Tinv(i, _);
+ C_(i, i) = 0; // not really clever but probably too clever
+ h_(i) = std::sqrt(1 / Tinv(i, i));
+ SCYTHE_CHECK_30(std::isnan(h_(i)), scythe_invalid_arg,
+ "sigma is not positive definite");
+ }
+
+ // Do burnin
+ for (unsigned int i = 0; i < burnin; ++i)
+ sample ();
+ }
+
+ /*! \brief Generate random variates.
+ *
+ * Iterates the Gibbs sampler and returns a Matrix containing a
+ * single draw from the truncated multivariate random number
+ * generator encapsulated by the instantiated object. Thinning
+ * of sampler draws is specified at construction.
+ *
+ * \see rtmvnorm()
+ */
+ template <matrix_order O, matrix_style S>
+ Matrix<double, O, S> operator() ()
+ {
+ do { sample (); } while (iter_ % thin_ != 0);
+
+ return (mu_ + Dinv_ * z_);
+ }
+
+ /*! \brief Generate random variates.
+ *
+ * Default template. See general template for details.
+ *
+ * \see operator()().
+ */
+ Matrix<double,Col,Concrete> operator() ()
+ {
+ return operator()<Col, Concrete>();
+ }
+
+ protected:
+ /* Does one step of the Gibbs sampler (see Geweke 1991 p 6) */
+ void sample ()
+ {
+ double czsum;
+ double above;
+ double below;
+ for (unsigned int i = 0; i < n_; ++i) {
+
+ // Calculate sum_{j \ne i} c_{ij} z_{j}
+ czsum = 0;
+ for (unsigned int j = 0; j < n_; ++j) {
+ if (i == j) continue;
+ czsum += C_(i, j) * z_(j);
+ }
+
+ // Calc truncation of conditional univariate std normal
+ below = (alpha_(i) - czsum) / h_(i);
+ above = (beta_(i) - czsum) / h_(i);
+
+ // Draw random variate z_i
+ z_(i) = h_(i);
+ if (above == std::numeric_limits<double>::infinity()){
+ if (below == -std::numeric_limits<double>::infinity())
+ z_(i) *= generator_.rnorm(0, 1); // untruncated
+ else
+ z_(i) *= generator_.rtbnorm_combo(0, 1, below);
+ } else if (below ==
+ -std::numeric_limits<double>::infinity())
+ z_(i) *= generator_.rtanorm_combo(0, 1, above);
+ else
+ z_(i) *= generator_.rtnorm_combo(0, 1, below, above);
+
+ z_(i) += czsum;
+ }
+
+ ++iter_;
+ }
+
+ /* Instance variables */
+ // Various reused computation matrices with names from
+ // Geweke 1991.
+ Matrix<> mu_; Matrix<> Dinv_;
+ Matrix<> C_; Matrix<> alpha_; Matrix<> beta_; Matrix<> h_;
+
+ Matrix<> z_; // The current draw of the posterior
+
+ rng<RNGTYPE>& generator_; // Refernce to random number generator
+
+ unsigned int n_; // The dimension of the distribution
+ unsigned int thin_; // thinning parameter
+ unsigned int iter_; // The current post-burnin iteration
+ };
+} // end namespace scythe
+#endif
diff --git a/src/smath.cc b/src/smath.cc
deleted file mode 100644
index 19cb34a..0000000
--- a/src/smath.cc
+++ /dev/null
@@ -1,625 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/math.cc
- *
- * Provides implementations of the template wrapper functions
- * that allow common math.h operation to be performed on
- * Scythe matrices.
- *
- */
-
-#ifndef SCYTHE_MATH_CC
-#define SCYTHE_MATH_CC
-
-#include <cmath>
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "smath.h"
-#include "error.h"
-#include "util.h"
-#else
-#include "scythestat/smath.h"
-#include "scythestat/error.h"
-#include "scythestat/util.h"
-#endif
-
-namespace SCYTHE {
-
- /* calc the inverse cosine of each element of a Matrix */
- template <class T>
- Matrix<T>
- acos (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::acos(A[i]);
-
- return A;
- }
-
-// /* calc the inverse hyperbolic cosine of each element of a Matrix */
-// template <class T>
-// Matrix<T>
-// acosh (Matrix<T> A)
-// {
-// for (int i = 0; i < A.size(); ++i)
-// A[i] = ::acosh(A[i]);
-//
-// return A;
-// }
-
- /* calc the inverse sine of each element of a Matrix */
- template <class T>
- Matrix<T>
- asin (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::asin(A[i]);
-
- return A;
- }
-
-// /* calc the inverse hyperbolic sine of each element of a Matrix */
-// template <class T>
-// Matrix<T>
-// asinh (Matrix<T> A)
-// {
-// for (int i = 0; i < A.size(); ++i)
-// A[i] = ::asinh(A[i]);
-//
-// return A;
-// }
-
- /* calc the inverse tangent of each element of a Matrix */
- template <class T>
- Matrix<T>
- atan (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::atan(A[i]);
-
- return A;
- }
-
-// /* calc the inverse hyperbolic tangent of each element of a Matrix */
-// template <class T>
-// Matrix<T>
-// atanh (Matrix<T> A)
-// {
-// for (int i = 0; i < A.size(); ++i)
-// A[i] = ::atanh(A[i]);
-//
-// return A;
-// }
-
- /* calc the angle whose tangent is y/x */
- template <class T>
- Matrix<T>
- atan2 (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<T> temp;
-
- if (A.isScalar()) {
- temp = B;
- for (int i = 0; i < B.size(); ++i)
- temp[i] = ::atan2(A[0], B[i]);
- } else if (B.isScalar()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::atan2(A[i], B[0]);
- } else if (A.size() == B.size()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::atan2(A[i], B[i]);
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A.size() != B.size() and neither A nor B is scalar");
- }
-
- return temp;
- }
-
- /* calc the cube root of each element of a Matrix */
- template <class T>
- Matrix<T>
- cbrt (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::cbrt(A[i]);
-
- return A;
- }
-
- /* calc the ceil of each element of a Matrix */
- template <class T>
- Matrix<T>
- ceil (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::ceil(A[i]);
-
- return A;
- }
-
- /* create a matrix containing the absval of the first input and the
- * sign of the second
- */
- template <class T>
- Matrix<T>
- copysign (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<T> temp;
-
- if (A.isScalar()) {
- temp = B;
- for (int i = 0; i < B.size(); ++i)
- temp[i] = ::copysign(A[0], B[i]);
- } else if (B.isScalar()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::copysign(A[i], B[0]);
- } else if (A.size() == B.size()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::copysign(A[i], B[i]);
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A.size() != B.size() and neither A nor B is scalar");
- }
-
- return temp;
- }
-
- /* calc the cosine of each element of a Matrix */
- template <class T>
- Matrix<T>
- cos (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::cos(A[i]);
-
- return A;
- }
-
- /* calc the hyperbolic cosine of each element of a Matrix */
- template <class T>
- Matrix<T>
- cosh (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::cosh(A[i]);
-
- return A;
- }
-
- /* calc the error function of each element of a Matrix */
- template <class T>
- Matrix<T>
- erf (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::erf(A[i]);
-
- return A;
- }
-
- /* calc the complementary error function of each element of a Matrix */
- template <class T>
- Matrix<T>
- erfc (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::erfc(A[i]);
-
- return A;
- }
-
- /* calc the vaue e^x of each element of a Matrix */
- template <class T>
- Matrix<T>
- exp (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::exp(A[i]);
-
- return A;
- }
-
-// /* calc the exponent - 1 of each element of a Matrix */
-// template <class T>
-// Matrix<T>
-// expm1 (Matrix<T> A)
-// {
-// for (int i = 0; i < A.size(); ++i)
-// A[i] = ::expm1(A[i]);
-//
-// return A;
-// }
-
- /* calc the absval of each element of a Matrix */
- template <class T>
- Matrix<T>
- fabs (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::fabs (A[i]);
-
- return A;
- }
-
- /* calc the floor of each element of a Matrix */
- template <class T>
- Matrix<T>
- floor (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::floor(A[i]);
-
- return A;
- }
-
- /* calc the remainder of the division of each matrix element */
- template <class T>
- Matrix<T>
- fmod (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<T> temp;
-
- if (A.isScalar()) {
- temp = B;
- for (int i = 0; i < B.size(); ++i)
- temp[i] = ::fmod(A[0], B[i]);
- } else if (B.isScalar()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::fmod(A[i], B[0]);
- } else if (A.size() == B.size()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::fmod(A[i], B[i]);
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A.size() != B.size() and neither A nor B is scalar");
- }
-
- return temp;
- }
-
- /* calc the fractional val of input and return exponents in int
- * matrix reference
- */
- template <class T>
- Matrix<T>
- frexp (Matrix<T> A, Matrix<int> &ex)
- {
- if (A.size() != ex.size())
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "The input matrix sizes do not match");
-
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::frexp(A[i], &(ex[i]));
-
- return A;
- }
-
- /* calc the euclidean distance between the two inputs */
- template <class T>
- Matrix<T>
- hypot (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<T> temp;
-
- if (A.isScalar()) {
- temp = B;
- for (int i = 0; i < B.size(); ++i)
- temp[i] = ::hypot(A[0], B[i]);
- } else if (B.isScalar()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::hypot(A[i], B[0]);
- } else if (A.size() == B.size()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::hypot(A[i], B[i]);
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A.size() != B.size() and neither A nor B is scalar");
- }
-
- return temp;
- }
-
- /* return (int) logb */
- template <class T>
- Matrix<int>
- ilogb (const Matrix<T> &A)
- {
- Matrix<int> temp(A.rows(), A.cols(), false);
-
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::ilogb(A[i]);
-
- return temp;
- }
-
- /* compute the bessel func of the first kind of the order 0 */
- template <class T>
- Matrix<T>
- j0 (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::j0(A[i]);
-
- return A;
- }
-
- /* compute the bessel func of the first kind of the order 1 */
- template <class T>
- Matrix<T>
- j1 (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::j1(A[i]);
-
- return A;
- }
-
- /* compute the bessel func of the first kind of the order n */
- template <class T>
- Matrix<T>
- jn (const int &n, Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::jn(n, A[i]);
-
- return A;
- }
-
- /* calc x * 2 ^ex */
- template <class T>
- Matrix<T>
- ldexp (Matrix<T> A, const int &ex)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::ldexp(A[i], ex);
-
- return A;
- }
-
- /* compute the natural log of the absval of gamma function */
- template <class T>
- Matrix<T>
- lgamma (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::lgamma(A[i]);
-
- return A;
- }
-
- /* calc the natural log of each element of a Matrix */
- template <class T>
- Matrix<T>
- log (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::log(A[i]);
-
- return A;
- }
-
- /* calc the base-10 log of each element of a Matrix */
- template <class T>
- Matrix<T>
- log10 (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::log10(A[i]);
-
- return A;
- }
-
- /* calc the natural log of 1 + each element of a Matrix */
- template <class T>
- Matrix<T>
- log1p (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::log1p(A[i]);
-
- return A;
- }
-
- /* calc the logb of each element of a Matrix */
- template <class T>
- Matrix<T>
- logb (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::logb(A[i]);
-
- return A;
- }
-
- /* x = frac + i, return matrix of frac and place i in 2nd matrix
- */
- template <class T>
- Matrix<T>
- modf (Matrix<T> A, Matrix<double> &iret)
- {
- if (A.size() != iret.size())
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "The input matrix sizes do not match");
-
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::modf(A[i], &(iret[i]));
-
- return A;
- }
-
- /* calc x^ex of each element of a Matrix */
- template <class T, class S>
- Matrix<T>
- pow (Matrix<T> A, const S &ex)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::pow(A[i], ex);
-
- return A;
- }
-
- /* calc rem == x - n * y */
- template <class T>
- Matrix<T>
- remainder (const Matrix<T> &A, const Matrix<T> &B)
- {
- Matrix<T> temp;
-
- if (A.isScalar()) {
- temp = B;
- for (int i = 0; i < B.size(); ++i)
- temp[i] = ::remainder(A[0], B[i]);
- } else if (B.isScalar()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::remainder(A[i], B[0]);
- } else if (A.size() == B.size()) {
- temp = A;
- for (int i = 0; i < A.size(); ++i)
- temp[i] = ::remainder(A[i], B[i]);
- } else {
- throw scythe_conformation_error(__FILE__, __PRETTY_FUNCTION__,
- __LINE__, "A.size() != B.size() and neither A nor B is scalar");
- }
-
- return temp;
- }
-
- /* return x rounded to nearest int */
- template <class T>
- Matrix<T>
- rint (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::rint(A[i]);
-
- return A;
- }
-
- /* returns x * FLT_RADIX^ex */
- template <class T>
- Matrix<T>
- scalbn (Matrix<T> A, const int &ex)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::scalbn(A[i], ex);
-
- return A;
- }
-
- /* calc the sine of x */
- template <class T>
- Matrix<T>
- sin (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::sin(A[i]);
-
- return A;
- }
-
- /* calc the hyperbolic sine of x */
- template <class T>
- Matrix<T>
- sinh (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::sinh(A[i]);
-
- return A;
- }
-
- /* calc the sqrt of x */
- template <class T>
- Matrix<T>
- sqrt (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::sqrt(A[i]);
-
- return A;
- }
-
-
- /* calc the tangent of x */
- template <class T>
- Matrix<T>
- tan (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::tan(A[i]);
-
- return A;
- }
-
- /* calc the hyperbolic tangent of x */
- template <class T>
- Matrix<T>
- tanh (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::tanh(A[i]);
-
- return A;
- }
-
- /* bessel function of the second kind of order 0*/
- template <class T>
- Matrix<T>
- y0 (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::y0(A[i]);
-
- return A;
- }
-
- /* bessel function of the second kind of order 1*/
- template <class T>
- Matrix<T>
- y1 (Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::y1(A[i]);
-
- return A;
- }
-
- /* bessel function of the second kind of order n*/
- template <class T>
- Matrix<T>
- yn (const int &n, Matrix<T> A)
- {
- for (int i = 0; i < A.size(); ++i)
- A[i] = ::yn(n, A[i]);
-
- return A;
- }
-
-} // end namespace SCYTHE
-
-#ifndef SCYTHE_COMPILE_DIRECT
-#include "scythestat/eti/smath.t"
-#endif
-
-#endif /* SCYTHE_MATH_CC */
diff --git a/src/smath.h b/src/smath.h
index 1e67050..3669358 100644
--- a/src/smath.h
+++ b/src/smath.h
@@ -1,21 +1,31 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * scythestat/math.h
+ * scythestat/smath.h
*
- * Provides definitions for the template wrapper functions
- * that allow common math.h operations to be performed on
- * Scythe matrices.
+ */
+
+/*!
+ * \file smath.h
+ * \brief Definitions for functions that perform common mathematical
+ * operations on every element of a Matrix.
+ *
+ * \note As is the case throughout the library, we provide both
+ * general and default template definitions of the Matrix-returning
+ * functions in this file, explicitly providing documentation for only
+ * the general template versions. As is also often the case, Doxygen
+ * does not always correctly add the default template definition to
+ * the function list below; there is always a default template
+ * definition available for every function.
*
*/
@@ -24,225 +34,922 @@
#ifdef SCYTHE_COMPILE_DIRECT
#include "matrix.h"
+#include "algorithm.h"
+#include "error.h"
#else
#include "scythestat/matrix.h"
+#include "scythestat/algorithm.h"
+#include "scythestat/error.h"
#endif
-/* This portion of the library mimics math.h for Matrix<T> objects. T
- * should be a floating point type of either float, double or long
- * double. Using ints or other objects will cause warnings or errors.
- * You'll also need a sufficiently modern c++ compiler. Note that the
- * f and l versions of these functions do not exist in c++ (you can
- * use the c calls if you wish) because type promotion takes care of
- * these functions.
- *
- * NOTE: When I refer to x and y in the documentation below it means
- * the first and second matrix arguements respectively. Also, I will
- * typically just write x when I mean forall elements in x
- */
+#include <cmath>
+#include <numeric>
+#include <set>
-namespace SCYTHE {
+namespace scythe {
- /* acos - inverse cosine function */
- template <class T>
- Matrix<T> acos (Matrix<T>);
-
-// /* acosh - inverse hyperbolic cosine function */
-// template <class T>
-// Matrix<T> acosh (Matrix<T>);
+ namespace {
+ typedef unsigned int uint;
+ }
- /* asin - inverse sine function */
- template <class T>
- Matrix <T> asin (Matrix<T>);
-
-// /* asinh - inverse hyperbolic sine function */
-// template <class T>
-// Matrix<T> asinh (Matrix<T>);
-
- /* atan - inverse tangent function */
- template <class T>
- Matrix<T> atan (Matrix<T>);
+/* Almost every function in this file follows one of the two patterns
+ * described by these macros. The first macro handles single-argument
+ * functions. The second handles two-matrix-argument functions (or
+ * scalar-matrix, matrix-scalar. The second macro also permits
+ * cross-type operations (these are limited only by the capabilities
+ * of the underlying functions).
+ */
+#define SCYTHE_MATH_OP(NAME, OP) \
+ template <matrix_order RO, matrix_style RS, typename T, \
+ matrix_order PO, matrix_style PS> \
+ Matrix<T,RO,RS> \
+ NAME (const Matrix<T,PO,PS>& A) \
+ { \
+ Matrix<T,RO,RS> res(A.rows(), A.cols(), false); \
+ std::transform(A.begin_f(), A.end_f(), res.begin_f(), OP); \
+ return res; \
+ } \
+ \
+ template <typename T, matrix_order O, matrix_style S> \
+ Matrix<T,O,Concrete> \
+ NAME (const Matrix<T,O,S>& A) \
+ { \
+ return NAME<O,Concrete>(A); \
+ }
+
+#define SCYTHE_MATH_OP_2ARG(NAME, OP) \
+ template <matrix_order RO, matrix_style RS, typename T, \
+ matrix_order PO1, matrix_style PS1, \
+ matrix_order PO2, matrix_style PS2, typename S> \
+ Matrix<T,RO,RS> \
+ NAME (const Matrix<T,PO1,PS1>& A, const Matrix<S,PO2,PS2>& B) \
+ { \
+ SCYTHE_CHECK_10 (A.size() != 1 && B.size() != 1 && \
+ A.size() != B.size(), scythe_conformation_error, \
+ "Matrices with dimensions (" << A.rows() \
+ << ", " << A.cols() \
+ << ") and (" << B.rows() << ", " << B.cols() \
+ << ") are not conformable"); \
+ \
+ Matrix<T,RO,RS> res; \
+ \
+ if (A.size() == 1) { \
+ res.resize2Match(B); \
+ std::transform(B.template begin_f<RO>(), B.template end_f<RO>(),\
+ res.begin_f(), std::bind1st(OP, A(0))); \
+ } else if (B.size() == 1) { \
+ res.resize2Match(A); \
+ std::transform(A.template begin_f<RO>(), A.template end_f<RO>(),\
+ res.begin_f(), std::bind2nd(OP, B(0))); \
+ } else { \
+ res.resize2Match(A); \
+ std::transform(A.template begin_f<RO>(), A.template end_f<RO>(),\
+ B.template begin_f<RO>(), res.begin_f(), OP); \
+ } \
+ \
+ return res; \
+ } \
+ \
+ template <typename T, matrix_order PO1, matrix_style PS1, \
+ matrix_order PO2, matrix_style PS2, \
+ typename S> \
+ Matrix<T,PO1,Concrete> \
+ NAME (const Matrix<T,PO1,PS1>& A, const Matrix<S,PO2,PS2>& B) \
+ { \
+ return NAME<PO1,Concrete>(A, B); \
+ } \
+ \
+ template<matrix_order RO, matrix_style RS, typename T, \
+ matrix_order PO, matrix_style PS, typename S> \
+ Matrix<T,RO,RS> \
+ NAME (const Matrix<T,PO,PS>& A, S b) \
+ { \
+ return NAME<RO,RS>(A, Matrix<S,RO,Concrete>(b)); \
+ } \
+ \
+ template <typename T, typename S, matrix_order PO, matrix_style PS> \
+ Matrix<T,PO,Concrete> \
+ NAME (const Matrix<T,PO,PS>& A, S b) \
+ { \
+ return NAME<PO,Concrete>(A, Matrix<S,PO,Concrete>(b)); \
+ } \
+ \
+ template<matrix_order RO, matrix_style RS, typename T, \
+ matrix_order PO, matrix_style PS, typename S> \
+ Matrix<T,RO,RS> \
+ NAME (T a, const Matrix<S,PO,PS>& B) \
+ { \
+ return NAME<RO,RS>(Matrix<S, RO,Concrete>(a), B); \
+ } \
+ \
+ template <typename T, typename S, matrix_order PO, matrix_style PS> \
+ Matrix<T,PO,Concrete> \
+ NAME (T a, const Matrix<S,PO,PS>& B) \
+ { \
+ return NAME<PO,Concrete>(Matrix<S,PO,Concrete>(a), B); \
+ }
+
+
+ /* calc the inverse cosine of each element of a Matrix */
-// /* atanh - inverse hyperbolic tangent function */
-// template <class T>
-// Matrix<T> atanh (Matrix<T>);
+ /*!
+ * \brief Calculate the inverse cosine of each element of a Matrix
+ *
+ * This function calculates the inverse cosine of each element in a Matrix
+ *
+ * \param A The matrix whose inverse cosines are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cos()
+ * \see cosh()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(acos, ::acos)
- /* atan2 - returns angle whose tangent is y/x in the full angular
- * range [-pit,+pi]. Domain error if both x and y zero
- * The two matrices must have equal dimensions or one of the two
- * matrices must be scalar
- */
- template <class T>
- Matrix<T> atan2 (const Matrix<T> &, const Matrix<T> &);
+ /* calc the inverse hyperbolic cosine of each element of a Matrix */
+ /*!
+ * \brief Calculate the inverse hyperbolic cosine of each element of a Matrix
+ *
+ * This function calculates the inverse hyperbolic cosine of each element
+ * in a Matrix
+ *
+ * \param A The matrix whose inverse hyperbolic cosines are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(acosh, ::acosh)
+
+ /* calc the inverse sine of each element of a Matrix */
- /* cbrt - cube root */
- template <class T>
- Matrix<T> cbrt (Matrix<T>);
+ /*!
+ * \brief Calculate the inverse sine of each element of a Matrix
+ *
+ * This function calculates the inverse sine of each element
+ * in a Matrix
+ *
+ * \param A The matrix whose inverse sines are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(asin, ::asin)
- /* ceil - ceiling of a floating point number */
- template <class T>
- Matrix<T> ceil (Matrix<T>);
+ /* calc the inverse hyperbolic sine of each element of a Matrix */
- /* copysign - return values with absval of 1st arg but sign of 2nd
- * The two matrices must have equal dimensions or one of the two
- * matrices must be scalar
- */
- template <class T>
- Matrix<T> copysign (const Matrix<T> &, const Matrix<T> &);
-
- /* cos - cosine function */
- template <class T>
- Matrix<T> cos (Matrix<T>);
-
- /* cosh - hyperbolic cosine function */
- template <class T>
- Matrix<T> cosh (Matrix<T>);
-
- /* erf - error function */
- template <class T>
- Matrix<T> erf (Matrix<T>);
-
- /* erfc - complementary error function */
- template <class T>
- Matrix<T> erfc (Matrix<T>);
-
- /* exp - Calculate the value of e^x for each individual */
- template <class T>
- Matrix<T> exp (Matrix<T>);
-
-// /* expm1 - exponent minus 1 */
-// template <class T>
-// Matrix<T> expm1 (Matrix<T>);
+ /*!
+ * \brief Calculate the inverse hyperbolic sine of each element of a Matrix
+ *
+ * This function calculates the inverse hyperbolic sine of each element
+ * in a Matrix
+ *
+ * \param A The matrix whose inverse hyperbolic sines are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(asinh, ::asinh)
- /* fabs - Calculate the absolute value of each Matrix element */
- template <class T>
- Matrix<T> fabs (Matrix<T>);
-
- /* floor - floor of floating point number */
- template <class T>
- Matrix<T> floor (Matrix<T>);
-
- /* fmod - return the remainder */
- template <class T>
- Matrix<T> fmod (const Matrix<T> &, const Matrix<T> &);
-
- /* frexp - returns fractional value of input, and fills int matrix
- * with exponent ex. Frac on interval [1/2,1) x == frac * 2^ex
- */
- template <class T>
- Matrix<T> frexp(Matrix<T>, Matrix<int> &);
-
- /* hypot - euclidean distance function */
- template <class T>
- Matrix<T> hypot (const Matrix<T> &, const Matrix<T> &);
+ /* calc the inverse tangent of each element of a Matrix */
- /* ilogb - returns int verison of logb */
- template <class T>
- Matrix<int> ilogb (const Matrix<T> &);
-
- /* j0, j1, jn - bessel functions of the first kind of order
- * (May only support doubles, consult standard)
- */
- template <class T>
- Matrix<T> j0 (Matrix<T>);
-
- template <class T>
- Matrix<T> j1 (Matrix<T>);
-
- template <class T>
- Matrix<T> jn (const int &n, Matrix<T>);
-
- /* ldexp - returns x * 2^ex */
- template <class T>
- Matrix<T> ldexp(Matrix<T>, const int &);
-
- /* lgamma - returns natural log of the absval of the gamma function */
- template <class T>
- Matrix<T> lgamma (Matrix<T>);
-
- /* Log - Calculate the natural log of each Matrix element */
- template <class T>
- Matrix<T> log(Matrix<T>);
+ /*!
+ * \brief Calculate the inverse tangent of each element of a Matrix
+ *
+ * This function calculates the inverse tangent of each element
+ * in a Matrix
+ *
+ * \param A The matrix whose inverse tangents are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asin()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(atan, ::atan)
- /* Log10 - Calculate the Base 10 Log of each Matrix element */
- template <class T>
- Matrix<T> log10(Matrix<T>);
-
- /* log1p - returns natrual log of 1 + x, domain error if x < -1 */
- template <class T>
- Matrix<T> log1p (Matrix<T>);
-
- /* logb - returns ex s.t. x == frac * ex^FLT_RADIX where frac is on
- * the interval [1,FLT_RADIX]. Domain error if x is 0.
+ /* calc the inverse hyperbolic tangent of each element of a Matrix */
+ /*!
+ * \brief Calculate the inverse hyperbolic tangent of each element of a Matrix
+ *
+ * This function calculates the inverse hyperbolic tangent of each element
+ * in a Matrix
+ *
+ * \param A The matrix whose inverse hyperbolic tangents are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(atanh, ::atanh)
+
+ /* calc the angle whose tangent is y/x */
+
+ /*!
+ * \brief Calculate the angle whose tangent is y/x
+ *
+ * This function calculates the angle whose tangent is y/x, given two
+ * matrices A and B (where y is the ith element of A, and x is the jth element
+ * of matrix B).
+ *
+ * \param A The matrix of y values
+ * \param B The matrix of x values
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ */
+
+ SCYTHE_MATH_OP_2ARG(atan2, std::ptr_fun(::atan2))
+
+ /* calc the cube root of each element of a Matrix */
+ /*!
+ * \brief Calculate the cube root of each element of a Matrix
+ *
+ * This function calculates the cube root of each element
+ * in a Matrix
+ *
+ * \param A The matrix whose cube roots are of interest.
+ *
+ * \see sqrt()
+ */
+
+ SCYTHE_MATH_OP(cbrt, ::cbrt)
+
+ /* calc the ceil of each element of a Matrix */
+ /*!
+ * \brief Calculate the ceiling of each element of a Matrix
+ *
+ * This function calculates the ceiling of each element
+ * in a Matrix
+ *
+ * \param A The matrix whose ceilings are of interest.
+ *
+ * \see floor()
+ */
+
+ SCYTHE_MATH_OP(ceil, ::ceil)
+
+ /* create a matrix containing the absval of the first input and the
+ * sign of the second
*/
- template <class T>
- Matrix<T> logb (Matrix<T>);
-
- /* modf - x == frac + i where |frac| on [0,1) and both frac and i
- * have the same sign as x. I is stored in the second matrix.
+ /*!
+ * \brief Create a matrix containing the absolute value of the first input
+ * and the sign of the second input
+ *
+ * This function creates a matrix containing the absolute value of the first
+ * input, a matrix called A, and the sign of the second input, matrix B.
+ *
+ * \param A The matrix whose absolute values will comprise the resultant matrix.
+ * \param B The matrix whose signs will comprise the resultant matrix
+ */
+
+ SCYTHE_MATH_OP_2ARG(copysign, std::ptr_fun(::copysign))
+
+ /* calc the cosine of each element of a Matrix */
+
+ /*!
+ * \brief Calculate the cosine of each element of a Matrix
+ *
+ * This function calculates the cosine of each element in a Matrix
+ *
+ * \param A The matrix whose cosines are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(cos, ::cos)
+
+ /* calc the hyperbolic cosine of each element of a Matrix */
+ /*!
+ * \brief Calculate the hyperbolic cosine of each element of a Matrix
+ *
+ * This function calculates the hyperbolic cosine of each element in a Matrix
+ *
+ * \param A The matrix whose hyperbolic cosines are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see sinh()
+ * \see cos()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(cosh, ::cosh)
+
+ /* calc the error function of each element of a Matrix */
+ /*!
+ * \brief Calculate the error function of each element of a Matrix
+ *
+ * This function calculates the error function of each element in a Matrix
+ *
+ * \param A The matrix whose error functions are of interest.
+ *
+ * \see erfc()
+ */
+
+ SCYTHE_MATH_OP(erf, ::erf)
+
+ /* calc the complementary error function of each element of a Matrix */
+ /*!
+ * \brief Calculate the complementary error function of each element of a Matrix
+ *
+ * This function calculates the complemenatry error function of each
+ * element in a Matrix
+ *
+ * \param A The matrix whose complementary error functions are of interest.
+ *
+ * \see erf()
+ */
+
+ SCYTHE_MATH_OP(erfc, ::erfc)
+
+ /* calc the vaue e^x of each element of a Matrix */
+ /*!
+ * \brief Calculate the value e^x for each element of a Matrix
+ *
+ * This function calculates the value e^x for each element of a matrix, where
+ * x is the ith element of the matrix A
+ *
+ * \param A The matrix whose elements are to be exponentiated.
+ *
+ * \see expm1()
+ */
+
+ SCYTHE_MATH_OP(exp, ::exp)
+
+ /* calc the exponent - 1 of each element of a Matrix */
+ /*!
+ * \brief Calculate the value e^(x-1) for each element of a Matrix
+ *
+ * This function calculates the value e^(x-1) for each element of a matrix, where
+ * x is the ith element of the matrix A
+ *
+ * \param A The matrix whose elements are to be exponentiated.
+ *
+ * \see exp()
+ */
+
+ SCYTHE_MATH_OP(expm1, ::expm1)
+
+ /* calc the absval of each element of a Matrix */
+ /*!
+ * \brief Calculate the absolute value of each element of a Matrix
+ *
+ * This function calculates the absolute value of each element in a Matrix
+ *
+ * \param A The matrix whose absolute values are to be taken.
+ */
+
+ SCYTHE_MATH_OP(fabs, ::fabs)
+
+ /* calc the floor of each element of a Matrix */
+ /*!
+ * \brief Calculate the floor of each element of a Matrix
+ *
+ * This function calculates the floor of each element
+ * in a Matrix
+ *
+ * \param A The matrix whose floors are of interest.
+ *
+ * \see ceil()
+ */
+
+ SCYTHE_MATH_OP(floor, ::floor)
+
+ /* calc the remainder of the division of each matrix element */
+ /*!
+ * \brief Calculate the remainder of the division of each matrix element
+ *
+ * This function calculates the remainder when the elements of Matrix A are
+ * divided by the elements of Matrix B.
+ *
+ * \param A The matrix to serve as dividend
+ * \param B the matrix to serve as divisor
+ */
+
+ SCYTHE_MATH_OP_2ARG(fmod, std::ptr_fun(::fmod))
+
+ /* calc the fractional val of input and return exponents in int
+ * matrix reference
*/
- template <class T>
- Matrix<T> modf (Matrix<T>, Matrix<double> &);
+
+ /*!
+ */
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ frexp (const Matrix<T,PO1,PS1>& A, Matrix<int,PO2,PS2>& ex)
+ {
+ SCYTHE_CHECK_10(A.size() != ex.size(), scythe_conformation_error,
+ "The input matrix sizes do not match");
+ Matrix<T,PO1,Concrete> res(A.rows(), A.cols());
+
+ typename Matrix<T,PO1,PS1>::const_forward_iterator it;
+ typename Matrix<T,PO1,Concrete>::forward_iterator rit
+ = res.begin_f();
+ typename Matrix<int,PO2,PS2>::const_forward_iterator it2
+ = ex.begin_f();
+ for (it = A.begin_f(); it != A.end_f(); ++it) {
+ *rit = ::frexp(*it, &(*it2));
+ ++it2; ++rit;
+ }
+
+ return res;
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ frexp (Matrix<T,PO1,PS1>& A, Matrix<int,PO2,PS2>& ex)
+ {
+ return frexp<PO1,Concrete>(A,ex);
+ }
+
+ /* calc the euclidean distance between the two inputs */
+ /*!
+ * \brief Calculate the euclidean distance between two inputs
+ *
+ * This function calculates the euclidean distance between the elements of Matrix
+ * A and the elements of Matrix B.
+ *
+ * \param A Input matrix
+ * \param B Input matrix
+ */
+
+ SCYTHE_MATH_OP_2ARG(hypot, std::ptr_fun(::hypot))
+
+ /* return (int) logb */
+ SCYTHE_MATH_OP(ilogb, ::ilogb)
+
+ /* compute the bessel func of the first kind of the order 0 */
+ /*!
+ * \brief Compute the Bessel function of the first kind of the order 0
+ *
+ * This function computes the Bessel function of the first kind of order 0
+ * for each element in the input matrix, A.
+ *
+ * \param A Matrix for which the Bessel function is of interest
+ *
+ * \see j1()
+ * \see jn()
+ * \see y0()
+ * \see y1()
+ * \see yn()
+ */
- /* Pow - Raise each Matrix element to the power of the 2nd arg
+ SCYTHE_MATH_OP(j0, ::j0)
+
+ /* compute the bessel func of the first kind of the order 1 */
+ /*!
+ * \brief Compute the Bessel function of the first kind of the order 1
+ *
+ * This function computes the Bessel function of the first kind of order 1
+ * for each element in the input matrix, A.
+ *
+ * \param A Matrix for which the Bessel function is of interest
+ *
+ * \see j0()
+ * \see jn()
+ * \see y0()
+ * \see y1()
+ * \see yn()
+ */
+
+ SCYTHE_MATH_OP(j1, ::j1)
+
+ /* compute the bessel func of the first kind of the order n
+ * TODO: This definition causes the compiler to issue some warnings.
+ * Fix
*/
- template <class T, class S>
- Matrix<T> pow(Matrix<T>, const S &);
-
- /* return the remainder of dividing */
- template <class T>
- Matrix<T> remainder (const Matrix<T> &, const Matrix<T> &);
-
- /* rint - returns x round to the nearest int using the current
- * rounding mode. May rais and inexact floating-point exception if
- * the return value does not equal x???
+ /*!
+ * \brief Compute the Bessel function of the first kind of the order n
+ *
+ * This function computes the Bessel function of the first kind of order n
+ * for each element in the input matrix, A.
+ *
+ * \param n Order of the Bessel function
+ * \param A Matrix for which the Bessel function is of interest
+ *
+ * \see j0()
+ * \see j1()
+ * \see y0()
+ * \see y1()
+ * \see yn()
+ */
+
+ SCYTHE_MATH_OP_2ARG(jn, std::ptr_fun(::jn))
+
+ /* calc x * 2 ^ex */
+ /*!
+ * \brief Compute x * 2^ex
+ *
+ * This function computes the value of x * 2^ex, where x is the ith element of
+ * the input matrix A, and ex is the desired value of the exponent.
+ *
+ * \param A Matrix whose elements are to be multiplied
+ * \param ex Matrix of powers to which 2 will be raised.
+ */
+ SCYTHE_MATH_OP_2ARG(ldexp, std::ptr_fun(::ldexp))
+
+ /* compute the natural log of the absval of gamma function */
+
+ /*!
+ * \brief Compute the natural log of the absolute value of the gamma function
+ *
+ * This function computes the absolute value of the Gamma Function, evaluated at
+ * each element of the input matrix A.
+ *
+ * \param A Matrix whose elements will serve as inputs for the Gamma Function
+ *
+ * \see log()
+ */
+
+ SCYTHE_MATH_OP(lgamma, ::lgamma)
+
+ /* calc the natural log of each element of a Matrix */
+ /*!
+ * \brief Compute the natural log of each element of a Matrix
+ *
+ * This function computes the natural log of each element in a matrix, A.
+ *
+ * \param A Matrix whose natural logs are of interest
+ *
+ * \see log10()
+ * \see log1p()
+ * \see logb()
+ */
+
+ SCYTHE_MATH_OP(log, ::log)
+
+ /* calc the base-10 log of each element of a Matrix */
+ /*!
+ * \brief Compute the log base 10 of each element of a Matrix
+ *
+ * This function computes the log base 10 of each element in a matrix, A.
+ *
+ * \param A Matrix whose logs are of interest
+ *
+ * \see log()
+ * \see log1p()
+ * \see logb()
+ */
+
+ SCYTHE_MATH_OP(log10, ::log10)
+
+ /* calc the natural log of 1 + each element of a Matrix */
+ /*!
+ * \brief Compute the natural log of 1 + each element of a Matrix
+ *
+ * This function computes the natural log of 1 + each element of a Matrix.
+ *
+ * \param A Matrix whose logs are of interest
+ *
+ * \see log()
+ * \see log10()
+ * \see logb()
+ */
+
+ SCYTHE_MATH_OP(log1p, ::log1p)
+
+ /* calc the logb of each element of a Matrix */
+ /*!
+ * \brief Compute the logb each element of a Matrix
+ *
+ * This function computes the log base b of each element of a Matrix.
+ *
+ * \param A Matrix whose logs are of interest
+ *
+ * \see log()
+ * \see log10()
+ * \see log1p()
+ */
+
+ SCYTHE_MATH_OP(logb, ::logb)
+
+ /* x = frac + i, return matrix of frac and place i in 2nd matrix
*/
- template <class T>
- Matrix<T> rint (Matrix<T>);
-
- /* scalbn - returns x * FLT_RADIX^ex (ex is 2nd arg) */
- template <class T>
- Matrix<T> scalbn (Matrix<T>, const int &);
-
- /* sin - return the sine of x */
- template <class T>
- Matrix<T> sin (Matrix<T>);
+ template <matrix_order RO, matrix_style RS, typename T,
+ matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,RO,RS>
+ modf (const Matrix<T,PO1,PS1>& A, Matrix<double,PO2,PS2>& ipart)
+ {
+ SCYTHE_CHECK_10(A.size() != ipart.size(), scythe_conformation_error,
+ "The input matrix sizes do not match");
+ Matrix<T,PO1,Concrete> res(A.rows(), A.cols());
+
+ typename Matrix<T,PO1,PS1>::const_forward_iterator it;
+ typename Matrix<T,PO1,Concrete>::forward_iterator rit
+ = res.begin_f();
+ typename Matrix<double,PO2,PS2>::const_forward_iterator it2
+ = ipart.begin_f();
+ for (it = A.begin_f(); it != A.end_f(); ++it) {
+ *rit = ::modf(*it, &(*it2));
+ ++it2; ++rit;
+ }
+
+ return res;
+ }
+
+ template <typename T, matrix_order PO1, matrix_style PS1,
+ matrix_order PO2, matrix_style PS2>
+ Matrix<T,PO1,Concrete>
+ modf (Matrix<T,PO1,PS1>& A, Matrix<double,PO2,PS2>& ipart)
+ {
+ return modf<PO1,Concrete>(A,ipart);
+ }
+
+ /* calc x^ex of each element of a Matrix */
+
+ /*!
+ * \brief Compute x^ex for each element of a matrix
+ *
+ * This function computes x^ex, where x is the ith element of the matrix A,
+ * and ex is the desired exponent.
+ *
+ * \param A Matrix to be exponentiated
+ * \param ex Desired exponent
+ */
+ SCYTHE_MATH_OP_2ARG(pow, std::ptr_fun(::pow))
+
+ /* calc rem == x - n * y */
+ SCYTHE_MATH_OP_2ARG(remainder, std::ptr_fun(::remainder))
+
+ /* return x rounded to nearest int */
+
+ /*!
+ * \brief Return x rounded to the nearest integer
+ *
+ * This function returns x, where x is the ith element of the Matrix A,
+ * rounded to the nearest integer.
+ *
+ * \param A Matrix whose elements are to be rounded
+ */
- /* sinh - return the hyperbolic sine of x */
- template <class T>
- Matrix<T> sinh (Matrix<T>);
+ SCYTHE_MATH_OP(rint, ::rint)
- /* Sqrt - Calculate the sqrt of each element of a Matrix */
- template <class T>
- Matrix<T> sqrt (Matrix<T>);
+ /* returns x * FLT_RADIX^ex */
+ SCYTHE_MATH_OP_2ARG(scalbn, std::ptr_fun(::scalbn))
- /* tan - return the tangent of x */
- template <class T>
- Matrix<T> tan (Matrix<T>);
+ /* calc the sine of x */
- /* tanh - return the hyperbolic tangent of x */
- template <class T>
- Matrix<T> tanh (Matrix<T>);
-
- /* y0, y1, yn - bessel functions of the second kind of order
- * (May only support doubles, consult standard)
+ /*!
+ * \brief Calculate the sine of each element of a Matrix
+ *
+ * This function calculates the sine of each element in a Matrix
+ *
+ * \param A The matrix whose sines are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sinh()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(sin, ::sin)
+
+ /* calc the hyperbolic sine of x */
+ /*!
+ * \brief Calculate the hyperbolic sine of each element of a Matrix
+ *
+ * This function calculates the hyperbolic sine of each element in a Matrix
+ *
+ * \param A The matrix whose hyperbolic sines are of interest.
+ *
+ * \see tan()
+ * \see tanh()
+ * \see sin()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(sinh, ::sinh)
+
+ /* calc the sqrt of x */
+ /*!
+ * \brief Calculate the square root of each element in a matrix
+ *
+ * This function calculates the square root of each element in a Matrix
+ *
+ * \param A The matrix whose roots are of interest.
+ *
+ * \see cbrt()
+
+ */
+
+ SCYTHE_MATH_OP(sqrt, ::sqrt)
+
+ /* calc the tangent of x */
+
+ /*!
+ * \brief Calculate the tangent of each element of a Matrix
+ *
+ * This function calculates the tangent of each element in a Matrix
+ *
+ * \param A The matrix whose tangents are of interest.
+ *
+ * \see sinh()
+ * \see tanh()
+ * \see sin()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(tan, ::tan)
+
+ /* calc the hyperbolic tangent of x */
+ /*!
+ * \brief Calculate the hyperbolic tangent of each element of a Matrix
+ *
+ * This function calculates the hyperbolic tangent of each element in a Matrix
+ *
+ * \param A The matrix whose hyperbolic tangents are of interest.
+ *
+ * \see sinh()
+ * \see tan()
+ * \see sin()
+ * \see cos()
+ * \see cosh()
+ * \see acos()
+ * \see acosh()
+ * \see asin()
+ * \see asinh()
+ * \see atan()
+ * \see atanh()
+ * \see atan2()
+ */
+
+ SCYTHE_MATH_OP(tanh, ::tanh)
+
+ /* bessel function of the second kind of order 0*/
+ /*!
+ * \brief Compute the Bessel function of the second kind of order 0
+ *
+ * This function computes the Bessel function of the second kind of order 0
+ * for each element in the input matrix, A.
+ *
+ * \param A Matrix for which the Bessel function is of interest
+ *
+ * \see j0()
+ * \see j1()
+ * \see jn()
+ * \see y1()
+ * \see yn()
+ */
+
+ SCYTHE_MATH_OP(y0, ::y0)
+
+ /* bessel function of the second kind of order 1*/
+ /*!
+ * \brief Compute the Bessel function of the second kind of order 1
+ *
+ * This function computes the Bessel function of the second kind of order 1
+ * for each element in the input matrix, A.
+ *
+ * \param A Matrix for which the Bessel function is of interest
+ *
+ * \see j0()
+ * \see j1()
+ * \see jn()
+ * \see y0()
+ * \see yn()
+ */
+
+ SCYTHE_MATH_OP(y1, ::y1)
+
+ /* bessel function of the second kind of order n
+ * TODO: This definition causes the compiler to issue some warnings.
+ * Fix
*/
- template <class T>
- Matrix<T> y0 (Matrix<T>);
-
- template <class T>
- Matrix<T> y1 (Matrix<T>);
-
- template <class T>
- Matrix<T> yn (const int &, Matrix<T>);
-
-
-} // end namespace SCYTHE
-
-#if defined (SCYTHE_COMPILE_DIRECT) && \
- (defined (__GNUG__) || defined (__MWERKS__) || \
- defined (_MSC_VER) || defined (EXPLICIT_TEMPLATE_INSTANTIATION))
-#include "smath.cc"
-#endif /* EXPLICIT_TEMPLATE_INSTANTIATION */
+ /*!
+ * \brief Compute the Bessel function of the second kind of order n
+ *
+ * This function computes the Bessel function of the second kind of order n
+ * for each element in the input matrix, A.
+ *
+ * \param n Order of the Bessel function
+ * \param A Matrix for which the Bessel function is of interest
+ *
+ * \see j0()
+ * \see j1()
+ * \see jn()
+ * \see y0()
+ * \see y1()
+ */
+
+ SCYTHE_MATH_OP_2ARG(yn, std::ptr_fun(::yn))
+
+} // end namespace scythe
#endif /* SCYTHE_MATH_H */
diff --git a/src/stat.cc b/src/stat.cc
deleted file mode 100644
index ea9ee9e..0000000
--- a/src/stat.cc
+++ /dev/null
@@ -1,431 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/stat.cc
- *
- * Provides implementations of descriptive statistical
- * functions.
- *
- */
-
-#ifndef SCYTHE_STAT_CC
-#define SCYTHE_STAT_CC
-
-#include <numeric>
-#include <algorithm>
-#include <cmath>
-
-#ifdef SCYTHE_COMPILE_DIRECT
-#include "stat.h"
-#include "error.h"
-#include "util.h"
-#else
-#include "scythestat/stat.h"
-#include "scythestat/error.h"
-#include "scythestat/util.h"
-#endif
-
-namespace SCYTHE {
-
- /* Calculate the sum of a Matrix */
- template <class T>
- T
- sum (const Matrix<T> &A)
- {
- return (std::accumulate(A.begin(), A.end(), (T) 0));
- }
-
- /* Calculate the sum of each column in a Matrix */
- template <class T>
- Matrix<T>
- sumc (const Matrix<T> &A)
- {
- Matrix<T> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j)
- temp[j] = std::accumulate(A.vecc(j), A.vecc(j + 1), (T) 0);
-
- return temp;
- }
-
- /* Calculate the product of a Matrix */
- template <class T>
- T
- prod (const Matrix<T> &A)
- {
- T temp = (T) 1;
-
- for (int i = 0; i < A.size(); ++i)
- temp *= A[i];
-
- return temp;
- }
-
- /* Calculate the product of each column of a matrix */
- template <class T>
- Matrix<T>
- prodc (const Matrix<T> &A)
- {
- Matrix<T> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j) {
- temp[j] = (T) 1;
- for (int i = 0; i < A.rows(); ++i)
- temp[j] *= A(i,j);
- }
-
- return temp;
- }
-
- /* Calculate the mean of a Matrix */
- template <class T>
- T
- mean (const Matrix<T> &A)
- {
- return (std::accumulate(A.begin(), A.end(), (T) 0) / A.size());
- }
-
- /* Calculate the mean of each column of a Matrix */
- template <class T>
- Matrix<T>
- meanc (const Matrix<T> &A)
- {
- Matrix<T> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j)
- temp[j] = std::accumulate(A.vecc(j), A.vecc(j + 1), (T) 0) / A.rows();
-
- return temp;
- }
-
- /* Calculate the median of a matrix. Uses a sort but I'll implement
- * the randomized alg when I figure out how to generalize it to
- * even-length lists
- */
- template <class T>
- T
- median (const Matrix<T> &A)
- {
- Matrix<T> temp(A);
- int n = temp.size();
-
- sort(temp.begin(), temp.end());
- if (n % 2 == 0)
- return ((temp[n / 2] + temp[n / 2 - 1]) / 2);
- else
- return temp[(int) floor(n / 2)];
- }
-
- /* Calculate the median of each column of a matrix */
- template <class T>
- Matrix<T>
- medianc (const Matrix<T> &A)
- {
- Matrix<T> temp;
- Matrix<T> result(1, A.cols(), false);
-
- for (int i = 0; i < A.cols(); ++i) {
- temp = A(_, i);
- int n = temp.size();
- sort(temp.begin(), temp.end());
- if (n % 2 == 0)
- result[i] = ((temp[n / 2] +
- temp[n / 2 - 1]) / 2);
- else
- result[i] = temp[(int) floor(n / 2)];
- }
-
- return result;
- }
-
- /* Calculate the mode of a matrix */
- template <class T>
- T
- mode (const Matrix<T> &A)
- {
- Matrix<T> temp(A);
-
- sort(temp.begin(), temp.end());
-
- T last = temp[0];
- int cnt = 1;
- T cur_max = temp[0];
- int max_cnt = 1;
-
- for (int i = 1; i < temp.size(); ++i) {
- if (last == temp[i]) {
- ++cnt;
- } else {
- last = temp[i];
- cnt = 1;
- }
- if (cnt > max_cnt) {
- max_cnt = cnt;
- cur_max = temp[i];
- }
- }
-
- return cur_max;
- }
-
- template <class T>
- Matrix<T>
- modec (const Matrix<T> & A)
- {
- Matrix<T> temp;
- Matrix<T> result(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j) {
- temp = A(_, j);
- T last = temp[0];
- int cnt = 1;
- T cur_max = temp[0];
- int max_cnt = 1;
-
- for (int i = 1; i < temp.size(); ++i) {
- if (last == temp[i]) {
- ++cnt;
- } else {
- last = temp[i];
- cnt = 1;
- }
- if (cnt > max_cnt) {
- max_cnt = cnt;
- cur_max = temp[i];
- }
- }
- result[j] = cur_max;
- }
-
- return result;
- }
-
- /* Calculate the skew of a Matrix */
- template <class T>
- T
- skew (const Matrix<T> &A)
- {
- T sde = sd(A);
- T mu = mean(A);
- T temp = (T) 0;
-
- for (int i = 0; i < A.size(); ++i) {
- temp += ::pow(A[i] - mu, 3);
- }
- temp /= A.size() * ::pow(sde, 3);
-
- return temp;
- }
-
- /* Calculate the skew of each column of a Matrix. */
- template <class T>
- Matrix<T>
- skewc (const Matrix<T> &A)
- {
- Matrix<T> sd = stdc(A);
- Matrix<T> mu = meanc(A);
- Matrix<T> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j) {
- temp[j] = 0;
- for (int i = 0; i < A.rows(); ++i) {
- temp[j] += ::pow(A(i,j) - mu[j], 3);
- }
- temp[j] /= A.cols() * ::pow(sd[j], 3);
- }
-
- return temp;
- }
-
- /* Calculate the kurtosis of a Matrix */
- template <class T>
- T
- kurtosis (const Matrix<T> &A)
- {
- T sde = sd(A);
- T mu = mean(A);
- T temp = (T) 0;
-
- for (int i = 0; i < A.size(); ++i) {
- temp += ::pow(A[i] - mu, 4);
- }
- temp /= A.size() * ::pow(sde, 4);
- temp -= 3;
-
- return temp;
- }
-
- /* Calculate the kurtosis of each column of a Matrix. */
- template <class T>
- Matrix<T>
- kurtosisc (const Matrix<T> &A)
- {
- Matrix<T> sd = stdc(A);
- Matrix<T> mu = meanc(A);
- Matrix<T> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j) {
- temp[j] = 0;
- for (int i = 0; i < A.rows(); ++i) {
- temp[j] += ::pow(A(i,j) - mu[j], 4);
- }
- temp[j] /= A.cols() * ::pow(sd[j], 4);
- temp[j] -= 3;
- }
-
- return temp;
- }
-
- /* Calculate the variance of a Matrix */
- template <class T>
- T
- var (const Matrix<T> &A)
- {
- T mu = mean(A);
- T temp = (T) 0;
-
- for (int i =0; i < A.size(); ++i)
- temp += ::pow(mu - A[i], 2) / (A.size() - 1);
-
- return temp;
- }
-
- /* Calculate the variances of each column of a Matrix. */
- template <class T>
- Matrix<T>
- varc (const Matrix<T> &A)
- {
- Matrix<T> mu = meanc (A);
- Matrix<T> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j) {
- temp[j] = 0;
- for (int i = 0; i < A.rows(); ++i)
- temp[j] += ::pow (mu[j] - A(i,j), 2) / (A.rows() - 1);
- }
-
- return temp;
- }
-
- /* Calculate the mean of a Matrix (not std cause of namespace std:: */
- template <class T>
- T
- sd (const Matrix<T> &A)
- {
- return ::sqrt(var(A));
- }
-
- /* Calculate the standard deviation of each column of a Matrix */
- template <class T>
- Matrix<T>
- stdc (const Matrix<T> &A)
- {
- Matrix<T> temp = varc(A);
-
- for (int i = 0; i < A.cols(); ++i)
- temp[i] = ::sqrt(temp[i]);
-
- return temp;
- }
-
- /* Calculates the maximum element in a Matrix */
- template <class T>
- T
- max (const Matrix<T> &A)
- {
- return *(max_element(A.begin(), A.end()));
- }
-
- /* Calculates the minimum element in a Matrix */
- template <class T>
- T
- min (const Matrix<T> &A)
- {
- return *(min_element(A.begin(), A.end()));
- }
-
- /* Find the index of the max element */
- template <class T>
- int
- maxind (const Matrix<T> &A)
- {
- return (max_element(A.begin(), A.end())).get_index();
- }
-
- /* Find the index of the min element */
- template <class T>
- int
- minind (const Matrix<T> &A)
- {
- return (min_element(A.begin(), A.end())).get_index();
- }
-
- /* Calculates the maximum of each Matrix column */
- template <class T>
- Matrix<T>
- maxc (const Matrix<T> &A)
- {
- Matrix<T> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j)
- temp[j] = *(max_element(A.vecc(j), A.vecc(j + 1)));
-
- return temp;
- }
-
- /* Calculates the minimum of each Matrix column */
- template <class T>
- Matrix<T>
- minc (const Matrix<T> &A)
- {
- Matrix<T> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j)
- temp[j] = *(min_element(A.vecc(j), A.vecc(j + 1)));
-
- return temp;
- }
-
- /* Finds the index of the maximum of each Matrix column */
- template <class T>
- Matrix<int>
- maxindc(const Matrix<T> &A)
- {
- Matrix<int> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j)
- temp[j] = (max_element(A.vecc(j), A.vecc(j + 1))).get_row();
-
- return temp;
- }
-
- /* Finds the index of the minimum of each Matrix column */
- template <class T>
- Matrix<int>
- minindc(const Matrix<T> &A)
- {
- Matrix<int> temp(1, A.cols(), false);
-
- for (int j = 0; j < A.cols(); ++j)
- temp[j] = (min_element(A.vecc(j), A.vecc(j + 1))).get_row();
-
- return temp;
- }
-
-} // end namespace SCYTHE
-
-#ifndef SCYTHE_COMPILE_DIRECT
-#include "scythestat/eti/stat.t"
-#endif
-
-#endif /* SCYTHE_STAT_CC */
diff --git a/src/stat.h b/src/stat.h
index 434cb4d..5194539 100644
--- a/src/stat.h
+++ b/src/stat.h
@@ -1,21 +1,28 @@
/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
+ * Scythe Statistical Library Copyright (C) 2000-2002 Andrew D. Martin
+ * and Kevin M. Quinn; 2002-present Andrew D. Martin, Kevin M. Quinn,
+ * and Daniel Pemstein. All Rights Reserved.
*
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
+ * This program is free software; you can redistribute it and/or
+ * modify under the terms of the GNU General Public License as
+ * published by Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version. See the text files
+ * COPYING and LICENSE, distributed with this source code, for further
* information.
* --------------------------------------------------------------------
- * scythestat/stat.h
+ * scythestat/stat.h
*
- * Provides declarations for descriptive statistical
- * functions.
+ */
+
+/*!
+ * \file stat.h
+ * \brief Definitions for functions that perform common
+ * statistical operations on Scythe Matrix objects.
*
+ * \note As is the case throughout the library, we provide both
+ * general and default template definitions of the Matrix-returning
+ * functions in this file, explicitly providing documentation for only
+ * the general template versions.
*/
#ifndef SCYTHE_STAT_H
@@ -23,122 +30,631 @@
#ifdef SCYTHE_COMPILE_DIRECT
#include "matrix.h"
+#include "algorithm.h"
+#include "error.h"
#else
#include "scythestat/matrix.h"
+#include "scythestat/algorithm.h"
+#include "scythestat/error.h"
#endif
-namespace SCYTHE {
+#include <numeric>
+#include <set>
+
+
+namespace scythe {
+
+ namespace {
+ typedef unsigned int uint;
+ }
+
+/* A macro for defining column versions of a function. That is,
+ * when expanded, this macro produces general and default template
+ * functions that compute function NAME on each column in a matrix and
+ * return a row vector with the results. We use this to generate
+ * column versions of every function in this header file.
+ */
+#define SCYTHE_STATMETH_COL(NAME) \
+ template <matrix_order RO, matrix_style RS, typename T, \
+ matrix_order PO, matrix_style PS> \
+ Matrix<T,RO,RS> \
+ NAME ## c (const Matrix<T,PO,PS>& A) \
+ { \
+ Matrix<T,RO,RS> res (1, A.cols(), false); \
+ \
+ for (uint j = 0; j < A.cols(); ++j) \
+ res[j] = NAME(A(_, j)); \
+ \
+ return res; \
+ } \
+ \
+ template <typename T, matrix_order O, matrix_style S> \
+ Matrix<T,O,Concrete> \
+ NAME ## c (const Matrix<T,O,S>& A) \
+ { \
+ return NAME ## c<O,Concrete>(A); \
+ }
+
+
+ /* Calculate the sum of a Matrix */
+
+ /*!
+ * \brief Calculate the sum of a Matrix
+ *
+ * This function calculates the sum of a matrix by adding each element
+ * in turn.
+ *
+ * \param A The matrix to be summed.
+ *
+ * \see prod(const Matrix<T,PO,PS> &A)
+ * \see sumc(const Matrix<T,PO,PS> &A)
+ * \see prodc(const Matrix<T,PO,PS> &A)
+ */
+
+
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ sum (const Matrix<T,PO,PS> &A)
+ {
+ return (std::accumulate(A.begin_f(), A.end_f(), (T) 0));
+ }
+
+ /* Calculate the sum of each column in a Matrix */
+
+ /*!
+ * \brief Calculate the sum of each column in a Matrix
+ *
+ * This function calculates the sum of each column in a matrix by
+ * consecutively adding elements in a single column, looping through all
+ * columns, and returning the results.
+ *
+ * \param A The matrix to be summed.
+ *
+ * \see prod(const Matrix<T,PO,PS> &A)
+ * \see sum(const Matrix<T,PO,PS> &A)
+ * \see prodc(const Matrix<T,PO,PS> &A)
+ */
+
+ SCYTHE_STATMETH_COL(sum)
- /* Sum - Calculate the sum of a Matrix */
- template <class T>
- T sum (const Matrix<T> &);
+ /* Calculate the product of a Matrix */
+
+ /*!
+ * \brief Calculate the product of a Matrix
+ *
+ * This function calculates the product of a matrix by beginning with the
+ * first element of a matrix, and consecutively multiplying each entry.
+ *
+ * \param A The matrix to be multiplied.
+ *
+ * \see sumc(const Matrix<T,PO,PS> &A)
+ * \see sum(const Matrix<T,PO,PS> &A)
+ * \see prodc(const Matrix<T,PO,PS> &A)
+ */
+
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ prod (const Matrix<T,PO,PS> &A)
+ {
+ return std::accumulate(A.begin_f(), A.end_f(), (T) 1,
+ std::multiplies<T> ());
+ }
- /* Sumc - Calculate the sum of each column of a Matrix */
- template <class T>
- Matrix<T> sumc (const Matrix<T> &);
+ /* Calculate the product of each column of a matrix */
+
+ /*!
+ * \brief Calculate the product of each column of a Matrix
+ *
+ * This function calculates the product of each column of a matrix by
+ * multiplying all elements of a single column, looping through all columns,
+ * and returning the results.
+ *
+ * \param A The matrix to be multiplied.
+ *
+ * \see sumc(const Matrix<T,PO,PS> &A)
+ * \see sum(const Matrix<T,PO,PS> &A)
+ * \see prod(const Matrix<T,PO,PS> &A)
+ */
+
+ SCYTHE_STATMETH_COL(prod)
- /* Prod - Calculate the product of a Matrix */
- template <class T>
- T prod (const Matrix<T> &);
+ /* Calculate the mean of a Matrix */
+
+ /*!
+ * \brief Calculate the mean of a Matrix
+ *
+ * This function calculates the mean of a matrix by summing all elements of
+ * the matrix, and dividing by the total number of elements in the matrix.
+ *
+ * \param A The matrix to be averaged.
+ *
+ * \see sum(const Matrix<T,PO,PS> &A)
+ * \see meanc(const Matrix<T,PO,PS> &A)
+ * \see median(const Matrix<T,PO,PS> &A)
+ * \see mode(const Matrix<T,PO,PS> &A)
+ * \see variance(const Matrix<T,PO,PS> &A)
+ */
+
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ mean (const Matrix<T,PO,PS> &A)
+ {
+ return (std::accumulate(A.begin_f(), A.end_f(), (T) 0) / A.size());
+ }
- /* Prodc - Calculate the product of each column of a Matrix */
- template <class T>
- Matrix<T> prodc (const Matrix<T> &);
+ /* Calculate the mean of each column of a Matrix */
- /* Mean - Calculate the mean of a Matrix */
- template <class T>
- T mean (const Matrix<T> &);
+ /*!
+ * \brief Calculate the mean of each column of a Matrix
+ *
+ * This function calculates the mean of each column of a matrix by summing
+ * all elements of a column in the matrix, divding by the total number of
+ * elements in the column, and looping over every column in the matrix.
+ *
+ * \param A The matrix to be averaged.
+ *
+ * \see sumc(const Matrix<T,PO,PS> &A)
+ * \see mean(const Matrix<T,PO,PS> &A)
+ * \see medianc(const Matrix<T,PO,PS> &A)
+ * \see modec(const Matrix<T,PO,PS> &A)
+ * \see variancec(const Matrix<T,PO,PS> &A)
+ */
- /* Meanc - Calculate the mean of each column of a Matrix */
- template <class T>
- Matrix<T> meanc (const Matrix<T> &);
+ SCYTHE_STATMETH_COL(mean)
+
+ /* Calculate the median of a matrix. Uses a sort but I'll implement
+ * the randomized alg when I figure out how to generalize it to
+ * even-length lists
+ */
+
+ /*!
+ * \brief Calculate the median of a Matrix
+ *
+ * This function calculates the median of a matrix by first sorting the elements
+ * of the matrix, and then finding the middle element.
+ *
+ * \param A The matrix whose median is of interest.
+ *
+ * \see medianc(const Matrix<T,PO,PS> &A)
+ * \see mean(const Matrix<T,PO,PS> &A)
+ * \see mode(const Matrix<T,PO,PS> &A)
+ */
- /* Median - Calculate the median of a Matrix */
- template <class T>
- T median (const Matrix<T> &);
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ median (const Matrix<T,PO,PS> &A)
+ {
+ Matrix<T, PO, PS> temp(A);
+ uint n = temp.size();
- /* Medianc - Calculate the median of each column of a Matrix */
- template <class T>
- Matrix<T> medianc (const Matrix<T> &);
+ sort(temp.begin(), temp.end());
+ if (n % 2 == 0)
+ return ((temp[n / 2] + temp[n / 2 - 1]) / 2);
+ else
+ return temp[(uint) ::floor(n / 2)];
+ }
- /* Mode - Calcualte the mode of the Matrix */
- template <class T>
- T mode (const Matrix<T> &);
+ /* Calculate the median of each column of a matrix */
- /* Modec - Calculate the mode of each column of a Matrix */
- template <class T>
- Matrix<T> modec (const Matrix<T> &);
+ /*!
+ * \brief Calculate the median of each column a Matrix
+ *
+ * This function calculates the median of each column of a matrix by first
+ * sorting the elements and locating the middle in a single column, and then
+ * looping over all columns.
+ *
+ * \param A The matrix whose medians are of interest.
+ *
+ * \see median(const Matrix<T,PO,PS> &A)
+ * \see meanc(const Matrix<T,PO,PS> &A)
+ * \see modec(const Matrix<T,PO,PS> &A)
+ */
+
+ SCYTHE_STATMETH_COL(median)
+
+ /* Calculate the mode of a matrix */
+
+ /*!
+ * \brief Calculate the mode of a Matrix
+ *
+ * This function calculates the mode of a matrix by determining which value of
+ * the matrix occurs with the highest frequency.
+ *
+ * \param A The matrix whose mode is of interest.
+ *
+ * \see modec(const Matrix<T,PO,PS> &A)
+ * \see mean(const Matrix<T,PO,PS> &A)
+ * \see median(const Matrix<T,PO,PS> &A)
+ */
+
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ mode (const Matrix<T,PO,PS> &A)
+ {
+ Matrix<T, PO, PS> temp(A);
+
+ sort(temp.begin(), temp.end());
+
+ T last = temp[0];
+ uint cnt = 1;
+ T cur_max = temp[0];
+ uint max_cnt = 1;
+
+ for (uint i = 1; i < temp.size(); ++i) {
+ if (last == temp[i]) {
+ ++cnt;
+ } else {
+ last = temp[i];
+ cnt = 1;
+ }
+ if (cnt > max_cnt) {
+ max_cnt = cnt;
+ cur_max = temp[i];
+ }
+ }
+
+ return cur_max;
+ }
+
+ /*!
+ * \brief Calculate the mode of the columns of a Matrix
+ *
+ * This function calculates the mode of the columns of a matrix by
+ * determining which value in a single column of the matrix occurs
+ * most frequently, and then looping over all columns.
+ *
+ * \param A The matrix whose modes are of interest.
+ *
+ * \see mode(const Matrix<T,PO,PS> &A)
+ * \see meanc(const Matrix<T,PO,PS> &A)
+ * \see medianc(const Matrix<T,PO,PS> &A)
+ */
+
+ SCYTHE_STATMETH_COL(mode)
+
+ /* Calculate the variance of a Matrix */
+
+ /* A functor that encapsulates a single variance calculation step.
+ * Also used by skew and kurtosis. */
+ namespace {
+ template <typename T, typename T2>
+ struct var_step : std::binary_function<T, T, T>
+ {
+ T constant_;
+ T2 divisor_;
+ T exponent_;
+ var_step (T c, T2 d, T e) : constant_ (c), divisor_ (d),
+ exponent_ (e) {}
+ T operator() (T last, T x) const
+ {
+ return (last + std::pow(constant_ - x, exponent_) / divisor_);
+ }
+ };
+ }
- /* Skew - Calcualte the skew of the Matrix */
- template <class T>
- T skew (const Matrix<T> &);
+ /*!
+ * \brief Calculate the variance of a Matrix
+ *
+ * This function calculates the variance of a matrix.
+ *
+ * \param A The matrix whose variance is of interest.
+ *
+ * \see var(cons Matrix<T,PO,PS> &A, T mu)
+ * \see varc(const Matrix<T,PO,PS> &A)
+ * \see sd(const Matrix<T,PO,PS> &A)
+ * \see mean(const Matrix<T,PO,PS> &A)
+ */
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ var (const Matrix<T,PO,PS> &A)
+ {
+ return var(A, mean(A));
+ }
+
+ /* Calculate the variances of each column of a Matrix. */
- /* Skewc - Calculate the skew of each column of a Matrix */
- template <class T>
- Matrix<T> skewc (const Matrix<T> &);
+ /*!
+ * \brief Calculate the variance of each column of a Matrix
+ *
+ * This function calculates the variance of each column of a matrix.
+ *
+ * \param A The matrix whose variances are of interest.
+ *
+ * \see var(const Matrix<T,PO,PS> &A)
+ * \see var(cons Matrix<T,PO,PS> &A, T mu)
+ * \see sdc(const Matrix<T,PO,PS> &A)
+ * \see meanc(const Matrix<T,PO,PS> &A)
+ */
+
+ SCYTHE_STATMETH_COL(var)
+
+ /*!
+ * \brief Calculate the variance of a Matrix
+ *
+ * This function calculates the variance of a matrix when the mean is
+ * already known.
+ *
+ * \param A The matrix whose variance is of interest.
+ * \param mu The mean of the values in the matrix.
+ *
+ * \see var(cons Matrix<T,PO,PS> &A)
+ * \see varc(const Matrix<T,PO,PS> &A)
+ * \see sd(const Matrix<T,PO,PS> &A)
+ * \see mean(const Matrix<T,PO,PS> &A)
+ */
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ var (const Matrix<T,PO,PS> &A, T mu)
+ {
+ return std::accumulate(A.begin_f(), A.end_f(), (T) 0,
+ var_step<T, uint> (mu, A.size() - 1, 2));
+ }
- /* Kurtosis - Calcualte the kurtosis of the Matrix */
- template <class T>
- T kurtosis (const Matrix<T> &);
+ /* Calculate the standard deviation of a Matrix (not std cause of namespace std:: */
- /* Kurtosisc - Calculate the kurtosis of each column of a Matrix */
- template <class T>
- Matrix<T> kurtosisc (const Matrix<T> &);
+ /*!
+ * \brief Calculate the standard deviation of a Matrix
+ *
+ * This function calculates the standard deviation of a matrix by
+ * taking the square root of the matrix's variance.
+ *
+ * \param A The matrix whose standard deviation is of interest.
+ *
+ * \see sd(const Matrix<T,PO,PS) &A, T mu)
+ * \see sdc(const Matrix<T,PO,PS> &A)
+ * \see variance(const Matrix<T,PO,PS> &A)
+ */
+
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ sd (const Matrix<T,PO,PS> &A)
+ {
+ return std::sqrt(var(A));
+ }
- /* Var - Calculate the variance of a Matrix */
- template <class T>
- T var (const Matrix<T> &);
+ /* Calculate the standard deviation of each column of a Matrix */
+ /*!
+ * \brief Calculate the standard deviation of each column of a Matrix
+ *
+ * This function calculates the standard deviation of each column of a matrix by
+ * taking the square root of each column's variance.
+ *
+ * \param A The matrix whose standard deviations are of interest.
+ *
+ * \see sd(const Matrix<T,PO,PS> &A)
+ * \see variancec(const Matrix<T,PO,PS> &A)
+ */
+
+ SCYTHE_STATMETH_COL(sd)
+
+ /*!
+ * \brief Calculate the standard deviation of a Matrix
+ *
+ * This function calculates the standard deviation of a matrix
+ * when the matrix's mean is already known.
+ *
+ * \param A The matrix whose standard deviation is of interest.
+ * \param mu The matrix mean.
+ *
+ * \see sd(const Matrix<T,PO,PS) &A)
+ * \see sdc(const Matrix<T,PO,PS> &A)
+ * \see variance(const Matrix<T,PO,PS> &A)
+ */
+
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ sd (const Matrix<T,PO,PS> &A, T mu)
+ {
+ return std::sqrt(var(A, mu));
+ }
+
+ /* Calculate the skew of a Matrix */
+
+ /*!
+ * \brief Calculate the skew of a Matrix
+ *
+ * This function calculates the skew of a matrix.
+ *
+ * \param A The matrix whose skew is of interest.
+ *
+ * \see skewc(const Matrix<T,PO,PS> &A)
+ * \see kurtosis(const Matrix<T,PO,PS> &A)
+ */
+
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ skew (const Matrix<T,PO,PS> &A)
+ {
+ T mu = mean(A);
+ T sde = sd(A, mu);
+ return std::accumulate(A.begin_f(), A.end_f(), (T) 0,
+ var_step<T, T> (mu, A.size() * std::pow(sde, 3), 3));
+ }
- /* Varc - Calculate the variance of each Matrix column */
- template <class T>
- Matrix<T> varc (const Matrix<T> &);
+ /* Calculate the skew of each column of a Matrix. */
+
+ /*!
+ * \brief Calculate the skew of each column of a Matrix
+ *
+ * This function calculates the skew of each column of a matrix.
+ *
+ * \param A The matrix whose skews are of interest.
+ *
+ * \see skew(const Matrix<T,PO,PS> &A)
+ * \see kurtosisc(const Matrix<T,PO,PS> &A)
+ */
- /* Std - Calculate the std deviation of a Matrix */
- template <class T>
- T sd (const Matrix<T> &);
+ SCYTHE_STATMETH_COL(skew)
+
+ /* Calculate the kurtosis of a Matrix */
+
+ /*!
+ * \brief Calculate the kurtosis of a Matrix
+ *
+ * This function calculates the kurtosis of a matrix.
+ *
+ * \param A The matrix whose kurtosis is of interest.
+ *
+ * \see skew(const Matrix<T,PO,PS> &A)
+ * \see kurtosisc(const Matrix<T,PO,PS> &A)
+ */
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ kurtosis (const Matrix<T,PO,PS> &A)
+ {
+ T mu = mean(A);
+ T sde = sd(A, mu);
+ return (std::accumulate(A.begin_f(), A.end_f(), (T) 0,
+ var_step<T, T> (mu, A.size() * std::pow(sde, 4), 4))
+ - 3);
+ }
+
+ /* Calculate the kurtosis of each column of a Matrix. */
- /* Stdc - Calculate the std deviation of each Matrix column */
- template <class T>
- Matrix<T> stdc (const Matrix<T> &);
+ /*!
+ * \brief Calculate the kurtosis of each column of a Matrix
+ *
+ * This function calculates the kurtosis of each column of a matrix.
+ *
+ * \param A The matrix whose kurtoses are of interest.
+ *
+ * \see skewc(const Matrix<T,PO,PS> &A)
+ * \see kurtosis(const Matrix<T,PO,PS> &A)
+ */
- /* Max - Calculates the maximum element in a Matrix */
- template <class T>
- T max (const Matrix<T> &);
+ SCYTHE_STATMETH_COL(kurtosis)
- /* Min - Calculates the minimum element in a Matrix */
- template <class T>
- T min (const Matrix<T> &);
+ /* Calculates the maximum element in a Matrix */
+ /*!
+ * \brief Calculate the maximum element in a Matrix
+ *
+ * This function identifies the maximum element in a matrix.
+ *
+ * \param A The matrix whose maximum element is of interest.
+ *
+ * \see min(const Matrix<T,PO,PS> &A)
+ * \see maxc (const Matrix<T,PO,PS> &A)
- /* Maxind - Finds the index of the max element */
- template <class T>
- int maxind(const Matrix<T> &);
+ */
+
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ max (const Matrix<T,PO,PS> &A)
+ {
+ return *(max_element(A.begin_f(), A.end_f()));
+ }
- /* Minind - Finds the index of the min element */
- template <class T>
- int minind(const Matrix<T> &);
+ /*!
+ * \brief Calculate the maximum of each column of a Matrix
+ *
+ * This function identifies the maximum of each column in a matrix.
+ *
+ * \param A The matrix whose maximae are of interest.
+ *
+ * \see max(const Matrix<T,PO,PS> &A)
+ * \see minc(const Matrix<T,PO,PS> &A)
+ */
+
+ SCYTHE_STATMETH_COL(max)
- /* Maxc - Calculates the maximum of each Matrix column */
- template <class T>
- Matrix<T> maxc (const Matrix<T> &);
+ /* Calculates the minimum element in a Matrix */
+
+ /*!
+ * \brief Calculate the maximum element in a Matrix
+ *
+ * This function identifies the maximum element in a matrix.
+ *
+ * \param A The matrix whose maximum element is of interest.
+ *
+ * \see max(const Matrix<T,PO,PS> &A)
+ * \see minc(const Matrix<T,PO,PS> &A)
+ */
+ template <typename T, matrix_order PO, matrix_style PS>
+ T
+ min (const Matrix<T,PO,PS> &A)
+ {
+ return *(min_element(A.begin_f(), A.end_f()));
+ }
+
+ /*!
+ * \brief Calculate the minimum of each column of a Matrix
+ *
+ * This function identifies the minimum of each column in a matrix.
+ *
+ * \param A The matrix whose minimae are of interest.
+ *
+ * \see min(const Matrix<T,PO,PS> &A)
+ * \see maxc(const Matrix<T,PO,PS> &A)
+ */
+
+ SCYTHE_STATMETH_COL(min)
+
+ /* Find the index of the max element */
+ /*!
+ * \brief Calculate the index of the maximum element in a Matrix
+ *
+ * This function identifies the index of the maximum element in a matrix.
+ *
+ * \param A The matrix whose maximum element indices are of interest.
+ *
+ * \see minind(const Matrix<T,PO,PS> &A)
+ * \see max(const Matrix<T,PO,PS> &A)
+ * \see maxindc(const Matrix<T,PO,PS> &A)
+ */
- /* Minc - Calculates the minimum of each Matrix column */
- template <class T>
- Matrix<T> minc (const Matrix<T> &);
+ template <typename T, matrix_order PO, matrix_style PS>
+ unsigned int
+ maxind (const Matrix<T,PO,PS> &A)
+ {
+ return (max_element(A.begin_f(), A.end_f())).get_index();
+ }
+
+ /*!
+ * \brief Calculate the index of the maximum for each column of a Matrix
+ *
+ * This function identifies the index of the maximum for each column of a Matrix.
+ *
+ * \param A The matrix whose maximum indices are of interest.
+ *
+ * \see maxc(const Matrix<T,PO,PS> &A)
+ * \see minindc(const Matrix<T,PO,PS> &A)
+ */
- /* Maxindc - Finds the index of the max of each Matrix column */
- template <class T>
- Matrix<int> maxindc(const Matrix<T> &);
+ SCYTHE_STATMETH_COL(maxind)
- /* Minindc - Finds the index of the min of each Matrix column */
- template <class T>
- Matrix<int> minindc(const Matrix<T> &);
+ /* Find the index of the min element */
+
+ /*!
+ * \brief Calculate the index of the minimum element in a Matrix
+ *
+ * This function identifies the index of the minimum element in a matrix.
+ *
+ * \param A The matrix whose minimum element indices are of interest.
+ *
+ * \see maxind(const Matrix<T,PO,PS> &A)
+ * \see min(const Matrix<T,PO,PS> &A)
+ * \see minindc(const Matrix <T> &A)
+ */
+ template <typename T, matrix_order PO, matrix_style PS>
+ unsigned int
+ minind (const Matrix<T,PO,PS> &A)
+ {
+ return (min_element(A.begin_f(), A.end_f())).get_index();
+ }
+
+ /*!
+ * \brief Calculate the index of the minimum for each column of a Matrix
+ *
+ * This function identifies the index of the minimum for each column of a Matrix.
+ *
+ * \param A The matrix whose minimum indices are of interest.
+ *
+ * \see minc(const Matrix<T,PO,PS> &A)
+ * \see maxindc(const Matrix<T,PO,PS> &A)
+ */
+ SCYTHE_STATMETH_COL(minind)
-} // end namespace SCYTHE
+} // end namespace scythe
-#if defined (SCYTHE_COMPILE_DIRECT) && \
- (defined (__GNUG__) || defined (__MWERKS__) || \
- defined (_MSC_VER) || defined (EXPLICIT_TEMPLATE_INSTANTIATION))
-#include "stat.cc"
-#endif /* EXPLICIT_TEMPLATE_INSTANTIATION */
#endif /* SCYTHE_STAT_H */
diff --git a/src/util.h b/src/util.h
deleted file mode 100644
index 535ad7e..0000000
--- a/src/util.h
+++ /dev/null
@@ -1,74 +0,0 @@
-/*
- * Scythe Statistical Library
- * Copyright (C) 2000-2002 Andrew D. Martin and Kevin M. Quinn;
- * 2002-2004 Andrew D. Martin, Kevin M. Quinn, and Daniel
- * Pemstein. All Rights Reserved.
- *
- * This program is free software; you can redistribute it and/or modify
- * under the terms of the GNU General Public License as published by
- * Free Software Foundation; either version 2 of the License, or (at
- * your option) any later version. See the text files COPYING
- * and LICENSE, distributed with this source code, for further
- * information.
- * --------------------------------------------------------------------
- * scythestat/util.h
- *
- * Provides definitions and implementations for some basic
- * utilities used within Scythe.
- *
- */
-
-#ifndef SCYTHE_UTIL_H
-#define SCYTHE_UTIL_H
-
-#include <string>
-#include <iterator>
-#include <sstream>
-
-namespace SCYTHE
-{
- /**** A couple of useful functions that make life easier but really
- * don't have anything to do with Scythe, per se.
- ****/
-
- template <class T>
- inline std::string operator& (const std::string & s, const T & v)
- {
- std::ostringstream ss;
- ss << s << v;
- return ss.str ();
- }
-
- inline std::ostream & operator<< (std::ostream & os,
- const scythe_exception & se)
- {
- os << se.what ();
- return os;
- }
-
- template <class T>
- inline T min (const T & a, const T & b)
- {
- return b < a ? b : a;
- }
-
- template <class T>
- inline T max (const T & a, const T & b)
- {
- return a < b ? b : a;
- }
-
- template <class T>
- inline T sgn (const T & x)
- {
- if (x > 0)
- return 1;
- else if (x < 0)
- return -1;
- else
- return 0;
- }
-
-} // end namespace SCYTHE
-
-#endif /* SCYTHE_ERROR_H */
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-mcmcpack.git
More information about the debian-science-commits
mailing list