[r-cran-mnp] 45/51: Import Upstream version 2.6-2

[Andreas Tille]

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