[r-cran-mnp] 45/51: Import Upstream version 2.6-2
Andreas Tille
tille at debian.org
Fri Sep 8 14:14:48 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-mnp.
commit fe12d27960fcc87b8980ce15b49b8b687208eab6
Author: Andreas Tille <tille at debian.org>
Date: Fri Sep 8 15:55:13 2017 +0200
Import Upstream version 2.6-2
---
DESCRIPTION | 8 ++++----
src/MNP.c | 4 ++--
src/rand.c | 39 ++++++++++++++++++++++++++++++++++++++-
src/rand.h | 2 +-
4 files changed, 45 insertions(+), 8 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 96a3beb..d4cce51 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: MNP
-Version: 2.6-1
-Date: 2009-09-23
+Version: 2.6-2
+Date: 2010-10-27
Title: R Package for Fitting the Multinomial Probit Model
Author: Kosuke Imai <kimai at princeton.edu>, David A. van Dyk
<dvd at uci.edu>.
@@ -29,6 +29,6 @@ LazyLoad: yes
LazyData: yes
License: GPL (>= 2)
URL: http://imai.princeton.edu/software/MNP.html
-Packaged: 2009-09-24 02:29:56 UTC; kimai
+Packaged: 2010-10-28 02:53:15 UTC; kimai
Repository: CRAN
-Date/Publication: 2009-09-24 06:31:42
+Date/Publication: 2010-10-28 08:26:49
diff --git a/src/MNP.c b/src/MNP.c
index b02e3f1..ca0ec09 100644
--- a/src/MNP.c
+++ b/src/MNP.c
@@ -547,8 +547,8 @@ void predict(double *dX, /* X matrix */
/* PdoubleArray(Xbeta, n_dim); */
/* sample W */
for (j = 0; j < n_extra; j++) {
- dinv(Sigma[main_loop], n_dim, mtemp);
- rMVN(vtemp, Xbeta, mtemp, n_dim);
+ /*dinv(Sigma[main_loop], n_dim, mtemp);*/
+ rMVN(vtemp, Xbeta, Sigma[main_loop], n_dim);
for (k = 0; k < n_dim; k++)
W[j][k+1] = vtemp[k];
W[j][0] = 0;
diff --git a/src/rand.c b/src/rand.c
index e61bf39..ea97fd3 100644
--- a/src/rand.c
+++ b/src/rand.c
@@ -10,6 +10,39 @@
#include "rand.h"
+double sTruncNorm(
+ double bd, /* bound */
+ double mu,
+ double var,
+ int lower /* 1 = x > bd, 0 = x < bd */
+ ) {
+
+ double z, logb, lambda, u;
+ double sigma = sqrt(var);
+ double stbd = (bd - mu)/sigma;
+
+ if (lower == 0) {
+ stbd = (mu - bd)/sigma;
+ }
+ if (stbd > 0) {
+ lambda = 0.5*(stbd + sqrt(stbd*stbd + 4));
+ logb = 0.5*(lambda*lambda-2*lambda*stbd);
+ do {
+ z = rexp(1/lambda);
+ /* Rprintf("%5g\n", exp(-0.5*(z+stbd)*(z+stbd)+lambda*z-logb)); */
+ } while (unif_rand() > exp(-0.5*(z+stbd)*(z+stbd)+lambda*z-logb));
+ } else {
+ do z = norm_rand();
+ while(z < stbd);
+ }
+ if (lower == 1) {
+ return(z*sigma + mu);
+ } else {
+ return(-z*sigma + mu);
+ }
+}
+
+
/* Sample from a univariate truncated Normal distribution
(truncated both from above and below): choose either inverse cdf
method or rejection sampling method. For rejection sampling,
@@ -27,8 +60,12 @@ double TruncNorm(
double sigma = sqrt(var);
double stlb = (lb-mu)/sigma; /* standardized lower bound */
double stub = (ub-mu)/sigma; /* standardized upper bound */
- if(stlb >= stub)
+ if(stlb > stub)
error("TruncNorm: lower bound is greater than upper bound\n");
+ if(stlb == stub) {
+ warning("TruncNorm: lower bound is equal to upper bound\n");
+ return(stlb*sigma + mu);
+ }
if (invcdf) { /* inverse cdf method */
z = qnorm(runif(pnorm(stlb, 0, 1, 1, 0), pnorm(stub, 0, 1, 1, 0)),
0, 1, 1, 0);
diff --git a/src/rand.h b/src/rand.h
index b7d9de7..382a46d 100644
--- a/src/rand.h
+++ b/src/rand.h
@@ -1,4 +1,4 @@
-
+double sTruncNorm(double bd, double mu, double var, int lower);
double TruncNorm(double lb, double ub, double mu, double var, int invcdf);
void rMVN(double *Sample, double *mean, double **inv_Var, int size);
void rWish(double **Sample, double **S, int df, int size);
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-mnp.git
More information about the debian-science-commits
mailing list