[r-cran-mcmcpack] 01/90: Imported Upstream version 0.5-2
Andreas Tille
tille at debian.org
Fri Dec 16 09:07:29 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 f3731e0a0e4caa86a48a9d0a5bd22f798ff3dd3e
Author: Andreas Tille <tille at debian.org>
Date: Fri Dec 16 08:07:00 2016 +0100
Imported Upstream version 0.5-2
---
COPYING | 278 ++++
DESCRIPTION | 20 +
HISTORY | 124 ++
INDEX | 43 +
LICENSE | 33 +
NAMESPACE | 37 +
R/MCMCdynamicEI.R | 127 ++
R/MCMCfactanal.R | 153 ++
R/MCMChierEI.R | 134 ++
R/MCMCirt1d.R | 180 ++
R/MCMCirtKd.R | 37 +
R/MCMClogit.R | 70 +
R/MCMCmetrop1R.R | 68 +
R/MCMCmixfactanal.R | 362 +++++
R/MCMCoprobit.R | 137 ++
R/MCMCordfactanal.R | 361 ++++
R/MCMCpanel.R | 247 +++
R/MCMCpoisson.R | 67 +
R/MCMCprobit.R | 102 ++
R/MCMCregress.R | 56 +
R/automate.R | 264 +++
R/distn.R | 492 ++++++
R/hidden.R | 709 ++++++++
R/scythe.R | 55 +
R/tomog.R | 115 ++
R/utility.R | 34 +
R/zzz.R | 12 +
README | 77 +
cleanup | 3 +
config.status | 712 ++++++++
configure | 4253 ++++++++++++++++++++++++++++++++++++++++++++++++
configure.ac | 29 +
data/PErisk.rda | Bin 0 -> 4653 bytes
data/Senate.rda | Bin 0 -> 294202 bytes
data/SupremeCourt.rda | Bin 0 -> 6317 bytes
man/MCMCdynamicEI.Rd | 226 +++
man/MCMCfactanal.Rd | 196 +++
man/MCMChierEI.Rd | 189 +++
man/MCMCirt1d.Rd | 210 +++
man/MCMCirtKd.Rd | 229 +++
man/MCMClogit.Rd | 126 ++
man/MCMCmetrop1R.Rd | 189 +++
man/MCMCmixfactanal.Rd | 282 ++++
man/MCMCoprobit.Rd | 137 ++
man/MCMCordfactanal.Rd | 228 +++
man/MCMCpanel.Rd | 157 ++
man/MCMCpoisson.Rd | 129 ++
man/MCMCprobit.Rd | 127 ++
man/MCMCregress.Rd | 136 ++
man/PErisk.Rd | 50 +
man/Senate.Rd | 29 +
man/SupremeCourt.Rd | 31 +
man/dirichlet.Rd | 43 +
man/dtomog.Rd | 122 ++
man/invgamma.Rd | 35 +
man/iwishart.Rd | 33 +
man/noncenhypergeom.Rd | 57 +
man/readscythe.Rd | 34 +
man/tomog.Rd | 81 +
man/vech.Rd | 38 +
man/wishart.Rd | 33 +
man/writescythe.Rd | 40 +
man/xpnd.Rd | 37 +
src/MCMCdynamicEI.cc | 418 +++++
src/MCMCfactanal.cc | 187 +++
src/MCMCfcds.cc | 400 +++++
src/MCMCfcds.h | 100 ++
src/MCMChierEI.cc | 440 +++++
src/MCMCirt1d.cc | 155 ++
src/MCMClogit.cc | 154 ++
src/MCMCmetrop1R.cc | 178 ++
src/MCMCmixfactanal.cc | 366 +++++
src/MCMCoprobit.cc | 190 +++
src/MCMCordfactanal.cc | 286 ++++
src/MCMCpanel.cc | 231 +++
src/MCMCpoisson.cc | 156 ++
src/MCMCprobit.cc | 119 ++
src/MCMCprobitres.cc | 128 ++
src/MCMCregress.cc | 125 ++
src/MCMCrng.cc | 59 +
src/MCMCrng.h | 42 +
src/Makevars | 2 +
src/Makevars.in | 2 +
src/distributions.cc | 2055 +++++++++++++++++++++++
src/distributions.h | 376 +++++
src/error.h | 317 ++++
src/ide.cc | 534 ++++++
src/ide.h | 114 ++
src/la.cc | 371 +++++
src/la.h | 146 ++
src/lecuyer.cc | 689 ++++++++
src/lecuyer.h | 132 ++
src/matrix.h | 2014 +++++++++++++++++++++++
src/matrix_iterator.h | 1842 +++++++++++++++++++++
src/mersenne.cc | 125 ++
src/mersenne.h | 117 ++
src/optimize.cc | 642 ++++++++
src/optimize.h | 171 ++
src/rng.cc | 1159 +++++++++++++
src/rng.h | 228 +++
src/smath.cc | 625 +++++++
src/smath.h | 248 +++
src/stat.cc | 431 +++++
src/stat.h | 144 ++
src/util.h | 74 +
105 files changed, 28907 insertions(+)
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..727ef8f
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,278 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 675 Mass Ave, Cambridge, MA 02139, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..dfc8e96
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,20 @@
+Package: MCMCpack
+Version: 0.5-2
+Date: 2004-8-17
+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 (>= 1.9.0), coda (>= 0.8-1), MASS
+Description: This package contains functions for posterior
+ simulation for a number of statistical models. All simulation
+ is done in compiled C++ written in the Scythe Statistical
+ Library Version 1.0. 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
+ for statistical distributions, a general purpose Metropolis
+ sampling algorithm, and tools for visualization.
+License: GPL version 2 or newer
+URL: http://mcmcpack.wustl.edu
+Packaged: Tue Aug 17 13:21:51 2004; adm
diff --git a/HISTORY b/HISTORY
new file mode 100644
index 0000000..7abe47c
--- /dev/null
+++ b/HISTORY
@@ -0,0 +1,124 @@
+//
+// Changes and Bug Fixes
+//
+
+MCMCpack 0.5-1 was a major revision of MCMCpack. The entire package was
+been essentially re-written using the new development environment (documented
+in the MCMCpack specification) and the new Scythe Statistical Library 1.0.
+This following list summarizes major changes, but is by no means
+exhaustive.
+
+0.5-1 to 0.5-2
+ * C++ code for truncated normal draws optimized for speed
+ * with the permission of Pierre L'Ecuyer licensing of RngStream code
+ changed to a dual license setup that is GPL compatible. Thanks to Chris
+ Lawrence for bringing the licensing issues to our attention and
+ drafting a new licensing statement and to Pierre L'Ecuyer for
+ agreeing to use the new licensing statement for his RngStream
+ code.
+ * Fixed serious bugs in MCMChierEI() and MCMCdynamicEI()
+ * Implemented a new sampling scheme based on slice sampling for
+ MCMChierEI() and MCMCdynamicEI().
+ * Removed MCMCbaselineEI()
+ * Added delay argument to dtomogplog()
+
+0.4-8 to 0.5-1
+ * NAMESPACE implemented
+ * hidden functions are now available to aid in development (see hidden.R)
+ * a function is available to automate the C++ call and generate
+ template C++ code for estimation (see automate.R)
+ * all model functions have been updated to the new specification, and
+ most use hidden functions and automate
+ * added a general purpose Metropolis sampler that allows the user
+ to sample from an arbitrary (log)-density.
+ * C++ code now using Scythe 1.0 (now using the unedited Scythe codebase
+ through IFDEFs)
+ * support for arbitrary random number generators, including
+ the L'Ecuyer RNG for parallel computation (the RNG helper functions
+ are available in MCMCrng.cc)
+ * many full conditional distributions are available in MCMfcnds.cc
+ * documentation for density functions and RNGs have been made "R-like"
+ * fixed some spelling errors and misnomers in the documentation
+ * all documentation updated to reflect changes
+ * MCMCirt1d() has a new interface with new types of constraints--
+ sampling for this model is also now much faster.
+
+//
+// Old Changes and Bug Fixes
+//
+
+0.4-8 to 0.4-9
+ * Fixed a minor Scythe issue to fix error found by gcc 3.4.
+
+0.4-7 to 0.4-8
+ * Repaired Scythe_Simulate.*, for which an outdated version was included
+ in the last release.
+
+0.4-6 to 0.4-7
+ * Fixed some Scythe bugs, including a problem with memory allocation for
+ matrix multiplication. See http://sourceforge.net/projects/scythestat/
+ for the latest version of Scythe, which is now distributed with MCMCpack.
+ The Scythe code differs slightly in the paths ../include and ../src are
+ replace with the current path, and in pnorm2 the isnan() function is
+ commented out to allow for cross-compilation.
+ * Rolled out http://mcmcpack.wustl.edu website.
+ * Mixed response factor code.
+ * Fixed factanal.
+ * Fixed irtKd.
+
+0.4-5 to 0.4-6
+ * Fixed a bug in rnoncenhypergeom() [thanks to Tom LaFramboise]
+ * Patched Scythe0.3 to fix an error in inv() [thanks to Donour Sizemore].
+ Note that this function is not called in MCMCpack, so was causing no
+ explicit errors.
+
+0.4-3 to 0.4-5
+ * Fixed a bug in xpnd() [thanks to Michael Man]
+ * Fixed some inconsistencies in documentation [thanks to Kurt Hornik]
+
+0.4-2 to 0.4-3
+ * Fixed bug in Scythe truncated Normal generators (which had been
+ fixed before but sneaked into the last release) -- this fixes
+ a problem with MCMCirt1d
+ * Cleaned up MCMCbaselineDA.cc (eliminated unused arguments)
+ * Cleaned up MCMCbaseline.R (tuning argument)
+ * Set seed in MCMClogit.cc fixed
+ * Set seed in MCMCpoisson.cc fixed
+ * Fixed all examples such that they work out of the box
+
+0.4-1 to 0.4-2
+ * Optimized some of the Scythe 0.4 code, which provides faster
+ computation for most models.
+ * Corrected a permissions problem on cleanup [thanks to Kurt Hornik]
+ * Added explicit licensing information and a text echo when loading
+ MCMCpack.
+
+0.3-11 to 0.4-1
+ * Ported to Scythe Version 0.4 (which will soon be publicly available)
+ * Cleaned up the codebase and documentation (changes will
+ soon be part of the specification)
+ * Added vech() and xpnd() utility functions
+ * Included data file of 106th Senate roll call votes for the
+ MCMCirt1d() and MCMCirtKd() models
+ * Added Dirichlet, Noncentral Hypergeometric, and Inverse Gamma
+ generators and densities [with contributions from Kevin Rompala]
+ * Added read.Scythe() function to read matrices written by Scythe
+ [contributed by Kevin Rompala]
+ * Added helper functions to make coding easier [contributed by
+ Kevin Rompala]
+ * Added three models: a K-dimensional item response theory
+ model (MCMCirtKd), a linear factor model (MCMCfactanal), and
+ an ordinal item response theory model (MCMCordfactanal)
+ * Added a pre-processor command to handle ininf() compilation
+ issues on SGI [thanks to Dave Henderson]
+ * All MCMC* functions now only allow starting values for the
+ first simulated block of parameters and use check.parameters()
+ function.
+ * Range checking is turned off in the compiled C++ code, yielding
+ significant speed gains for most models.
+
+0.3-10 to 0.3-11
+ * Fixed a bug in MCMCpoisson() re: non-negative counts
+ * Included a data file of Supreme Court votes for the
+ MCMCirt1d() model [thanks to Simon Jackman for the suggestion]
+ * Fixed memory leak caused by Scythe_Matrix.cc [thanks to Dan Pemstein]
diff --git a/INDEX b/INDEX
new file mode 100644
index 0000000..7aa12a1
--- /dev/null
+++ b/INDEX
@@ -0,0 +1,43 @@
+Dirichlet The Dirichlet Distribution
+InvGamma The Inverse Gamma Distribution
+InvWishart The Inverse Wishart Distribution
+MCMCdynamicEI Markov chain Monte Carlo for Quinn's Dynamic
+ Ecological Inference Model
+MCMCfactanal Markov chain Monte Carlo for Normal Theory
+ Factor Analysis Model
+MCMChierEI Markov chain Monte Carlo for Wakefield's
+ Hierarchial Ecological Inference Model
+MCMCirt1d Markov chain Monte Carlo for One Dimensional
+ Item Response Theory Model
+MCMCirtKd Markov chain Monte Carlo for K-Dimensional
+ Item Response Theory Model
+MCMClogit Markov chain Monte Carlo for Logistic
+ Regression
+MCMCmetrop1R Metropolis Sampling from User-Written R
+ function
+MCMCmixfactanal Markov chain Monte Carlo for Mixed Data Factor
+ Analysis Model
+MCMCoprobit Markov chain Monte Carlo for Ordered Probit
+ Regression
+MCMCordfactanal Markov chain Monte Carlo for Ordinal Data
+ Factor Analysis Model
+MCMCpanel Markov chain Monte Carlo for the General
+ Linear Panel Model
+MCMCpoisson Markov chain Monte Carlo for Poisson
+ Regression
+MCMCprobit Markov chain Monte Carlo for Probit Regression
+MCMCregress Markov Chain Monte Carlo for Gaussian Linear
+ Regression
+NoncenHypergeom The Noncentral Hypergeometric Distribution
+PErisk Political Economic Risk Data from 62 Countries
+ in 1987
+Senate 106th U.S. Senate Roll Call Vote Matrix
+SupremeCourt U.S. Supreme Court Vote Matrix
+Wishart The Wishart Distribution
+dtomogplot Dynamic Tomography Plot
+read.Scythe Read a Matrix from a File written by Scythe
+tomogplot Tomography Plot
+vech Extract Lower Triangular Elements from a
+ Symmetric Matrix
+write.Scythe Write a Matrix to a File to be Read by Scythe
+xpnd Expand a Vector into a Symmetric Matrix
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..9ff4eee
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,33 @@
+Markov chain Monte Carlo Package (MCMCpack)
+Copyright (C) 2003, 2004 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
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Please contact:
+
+Andrew D. Martin, Ph.D.
+Department of Political Science
+Washington University
+Campus Box 1063
+One Brookings Drive
+St. Louis, MO 63130
+(314) 935-5863 (Office)
+(314) 753-8377 (Cell)
+(314) 935-5856 (Fax)
+
+Email: admartin at wustl.edu
+WWW: http://adm.wustl.edu
+
+With any problems or questions.
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..32d40fe
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,37 @@
+useDynLib(MCMCpack)
+import(coda)
+import(MASS)
+
+export(
+ ddirichlet,
+ dinvgamma,
+ diwish,
+ dnoncenhypergeom,
+ dtomogplot,
+ dwish,
+ MCMCdynamicEI,
+ MCMCfactanal,
+ MCMChierEI,
+ MCMCirt1d,
+ MCMCirtKd,
+ MCMClogit,
+ MCMCmetrop1R,
+ MCMCmixfactanal,
+ MCMCoprobit,
+ MCMCordfactanal,
+ MCMCpanel,
+ MCMCpoisson,
+ MCMCprobit,
+ MCMCregress,
+ rdirichlet,
+ read.Scythe,
+ rinvgamma,
+ riwish,
+ rnoncenhypergeom,
+ rwish,
+ tomogplot,
+ vech,
+ write.Scythe,
+ xpnd
+ )
+
diff --git a/R/MCMCdynamicEI.R b/R/MCMCdynamicEI.R
new file mode 100644
index 0000000..d349872
--- /dev/null
+++ b/R/MCMCdynamicEI.R
@@ -0,0 +1,127 @@
+# sample from the posterior of Quinn's dynamic ecological inference model
+# in R using linked C++ code in Scythe
+#
+# KQ 10/25/2002
+
+"MCMCdynamicEI" <-
+ function(r0, r1, c0, c1, burnin=5000, mcmc=50000,
+ thin=1, verbose=FALSE, seed=NA,
+ W=0, a0=0.825, b0=0.0105, a1=0.825,
+ b1=0.0105, ...){
+
+ # Error checking
+ if (length(r0) != length(r1)){
+ cat("length(r0) != length(r1).\n")
+ stop("Please check data and try MCMCdynamicEI() again.\n")
+ }
+
+ if (length(r0) != length(c0)){
+ cat("length(r0) != length(c0).\n")
+ stop("Please check data and try MCMCdynamicEI() again.\n")
+ }
+
+ if (length(r0) != length(c1)){
+ cat("length(r0) != length(c1).\n")
+ stop("Please check data and try MCMCdynamicEI() again.\n")
+ }
+
+ if (length(r1) != length(c0)){
+ cat("length(r1) != length(c0).\n")
+ stop("Please check data and try MCMCdynamicEI() again.\n")
+ }
+
+ if (length(r1) != length(c1)){
+ cat("length(r1) != length(c1).\n")
+ stop("Please check data and try MCMCdynamicEI() again.\n")
+ }
+
+ if (length(c0) != length(c1)){
+ cat("length(c0) != length(c1).\n")
+ stop("Please check data and try MCMCdynamicEI() again.\n")
+ }
+
+ if (min((r0+r1) == (c0+c1))==0){
+ cat("Rows and columns do not sum to same thing.\n")
+ stop("Please check data and try MCMCdynamicEI() again.\n")
+ }
+
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ # seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ if (a0 <= 0 ){
+ cat("Parameter a0 <= 0.\n")
+ stop("Please respecify and try MCMCdynamicEI() again.\n")
+ }
+
+ if (b0 <= 0 ){
+ cat("Parameter b0 <= 0.\n")
+ stop("Please respecify and try MCMCdynamicEI() again.\n")
+ }
+
+ if (a1 <= 0 ){
+ cat("Parameter a1 <= 0.\n")
+ stop("Please respecify and try MCMCdynamicEI() again.\n")
+ }
+
+ if (b1 <= 0 ){
+ cat("Parameter b1 <= 0.\n")
+ stop("Please respecify and try MCMCdynamicEI() again.\n")
+ }
+
+ ntables = length(r0)
+
+ if (W==0){ # construct weight matrix for a simple random walk assuming
+ # tables are temporally ordered and 1 time unit apart
+ W <- matrix(0, ntables, ntables)
+ for (i in 2:(ntables)){
+ W[i,i-1] <- 1
+ W[i-1,i] <- 1
+ }
+ }
+
+ # setup matrix to hold output from sampling
+ sample <- matrix(0, mcmc/thin, ntables*2+2)
+
+ # call C++ code to do the sampling
+ C.sample <- .C("dynamicEI",
+ samdata = as.double(sample),
+ samrow = as.integer(nrow(sample)),
+ samcol = as.integer(ncol(sample)),
+ r0 = as.double(r0),
+ r1 = as.double(r1),
+ c0 = as.double(c0),
+ c1 = as.double(c1),
+ ntables = as.integer(ntables),
+ burnin = as.integer(burnin),
+ mcmc = as.integer(mcmc),
+ thin = as.integer(thin),
+ W = as.double(W),
+ a0 = as.double(a0),
+ b0 = as.double(b0),
+ a1 = as.double(a1),
+ b1 = as.double(b1),
+ verbose = as.integer(verbose),
+ lecuyer = as.integer(lecuyer),
+ seedarray = as.integer(seed.array),
+ lecuyerstream = as.integer(lecuyer.stream),
+ PACKAGE="MCMCpack"
+ )
+
+ sample <- matrix(C.sample$samdata, C.sample$samrow, C.sample$samcol,
+ byrow=TRUE)
+ output <- mcmc(data=sample, start=1, end=mcmc, thin=thin)
+ p0names <- paste("p0table", 1:ntables, sep="")
+ p1names <- paste("p1table", 1:ntables, sep="")
+ varnames(output) <- c(p0names, p1names, "sigma^2_0", "sigma^2_1")
+
+ attr(output, "title") <- "MCMCpack Quinn's Dynamic EI Model Posterior Density Sample"
+
+
+ return(output)
+
+ }
diff --git a/R/MCMCfactanal.R b/R/MCMCfactanal.R
new file mode 100644
index 0000000..0c1d9e2
--- /dev/null
+++ b/R/MCMCfactanal.R
@@ -0,0 +1,153 @@
+##########################################################################
+## sample from the posterior distribution of a factor analysis model
+## model in R using linked C++ code in Scythe.
+##
+## The model is:
+##
+## x_i = \Lambda \phi_i + \epsilon_i, \epsilon_i \sim N(0, \Psi)
+##
+## where \Psi is diagonal and the priors are:
+##
+## \lambda_{ij} \sim N(l_{ij}, L^{-1}_{ij})
+## \phi_i \sim N(0,I)
+## \psi^2_{jj} \sim IG(a0_j/2, b0_j/2)
+##
+##
+## Andrew D. Martin
+## Washington University
+##
+## Kevin M. Quinn
+## Harvard University
+##
+## May 7, 2003
+## revised to accomodate new spec 7/5/2004 KQ
+##
+##########################################################################
+
+"MCMCfactanal" <-
+ function(x, factors, lambda.constraints=list(),
+ data=parent.environment(), burnin = 1000, mcmc = 20000,
+ thin=1, verbose = FALSE, seed = NA,
+ lambda.start = NA, psi.start = NA,
+ l0=0, L0=0, a0=0.001, b0=0.001,
+ store.scores = FALSE, std.var=TRUE, ... ) {
+
+ ## check for an offset
+ check.offset(list(...))
+
+ ## get data matrix and associated constants
+ if (is.matrix(x)){
+ X <- x
+ xvars <- dimnames(X)[[2]]
+ xobs <- dimnames(X)[[1]]
+ N <- nrow(X)
+ K <- ncol(X)
+ }
+ else {
+ holder <- parse.formula(formula=x, data=data,
+ intercept=FALSE, justX=TRUE)
+ X <- holder[[2]]
+ xvars <- holder[[3]]
+ xobs <- holder[[4]]
+ N <- nrow(X)
+ K <- ncol(X)
+ }
+
+ ## standardize X
+ if (std.var){
+ for (i in 1:K){
+ X[,i] <- (X[,i]-mean(X[,i]))/sd(X[,i])
+ }
+ }
+ else{
+ for (i in 1:K){
+ X[,i] <- X[,i]-mean(X[,i])
+ }
+ }
+
+ ## take care of the case where X has no row names
+ if (is.null(xobs)){
+ xobs <- 1:N
+ }
+
+ ## check mcmc parameters
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ # seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ ## setup constraints on Lambda
+ holder <- build.factor.constraints(lambda.constraints, X, K, factors)
+ Lambda.eq.constraints <- holder[[1]]
+ Lambda.ineq.constraints <- holder[[2]]
+ X.names <- holder[[3]]
+
+ ## setup prior on Lambda
+ holder <- form.factload.norm.prior(l0, L0, K, factors, X.names)
+ Lambda.prior.mean <- holder[[1]]
+ Lambda.prior.prec <- holder[[2]]
+
+ ## setup and check prior on Psi
+ holder <- form.ig.diagmat.prior(a0, b0, K)
+ a0 <- holder[[1]]
+ b0 <- holder[[2]]
+
+ ## starting values for Lambda
+ Lambda <- factload.start(lambda.start, K, factors,
+ Lambda.eq.constraints, Lambda.ineq.constraints)
+
+ ## starting values for Psi
+ Psi <- factuniqueness.start(psi.start, X)
+
+
+ ## define holder for posterior density sample
+ if(store.scores == FALSE) {
+ sample <- matrix(data=0, mcmc/thin, K*factors+K)
+ }
+ else {
+ sample <- matrix(data=0, mcmc/thin, K*factors+K+factors*N)
+ }
+
+ ## call C++ code to do the sampling
+ auto.Scythe.call(output.object="posterior", cc.fun.name="MCMCfactanal",
+ sample=sample, X=X, burnin=as.integer(burnin),
+ mcmc=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),
+ Lambda=Lambda, Psi=Psi, Lameq=Lambda.eq.constraints,
+ Lamineq=Lambda.ineq.constraints,
+ Lampmean=Lambda.prior.mean, Lampprec=Lambda.prior.prec,
+ a0=a0, b0=b0, storescores=as.integer(store.scores))
+
+ Lambda.names <- paste(paste("Lambda",
+ rep(X.names,
+ each=factors), sep=""),
+ rep(1:factors,K), sep="_")
+ Psi.names <- paste("Psi", X.names, sep="")
+ par.names <- c(Lambda.names, Psi.names)
+ if (store.scores==TRUE){
+ phi.names <- paste(paste("phi",
+ rep(xobs, each=factors), sep="_"),
+ rep(1:factors,factors), sep="_")
+ par.names <- c(par.names, phi.names)
+ }
+ title <- "MCMCpack Factor Analysis Posterior Density Sample"
+ 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 <- mcmc(as.matrix(output.df), start=1, end=mcmc, thin=thin)
+
+ ## add constraint info so this isn't lost
+ attr(output, "constraints") <- lambda.constraints
+ attr(output, "n.manifest") <- K
+ attr(output, "n.factors") <- factors
+ return(output)
+ }
diff --git a/R/MCMChierEI.R b/R/MCMChierEI.R
new file mode 100644
index 0000000..d07fc3f
--- /dev/null
+++ b/R/MCMChierEI.R
@@ -0,0 +1,134 @@
+# sample from the posterior distribution of Wakefield's baseline model
+# for ecological inference in R using linked C++ code in Scythe
+#
+# KQ 10/22/2002
+
+"MCMChierEI" <-
+ function(r0, r1, c0, c1, burnin=5000, mcmc=50000, thin=1,
+ verbose=FALSE, seed=NA,
+ m0=0, M0=2.287656,
+ m1=0, M1=2.287656,
+ a0=0.825, b0=0.0105,
+ a1=0.825, b1=0.0105, ...){
+
+ # Error checking
+ if (length(r0) != length(r1)){
+ cat("length(r0) != length(r1).\n")
+ stop("Please check data and try MCMChierEI() again.\n")
+ }
+
+ if (length(r0) != length(c0)){
+ cat("length(r0) != length(c0).\n")
+ stop("Please check data and try MCMChierEI() again.\n")
+ }
+
+ if (length(r0) != length(c1)){
+ cat("length(r0) != length(c1).\n")
+ stop("Please check data and try MCMChierEI() again.\n")
+ }
+
+ if (length(r1) != length(c0)){
+ cat("length(r1) != length(c0).\n")
+ stop("Please check data and try MCMChierEI() again.\n")
+ }
+
+ if (length(r1) != length(c1)){
+ cat("length(r1) != length(c1).\n")
+ stop("Please check data and try MCMChierEI() again.\n")
+ }
+
+ if (length(c0) != length(c1)){
+ cat("length(c0) != length(c1).\n")
+ stop("Please check data and try MCMChierEI() again.\n")
+ }
+
+ if (min((r0+r1) == (c0+c1))==0){
+ cat("Rows and columns do not sum to same thing.\n")
+ stop("Please check data and try MCMChierEI() again.\n")
+ }
+
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ # seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+
+ if (M0 <= 0 ){
+ cat("Parameter M0 <= 0.\n")
+ stop("Please respecify and try MCMChierEI() again.\n")
+ }
+
+ if (M1 <= 0 ){
+ cat("Parameter M1 <= 0.\n")
+ stop("Please respecify and try MCMChierEI() again.\n")
+ }
+
+ if (a0 <= 0 ){
+ cat("Parameter a0 <= 0.\n")
+ stop("Please respecify and try MCMChierEI() again.\n")
+ }
+
+ if (a1 <= 0 ){
+ cat("Parameter a1 <= 0.\n")
+ stop("Please respecify and try MCMChierEI() again.\n")
+ }
+
+ if (b0 <= 0 ){
+ cat("Parameter b0 <= 0.\n")
+ stop("Please respecify and try MCMChierEI() again.\n")
+ }
+
+ if (b1 <= 0 ){
+ cat("Parameter b1 <= 0.\n")
+ stop("Please respecify and try MCMChierEI() again.\n")
+ }
+
+ # setup matrix to hold output from sampling
+ ntables = length(r0)
+ sample <- matrix(0, mcmc/thin, ntables*2+4)
+
+ # call C++ code to do the sampling
+ C.sample <- .C("hierEI",
+ samdata = as.double(sample),
+ samrow = as.integer(nrow(sample)),
+ samcol = as.integer(ncol(sample)),
+ r0 = as.double(r0),
+ r1 = as.double(r1),
+ c0 = as.double(c0),
+ c1 = as.double(c1),
+ ntables = as.integer(ntables),
+ burnin = as.integer(burnin),
+ mcmc = as.integer(mcmc),
+ thin = as.integer(thin),
+ mu0priormean = as.double(m0),
+ mu0priorvar = as.double(M0),
+ mu1priormean = as.double(m1),
+ mu1priorvar = as.double(M1),
+ a0 = as.double(a0),
+ b0 = as.double(b0),
+ a1 = as.double(a1),
+ b1 = as.double(b1),
+ verbose = as.integer(verbose),
+ lecuyer = as.integer(lecuyer),
+ seedarray = as.integer(seed.array),
+ lecuyerstream = as.integer(lecuyer.stream),
+ PACKAGE="MCMCpack"
+ )
+
+ sample <- matrix(C.sample$samdata, C.sample$samrow, C.sample$samcol,
+ byrow=TRUE)
+
+ output <- mcmc(data=sample, start=1, end=mcmc, thin=thin)
+ p0names <- paste("p0table", 1:ntables, sep="")
+ p1names <- paste("p1table", 1:ntables, sep="")
+ varnames(output) <- c(p0names, p1names, "mu0", "mu1", "sigma^2.0",
+ "sigma^2.1")
+
+ attr(output, "title") <- "MCMCpack Wakefield's Hierarchical EI Model Posterior Density Sample"
+
+ return(output)
+
+ }
diff --git a/R/MCMCirt1d.R b/R/MCMCirt1d.R
new file mode 100644
index 0000000..a9020e6
--- /dev/null
+++ b/R/MCMCirt1d.R
@@ -0,0 +1,180 @@
+## sample from the posterior distribution of a one-dimensional item
+## response theory model in R using linked C++ code in Scythe.
+##
+## ADM and KQ 1/23/2003
+## updated extensively ADM & KQ 7/28/2004
+
+"MCMCirt1d" <-
+ function(datamatrix, theta.constraints=list(), burnin = 1000,
+ mcmc = 20000, thin=1, verbose = FALSE, seed = NA,
+ theta.start = NA, alpha.start = NA, beta.start = NA, t0 = 0,
+ T0 = 1, ab0=0, AB0=.25, store.item = FALSE, ... ) {
+
+ ## checks
+ check.offset(list(...))
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ ## check vote matrix and convert to work with C++ code
+ datamatrix <- as.matrix(datamatrix)
+ K <- ncol(datamatrix) # cases, bills, items, etc
+ J <- nrow(datamatrix) # justices, legislators, subjects, etc
+ if(sum(datamatrix==1 | datamatrix==0 | is.na(datamatrix)) != (J*K)) {
+ cat("Error: Data matrix contains elements other than 0, 1 or NA.\n")
+ stop("Please check data and try MCMCirt1d() again.\n",
+ call.=FALSE)
+ }
+ datamatrix[is.na(datamatrix)] <- 9
+ item.names <- colnames(datamatrix)
+ subject.names <- rownames(datamatrix)
+
+ ## setup constraints on theta
+ for (i in 1:length(theta.constraints)){
+ theta.constraints[[i]] <- list(as.integer(1), theta.constraints[[i]][1])
+ }
+ holder <- build.factor.constraints(theta.constraints, t(datamatrix), J, 1)
+ theta.eq.constraints <- holder[[1]]
+ theta.ineq.constraints <- holder[[2]]
+ subject.names <- holder[[3]]
+ ## names
+ item.names <- colnames(datamatrix)
+ if (is.null(item.names)){
+ item.names <- paste("item", 1:K, sep="")
+ }
+
+ ## prior for theta
+ holder <- form.mvn.prior(t0, T0, 1)
+ t0 <- holder[[1]]
+ T0 <- holder[[2]]
+
+ ## prior for (alpha, beta)
+ holder <- form.mvn.prior(ab0, AB0, 2)
+ ab0 <- holder[[1]]
+ AB0 <- holder[[2]]
+
+ ## starting values for theta error checking
+ theta.start <- factor.score.start.check(theta.start, datamatrix,
+ t0, T0,
+ theta.eq.constraints,
+ theta.ineq.constraints, 1)
+
+ ## starting values for (alpha, beta)
+ ab.starts <- matrix(NA, K, 2)
+ for (i in 1:K){
+ local.y <- datamatrix[,i]
+ local.y[local.y==9] <- NA
+ if (var(na.omit(local.y))==0){
+ ab.starts[i,] <- c(0,10)
+ }
+ else {
+ ab.starts[i,] <- coef(suppressWarnings(glm(local.y~theta.start,
+ family=binomial(probit),
+ control=glm.control(
+ maxit=8, epsilon=1e-3)
+ )))
+ }
+ }
+ ab.starts[,1] <- -1 * ab.starts[,1] # make this into a difficulty param
+
+ ## starting values for alpha and beta error checking
+ if (is.na(alpha.start)) {
+ alpha.start <- ab.starts[,1]
+ }
+ else if(is.null(dim(alpha.start))) {
+ alpha.start <- alpha.start * matrix(1,K,1)
+ }
+ else if((dim(alpha.start)[1] != K) || (dim(alpha.start)[2] != 1)) {
+ cat("Error: Starting value for alpha not conformable.\n")
+ stop("Please respecify and call MCMCirt1d() again.\n",
+ call.=FALSE)
+ }
+ if (is.na(beta.start)) {
+ beta.start <- ab.starts[,2]
+ }
+ else if(is.null(dim(beta.start))) {
+ beta.start <- beta.start * matrix(1,K,1)
+ }
+ else if((dim(beta.start)[1] != K) || (dim(beta.start)[2] != 1)) {
+ cat("Error: Starting value for beta not conformable.\n")
+ stop("Please respecify and call MCMCirt1d() again.\n",
+ call.=FALSE)
+ }
+
+ ## define holder for posterior density sample
+ if(store.item == FALSE) {
+ sample <- matrix(data=0, mcmc/thin, J)
+ }
+ else {
+ sample <- matrix(data=0, mcmc/thin, J + 2 * K)
+ }
+
+ ## seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ # call C++ code to draw sample
+ posterior <- .C("MCMCirt1d",
+ sampledata = as.double(sample),
+ samplerow = as.integer(nrow(sample)),
+ samplecol = as.integer(ncol(sample)),
+ Xdata = as.integer(datamatrix),
+ Xrow = as.integer(nrow(datamatrix)),
+ Xcol = as.integer(ncol(datamatrix)),
+ burnin = as.integer(burnin),
+ mcmc = 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),
+ thetastartdata = as.double(theta.start),
+ thetastartrow = as.integer(nrow(theta.start)),
+ thetastartcol = as.integer(ncol(theta.start)),
+ astartdata = as.double(alpha.start),
+ astartrow = as.integer(length(alpha.start)),
+ astartcol = as.integer(1),
+ bstartdata = as.double(beta.start),
+ bstartrow = as.integer(length(beta.start)),
+ bstartcol = as.integer(1),
+ t0 = as.double(t0),
+ T0 = as.double(T0),
+ ab0data = as.double(ab0),
+ ab0row = as.integer(nrow(ab0)),
+ ab0col = as.integer(ncol(ab0)),
+ AB0data = as.double(AB0),
+ AB0row = as.integer(nrow(AB0)),
+ AB0col = as.integer(ncol(AB0)),
+ thetaeqdata = as.double(theta.eq.constraints),
+ thetaeqrow = as.integer(nrow(theta.eq.constraints)),
+ thetaeqcol = as.integer(ncol(theta.eq.constraints)),
+ thetaineqdata = as.double(theta.ineq.constraints),
+ thetaineqrow = as.integer(nrow(theta.ineq.constraints)),
+ thetaineqcol = as.integer(ncol(theta.ineq.constraints)),
+ store = as.integer(store.item),
+ PACKAGE="MCMCpack"
+ )
+
+ theta.names <- paste("theta.", subject.names, sep = "")
+ alpha.beta.names <- paste(rep(c("alpha.","beta."), K),
+ rep(item.names, each = 2),
+ sep = "")
+
+ # put together matrix and build MCMC object to return
+ sample <- matrix(posterior$sampledata, posterior$samplerow,
+ posterior$samplecol,
+ byrow=TRUE)
+ output <- mcmc(data=sample, start=1, end=mcmc, thin=thin)
+
+ if(store.item == FALSE) {
+ names <- theta.names
+ }
+ else {
+ names <- c(theta.names, alpha.beta.names)
+ }
+ varnames(output) <- names
+ attr(output,"title") <-
+ "MCMCirt1d Posterior Density Sample"
+ return(output)
+
+ }
diff --git a/R/MCMCirtKd.R b/R/MCMCirtKd.R
new file mode 100644
index 0000000..5d90394
--- /dev/null
+++ b/R/MCMCirtKd.R
@@ -0,0 +1,37 @@
+##########################################################################
+## sample from a K-dimensional two-parameter item response model with
+## probit link. This is just a wrapper function that calls
+## MCMCordfactanal.
+##
+## Andrew D. Martin
+## Washington University
+##
+## Kevin M. Quinn
+## Harvard University
+##
+## June 8, 2003
+##
+##########################################################################
+
+"MCMCirtKd" <-
+ function(datamatrix, dimensions, item.constraints=list(),
+ burnin = 1000, mcmc = 10000,
+ thin=1, verbose = FALSE, seed = NA,
+ alphabeta.start = NA, b0=0, B0=0,
+ store.item=FALSE, store.ability=TRUE,
+ drop.constantvars=TRUE, ... ) {
+
+ datamatrix <- t(as.matrix(datamatrix))
+
+ post <- MCMCordfactanal(x=datamatrix, factors=dimensions,
+ lambda.constraints=item.constraints,
+ burnin=burnin, mcmc=mcmc, thin=thin,
+ tune=NA, verbose=verbose, seed=seed,
+ lambda.start=alphabeta.start,
+ l0=b0, L0=B0, store.lambda=store.item,
+ store.scores=store.ability,
+ drop.constantvars=drop.constantvars,
+ model="MCMCirtKd")
+ return(post)
+ }
+
diff --git a/R/MCMClogit.R b/R/MCMClogit.R
new file mode 100644
index 0000000..7ccc1f4
--- /dev/null
+++ b/R/MCMClogit.R
@@ -0,0 +1,70 @@
+## sample from the posterior distribution of a logistic regression
+## model in R using linked C++ code in Scythe
+##
+## KQ 1/23/2003
+##
+## Modified to meet new developer specification 7/15/2004 KQ
+## Modified for new Scythe and rngs 7/25/2004 KQ
+## note: B0 is now a precision
+
+"MCMClogit" <-
+ function(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin=1, tune=1.1, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, ...) {
+
+ ## checks
+ check.offset(list(...))
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ ## seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ ## form response and model matrices
+ holder <- parse.formula(formula, data)
+ Y <- holder[[1]]
+ X <- holder[[2]]
+ xnames <- holder[[3]]
+ K <- ncol(X) # number of covariates
+
+ ## starting values and priors
+ beta.start <- coef.start(beta.start, K, formula, family=binomial, data)
+ mvn.prior <- form.mvn.prior(b0, B0, K)
+ b0 <- mvn.prior[[1]]
+ B0 <- mvn.prior[[2]]
+
+ ## form the tuning parameter
+ tune <- vector.tune(tune, K)
+ V <- vcov(glm(formula=formula, data=data, family=binomial))
+
+ ## y \in {0, 1} error checking
+ if (sum(Y!=0 & Y!=1) > 0) {
+ cat("Elements of Y equal to something other than 0 or 1.\n")
+ stop("Check data and call MCMClogit() again. \n")
+ }
+
+
+ ## define holder for posterior density sample
+ sample <- matrix(data=0, mcmc/thin, dim(X)[2] )
+
+ ## call C++ code to draw sample
+ auto.Scythe.call(output.object="posterior", cc.fun.name="MCMClogit",
+ sample=sample, Y=Y, X=X, burnin=as.integer(burnin),
+ mcmc=as.integer(mcmc), thin=as.integer(thin),
+ tune=tune, lecuyer=as.integer(lecuyer),
+ seedarray=as.integer(seed.array),
+ lecuyerstream=as.integer(lecuyer.stream),
+ verbose=as.integer(verbose), betastart=beta.start,
+ b0=b0, B0=B0, V=V)
+
+ ## put together matrix and build MCMC object to return
+ output <- form.mcmc.object(posterior, names=xnames,
+ title="MCMClogit Posterior Density Sample")
+ return(output)
+ }
+
+##########################################################################
+
+
diff --git a/R/MCMCmetrop1R.R b/R/MCMCmetrop1R.R
new file mode 100644
index 0000000..356585d
--- /dev/null
+++ b/R/MCMCmetrop1R.R
@@ -0,0 +1,68 @@
+## samples from a user-written posterior code in R using a
+## random walk Metropolis algorithm
+##
+## KQ 6/24/2004
+##
+
+"MCMCmetrop1R" <- function(fun, theta.init,
+ burnin=500, mcmc=20000, thin=1,
+ tune=1, verbose=TRUE, seed=NA, logfun=TRUE,
+ optim.trace=0, optim.REPORT=10,
+ optim.maxit=500, ...){
+
+ ## error checking here
+ check.offset(list(...))
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ ## form the tuning vector
+ tune <- vector.tune(tune, length(theta.init))
+
+ ## form seed
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+
+ ## setup the environment so that fun can see the things passed as ...
+ ## it should be the case that users can specify arguments with the same
+ ## names as variables defined in MCMCmetrop1R without causing problems.
+ my.env <- new.env()
+ environment(fun) <- my.env
+ dots <- list(...)
+ dotnames <- names(dots)
+ ndots <- length(dots)
+ if (ndots >= 1){
+ for (i in 1:ndots){
+ assign(x=dotnames[[i]], value=dots[[i]], inherits=FALSE, envir=my.env)
+ }
+ }
+
+ ## find approx mode and Hessian using optim()
+ opt.out <- optim(theta.init, fun,
+ control=list(fnscale=-1, trace=optim.trace,
+ REPORT=optim.REPORT, maxit=optim.maxit),
+ method="BFGS", hessian=TRUE)
+ if(opt.out$convergence!=0){
+ warning("Mode and Hessian were not found with call to optim().\nSampling proceeded anyway. \n")
+ }
+
+ propvar <- tune %*% solve(-1*opt.out$hessian) %*% tune
+
+ ## Call the C++ function to do the MCMC sampling
+ sample <- .Call("MCMCmetrop1R_cc", fun, as.double(theta.init),
+ my.env, as.integer(burnin), as.integer(mcmc),
+ as.integer(thin),
+ as.logical(verbose),
+ lecuyer=as.integer(lecuyer),
+ seedarray=as.integer(seed.array),
+ lecuyerstream=as.integer(lecuyer.stream),
+ as.logical(logfun),
+ as.matrix(propvar),
+ PACKAGE="MCMCpack")
+
+ ## turn sample into an mcmc object
+ sample <- mcmc(data=sample, start=1, end = mcmc, thin=thin)
+ return(sample)
+}
+
diff --git a/R/MCMCmixfactanal.R b/R/MCMCmixfactanal.R
new file mode 100644
index 0000000..f745651
--- /dev/null
+++ b/R/MCMCmixfactanal.R
@@ -0,0 +1,362 @@
+##########################################################################
+## sample from the posterior distribution of a factor analysis model
+## model in R using linked C++ code in Scythe.
+##
+## The model is:
+##
+## x*_i = \Lambda \phi_i + \epsilon_i, \epsilon_i \sim N(0, \Psi)
+##
+## \lambda_{ij} \sim N(l0_{ij}, L0^{-1}_{ij})
+## \phi_i \sim N(0,I)
+##
+## and x*_i is the latent variable formed from the observed ordinal
+## variable in the usual (Albert and Chib, 1993) way and is equal to
+## x_i when x_i is continuous. When x_j is ordinal \Psi_jj is assumed
+## to be 1.
+##
+## Andrew D. Martin
+## Washington University
+##
+## Kevin M. Quinn
+## Harvard University
+##
+## 12/2/2003
+## Revised to accommodate new spec 7/20/2004
+##
+##########################################################################
+
+"MCMCmixfactanal" <-
+ function(x, factors, lambda.constraints=list(),
+ data=parent.environment(), burnin = 1000, mcmc = 20000,
+ thin=1, tune=NA, verbose = FALSE, seed = NA,
+ lambda.start = NA, psi.start=NA,
+ l0=0, L0=0, a0=0.001, b0=0.001,
+ store.lambda=TRUE, store.scores=FALSE,
+ std.mean=TRUE, std.var=TRUE, ... ) {
+
+ call <- match.call()
+ mt <- terms(x, data=data)
+ if (attr(mt, "response") > 0)
+ stop("Response not allowed in formula in MCMCmixfactanal().\n")
+ if(missing(data)) data <- sys.frame(sys.parent())
+ mf <- match.call(expand.dots = FALSE)
+ mf$factors <- mf$lambda.constraints <- mf$burnin <- mf$mcmc <- NULL
+ mf$thin <- mf$tune <- mf$verbose <- mf$seed <- NULL
+ mf$lambda.start <- mf$l0 <- mf$L0 <- mf$a0 <- mf$b0 <- NULL
+ mf$store.lambda <- mf$store.scores <- mf$std.var <- mf$... <- NULL
+ mf$drop.unused.levels <- TRUE
+ mf[[1]] <- as.name("model.frame")
+ mf <- eval(mf, sys.frame(sys.parent()))
+ attributes(mt)$intercept <- 0
+ Xterm.length <- length(attr(mt, "variables"))
+ X <- subset(mf,
+ select=as.character(attr(mt, "variables"))[2:Xterm.length])
+
+ N <- nrow(X) # number of observations
+ K <- ncol(X) # number of manifest variables
+ ncat <- matrix(NA, K, 1) # vector of number of categ. in each man. var.
+ for (i in 1:K){
+ if (is.numeric(X[,i])){
+ ncat[i] <- -999
+ X[is.na(X[,i]), i] <- -999
+ }
+ else if (is.ordered(X[,i])){
+ ncat[i] <- nlevels(X[,i])
+ X[,i] <- as.integer(X[,i])
+ X[is.na(X[,i]), i] <- -999
+ }
+ else {
+ stop("Manifest variable ", dimnames(X)[[2]][i],
+ " neither ordered factor nor numeric variable.\n")
+ }
+ }
+
+ X <- as.matrix(X)
+ xvars <- dimnames(X)[[2]] # X variable names
+ xobs <- dimnames(X)[[1]] # observation names
+
+ if (is.null(xobs)){
+ xobs <- 1:N
+ }
+
+ # standardize X
+ if (std.mean){
+ for (i in 1:K){
+ if (ncat[i] == -999){
+ X[,i] <- X[,i]-mean(X[,i])
+ }
+ }
+ }
+ if (std.var){
+ for (i in 1:K){
+ if (ncat[i] == -999){
+ X[,i] <- (X[,i])/sd(X[,i])
+ }
+ }
+ }
+
+ n.ord.ge3 <- 0
+ for (i in 1:K)
+ if (ncat[i] >= 3) n.ord.ge3 <- n.ord.ge3 + 1
+
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ ## setup constraints on Lambda
+ holder <- build.factor.constraints(lambda.constraints, X, K, factors+1)
+ Lambda.eq.constraints <- holder[[1]]
+ Lambda.ineq.constraints <- holder[[2]]
+ X.names <- holder[[3]]
+
+ ## if subtracting out the mean of continuous X then constrain
+ ## the mean parameter to 0
+ for (i in 1:K){
+ if (ncat[i] < 2 && std.mean==TRUE){
+ if ((Lambda.eq.constraints[i,1] == -999 ||
+ Lambda.eq.constraints[i,1] == 0.0) &&
+ Lambda.ineq.constraints[i,1] == 0.0){
+ Lambda.eq.constraints[i,1] <- 0.0
+ }
+ else {
+ cat("Constraints on Lambda are logically\ninconsistent with std.mean==TRUE.\n")
+ stop("Please respecify and call MCMCmixfactanal() again\n")
+ }
+ }
+ }
+
+
+ ## setup and check prior on Psi
+ holder <- form.ig.diagmat.prior(a0, b0, K)
+ a0 <- holder[[1]]
+ b0 <- holder[[2]]
+
+ ## setup prior on Lambda
+ holder <- form.factload.norm.prior(l0, L0, K, factors+1, X.names)
+ Lambda.prior.mean <- holder[[1]]
+ Lambda.prior.prec <- holder[[2]]
+
+ # seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ # Starting values for Lambda
+ Lambda <- matrix(0, K, factors+1)
+ if (is.na(lambda.start)){# sets Lambda to equality constraints & 0s
+ for (i in 1:K){
+ for (j in 1:(factors+1)){
+ if (Lambda.eq.constraints[i,j]==-999){
+ if(Lambda.ineq.constraints[i,j]==0){
+ if (j==1){
+ if (ncat[i] < 2){
+ Lambda[i,j] <- mean(X[,i]!=-999)
+ }
+ if (ncat[i] == 2){
+ probit.out <- glm(as.factor(X[X[,i]!=-999,i])~1,
+ family=binomial(link=probit))
+ probit.beta <- coef(probit.out)
+ Lambda[i,j] <- probit.beta[1]
+ }
+ if (ncat[i] > 2){
+ polr.out <- polr(ordered(X[X[,i]!=-999,i])~1)
+ Lambda[i,j] <- -polr.out$zeta[1]*.588
+ }
+ }
+ }
+ if(Lambda.ineq.constraints[i,j]>0){
+ Lambda[i,j] <- 1.0
+ }
+ if(Lambda.ineq.constraints[i,j]<0){
+ Lambda[i,j] <- -1.0
+ }
+ }
+ else Lambda[i,j] <- Lambda.eq.constraints[i,j]
+ }
+ }
+ }
+ else if (is.matrix(lambda.start)){
+ if (nrow(lambda.start)==K && ncol(lambda.start)==(factors+1))
+ Lambda <- lambda.start
+ else {
+ cat("Starting values not of correct size for model specification.\n")
+ stop("Please respecify and call ", echo.name, "() again\n")
+ }
+ }
+ else if (length(lambda.start)==1 && is.numeric(lambda.start)){
+ Lambda <- matrix(lambda.start, K, factors+1)
+ for (i in 1:K){
+ for (j in 1:(factors+1)){
+ if (Lambda.eq.constraints[i,j] != -999)
+ Lambda[i,j] <- Lambda.eq.constraints[i,j]
+ }
+ }
+ }
+ else {
+ cat("Starting values neither NA, matrix, nor scalar.\n")
+ stop("Please respecify and call ", echo.name, "() again\n")
+ }
+
+ # check MH tuning parameter
+ if (is.na(tune)){
+ tune <- matrix(NA, K, 1)
+ for (i in 1:K){
+ tune[i] <- abs(0.05/ncat[i])
+ }
+ }
+ else if (is.double(tune)){
+ tune <- matrix(abs(tune/ncat), K, 1)
+ }
+
+ # starting values for gamma (note: not changeable by user)
+ if (max(ncat) <= 2){
+ gamma <- matrix(0, 3, K)
+ }
+ else {
+ gamma <- matrix(0, max(ncat)+1, K)
+ }
+ for (i in 1:K){
+ if (ncat[i]<=2){
+ gamma[1,i] <- -300
+ gamma[2,i] <- 0
+ gamma[3,i] <- 300
+ }
+ if(ncat[i] > 2) {
+ polr.out <- polr(ordered(X[X[,i]!=-999,i])~1)
+ gamma[1,i] <- -300
+ gamma[2,i] <- 0
+ gamma[3:ncat[i],i] <- (polr.out$zeta[2:(ncat[i]-1)] -
+ polr.out$zeta[1])*.588
+ gamma[ncat[i]+1,i] <- 300
+ }
+ }
+
+ ## starting values for Psi
+ Psi <- factuniqueness.start(psi.start, X)
+ for (i in 1:K){
+ if (ncat[i] >= 2){
+ Psi[i,i] <- 1.0
+ }
+ }
+
+ # define holder for posterior density sample
+ if (store.scores == FALSE && store.lambda == FALSE){
+ sample <- matrix(data=0, mcmc/thin, length(gamma)+K)
+ }
+ else if (store.scores == TRUE && store.lambda == FALSE){
+ sample <- matrix(data=0, mcmc/thin, (factors+1)*N + length(gamma)+K)
+ }
+ else if(store.scores == FALSE && store.lambda == TRUE) {
+ sample <- matrix(data=0, mcmc/thin, K*(factors+1)+length(gamma)+K)
+ }
+ else { # store.scores==TRUE && store.lambda==TRUE
+ sample <- matrix(data=0, mcmc/thin, K*(factors+1)+(factors+1)*N +
+ length(gamma)+K)
+ }
+
+ # Call the C++ code to do the real work
+ posterior <- .C("mixfactanalpost",
+ samdata = as.double(sample),
+ samrow = as.integer(nrow(sample)),
+ samcol = as.integer(ncol(sample)),
+ X = as.double(X),
+ Xrow = as.integer(nrow(X)),
+ Xcol = as.integer(ncol(X)),
+ burnin = as.integer(burnin),
+ mcmc = as.integer(mcmc),
+ thin = as.integer(thin),
+ tune = as.double(tune),
+ lecuyer = as.integer(lecuyer),
+ seedarray = as.integer(seed.array),
+ lecuyerstream = as.integer(lecuyer.stream),
+ verbose = as.integer(verbose),
+ Lambda = as.double(Lambda),
+ Lambdarow = as.integer(nrow(Lambda)),
+ Lambdacol = as.integer(ncol(Lambda)),
+ gamma = as.double(gamma),
+ gammarow = as.integer(nrow(gamma)),
+ gammacol = as.integer(ncol(gamma)),
+ Psi = as.double(Psi),
+ Psirow = as.integer(nrow(Psi)),
+ Psicol = as.integer(ncol(Psi)),
+ ncat = as.integer(ncat),
+ ncatrow = as.integer(nrow(ncat)),
+ ncatcol = as.integer(ncol(ncat)),
+ Lameq = as.double(Lambda.eq.constraints),
+ Lameqrow = as.integer(nrow(Lambda.eq.constraints)),
+ Lameqcol = as.integer(ncol(Lambda.ineq.constraints)),
+ Lamineq = as.double(Lambda.ineq.constraints),
+ Lamineqrow = as.integer(nrow(Lambda.ineq.constraints)),
+ Lamineqcol = as.integer(ncol(Lambda.ineq.constraints)),
+ Lampmean = as.double(Lambda.prior.mean),
+ Lampmeanrow = as.integer(nrow(Lambda.prior.mean)),
+ Lampmeancol = as.integer(ncol(Lambda.prior.prec)),
+ Lampprec = as.double(Lambda.prior.prec),
+ Lampprecrow = as.integer(nrow(Lambda.prior.prec)),
+ Lamppreccol = as.integer(ncol(Lambda.prior.prec)),
+ a0 = as.double(a0),
+ a0row = as.integer(nrow(a0)),
+ a0col = as.integer(ncol(a0)),
+ b0 = as.double(b0),
+ b0row = as.integer(nrow(b0)),
+ b0col = as.integer(ncol(b0)),
+ storelambda = as.integer(store.lambda),
+ storescores = as.integer(store.scores),
+ accepts = as.integer(0),
+ PACKAGE="MCMCpack"
+ )
+
+ cat(" overall acceptance rate = ",
+ posterior$accepts / ((posterior$burnin+posterior$mcmc)*n.ord.ge3), "\n")
+
+
+ # put together matrix and build MCMC object to return
+ sample <- matrix(posterior$samdata, posterior$samrow, posterior$samcol,
+ byrow=TRUE)
+ output <- mcmc(data=sample,start=1, end=mcmc, thin=thin)
+
+ par.names <- NULL
+ if (store.lambda==TRUE){
+ Lambda.names <- paste(paste("Lambda",
+ rep(X.names,
+ each=(factors+1)), sep=""),
+ rep(1:(factors+1),K), sep=".")
+ par.names <- c(par.names, Lambda.names)
+ }
+
+ gamma.names <- paste(paste("gamma",
+ rep(0:(nrow(gamma)-1),
+ each=K), sep=""),
+ rep(X.names, nrow(gamma)), sep=".")
+ par.names <- c(par.names, gamma.names)
+
+ if (store.scores==TRUE){
+ phi.names <- paste(paste("phi",
+ rep(xobs, each=(factors+1)), sep="."),
+ rep(1:(factors+1),(factors+1)), sep=".")
+ par.names <- c(par.names, phi.names)
+ }
+
+ Psi.names <- paste("Psi", X.names, sep=".")
+ par.names <- c(par.names, Psi.names)
+
+ varnames(output) <- par.names
+
+ # 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 <- mcmc(as.matrix(output.df), start=1, end=mcmc, thin=thin)
+
+ # add constraint info so this isn't lost
+ attr(output, "constraints") <- lambda.constraints
+ attr(output, "n.manifest") <- K
+ attr(output, "n.factors") <- factors
+ attr(output, "accept.rate") <- posterior$accepts /
+ ((posterior$burnin+posterior$mcmc)*n.ord.ge3)
+ attr(output,"title") <-
+ "MCMCpack Mixed Data Factor Analysis Posterior Density Sample"
+
+ return(output)
+
+ }
+
diff --git a/R/MCMCoprobit.R b/R/MCMCoprobit.R
new file mode 100644
index 0000000..635913e
--- /dev/null
+++ b/R/MCMCoprobit.R
@@ -0,0 +1,137 @@
+## sample from the posterior distribution of an ordered probit model
+## via the data augmentation approach of Cowles (1996)
+##
+## KQ 1/25/2003
+## Modified to meet new developer specification 7/26/2004 KQ
+## Modified for new Scythe and rngs 7/26/2004 KQ
+
+
+"MCMCoprobit" <-
+ function(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin = 1, tune = NA, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, ...) {
+
+
+ ## checks
+ check.offset(list(...))
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ ## seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+
+ ## extract X, Y, and variable names from the model formula and frame
+ call <- match.call()
+ mt <- terms(formula, data=data)
+ if(missing(data)) data <- sys.frame(sys.parent())
+ mf <- match.call(expand.dots = FALSE)
+ mf$burnin <- mf$mcmc <- mf$b0 <- mf$B0 <- NULL
+ mf$thin <- mf$... <- mf$tune <- mf$verbose <- mf$seed <- NULL
+ mf$beta.start <- NULL
+ mf$drop.unused.levels <- TRUE
+ mf[[1]] <- as.name("model.frame")
+ mf <- eval(mf, sys.frame(sys.parent()))
+ vars <- as.character(attr(mt, "variables"))[-1] # y varname and x varnames
+
+ ## null model support
+ X <- if (!is.empty.model(mt)) model.matrix(mt, mf, contrasts)# else NULL
+ X.names <- dimnames(X)[[2]]
+ Y <- model.response(mf, "numeric")
+ Y <- factor(Y, ordered=TRUE)
+ ncat <- nlevels(Y) # number of categories of y
+ cat <- levels(Y) # values of categories of y
+ N <- nrow(X) # number of observations
+ K <- ncol(X) # number of covariates
+ if (length(Y) != N){
+ cat("X and Y do not have same number of rows.\n")
+ stop("Please respecify and call MCMCoprobit() again.\n")
+ }
+
+ ## convert data to matrices to be passed
+ Y <- as.matrix(as.integer(Y))
+ X <- as.matrix(X)
+
+ ## check tuning parameter
+ if (is.na(tune)){
+ tune <- 0.05/ncat
+ }
+
+ xint <- match("(Intercept)", colnames(X), nomatch=0)
+ if (xint > 0){
+ new.X <- X[, -xint, drop=FALSE]
+ }
+ else warning("An intercept is needed and assumed in MCMCoprobit()\n.")
+ if (ncol(new.X) == 0){
+ polr.out <- polr(ordered(Y)~1)
+ }
+ else {
+ polr.out <- polr(ordered(Y)~new.X)
+ }
+
+ ## starting values for beta error checking
+ if (is.na(beta.start)){
+ beta.start <- matrix(0, K, 1)
+ beta.start[1] <- -.588 * polr.out$zeta[1]
+ if( ncol(new.X) > 0){
+ beta.start[2:K] <- .588 * coef(polr.out)
+ }
+ }
+ else if(is.null(dim(beta.start))) {
+ beta.start <- beta.start * matrix(1,K,1)
+ }
+ else if((dim(beta.start)[1] != K) || (dim(beta.start)[2] != 1)) {
+ cat("Starting value for beta not conformable.\n")
+ stop("Please respecify and call MCMCoprobit() again.\n")
+ }
+
+ ## prior for beta error checking
+ if(is.null(dim(b0))) {
+ b0 <- b0 * matrix(1,K,1)
+ }
+ if((dim(b0)[1] != K) || (dim(b0)[2] != 1)) {
+ cat("N(b0,B0) prior b0 not conformable.\n")
+ stop("Please respecify and call MCMCoprobit() again.\n")
+ }
+ if(is.null(dim(B0))) {
+ B0 <- B0 * diag(K)
+ }
+ if((dim(B0)[1] != K) || (dim(B0)[2] != K)) {
+ cat("N(b0,B0) prior B0 not conformable.\n")
+ stop("Please respecify and call MCMCoprobit() again.\n")
+ }
+
+ ## form gamma starting values (note: not changeable)
+ gamma <- matrix(NA,ncat+1,1)
+ gamma[1] <- -300
+ gamma[2] <- 0
+ gamma[3:ncat] <- (polr.out$zeta[2:(ncat-1)] - polr.out$zeta[1])*.588
+ gamma[ncat+1] <- 300
+
+ ## posterior density sample
+ sample <- matrix(data=0, mcmc/thin, K + ncat + 1)
+
+ ## call C++ code to draw sample
+ auto.Scythe.call(output.object="posterior", cc.fun.name="MCMCoprobit",
+ sample=sample, Y=as.integer(Y), X=X,
+ burnin=as.integer(burnin),
+ mcmc=as.integer(mcmc), thin=as.integer(thin),
+ tune=as.double(tune), lecuyer=as.integer(lecuyer),
+ seedarray=as.integer(seed.array),
+ lecuyerstream=as.integer(lecuyer.stream),
+ verbose=as.integer(verbose), beta=beta.start,
+ gamma=gamma, b0=b0, B0=B0)
+
+ ## put together matrix and build MCMC object to return
+ sample <- matrix(posterior$sampledata, posterior$samplerow,
+ posterior$samplecol, byrow=TRUE)
+ sample <- sample[,c(1:K, (K+3):(K+ncat))]
+ output <- mcmc(data=sample, start=1, end=mcmc, thin=thin)
+ xnames <- c(X.names, paste("gamma", 2:(ncat-1), sep=""))
+ varnames(output) <- xnames
+ attr(output, "title") <- "MCMCoprobit Posterior Density Sample"
+
+ return(output)
+ }
diff --git a/R/MCMCordfactanal.R b/R/MCMCordfactanal.R
new file mode 100644
index 0000000..ea772b5
--- /dev/null
+++ b/R/MCMCordfactanal.R
@@ -0,0 +1,361 @@
+###########################################################################
+## sample from the posterior distribution of a factor analysis model
+## model in R using linked C++ code in Scythe.
+##
+## The model is:
+##
+## x*_i = \Lambda \phi_i + \epsilon_i, \epsilon_i \sim N(0, I)
+##
+## \lambda_{ij} \sim N(l0_{ij}, L0^{-1}_{ij})
+## \phi_i \sim N(0,I)
+##
+## and x*_i is the latent variable formed from the observed ordinal
+## variable in the usual (Albert and Chib, 1993) way.
+##
+## Andrew D. Martin
+## Washington University
+##
+## Kevin M. Quinn
+## Harvard University
+##
+## May 12, 2003
+## Revised to accommodate new spec 7/13/2004
+##
+##########################################################################
+
+"MCMCordfactanal" <-
+ function(x, factors, lambda.constraints=list(),
+ data=parent.environment(), burnin = 1000, mcmc = 20000,
+ thin=1, tune=NA, verbose = FALSE, seed = NA,
+ lambda.start = NA, l0=0, L0=0,
+ store.lambda=TRUE, store.scores=FALSE,
+ drop.constantvars=TRUE, ... ) {
+
+ ## check for MCMCirtKd special case, this is used to tell the R
+ ## and C++ code what to echo (1 if regular, 2 if MCMCirtKd)
+ ## the test is based on the existence of model="MCMCirtKd"
+ ## passed through ...
+ args <- list(...)
+
+ if (length(args$model) > 0){ # if model arg is passed
+ if (args$model=="MCMCirtKd"){
+ case.switch <- 2
+ echo.name <- "MCMCirtKd"
+ }
+ ## could allow for other possibities here but not clear what they
+ ## would be
+ }
+ else { # if model arg not passed then assume MCMCordfactanal
+ case.switch <- 1
+ echo.name <- "MCMCordfactanal"
+ }
+
+
+ # extract X and variable names from the model formula and frame
+ if (is.matrix(x)){
+ if (drop.constantvars==TRUE){
+ x.col.var <- apply(x, 2, var, na.rm=TRUE)
+ x <- x[,x.col.var!=0]
+ x.row.var <- apply(x, 1, var, na.rm=TRUE)
+ x <- x[x.row.var!=0,]
+ }
+ X <- as.data.frame(x)
+ xvars <- dimnames(X)[[2]]
+ xobs <- dimnames(X)[[1]]
+ N <- nrow(X) # number of observations
+ K <- ncol(X) # number of manifest variables
+ ncat <- matrix(NA, K, 1) # vector of number of categ. in each man. var.
+ for (i in 1:K){
+ X[,i] <- factor(X[,i], ordered=TRUE)
+ ncat[i] <- nlevels(X[,i])
+ X[,i] <- as.integer(X[,i])
+ X[is.na(X[,i]), i] <- -999
+ }
+ X <- as.matrix(X)
+ }
+ else {
+ call <- match.call()
+ mt <- terms(x, data=data)
+ if (attr(mt, "response") > 0)
+ stop("Response not allowed in formula in ", echo.name, "().\n")
+ if(missing(data)) data <- sys.frame(sys.parent())
+ mf <- match.call(expand.dots = FALSE)
+ mf$factors <- mf$lambda.constraints <- mf$burnin <- mf$mcmc <- NULL
+ mf$thin <- mf$tune <- mf$verbose <- mf$seed <- NULL
+ mf$lambda.start <- mf$l0 <- mf$L0 <- NULL
+ mf$store.lambda <- mf$store.scores <- mf$drop.constantvars <- NULL
+ mf$... <- NULL
+ mf$drop.unused.levels <- TRUE
+ mf[[1]] <- as.name("model.frame")
+ mf <- eval(mf, sys.frame(sys.parent()))
+ attributes(mt)$intercept <- 0
+ Xterm.length <- length(attr(mt, "variables"))
+ X <- subset(mf,
+ select=as.character(attr(mt, "variables"))[2:Xterm.length])
+ if (drop.constantvars==TRUE){
+ x.col.var <- apply(X, 2, var, na.rm=TRUE)
+ X <- X[,x.col.var!=0]
+ }
+ N <- nrow(X) # number of observations
+ K <- ncol(X) # number of manifest variables
+ ncat <- matrix(NA, K, 1) # vector of number of categ. in each man. var.
+ for (i in 1:K){
+ X[,i] <- factor(X[,i], ordered=TRUE)
+ ncat[i] <- nlevels(X[,i])
+ X[,i] <- as.integer(X[,i])
+ X[is.na(X[,i]), i] <- -999
+ }
+ X <- as.matrix(X)
+ xvars <- dimnames(X)[[2]] # X variable names
+ xobs <- dimnames(X)[[1]] # observation names
+ }
+
+ ## take care of the case where X has no row names
+ if (is.null(xobs)){
+ xobs <- 1:N
+ }
+
+ check.offset(list(...))
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ ## setup constraints on Lambda
+ holder <- build.factor.constraints(lambda.constraints, X, K, factors+1)
+ Lambda.eq.constraints <- holder[[1]]
+ Lambda.ineq.constraints <- holder[[2]]
+ X.names <- holder[[3]]
+
+ ## setup prior on Lambda
+ holder <- form.factload.norm.prior(l0, L0, K, factors+1, X.names)
+ Lambda.prior.mean <- holder[[1]]
+ Lambda.prior.prec <- holder[[2]]
+
+ # seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ ## Starting values for Lambda
+ Lambda <- matrix(0, K, factors+1)
+ if (is.na(lambda.start)){# sets Lambda to equality constraints & 0s
+ for (i in 1:K){
+ for (j in 1:(factors+1)){
+ if (Lambda.eq.constraints[i,j]==-999){
+ if(Lambda.ineq.constraints[i,j]==0){
+ if (j==1){
+ if (ncat[i] == 2){
+ probit.out <- glm(as.factor(X[X[,i]!=-999,i])~1,
+ family=binomial(link=probit))
+ probit.beta <- coef(probit.out)
+ Lambda[i,j] <- probit.beta[1]
+ }
+ if (ncat[i] > 2){
+ polr.out <- polr(ordered(X[X[,i]!=-999,i])~1)
+ Lambda[i,j] <- -polr.out$zeta[1]*.588
+ }
+ }
+ }
+ if(Lambda.ineq.constraints[i,j]>0){
+ Lambda[i,j] <- 1.0
+ }
+ if(Lambda.ineq.constraints[i,j]<0){
+ Lambda[i,j] <- -1.0
+ }
+ }
+ else Lambda[i,j] <- Lambda.eq.constraints[i,j]
+ }
+ }
+ }
+ else if (is.matrix(lambda.start)){
+ if (nrow(lambda.start)==K && ncol(lambda.start)==(factors+1))
+ Lambda <- lambda.start
+ else {
+ cat("Starting values not of correct size for model specification.\n")
+ stop("Please respecify and call ", echo.name, "() again\n")
+ }
+ }
+ else if (length(lambda.start)==1 && is.numeric(lambda.start)){
+ Lambda <- matrix(lambda.start, K, factors+1)
+ for (i in 1:K){
+ for (j in 1:(factors+1)){
+ if (Lambda.eq.constraints[i,j] != -999)
+ Lambda[i,j] <- Lambda.eq.constraints[i,j]
+ }
+ }
+ }
+ else {
+ cat("Starting values neither NA, matrix, nor scalar.\n")
+ stop("Please respecify and call ", echo.name, "() again\n")
+ }
+
+ ## check MH tuning parameter
+ if (is.na(tune)){
+ tune <- matrix(NA, K, 1)
+ for (i in 1:K){
+ tune[i] <- 0.05/ncat[i]
+ }
+ }
+ else if (is.double(tune)){
+ tune <- matrix(tune/ncat, K, 1)
+ }
+ if(min(tune) < 0) {
+ cat("Tuning parameter is negative.\n")
+ stop("Please respecify and call ", echo.name, "() again\n")
+ }
+
+ ## starting values for gamma (note: not changeable by user)
+ gamma <- matrix(0, max(ncat)+1, K)
+ for (i in 1:K){
+ if (ncat[i]<=2){
+ gamma[1,i] <- -300
+ gamma[2,i] <- 0
+ gamma[3,i] <- 300
+ }
+ if(ncat[i] > 2) {
+ polr.out <- polr(ordered(X[X[,i]!=-999,i])~1)
+ gamma[1,i] <- -300
+ gamma[2,i] <- 0
+ gamma[3:ncat[i],i] <- (polr.out$zeta[2:(ncat[i]-1)] -
+ polr.out$zeta[1])*.588
+ gamma[ncat[i]+1,i] <- 300
+ }
+ }
+
+ ## define holder for posterior density sample
+ if (store.scores == FALSE && store.lambda == FALSE){
+ sample <- matrix(data=0, mcmc/thin, length(gamma))
+ }
+ else if (store.scores == TRUE && store.lambda == FALSE){
+ sample <- matrix(data=0, mcmc/thin, (factors+1)*N + length(gamma))
+ }
+ else if(store.scores == FALSE && store.lambda == TRUE) {
+ sample <- matrix(data=0, mcmc/thin, K*(factors+1)+length(gamma))
+ }
+ else { # store.scores==TRUE && store.lambda==TRUE
+ sample <- matrix(data=0, mcmc/thin, K*(factors+1)+(factors+1)*N +
+ length(gamma))
+ }
+
+
+ ## Call the C++ code to do the real work
+ posterior <- .C("ordfactanalpost",
+ samdata = as.double(sample),
+ samrow = as.integer(nrow(sample)),
+ samcol = as.integer(ncol(sample)),
+ X = as.integer(X),
+ Xrow = as.integer(nrow(X)),
+ Xcol = as.integer(ncol(X)),
+ burnin = as.integer(burnin),
+ mcmc = as.integer(mcmc),
+ thin = as.integer(thin),
+ tune = as.double(tune),
+ lecuyer = as.integer(lecuyer),
+ seedarray = as.integer(seed.array),
+ lecuyerstream = as.integer(lecuyer.stream),
+ verbose = as.integer(verbose),
+ Lambda = as.double(Lambda),
+ Lambdarow = as.integer(nrow(Lambda)),
+ Lambdacol = as.integer(ncol(Lambda)),
+ gamma = as.double(gamma),
+ gammarow = as.integer(nrow(gamma)),
+ gammacol = as.integer(ncol(gamma)),
+ ncat = as.integer(ncat),
+ ncatrow = as.integer(nrow(ncat)),
+ ncatcol = as.integer(ncol(ncat)),
+ Lameq = as.double(Lambda.eq.constraints),
+ Lameqrow = as.integer(nrow(Lambda.eq.constraints)),
+ Lameqcol = as.integer(ncol(Lambda.ineq.constraints)),
+ Lamineq = as.double(Lambda.ineq.constraints),
+ Lamineqrow = as.integer(nrow(Lambda.ineq.constraints)),
+ Lamineqcol = as.integer(ncol(Lambda.ineq.constraints)),
+ Lampmean = as.double(Lambda.prior.mean),
+ Lampmeanrow = as.integer(nrow(Lambda.prior.mean)),
+ Lampmeancol = as.integer(ncol(Lambda.prior.prec)),
+ Lampprec = as.double(Lambda.prior.prec),
+ Lampprecrow = as.integer(nrow(Lambda.prior.prec)),
+ Lamppreccol = as.integer(ncol(Lambda.prior.prec)),
+ storelambda = as.integer(store.lambda),
+ storescores = as.integer(store.scores),
+ accepts = as.integer(0),
+ outswitch = as.integer(case.switch),
+ PACKAGE="MCMCpack"
+ )
+ if(case.switch==1) {
+ cat(" overall acceptance rate = ",
+ posterior$accepts / ((posterior$burnin+posterior$mcmc)*K), "\n")
+ }
+
+ # put together matrix and build MCMC object to return
+ sample <- matrix(posterior$samdata, posterior$samrow, posterior$samcol,
+ byrow=TRUE)
+ output <- mcmc(data=sample,start=1, end=mcmc, thin=thin)
+
+ par.names <- NULL
+ if (store.lambda==TRUE){
+ if(case.switch==1) {
+ Lambda.names <- paste(paste("Lambda",
+ rep(X.names,
+ each=(factors+1)), sep=""),
+ rep(1:(factors+1),K), sep=".")
+ }
+ if(case.switch==2) {
+ alpha.hold <- paste("alpha", X.names, sep=".")
+ beta.hold <- paste("beta", X.names, sep = ".")
+ beta.hold <- rep(beta.hold, factors, each=factors)
+ beta.hold <- paste(beta.hold, 1:factors, sep=".")
+
+ Lambda.names <- t(cbind(matrix(alpha.hold, K, 1),
+ matrix(beta.hold,K,factors,byrow=TRUE)))
+ dim(Lambda.names) <- NULL
+ }
+ par.names <- c(par.names, Lambda.names)
+ }
+
+ gamma.names <- paste(paste("gamma",
+ rep(0:(nrow(gamma)-1),
+ each=K), sep=""),
+ rep(X.names, nrow(gamma)), sep=".")
+ par.names <- c(par.names, gamma.names)
+
+ if (store.scores==TRUE){
+ if(case.switch==1) {
+ phi.names <- paste(paste("phi",
+ rep(xobs, each=(factors+1)), sep="."),
+ rep(1:(factors+1),(factors+1)), sep=".")
+ par.names <- c(par.names, phi.names)
+ }
+ if(case.switch==2) {
+ phi.names <- paste(paste("theta",
+ rep(xobs, each=(factors+1)), sep="."),
+ rep(0:factors,(factors+1)), sep=".")
+ par.names <- c(par.names, phi.names)
+
+ }
+ }
+
+ varnames(output) <- par.names
+
+ # 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 <- mcmc(as.matrix(output.df), start=1, end=mcmc, thin=thin)
+
+ # add constraint info so this isn't lost
+ attr(output, "constraints") <- lambda.constraints
+ attr(output, "n.manifest") <- K
+ attr(output, "n.factors") <- factors
+ attr(output, "accept.rate") <- posterior$accepts /
+ ((posterior$burnin+posterior$mcmc)*K)
+ if(case.switch==1) {
+ attr(output,"title") <-
+ "MCMCpack Ordinal Data Factor Analysis Posterior Density Sample"
+ }
+ if(case.switch==2) {
+ attr(output,"title") <-
+ "MCMCpack K-Dimensional Item Response Theory Model Posterior Density Sample"
+ }
+ return(output)
+
+ }
+
diff --git a/R/MCMCpanel.R b/R/MCMCpanel.R
new file mode 100644
index 0000000..b8dc434
--- /dev/null
+++ b/R/MCMCpanel.R
@@ -0,0 +1,247 @@
+# 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 = FALSE, 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 Density Sample"
+ return(output)
+ }
+
diff --git a/R/MCMCpoisson.R b/R/MCMCpoisson.R
new file mode 100644
index 0000000..69e86c4
--- /dev/null
+++ b/R/MCMCpoisson.R
@@ -0,0 +1,67 @@
+### sample from the posterior distribution of a Poisson regression
+### model in R using linked C++ code in Scythe
+###
+### ADM 1/24/2003
+## KQ 3/17/2003 [bug fix]
+## Modified to meet new developer specification 7/15/2004 KQ
+## Modified for new Scythe and rngs 7/26/2004 KQ
+
+"MCMCpoisson" <-
+ function(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin=1, tune=1.1, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, ...) {
+
+ ## checks
+ check.offset(list(...))
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ ## seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ ## form response and model matrices
+ holder <- parse.formula(formula, data)
+ Y <- holder[[1]]
+ X <- holder[[2]]
+ xnames <- holder[[3]]
+ K <- ncol(X) # number of covariates
+
+ ## starting values and priors
+ beta.start <- coef.start(beta.start, K, formula, family=poisson, data)
+ mvn.prior <- form.mvn.prior(b0, B0, K)
+ b0 <- mvn.prior[[1]]
+ B0 <- mvn.prior[[2]]
+
+ ## form the tuning parameter
+ tune <- vector.tune(tune, K)
+ V <- vcov(glm(formula=formula, data=data, family=poisson))
+
+ ## test y non-negative
+ if (sum(Y < 0) > 0) {
+ cat("\n Elements of Y negative. ")
+ stop("\n Check data and call MCMCpoisson() again. \n")
+ }
+
+ ## define holder for posterior density sample
+ sample <- matrix(data=0, mcmc/thin, dim(X)[2] )
+
+ ## call C++ code to draw sample
+ auto.Scythe.call(output.object="posterior", cc.fun.name="MCMCpoisson",
+ sample=sample, Y=Y, X=X, burnin=as.integer(burnin),
+ mcmc=as.integer(mcmc), thin=as.integer(thin),
+ tune=tune, lecuyer=as.integer(lecuyer),
+ seedarray=as.integer(seed.array),
+ lecuyerstream=as.integer(lecuyer.stream),
+ verbose=as.integer(verbose), betastart=beta.start,
+ b0=b0, B0=B0, V=V)
+
+ ## put together matrix and build MCMC object to return
+ output <- form.mcmc.object(posterior, names=xnames,
+ title="MCMCpoisson Posterior Density Sample")
+ return(output)
+
+ }
+
+
diff --git a/R/MCMCprobit.R b/R/MCMCprobit.R
new file mode 100644
index 0000000..ff15b94
--- /dev/null
+++ b/R/MCMCprobit.R
@@ -0,0 +1,102 @@
+## sample from the posterior distribution of a probit
+## model in R using linked C++ code in Scythe
+##
+## ADM and KQ 5/21/2002
+## Modified to meet new developer specification 7/26/2004 KQ
+## Modified for new Scythe and rngs 7/26/2004 KQ
+
+
+"MCMCprobit" <-
+ function(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin = 1, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, bayes.resid=FALSE, ...) {
+
+ ## checks
+ check.offset(list(...))
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ ## seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ ## form response and model matrices
+ holder <- parse.formula(formula, data)
+ Y <- holder[[1]]
+ X <- holder[[2]]
+ xnames <- holder[[3]]
+ K <- ncol(X) # number of covariates
+
+ ## starting values and priors
+ beta.start <- coef.start(beta.start, K, formula,
+ family=binomial(link=probit), data)
+ mvn.prior <- form.mvn.prior(b0, B0, K)
+ b0 <- mvn.prior[[1]]
+ B0 <- mvn.prior[[2]]
+
+ ## residuals setup
+ resvec <- NULL
+ if (is.logical(bayes.resid) && bayes.resid==TRUE){
+ resvec <- matrix(1:length(Y), length(Y), 1)
+ }
+ else if (!is.logical(bayes.resid)){
+ resvec <- matrix(bayes.resid, length(bayes.resid), 1)
+ if (min(resvec %in% 1:length(Y)) == 0){
+ cat("Elements of bayes.resid are not valid row numbers.\n")
+ stop("Check data and call MCMCprobit() again.\n")
+ }
+ }
+
+ ## y \in {0, 1} error checking
+ if (sum(Y!=0 & Y!=1) > 0) {
+ cat("Elements of Y equal to something other than 0 or 1.\n")
+ stop("Check data and call MCMCprobit() again.\n")
+ }
+
+ if (is.null(resvec)){
+ ## define holder for posterior density sample
+ sample <- matrix(data=0, mcmc/thin, dim(X)[2] )
+
+ ## call C++ code to draw sample
+ auto.Scythe.call(output.object="posterior", cc.fun.name="MCMCprobit",
+ sample=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),
+ lecuyerstream=as.integer(lecuyer.stream),
+ verbose=as.integer(verbose), betastart=beta.start,
+ b0=b0, B0=B0)
+
+ ## put together matrix and build MCMC object to return
+ output <- form.mcmc.object(posterior, names=xnames,
+ title="MCMCprobit Posterior Density Sample")
+
+ }
+ else{
+ # define holder for posterior density sample
+ sample <- matrix(data=0, mcmc/thin, dim(X)[2]+length(resvec) )
+
+ ## call C++ code to draw sample
+ auto.Scythe.call(output.object="posterior", cc.fun.name="MCMCprobitres",
+ sample=sample, Y=Y, X=X, resvec=resvec,
+ burnin=as.integer(burnin),
+ mcmc=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), betastart=beta.start,
+ b0=b0, B0=B0)
+
+ ## put together matrix and build MCMC object to return
+ xnames <- c(xnames, paste("epsilonstar", as.character(resvec), sep="") )
+
+ output <- form.mcmc.object(posterior, names=xnames,
+ title="MCMCprobit Posterior Density Sample")
+
+ }
+ return(output)
+
+ }
+
+
diff --git a/R/MCMCregress.R b/R/MCMCregress.R
new file mode 100644
index 0000000..b32fb4d
--- /dev/null
+++ b/R/MCMCregress.R
@@ -0,0 +1,56 @@
+# MCMCregress.R samples from the posterior distribution of a Gaussian
+# linear regression model in R using linked C++ code in Scythe
+#
+# Original written by ADM and KQ 5/21/2002
+# Updated with helper functions ADM 5/28/2004
+# Modified to meet new developer specification 6/18/2004 KQ
+# Modified for new Scythe and rngs 7/22/2004 ADM
+
+"MCMCregress" <-
+ function(formula, data=parent.frame(), burnin = 1000, mcmc = 10000,
+ thin=1, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, c0 = 0.001, d0 = 0.001, ...) {
+
+ # checks
+ check.offset(list(...))
+ check.mcmc.parameters(burnin, mcmc, thin)
+
+ # seeds
+ seeds <- form.seeds(seed)
+ lecuyer <- seeds[[1]]
+ seed.array <- seeds[[2]]
+ lecuyer.stream <- seeds[[3]]
+
+ # form response and model matrices
+ holder <- parse.formula(formula, data)
+ Y <- holder[[1]]
+ X <- holder[[2]]
+ xnames <- holder[[3]]
+ K <- ncol(X) # number of covariates
+
+ # starting values and priors
+ beta.start <- coef.start(beta.start, K, formula, family=gaussian, data)
+ mvn.prior <- form.mvn.prior(b0, B0, K)
+ b0 <- mvn.prior[[1]]
+ B0 <- mvn.prior[[2]]
+ check.ig.prior(c0, d0)
+
+ # define holder for posterior density sample
+ sample <- matrix(data=0, mcmc/thin, K+1)
+
+ # call C++ code to draw sample
+ auto.Scythe.call(output.object="posterior", cc.fun.name="MCMCregress",
+ sample=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),
+ lecuyerstream=as.integer(lecuyer.stream),
+ verbose=as.integer(verbose), betastart=beta.start,
+ b0=b0, B0=B0, c0=as.double(c0), d0=as.double(d0))
+
+ # pull together matrix and build MCMC object to return
+ output <- form.mcmc.object(posterior,
+ names=c(xnames, "sigma2"),
+ title="MCMCregress Posterior Density Sample")
+ return(output)
+ }
diff --git a/R/automate.R b/R/automate.R
new file mode 100644
index 0000000..7123e65
--- /dev/null
+++ b/R/automate.R
@@ -0,0 +1,264 @@
+## this function automates the Scythe C++ call making book-keeping
+## much easier
+##
+## output.object: name of posterior sample that will be placed
+## in the parent environment (string)
+##
+## cc.fun.name: name of the C++ function to be called (string)
+##
+## package: name of package (string, "MCMCpack" by default)
+##
+## developer: option that determines whether the R call and
+## C++ template are echoed or whether the Scythe
+## call is made (logical)
+##
+## help.file: option that determines whether a template of a
+## helpfile for the calling R function should be
+## generated (logical)
+##
+## cc.file: the file used to store the C++ template
+## (string, output to the screen if "")
+##
+## R.file: the file used to store the clean R template
+## (string, output to the screen if "")
+##
+## ...: list of objects passed to C++
+## NOTE: this will only take integers (which have
+## to be coerced), doubles, and matrices. They
+## should all be of the form "X = X," with the first
+## part the C++ name and the second part the R name.
+## Remember that C++ names cannot have periods in them.
+## Matrices will be, for example, Xdata, Xrow, and
+## Xcol.
+##
+## This also build a skeleton C++ template and clean R template
+## for MCMCpack if developer=TRUE. All are arguments constants
+## except the matrix named "sample".
+##
+
+"auto.Scythe.call" <-
+ function(output.object, cc.fun.name, package="MCMCpack",
+ developer=FALSE, help.file=FALSE, cc.file="", R.file="", ...) {
+
+ # pull stuff from function call
+ objects <- list(...)
+ K <- length(objects)
+ c.names <- names(objects)
+ if (max(c.names=="sample") != 1){
+ stop("argument named 'sample' must be specified in call to auto.Scythe.call()\n")
+ }
+ R.names <- strsplit(toString(match.call()), ",")[[1]]
+ R.names <- R.names[(length(R.names)-K+1):length(R.names)]
+
+ ## put default values in for burnin, mcmc, thin, and verbose
+ ## if not explicitly supplied
+ burnin.exist <- mcmc.exist <- thin.exist <- seed.exist <-
+ verbose.exist <- FALSE
+ for (k in 1:K){
+ if(c.names[[k]]=="burnin" & is.integer(objects[[k]]))
+ burnin.exist <- TRUE
+ if(c.names[[k]]=="mcmc" & is.integer(objects[[k]]))
+ mcmc.exist <- TRUE
+ if(c.names[[k]]=="thin" & is.integer(objects[[k]]))
+ thin.exist <- TRUE
+ if(c.names[[k]]=="verbose" & is.null(dim(objects[[k]])))
+ verbose.exist <- TRUE
+ }
+ if (!burnin.exist){
+ objects <- c(objects, burnin=as.integer(5000))
+ R.names[length(objects)] <- "as.integer(5000)"
+ }
+ if (!mcmc.exist){
+ objects <- c(objects, mcmc=as.integer(25000))
+ R.names[length(objects)] <- "as.integer(25000)"
+ }
+ if (!thin.exist){
+ objects <- c(objects, thin=as.integer(1))
+ R.names[length(objects)] <- "as.integer(1)"
+ }
+ if (!verbose.exist){
+ objects <- c(objects, verbose=as.integer(FALSE))
+ R.names[length(objects)] <- "as.integer(FALSE)"
+ }
+ K <- length(objects)
+ c.names <- names(objects)
+
+ ## check parameters
+ check.mcmc.parameters(objects$burnin, objects$mcmc, objects$thin)
+
+ ## write out a template R help file
+ callfun <- strsplit(toString(sys.call(which=-1)),",")[[1]][1]
+ if (help.file){
+ prompt(callfun,file=paste(callfun, ".template.Rd", sep=""))
+ }
+
+ ##
+ ## pull together R call
+ ##
+
+ # strings for R call
+ start <- paste(".C('", cc.fun.name, "',", sep="")
+ end <- paste("PACKAGE='", package, "')", sep="")
+ middle <- NULL
+
+ for(k in 1:K) {
+ if(is.double(objects[[k]]) & is.null(dim(objects[[k]]))) {
+ if (regexpr("as.double", R.names[[k]])==-1){
+ holder <- paste(c.names[[k]], " = as.double(", R.names[[k]], "),",
+ sep="")
+ middle <- c(middle, holder)
+ }
+ else {
+ holder <- paste(c.names[[k]], " =", R.names[[k]], ",",
+ sep="")
+ middle <- c(middle, holder)
+ }
+ }
+ else if(is.integer(objects[[k]]) & is.null(dim(objects[[k]]))) {
+ if (regexpr("as.integer", R.names[[k]])==-1){
+ holder <- paste(c.names[[k]], " = as.integer(", R.names[[k]], "),",
+ sep="")
+ middle <- c(middle, holder)
+ }
+ else {
+ holder <- paste(c.names[[k]], " =", R.names[[k]], ",",
+ sep="")
+ middle <- c(middle, holder)
+ }
+ }
+ else if(is.matrix(objects[[k]])) {
+ holder.data <- paste(c.names[[k]], "data", " = as.double(",
+ R.names[[k]], "),", sep="")
+ holder.row <- paste(c.names[[k]], "row", " =", " nrow(",
+ R.names[[k]], "),", sep="")
+ holder.col <- paste(c.names[[k]], "col", " =", " ncol(",
+ R.names[[k]], "),", sep="")
+ middle <- c(middle, holder.data, holder.row, holder.col)
+ }
+ else {
+ stop("Integers, doubles, or matrices only to auto.Scythe.call().")
+ }
+ }
+
+
+
+ # clean up and return R call
+ middle <- paste(middle, sep=" ", collapse=" ")
+ call <- paste(start, middle, end, sep=" ")
+ call <- gsub('\\( ', '\\(', call)
+
+ ##
+ ## pull together C++ call
+ ##
+
+ # strings for C++ call
+ c.start <- paste("void ", cc.fun.name, "(", sep="")
+ c.end <- ")"
+ c.middle <- NULL
+ together.call <- NULL
+
+ for(k in 1:K) {
+ if(is.double(objects[[k]]) & is.null(dim(objects[[k]]))) {
+ holder <- paste("const double *", c.names[[k]], ",", sep="")
+ c.middle <- c(c.middle, holder)
+ }
+ else if(is.integer(objects[[k]]) & is.null(dim(objects[[k]]))) {
+ holder <- paste("const int *", c.names[[k]], ",", sep="")
+ c.middle <- c(c.middle, holder)
+ }
+ else if(is.matrix(objects[[k]])) {
+
+ # pull together Scythe call [note sample]
+ if(c.names[[k]]=="sample") {
+ holder.data <- paste("double *", c.names[[k]], "data,", sep="")
+ scythe <- NULL
+ together.call <- paste(together.call, scythe, sep="")
+ sample.block <- paste(" const int size = *", c.names[[k]],
+ "row * *", c.names[[k]],
+ "col;\n for(int i = 0; i < size; ++i)\n",
+ " ", c.names[[k]], "data[i] = STORAGEMATRIX[i];\n",
+ sep="")
+ }
+ else {
+ holder.data <- paste("const double *", c.names[[k]],
+ "data,", sep="")
+ scythe <- paste(" Matrix <double> ", c.names[[k]],
+ " = r2scythe(*",
+ c.names[[k]], "row, *", c.names[[k]], "col, ",
+ c.names[[k]], "data);\n", sep="")
+
+ together.call <- paste(together.call, scythe, sep="")
+ }
+ holder.row <- paste("const int *", c.names[[k]], "row,", sep="")
+ holder.col <- paste("const int *", c.names[[k]], "col,", sep="")
+ c.middle <- c(c.middle, holder.data, holder.row, holder.col)
+ }
+ }
+
+ # clean up and print C++ function call
+ c.middle <- paste(c.middle, sep=" ", collapse=" ")
+ c.call <- paste(c.start, c.middle, c.end, sep="")
+ c.call <- gsub(',)', ')', c.call)
+
+ # if developer dump Scythe code to file, R function to screen, and evaluate
+ if(developer) {
+ comment.block <- paste("// ", cc.file, " DESCRIPTION HERE\n//\n// The initial version of this file was generated by the\n// auto.Scythe.call() function in the MCMCpack R package\n// written by:\n//\n// Andrew D. Martin\n// Dept. of Political Science\n// Washington University in St. Louis\n// admartin at wustl.edu\n//\n// Kevin M. Quinn\n// Dept. of Government\n// Harvard University\n// kevin_quinn at harvard.edu\n// \n// This software is distributed under the terms of the GNU GENERAL\n// [...]
+
+ includes.block <- '#include "matrix.h"\n#include "distributions.h"\n#include "stat.h"\n#include "la.h"\n#include "ide.h"\n#include "smath.h"\n#include "MCMCrng.h"\n#include "MCMCfcds.h"\n\n#include <R.h> // needed to use Rprintf()\n#include <R_ext/Utils.h> // needed to allow user interrupts\n\nusing namespace SCYTHE;\nusing namespace std;\n\n'
+
+ main.block <- 'extern "C" {\n\n // BRIEF FUNCTION DESCRIPTION\n'
+
+ function.call <- paste(' ', c.call, ' {\n', sep="")
+
+ together.block <- " \n // pull together Matrix objects\n // REMEMBER TO ACCESS PASSED ints AND doubles PROPERLY\n"
+
+ constants.block <- "\n // define constants\n const int tot_iter = *burnin + *mcmc; // total number of mcmc iterations\n const int nstore = *mcmc / *thin; // number of draws to store\n const int NUMBER_OF_PARAMETERS = ????; // YOU NEED TO FILL THIS IN\n"
+
+ storage.block <- "\n // storage matrix or matrices\n Matrix<double> STORAGEMATRIX(nstore, NUMBER_OF_PARAMETERS);\n"
+
+ seed.block <- "\n // initialize rng stream\n rng *stream = MCMCpack_get_rng(*lecuyer, seedarray, *lecuyerstream);\n"
+
+ startval.block <- "\n // set starting values\n PARAMETER_BLOCK1 = ????;\n PARAMETER_BLOCK2 = ????;\n ETC.;\n"
+
+ sample.call <- paste('\n ///// MCMC SAMPLING OCCURS IN THIS FOR LOOP\n for(int iter = 0; iter < tot_iter; ++iter){\n\n // sample the parameters\n PARAMETER_BLOCK1 = ????;\n PARAMETER_BLOCK2 = ????;\n ETC;\n\n // store draws in storage matrix (or matrices)\n if(iter >= *burnin && (iter % *thin == 0)){\n // PUT DRAWS IN STORAGEMATRIX HERE\n }\n\n // print output to stdout\n if(*verbose == 1 && iter % 500 == 0){\n [...]
+
+ end.block <- paste("\n } // end", cc.fun.name, '\n} // end extern "C"\n')
+
+ if (cc.file == ""){
+ cat("\n\nThe C++ template file is:\n")
+ }
+ cat(comment.block, includes.block, main.block, function.call,
+ together.block, together.call, constants.block, storage.block,
+ seed.block, startval.block, sample.call,
+ sample.block, end.block, sep="", file=cc.file)
+ if (cc.file != "") {
+ cat("\nCreated file named '", cc.file, "'.\n", sep="")
+ cat("Edit the file and move it to the appropriate directory.\n")
+ }
+
+ if (R.file == "") {
+ cat("\n\nThe clean R template file is:\n")
+ }
+ dump(callfun, file=R.file)
+ if (R.file != "") {
+ cat("\nCreated file named '", R.file, "'.\n", sep="")
+ cat("Edit the file and move it to the appropriate directory.\n")
+ cat("Do not forget to edit the MCMCpack NAMESPACE file if\n")
+ cat("installing new functions as part of MCMCpack.\n")
+ }
+
+ cat("\nThe call to .C is:\n")
+ draw.sample.call <- parse(text=paste(output.object, " <- ", call))
+ print(draw.sample.call)
+ cat("\nAUTOMATIC TEMPLATE FILE CREATION SUCCEEDED.\n\n")
+ invokeRestart("abort")
+ }
+
+ # if not developer evaluate call leaving output.object in
+ # parent environment
+ if(!developer) {
+ draw.sample.call <- parse(text=paste(output.object, " <- ", call))
+ eval(draw.sample.call, envir=parent.frame(1))
+ }
+}
+
diff --git a/R/distn.R b/R/distn.R
new file mode 100644
index 0000000..d086212
--- /dev/null
+++ b/R/distn.R
@@ -0,0 +1,492 @@
+########## Density Functions and Random Number Generators ##########
+
+##
+## Wishart
+##
+
+# rwish delivers a pseudo-random Wishart deviate
+#
+# USAGE:
+#
+# A <- rwish(v, S)
+#
+# INPUT:
+#
+# v degrees of freedom
+#
+# S Scale matrix
+#
+# OUTPUT:
+#
+# A a pseudo-random Wishart deviate
+#
+# Based on code originally posted by Bill Venables to S-news
+# on 6/11/1998
+#
+# KQ on 2/5/2001
+
+"rwish" <-
+ function(v, S) {
+ if (!is.matrix(S))
+ S <- matrix(S)
+ if (nrow(S) != ncol(S)) {
+ stop(message="S not square in rwish().\n")
+ }
+ if (v < nrow(S)) {
+ stop(message="v is less than the dimension of S in rwish().\n")
+ }
+ p <- nrow(S)
+ CC <- chol(S)
+ Z <- matrix(0, p, p)
+ diag(Z) <- sqrt(rchisq(p, v:(v-p+1)))
+ if(p > 1) {
+ pseq <- 1:(p-1)
+ Z[rep(p*pseq, pseq) + unlist(lapply(pseq, seq))] <- rnorm(p*(p-1)/2)
+ }
+ return(crossprod(Z %*% CC))
+ }
+
+# dwish evaluations the Wishart pdf at positive definite matrix W.
+# note: uses the Gelman, et. al. parameterization.
+#
+# USAGE:
+#
+# x <- dwish(W, v, S)
+#
+# INPUT:
+#
+# W positive definite matrix at which to evaluate PDF
+#
+# v degrees of freedom
+#
+# S Scale matrix
+#
+# OUTPUT:
+#
+# x the PDF evaluated (scalar)
+#
+# ADM 8/16/2002
+
+"dwish" <-
+ function(W, v, S) {
+ if (!is.matrix(S))
+ S <- matrix(S)
+ if (nrow(S) != ncol(S)){
+ stop(message="W not square in dwish()\n\n")
+ }
+ if (!is.matrix(W))
+ S <- matrix(W)
+ if (nrow(W) != ncol(W)){
+ stop(message="W not square in dwish()\n\n")
+ }
+ if(nrow(S) != ncol(W)){
+ stop(message="W and X of different dimensionality in dwish()\n\n")
+ }
+ if (v < nrow(S)){
+ stop(message="v is less than the dimension of S in dwish()\n\n")
+ }
+ k <- nrow(S)
+
+ # denominator
+ gammapart <- 1
+ for(i in 1:k) {
+ gammapart <- gammapart * gamma((v + 1 - i)/2)
+ }
+ denom <- gammapart * 2^(v * k / 2) * pi^(k*(k-1)/4)
+
+ # numerator
+ detS <- det(S)
+ detW <- det(W)
+ hold <- solve(S) %*% W
+ tracehold <- sum(hold[row(hold) == col(hold)])
+ num <- detS^(-v/2) * detW^((v - k - 1)/2) * exp(-1/2 * tracehold)
+
+ return(num / denom)
+ }
+
+##
+## Inverse Wishart
+##
+
+# riwish generates a draw from the inverse Wishart distribution
+# (using the Wishart generator)
+
+"riwish" <-
+ function(v, S) {
+ return(solve(rwish(v,S)))
+ }
+
+# diwish evaluates the inverse Wishart pdf at positive definite
+# matrix W. note: uses the Gelman, et. al. parameterization.
+#
+# USAGE:
+#
+# x <- diwish(W, v, S)
+#
+# INPUT:
+#
+# W positive definite matrix at which to evaluate PDF
+#
+# v degrees of freedom
+#
+# S Scale matrix
+#
+# OUTPUT:
+#
+# x the PDF evaluated (scalar)
+#
+# ADM 8/16/2002
+
+"diwish" <-
+ function(W, v, S) {
+ if (!is.matrix(S))
+ S <- matrix(S)
+ if (nrow(S) != ncol(S)){
+ stop("W not square in diwish().\n")
+ }
+ if (!is.matrix(W))
+ S <- matrix(W)
+ if (nrow(W) != ncol(W)){
+ stop("W not square in diwish().\n")
+ }
+ if(nrow(S) != ncol(W)){
+ stop("W and X of different dimensionality in diwish().\n")
+ }
+ if (v < nrow(S)){
+ stop("v is less than the dimension of S in diwish().\n")
+ }
+
+ k <- nrow(S)
+
+ # denominator
+ gammapart <- 1
+ for(i in 1:k) {
+ gammapart <- gammapart * gamma((v + 1 - i)/2)
+ }
+ denom <- gammapart * 2^(v * k / 2) * pi^(k*(k-1)/4)
+
+ # numerator
+ detS <- det(S)
+ detW <- det(W)
+ hold <- S %*% solve(W)
+ tracehold <- sum(hold[row(hold) == col(hold)])
+ num <- detS^(v/2) * detW^(-(v + k + 1)/2) * exp(-1/2 * tracehold)
+
+ return(num / denom)
+ }
+
+##
+## Inverse Gamma
+##
+
+# evaluate the inverse gamma density
+#
+# Kevin Rompala 5/6/2003
+
+"dinvgamma" <-
+ function(x, shape, rate = 1) {
+
+ # error checking
+ if(shape <= 0 | rate <=0) {
+ stop("Shape or rate parameter negative in dinvgamma().\n")
+ }
+
+ alpha <- shape
+ beta <- rate
+ return(beta^alpha / gamma(alpha) * x^(-1*(alpha + 1)) * exp(-beta/x))
+ }
+
+# generate draws from the inverse gamma density (using
+# the gamma simulator)
+#
+# Kevin Rompala 5/6/2003
+
+"rinvgamma" <-
+ function(n, shape, rate = 1) {
+ return(1 / rgamma(n, shape, rate))
+ }
+
+##
+## Dirichlet (Multivariate Beta)
+##
+
+# ddirichlet evaluates the density of the Dirichlet at
+# vector x given shape parameter vector (or matrix)
+# alpha.
+#
+# note: this code is taken verbatim from the R-package
+# "Greg's Miscellaneous Functions" maintained by
+# Gregory R. Warnes <Gregory_R_Warnes at groton.pfizer.com>
+#
+# Kevin Rompala 5/6/2003
+
+"ddirichlet" <-
+ function(x, alpha) {
+
+ dirichlet1 <- function(x, alpha) {
+ logD <- sum(lgamma(alpha)) - lgamma(sum(alpha))
+ s <- sum((alpha-1)*log(x))
+ exp(sum(s)-logD)
+ }
+
+ # make sure x is a matrix
+ if(!is.matrix(x))
+ if(is.data.frame(x))
+ x <- as.matrix(x)
+ else
+ x <- t(x)
+ if(!is.matrix(alpha))
+ alpha <- matrix( alpha, ncol=length(alpha), nrow=nrow(x), byrow=TRUE)
+
+ if( any(dim(x) != dim(alpha)) )
+ stop("Mismatch between dimensions of x and alpha in ddirichlet().\n")
+
+ pd <- vector(length=nrow(x))
+ for(i in 1:nrow(x))
+ pd[i] <- dirichlet1(x[i,],alpha[i,])
+
+ # Enforce 0 <= x[i,j] <= 1, sum(x[i,]) = 1
+ pd[ apply( x, 1, function(z) any( z <0 | z > 1)) ] <- 0
+ pd[ apply( x, 1, function(z) all.equal(sum( z ),1) !=TRUE) ] <- 0
+ return(pd)
+ }
+
+
+# rdirichlet generates n random draws from the Dirichlet at
+# vector x given shape parameter vector (or matrix)
+# alpha.
+#
+# note: this code is taken verbatim from the R-package
+# "Greg's Miscellaneous Functions" maintained by
+# Gregory R. Warnes <Gregory_R_Warnes at groton.pfizer.com>
+#
+# Kevin Rompala 5/6/2003
+
+"rdirichlet" <-
+ function(n, alpha) {
+ l<-length(alpha);
+ x<-matrix(rgamma(l*n,alpha),ncol=l,byrow=TRUE);
+ sm<-x%*%rep(1,l);
+ return(x/as.vector(sm));
+ }
+
+##
+## Non-Central Hypergeometric
+##
+
+# code to evaluate the noncentral hypergeometric density (at a single point
+# or at all defined points).
+#
+# parameters:
+#
+# n1, n2 -- number of subjects in group 1 and 2
+#
+# Y1, Y2 -- number of subjects with positive outcome [unobserved]
+#
+# psi -- odds ratio
+#
+# m1 -- sum of observed values of Y1 and Y2 (Y1 + Y2)
+#
+# output:
+#
+# pi -- Pr(Y1 = x | Y1 + Y2 = m1) x=ll,...,uu
+#
+# for ll = max(0, m1-n2) and uu = min(n1, m1)
+#
+# if x is NA, then a matrix is returned, with the first column the possible
+# values of x, and the second columns the probabilities. if x is a scalar,
+# the density is evaluated at that point.
+#
+# ADM on 5/8/2003
+#
+# note: code adapted from R code published in conjunction with:
+#
+# Liao, J.G. And Rosen, O. (2001) Fast and Stable Algorithms for Computing and
+# Sampling from the Noncentral Hypergeometric Distribution. The American
+# Statistician 55, 366-369.
+#
+
+"dnoncenhypergeom" <-
+ function (x = NA, n1, n2, m1, psi) {
+
+ ##
+ ## AUXILIARY FUNCTIONS
+ ##
+
+ mode.compute <- function(n1, n2, m1, psi, ll, uu) {
+ a <- psi - 1
+ b <- -( (m1+n1+2)*psi + n2-m1 )
+ c <- psi*(n1+1)*(m1+1)
+ q <- b + sign(b)*sqrt(b*b-4*a*c)
+ q <- -q/2
+
+ mode <- trunc(c/q)
+ if(uu>=mode && mode>=ll) return(mode)
+ else return( trunc(q/a) )
+ }
+
+ r.function <- function(n1, n2, m1, psi, i) {
+ (n1-i+1)*(m1-i+1)/i/(n2-m1+i)*psi
+ }
+
+ ##
+ ## MAIN FUNCTION
+ ##
+
+ # upper and lower limits for density evaluation
+ ll <- max(0, m1-n2)
+ uu <- min(n1, m1)
+
+ # check parameters
+ if(n1 < 0 | n2 < 0) {
+ stop("n1 or n2 negative in dnoncenhypergeom().\n")
+ }
+ if(m1 < 0 | m1 > (n1 + n2)) {
+ stop("m1 out of range in dnoncenhypergeom().\n")
+ }
+ if(psi <=0) {
+ stop("psi [odds ratio] negative in dnoncenhypergeom().\n")
+ }
+ if(!is.na(x) & (x < ll | x > uu)) {
+ stop("x out of bounds in dnoncenhypergeom().\n")
+ }
+ if(!is.na(x) & length(x) > 1) {
+ stop("x neither missing or scalar in dnoncenhypergeom().\n")
+ }
+
+ # evaluate density using recursion (from mode)
+ mode <- mode.compute(n1, n2, m1, psi, ll, uu)
+ pi <- array(1, uu-ll+1)
+ shift <- 1-ll
+
+ if(mode<uu) { # note the shift of location
+ r1 <- r.function( n1, n2, m1, psi, (mode+1):uu )
+ pi[(mode+1 + shift):(uu + shift)] <- cumprod(r1)
+ }
+
+ if(mode>ll) {
+ r1 <- 1/r.function( n1, n2, m1, psi, mode:(ll+1) )
+ pi[(mode-1 + shift):(ll + shift)] <- cumprod(r1)
+ }
+
+ pi <- pi/sum(pi)
+ if(is.na(x)) return(cbind(ll:uu,pi))
+ else return(pi[x + shift])
+}
+
+# code to generate random deviates from the noncentral hypergeometric density
+#
+# parameters:
+#
+# n -- the number of draws to make
+#
+# n1, n2 -- number of subjects in group 1 and 2
+#
+# Y1, Y2 -- number of subjects with positive outcome [unobserved]
+#
+# psi -- odds ratio
+#
+# m1 -- sum of observed values of Y1 and Y2 (Y1 + Y2)
+#
+# output:
+#
+# output -- a list of length n of random deviates
+#
+#
+# ADM on 5/9/2003
+#
+# note: code adapted from R code published in conjunction with:
+#
+# Liao, J.G. And Rosen, O. (2001) Fast and Stable Algorithms for Computing and
+# Sampling from the Noncentral Hypergeometric Distribution. The American
+# Statistician 55, 366-369.
+#
+
+"rnoncenhypergeom" <-
+ function (n, n1, n2, m1, psi) {
+
+ ##
+ ## AUXILIARY FUNCTIONS
+ ##
+
+ mode.compute <- function(n1, n2, m1, psi, ll, uu) {
+ a <- psi - 1
+ b <- -( (m1+n1+2)*psi + n2-m1 )
+ c <- psi*(n1+1)*(m1+1)
+ q <- b + sign(b)*sqrt(b*b-4*a*c)
+ q <- -q/2
+
+ mode <- trunc(c/q)
+ if(uu>=mode && mode>=ll) return(mode)
+ else return( trunc(q/a) )
+
+ }
+
+ sample.low.to.high <- function(lower.end, ran, pi, shift) {
+ for(i in lower.end:uu) {
+ if(ran <= pi[i+shift]) return(i)
+ ran <- ran - pi[i+shift]
+ }
+ }
+
+ sample.high.to.low <- function(upper.end, ran, pi, shift) {
+ for(i in upper.end:ll) {
+ if(ran <= pi[i+shift]) return(i)
+ ran <- ran - pi[i+shift]
+ }
+ }
+
+ single.draw <- function(n1, n2, m1, psi, ll, uu, mode, pi) {
+ ran <- runif(1)
+ shift <- 1-ll
+ if(mode==ll) return(sample.low.to.high(ll, ran, pi, shift))
+ if(mode==uu) return(sample.high.to.low(uu, ran, pi, shift))
+ if(ran < pi[mode+shift]) return(mode)
+ ran <- ran - pi[mode+shift]
+ lower <- mode - 1
+ upper <- mode + 1
+
+ repeat {
+ if(pi[upper + shift] >= pi[lower + shift]) {
+ if(ran < pi[upper+shift]) return(upper)
+ ran <- ran - pi[upper+shift]
+ if(upper == uu) return( sample.high.to.low(lower, ran, pi, shift) )
+ upper <- upper + 1
+ }
+ else {
+ if(ran < pi[lower+shift]) return(lower)
+ ran <- ran - pi[lower+shift]
+ if(lower == ll) return( sample.low.to.high(upper, ran, pi, shift) )
+ lower <- lower - 1
+ }
+ }
+ }
+
+ ##
+ ## MAIN FUNCTION
+ ##
+
+ # upper and lower limits for density evaluation
+ ll <- max(0, m1-n2)
+ uu <- min(n1, m1)
+
+ # check parameters
+ if(n1 < 0 | n2 < 0) {
+ stop("n1 or n2 negative in rnoncenhypergeom().\n")
+ }
+ if(m1 < 0 | m1 > (n1 + n2)) {
+ stop("m1 out of range in rnoncenhypergeom().\n")
+ }
+ if(psi <=0) {
+ stop("psi [odds ratio] negative in rnoncenhypergeom().\n")
+ }
+
+
+ # get density and other parameters
+ mode <- mode.compute(n1, n2, m1, psi, ll, uu)
+ pi <- dnoncenhypergeom(NA, n1, n2, m1, psi)[,2]
+
+ output <- array(0,n)
+ for(i in 1:n) output[i] <- single.draw(n1, n2, m1, psi, ll, uu, mode, pi)
+ return(output)
+ }
diff --git a/R/hidden.R b/R/hidden.R
new file mode 100644
index 0000000..9db2bac
--- /dev/null
+++ b/R/hidden.R
@@ -0,0 +1,709 @@
+########## hidden functions to help in model implementation ##########
+
+## NOTE: these are not exported to the user and should always be
+## used in model functions. As such, fixing problems here
+## fixes them in all functions simultaneously.
+##
+## updated by ADM 7/22/04
+## re-organized (alphabetical) by adm 7/28/04
+
+## create an agreement score matrix from a vote matrix
+## subjects initially on rows and items on cols of X
+"agree.mat" <- function(X){
+ X <- t(X) # put subjects on columns
+ n <- ncol(X)
+ X[is.na(X)] <- -999
+ A <- matrix(NA, n, n)
+ for (i in 1:n){
+ A[i,] <- apply(X[,i] == X, 2, sum)
+ }
+ return(A/nrow(X))
+}
+
+## create constraints for measurement models
+"build.factor.constraints" <-
+ function(lambda.constraints, X, K, factors){
+
+ ## build initial constraint matrices and assign var names
+ Lambda.eq.constraints <- matrix(NA, K, factors)
+ Lambda.ineq.constraints <- matrix(0, K, factors)
+ if (is.null(colnames(X))){
+ X.names <- paste("V", 1:ncol(X), sep="")
+ }
+ else {
+ X.names <- colnames(X)
+ }
+ rownames(Lambda.eq.constraints) <- X.names
+ rownames(Lambda.ineq.constraints) <- X.names
+
+ ## setup the equality and inequality contraints on Lambda
+ if (length(lambda.constraints) != 0){
+ constraint.names <- names(lambda.constraints)
+ for (i in 1:length(constraint.names)){
+ name.i <- constraint.names[i]
+ lambda.constraints.i <- lambda.constraints[[i]]
+ col.index <- lambda.constraints.i[[1]]
+ replace.element <- lambda.constraints.i[[2]]
+ if (is.numeric(replace.element)){
+ Lambda.eq.constraints[rownames(Lambda.eq.constraints)==name.i,
+ col.index] <- replace.element
+ }
+ if (replace.element=="+"){
+ Lambda.ineq.constraints[rownames(Lambda.ineq.constraints)==name.i,
+ col.index] <- 1
+ }
+ if (replace.element=="-"){
+ Lambda.ineq.constraints[rownames(Lambda.ineq.constraints)==name.i,
+ col.index] <- -1
+ }
+ }
+ }
+
+ testmat <- Lambda.ineq.constraints * Lambda.eq.constraints
+
+ if (min(is.na(testmat))==0){
+ if ( min(testmat[!is.na(testmat)]) < 0){
+ cat("Constraints on factor loadings are logically inconsistent.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+ }
+ Lambda.eq.constraints[is.na(Lambda.eq.constraints)] <- -999
+
+ return( list(Lambda.eq.constraints, Lambda.ineq.constraints, X.names))
+ }
+
+# return name of the calling function
+"calling.function" <-
+ function(parentheses=TRUE) {
+ calling.function <- strsplit(toString(sys.call(which=-3)),",")[[1]][1]
+ if (parentheses){
+ calling.function <- paste(calling.function, "()", sep="")
+ }
+ return(calling.function)
+ }
+
+# check inverse Gamma prior
+"check.ig.prior" <-
+ function(c0, d0) {
+
+ if(c0 <= 0) {
+ cat("Error: IG(c0/2,d0/2) prior c0 less than or equal to zero.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+ if(d0 <= 0) {
+ cat("Error: IG(c0/2,d0/2) prior d0 less than or equal to zero.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+ return(0)
+ }
+
+# check mcmc parameters
+"check.mcmc.parameters" <-
+ function(burnin, mcmc, thin) {
+
+ if(mcmc %% thin != 0) {
+ cat("Error: MCMC iterations not evenly divisible by thinning interval.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if(mcmc < 0) {
+ cat("Error: MCMC iterations negative.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if(burnin < 0) {
+ cat("Error: Burnin iterations negative.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if(thin < 0) {
+ cat("Error: Thinning interval negative.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ return(0)
+ }
+
+# check to see if an offset is passed
+"check.offset" <-
+ function(args) {
+ if(sum(names(args)=="offset")==1) {
+ cat("Error: Offsets are currently not supported in MCMCpack.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+ return(0)
+ }
+
+# put together starting values for coefficients
+# NOTE: This can be used for any GLM model by passing the right family
+# or for another model by passing default starting values to
+# the function
+"coef.start" <-
+ function(beta.start, K, formula, family, data, defaults=NA) {
+
+ if (is.na(beta.start)[1] & is.na(defaults)[1]){ # use GLM estimates
+ beta.start <- matrix(coef(glm(formula, family=family, data=data)), K, 1)
+ }
+ else if(is.na(beta.start)[1] & !is.na(defaults)[1]){ # use passed values
+ beta.start <- matrix(defaults,K,1)
+ }
+ else if(is.null(dim(beta.start))) {
+ beta.start <- beta.start * matrix(1,K,1)
+ }
+ else if(!all(dim(beta.start) == c(K,1))) {
+ cat("Error: Starting value for beta not conformable.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+ return(beta.start)
+ }
+
+## generate starting values for a factor loading matrix
+"factload.start" <-
+ function(lambda.start, K, factors, Lambda.eq.constraints,
+ Lambda.ineq.constraints){
+
+ Lambda <- matrix(0, K, factors)
+ if (is.na(lambda.start)){# sets Lambda to equality constraints & 0s
+ for (i in 1:K){
+ for (j in 1:factors){
+ if (Lambda.eq.constraints[i,j]==-999){
+ if(Lambda.ineq.constraints[i,j]==0){
+ Lambda[i,j] <- 0
+ }
+ if(Lambda.ineq.constraints[i,j]>0){
+ Lambda[i,j] <- .5
+ }
+ if(Lambda.ineq.constraints[i,j]<0){
+ Lambda[i,j] <- -.5
+ }
+ }
+ else Lambda[i,j] <- Lambda.eq.constraints[i,j]
+ }
+ }
+ }
+ else if (is.matrix(lambda.start)){
+ if (nrow(lambda.start)==K && ncol(lambda.start)==factors)
+ Lambda <- lambda.start
+ else {
+ cat("lambda.start not of correct size for model specification.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+ }
+ else if (length(lambda.start)==1 && is.numeric(lambda.start)){
+ Lambda <- matrix(lambda.start, K, factors)
+ for (i in 1:K){
+ for (j in 1:factors){
+ if (Lambda.eq.constraints[i,j] != -999)
+ Lambda[i,j] <- Lambda.eq.constraints[i,j]
+ }
+ }
+ }
+ else {
+ cat("lambda.start neither NA, matrix, nor scalar.\n")
+ stop("Please respecify and call ", calling.function, " again.\n")
+ }
+
+ return(Lambda)
+ }
+
+
+
+
+## based on code originally written by Keith Poole
+## takes a subject by subject agreement score matrix as input
+"factor.score.eigen.start" <- function(A, factors){
+
+ AA <- A
+ arow <- matrix(NA, nrow(A), 1)
+ acol <- matrix(NA, ncol(A), 1)
+
+ for (i in 1:nrow(A)){
+ arow[i] <- mean(A[i,])
+ }
+ for (i in 1:ncol(A)){
+ acol[i] <- mean(A[,i])
+ }
+
+ matrixmean <- mean(acol)
+
+ for (i in 1:nrow(A)){
+ for (j in 1:ncol(A)){
+ AA[i,j] <- (A[i,j]-arow[i]-acol[j]+matrixmean)/(2)
+ }
+ }
+
+ ev <- eigen(AA)
+ scores <- matrix(NA, nrow(A), factors)
+ for (i in 1:factors){
+ scores[,i] <- ev$vec[,i]*sqrt(ev$val[i])
+ scores[,i] <- (scores[,i] - mean(scores[,i]))/sd(scores[,i])
+ }
+ return(scores)
+}
+
+
+## check starting values of factor scores or ability parameters
+## subjects on rows of X
+"factor.score.start.check" <- function(theta.start, X, prior.mean,
+ prior.prec, eq.constraints,
+ ineq.constraints, factors){
+
+ N <- nrow(X)
+
+ ## set value of theta.start
+ if (is.na(theta.start)) {
+ theta.start <- factor.score.eigen.start(agree.mat(X), 1)
+ for (i in 1:factors){
+ theta.start[,i] <- prior.mean[i] + theta.start[,i] *
+ sqrt(1/prior.prec[i,i])
+ }
+ }
+ else if(is.numeric(theta.start) && is.null(dim(theta.start))) {
+ theta.start <- theta.start * matrix(1, N, 1)
+ }
+ else if((dim(theta.start)[1] != N) ||
+ (dim(theta.start)[2] != factors)) {
+ cat("Starting value for theta not appropriately sized.\n")
+ stop("Please respecify and call", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+ else {
+ cat("Inappropriate value of theta.start passed.\n")
+ stop("Please respecify and call", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+
+ ## check value of theta.start
+ prev.bind.constraints <- rep(0, factors)
+ for (i in 1:N){
+ for (j in 1:factors){
+ if (eq.constraints[i,j]==-999){
+ if(ineq.constraints[i,j]>0 && theta.start[i,j] < 0){
+ if (prev.bind.constraints[j]==0){
+ theta.start[,j] <- -1*theta.start[,j]
+ }
+ else {
+ cat("Parameter constraints logically inconsistent.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ prev.bind.constraints[j] <- prev.bind.constraints[j] + 1
+ }
+ if(ineq.constraints[i,j]<0 && theta.start[i,j] > 0){
+ if (prev.bind.constraints[j]==0){
+ theta.start[,j] <- -1*theta.start[,j]
+ }
+ else {
+ cat("Parameter constraints logically inconsistent.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ prev.bind.constraints[j] <- prev.bind.constraints[j] + 1
+ }
+ }
+ else {
+ if ((theta.start[i,j] * eq.constraints[i,j]) > 0){
+ theta.start[i,j] <- eq.constraints[i,j]
+ }
+ else {
+ if (prev.bind.constraints[j]==0){
+ theta.start[,j] <- -1*theta.start[,j]
+ theta.start[i,j] <- eq.constraints[i,j]
+ }
+ else {
+ cat("Parameter constraints logically inconsistent.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ prev.bind.constraints[j] <- prev.bind.constraints[j] + 1
+ }
+ }
+ }
+ }
+ return(theta.start)
+}
+
+## get starting values for factor uniqueness matrix (Psi)
+"factuniqueness.start" <-
+ function(psi.start, X){
+
+ K <- ncol(X)
+ if (is.na(psi.start)){
+ Psi <- 0.5 * diag(diag(var(X)))
+ }
+ else if (is.double(psi.start) &&
+ (length(psi.start==1) || length(psi.start==K))){
+ Psi <- diag(K) * psi.start
+ }
+ else {
+ cat("psi.start neither NA, double. nor appropriately sized matrix.\n")
+ stop("Please respecify and call ", calling.function, " again.\n")
+ }
+ if (nrow(Psi) != K || ncol(Psi) != K){
+ cat("Psi starting value not K by K matrix.\n")
+ stop("Please respecify and call ", calling.function, " again.\n")
+ }
+
+ return(Psi)
+ }
+
+
+## form the ind. normal prior for a factor loading matrix
+"form.factload.norm.prior" <-
+ function(l0, L0, K, factors, X.names){
+
+ ## prior means
+ if (is.matrix(l0)){ # matrix input for l0
+ if (nrow(l0)==K && ncol(l0)==factors){
+ Lambda.prior.mean <- l0
+ rownames(Lambda.prior.mean) <- X.names
+ }
+ else {
+ cat("l0 not of correct size for model specification.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+ }
+ else if (is.list(l0)){ # list input for l0
+ Lambda.prior.mean <- matrix(0, K, factors)
+ rownames(Lambda.prior.mean) <- X.names
+ l0.names <- names(l0)
+ for (i in 1:length(l0.names)){
+ name.i <- l0.names[i]
+ l0.i <- l0[[i]]
+ col.index <- l0.i[[1]]
+ replace.element <- l0.i[[2]]
+ if (is.numeric(replace.element)){
+ Lambda.prior.mean[rownames(Lambda.prior.mean)==name.i,
+ col.index] <- replace.element
+ }
+ }
+ }
+ else if (length(l0)==1 && is.numeric(l0)){ # scalar input for l0
+ Lambda.prior.mean <- matrix(l0, K, factors)
+ rownames(Lambda.prior.mean) <- X.names
+ }
+ else {
+ cat("l0 neither matrix, list, nor scalar.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+
+ ## prior precisions
+ if (is.matrix(L0)){ # matrix input for L0
+ if (nrow(L0)==K && ncol(L0)==factors){
+ Lambda.prior.prec <- L0
+ rownames(Lambda.prior.prec) <- X.names
+ }
+ else {
+ cat("L0 not of correct size for model specification.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+ }
+ else if (is.list(L0)){ # list input for L0
+ Lambda.prior.prec <- matrix(0, K, factors)
+ rownames(Lambda.prior.prec) <- X.names
+ L0.names <- names(L0)
+ for (i in 1:length(L0.names)){
+ name.i <- L0.names[i]
+ L0.i <- L0[[i]]
+ col.index <- L0.i[[1]]
+ replace.element <- L0.i[[2]]
+ if (is.numeric(replace.element)){
+ Lambda.prior.prec[rownames(Lambda.prior.prec)==name.i,
+ col.index] <- replace.element
+ }
+ }
+ }
+ else if (length(L0)==1 && is.numeric(L0)){ # scalar input for L0
+ Lambda.prior.prec <- matrix(L0, K, factors)
+ rownames(Lambda.prior.prec) <- X.names
+ }
+ else {
+ cat("L0 neither matrix, list, nor scalar.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+ if (min(Lambda.prior.prec) < 0) {
+ cat("L0 contains negative elements.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+
+
+ return( list(Lambda.prior.mean, Lambda.prior.prec))
+ }
+
+## form ind. inv. gamma prior for a diagonal var. cov. matrix
+"form.ig.diagmat.prior" <-
+ function(a0, b0, K){
+
+ ## setup prior for diag(Psi)
+ if (length(a0)==1 && is.double(a0))
+ a0 <- matrix(a0, K, 1)
+ else if (length(a0) == K && is.double(a0))
+ a0 <- matrix(a0, K, 1)
+ else {
+ cat("a0 not properly specified.\n")
+ stop("Please respecify and call ", calling.function, " again.\n")
+ }
+ if (length(b0)==1 && is.double(b0))
+ b0 <- matrix(b0, K, 1)
+ else if (length(b0) == K && is.double(b0))
+ b0 <- matrix(b0, K, 1)
+ else {
+ cat("b0 not properly specified.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+
+ ## prior for Psi error checking
+ if(min(a0) <= 0) {
+ cat("IG(a0/2,b0/2) prior parameter a0 less than or equal to zero.\n")
+ stop("Please respecify and call ", calling.function, " again.\n")
+ }
+ if(min(b0) <= 0) {
+ cat("IG(a0/2,b0/2) prior parameter b0 less than or equal to zero.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+
+ return(list(a0, b0) )
+ }
+
+# pull together the posterior density sample
+"form.mcmc.object" <-
+ function(posterior.object, names, title) {
+ holder <- matrix(posterior.object$sampledata,
+ posterior.object$samplerow,
+ posterior.object$samplecol,
+ byrow=TRUE)
+
+ output <- mcmc(data=holder, start=1,
+ end=posterior.object$mcmc,
+ thin=posterior.object$thin)
+ varnames(output) <- names
+ attr(output,"title") <- title
+ return(output)
+ }
+
+# form multivariate Normal prior
+"form.mvn.prior" <-
+ function(b0, B0, K) {
+
+ # prior mean
+ if(is.null(dim(b0))) {
+ b0 <- b0 * matrix(1,K,1)
+ }
+ if((dim(b0)[1] != K) || (dim(b0)[2] != 1)) {
+ cat("Error: N(b0,B0^-1) prior b0 not conformable.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+
+ # prior precision
+ if(is.null(dim(B0))) {
+ B0 <- B0 * diag(K)
+ }
+ if((dim(B0)[1] != K) || (dim(B0)[2] != K)) {
+ cat("Error: N(b0,B0^-1) prior B0 not conformable.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+ return(list(b0,B0))
+ }
+
+# parse the passed seeds
+# 1] if a scalar is passed, it is used by Mersennse twister
+# 2] if a list of length two is passed, a parallel-friendly stream is
+# created using L'Ecuyer
+"form.seeds" <-
+ function(seed) {
+ if(length(seed)==1) {
+ if(is.na(seed)) seed <- 12345
+ seed <- as.integer(seed)
+ if(seed < 0) {
+ cat("Error: Mersenne seed negative.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ seeds <- list(0, rep(seed,6), 0)
+ }
+ if(length(seed)==2) {
+ if(!is.list(seed)) {
+ cat("Error: List must be passed to use L'Ecuyer.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ lec.seed <- seed[[1]]
+ lec.substream <- as.integer(seed[[2]])
+ if(is.na(lec.seed[1])) lec.seed <- rep(12345, 6)
+ if(length(lec.seed) != 6) {
+ cat("Error: L'Ecuyer seed not of length six.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if(!all(lec.seed >= 0)) {
+ cat("Error: At least one L'Ecuyer seed negative.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if( max(lec.seed[1:3]) >= 4294967087){
+ cat("Error: At least one of first three L'Ecuyer seeds\n")
+ cat(" greater than or equal to 4294967087\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if( all(lec.seed[1:3]) == 0 ){
+ cat("Error: first three L'Ecuyer seeds == 0\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if( max(lec.seed[4:6]) >= 4294944443){
+ cat("Error: At least one of last three L'Ecuyer seeds\n")
+ cat(" greater than or equal to 4294944443\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if( all(lec.seed[4:6]) == 0 ){
+ cat("Error: last three L'Ecuyer seeds == 0\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if(lec.substream < 1) {
+ cat("Error: L'Ecuyer substream number not positive.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ seeds <- list(1, lec.seed, lec.substream)
+ }
+ if(length(seed)>2) {
+ cat("Error: Seed passed as length greater than two.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ return(seeds)
+ }
+
+# form Wishart prior
+"form.wishart.prior" <-
+ function(v, S, K) {
+
+ # check to see if degrees of freedom produces proper prior
+ if(v < K) {
+ cat("Error: Wishart(v,S) prior v less than or equal to K.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+
+ # form the prior scale matrix
+ if(is.null(dim(S))) {
+ S <- S * diag(K)
+ }
+ if((dim(S)[1] != K) | (dim(S)[2] != K)) {
+ cat("Error: Wishart(v,S) prior S not comformable [K times K].\n")
+ stop("Please respecify and call ", calling.function(), " again.\n")
+ }
+
+ return(list(v,S))
+}
+
+# parse formula and return a list that contains the model response
+# matrix as element one, and the model matrix as element two
+"parse.formula" <-
+ function(formula, data, intercept=TRUE, justX=FALSE) {
+
+ # extract Y, X, and variable names for model formula and frame
+ mt <- terms(formula, data=data)
+ if(missing(data)) data <- sys.frame(sys.parent())
+ mf <- match.call(expand.dots = FALSE)
+ mf$intercept <- mf$justX <- NULL
+ mf$drop.unused.levels <- TRUE
+ mf[[1]] <- as.name("model.frame")
+ mf <- eval(mf, sys.frame(sys.parent()))
+ if (!intercept){
+ attributes(mt)$intercept <- 0
+ }
+
+ # null model support
+ X <- if (!is.empty.model(mt)) model.matrix(mt, mf, contrasts)
+ X <- as.matrix(X) # X matrix
+ xvars <- dimnames(X)[[2]] # X variable names
+ xobs <- dimnames(X)[[1]] # X observation names
+ if (justX){
+ Y <- NULL
+ }
+ else {
+ Y <- as.matrix(model.response(mf, "numeric")) # Y matrix
+ }
+ return(list(Y, X, xvars, xobs))
+ }
+
+# setup tuning constant for scalar parameter
+"scalar.tune" <- function(mcmc.tune){
+ if (max(is.na(mcmc.tune))){
+ cat("Error: Scalar tuning parameter cannot contain NAs.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if (length(mcmc.tune) != 1){
+ cat("Error: Scalar tuning parameter does not have length = 1.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if (mcmc.tune <= 0) {
+ cat("Error: Scalar tuning parameter not positive.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ return(mcmc.tune)
+}
+
+# put together starting values for sigma2
+"sigma2.start" <-
+ function(sigma2.start, formula, data) {
+
+ if(is.na(sigma2.start)){ # use MLE
+ lm.out <- lm(formula, data=data)
+ sigma2.start <- var(residuals(lm.out))
+ }
+ else if(sigma2.start <= 0) {
+ cat("Error: Starting value for sigma2 negative.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+ else if (length(sigma2.start) != 1){
+ cat("Error: Starting value for sigma2 not a scalar.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+ else if (!is.numeric(sigma2.start)){
+ cat("Error: Starting value for sigma2 neither numeric nor NA.\n")
+ stop("Please respecify and call ", calling.function(), " again.\n",
+ call.=FALSE)
+ }
+ return(sigma2.start)
+ }
+
+
+
+
+## setup diagonal tuning matrix for vector parameters
+"vector.tune" <- function(mcmc.tune, K){
+ if (max(is.na(mcmc.tune))){
+ cat("Error: Vector tuning parameter cannot contain NAs.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if (length(mcmc.tune) == 1){
+ mcmc.tune <- rep(mcmc.tune, K)
+ }
+ if (length(mcmc.tune) != K){
+ cat("Error: length(vector tuning parameter) != length(theta) or 1.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ if (sum(mcmc.tune <= 0) != 0) {
+ cat("Error: Vector tuning parameter cannot contain negative values.\n")
+ stop("Please respecify and call ", calling.function(), " again.",
+ call.=FALSE)
+ }
+ return(diag(as.double(mcmc.tune)))
+}
+
diff --git a/R/scythe.R b/R/scythe.R
new file mode 100644
index 0000000..574989d
--- /dev/null
+++ b/R/scythe.R
@@ -0,0 +1,55 @@
+########## Scythe Inter-Operation Functions ##########
+
+
+# writes a matrix out to an ASCII file that can be read by Scythe.
+# it puts the number of rows and columns in the first row
+# followed by the data.
+#
+# ADM 1/29/2003
+
+"write.Scythe" <-
+ function(outmatrix, outfile = NA, overwrite=FALSE) {
+ outmatrix <- as.matrix(outmatrix)
+
+ if(is.na(outfile)) {
+ stop("Please specify a file name in the write.Scythe() call.\n")
+ }
+ if(overwrite==FALSE & file.exists(outfile)) {
+ cat("File already exists in the write.Scythe() call.\n")
+ stop("Either delete the file, or flip the overwrite switch.\n")
+ }
+
+ outfile <- file(outfile, "w")
+ cat(dim(outmatrix), "\n", file=outfile)
+ write.table(outmatrix, file=outfile,
+ row.names=FALSE, col.names=FALSE, quote=FALSE)
+ close(outfile)
+ return(0)
+ }
+
+
+# reads in a matrix from an ASCII file written by Scythe.
+# the number of rows and columns should be in the first row followed
+# by the data.
+#
+# Kevin Rompala 5/1/2003
+# fixed by ADM 7/25/2004
+
+"read.Scythe" <-
+ function(infile = NA) {
+
+ if(is.na(infile)) {
+ stop("Please specify a file name in the read.Scythe() call.\n")
+ }
+ if(!file.exists(infile)) {
+ stop("Specified source file does not exist in read.Scythe() call.\n")
+ }
+
+ infile <- file(infile, "r")
+ dimensions <- scan(file=infile,n=2)
+ inputdata <- scan(file=infile)
+ close(infile)
+ hold <- matrix(data=inputdata,
+ nrow=dimensions[1], ncol=dimensions[2], byrow=TRUE)
+ return(hold)
+ }
diff --git a/R/tomog.R b/R/tomog.R
new file mode 100644
index 0000000..7a65166
--- /dev/null
+++ b/R/tomog.R
@@ -0,0 +1,115 @@
+########## Tomography Plots for Ecological Inference ##########
+
+# produces tomography plots (see King, 1997, A Solution to the
+# Ecological Inference Problem, Princeton University Press)
+#
+# KQ 11/9/2002
+
+"tomogplot" <-
+ function(r0, r1, c0, c1,
+ xlab="fraction of r0 in c0 (p0)",
+ ylab="fraction of r1 in c0 (p1)",
+ bgcol="white", ...) {
+ if (length(r0) != length(r1)) {
+ stop("r0 and r1 different lengths in tomogplot().\n")
+ }
+ if (length(r0) != length(c0)) {
+ stop("r0 and c0 different lengths in tomogplot().\n")
+ }
+ if (length(r0) != length(c1)) {
+ stop("r0 and c1 different lengths in tomogplot().\n")
+ }
+
+ intercept <- c0/r1
+ slope <- -1 * r0/r1
+ N <- length(r0)
+
+ par(pty="s")
+ plot(0:1, 0:1, type="n", main="", xlab=xlab, ylab=ylab)
+ rect(0, 0, 1, 1, col=bgcol, lty=0)
+
+ for (year in 1:N) {
+ abline(intercept[year], slope[year])
+ }
+
+ rect(-0.05, -0.05, 1.05, 0, col="white", lty=0)
+ rect(-0.05, -0.05, 0, 1.05, col="white", lty=0)
+ rect(-0.05, 1, 1.05, 1.05, col="white", lty=0)
+ rect(1, -0.05, 1.05, 1.05, col="white", lty=0)
+ box()
+ par(pty="m")
+ return(0)
+ }
+
+# produces temporally organized tomography plots
+# (see King, 1997, A Solution to the Ecological Inference
+# Problem, Princeton University Press)
+#
+# KQ 11/9/2002
+
+"dtomogplot" <-
+ function(r0, r1, c0, c1, time.vec=NA, delay=0,
+ xlab="fraction of r0 in c0 (p0)",
+ ylab="fraction of r1 in c0 (p1)",
+ color.palette=heat.colors,
+ bgcol="black", ...) {
+ if (length(r0) != length(r1)){
+ stop("r0 and r1 different lengths in dtomogplot().\n")
+ }
+ if (length(r0) != length(c0)){
+ stop("r0 and c0 different lengths in dtomogplot().\n")
+ }
+ if (length(r0) != length(c1)){
+ stop("r0 and c1 different lengths in dtomogplot().\n")
+ }
+ if (length(r0) != length(time.vec) & !is.na(time.vec)[1]){
+ stop("r0 and time.vec different lengths in dtomogplot().\n")
+ }
+
+ intercept <- c0/r1
+ slope <- -1 * r0/r1
+ N <- length(r0)
+ if (is.na(time.vec)[1])
+ time.vec <- 1:N
+ col.vec <- color.palette(N)
+
+ mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
+ on.exit(par(par.orig))
+ w <- (3 + mar.orig[2]) * par("csi") * 2.54
+ layout(matrix(c(2,1), nc=2), widths=c(1,lcm(w)))
+ par(las=1)
+ mar <- mar.orig
+ mar[4] <- mar[2]
+ mar[2] <- 1
+ par(mar=mar)
+ par(pty="m")
+ plot.new()
+ plot.window(xlim=c(0,1), ylim=range(time.vec), xaxs="i",
+ yaxs="i")
+ rect(0, time.vec[-length(time.vec)], 1, time.vec[-1], col=col.vec)
+ axis(4)
+ box()
+ mar <- mar.orig
+ mar[4] <- 1
+ par(mar=mar)
+ par(pty="s")
+ plot(0:1, 0:1, type="n", main="", xlab=xlab, ylab=ylab)
+ rect(0, 0, 1, 1, col=bgcol, lty=0)
+
+ for (year in 1:N) {
+ time.last <- proc.time()[3]
+ time.next <- proc.time()[3]
+ while ( (time.next - time.last) < delay ){
+ time.next <- proc.time()[3]
+ }
+ abline(intercept[year], slope[year], col=col.vec[year])
+ }
+
+ rect(-0.05, -0.05, 1.05, 0, col="white", lty=0)
+ rect(-0.05, -0.05, 0, 1.05, col="white", lty=0)
+ rect(-0.05, 1, 1.05, 1.05, col="white", lty=0)
+ rect(1, -0.05, 1.05, 1.05, col="white", lty=0)
+ box()
+ par(pty="m")
+ return(0)
+ }
diff --git a/R/utility.R b/R/utility.R
new file mode 100644
index 0000000..425f011
--- /dev/null
+++ b/R/utility.R
@@ -0,0 +1,34 @@
+########## Utility Functions ##########
+
+# takes a symmetric matrix x and returns lower diagonal
+# note: does not check for symmetry
+#
+# ADM 4/18/2003
+
+"vech" <-
+ function (x) {
+ x <- as.matrix(x)
+ if (dim(x)[1] != dim(x)[2]) {
+ stop("Non-square matrix passed to vech().\n")
+ }
+ output <- x[lower.tri(x, diag = TRUE)]
+ dim(output) <- NULL
+ return(output)
+ }
+
+# takes vector x and returns an nrow times nrow symmetric matrix
+# this will recycle the elements of x as needed to fill the matrix
+#
+# ADM 4/18/2003
+# ADM 11/13/2003 [bug fix]
+
+"xpnd" <-
+ function (x, nrow) {
+ dim(x) <- NULL
+ output <- matrix(0, nrow, nrow)
+ output[lower.tri(output, diag = TRUE)] <- x
+ hold <- output
+ hold[upper.tri(hold, diag=TRUE)] <- 0
+ output <- output + t(hold)
+ return(output)
+ }
diff --git a/R/zzz.R b/R/zzz.R
new file mode 100644
index 0000000..1c8f07f
--- /dev/null
+++ b/R/zzz.R
@@ -0,0 +1,12 @@
+.onAttach <- function(...) {
+ cat("##\n## Markov Chain Monte Carlo Package (MCMCpack)\n")
+ cat("## Copyright (C) 2003, 2004, Andrew D. Martin and Kevin M. Quinn\n")
+ cat("##\n## Support provided by the U.S. National Science Foundation\n")
+ cat("## (Grants SES-0350646 and SES-0350613)\n##\n")
+ require(coda, quietly=TRUE)
+ require(MASS, quietly=TRUE)
+}
+
+.onUnload <- function(libpath) {
+ library.dynam.unload("MCMCpack", libpath)
+}
diff --git a/README b/README
new file mode 100644
index 0000000..deb012e
--- /dev/null
+++ b/README
@@ -0,0 +1,77 @@
+//
+// MCMCpack, Version 0.5-2
+//
+
+Release Date: August 17, 2004
+
+This package contains functions for posterior simulation for a number of
+statistical models. All simulation is done in compiled C++ written in
+the Scythe Statistical Library Version 1.0. All models return coda mcmc
+objects that can then be summarized using coda functions or the coda
+menu interface. The package also contains some useful utility
+functions, including some additional density functions and pseudo-random
+number generators for statistical distributions, a general purpose Metropolis
+sampling algorithm, and tools for visualization.
+
+//
+// Authors
+//
+
+Andrew D. Martin <admartin at wustl.edu>
+Kevin M. Quinn <kquinn at latte.harvard.edu>
+
+//
+// Compilation
+//
+
+This package (along with Scythe) uses C++ and the Standard Template
+Library (STL). It requires use of the GCC compiler 3.0 or greater. It
+has been tested on GCC 3.1, 3.2, 3.3, and 3.4 on Linux and MacOS X.
+
+We have also successfully compiled this package for Windows using
+a MinGW cross-compiler using binutils 2.13, gcc 3.2, mingw
+runtime 2.2, and w32api 2.0. This is essentially the same setup
+described by Yan and Rossini (2002), except for more recent
+versions of the compiler to successfully handle the C++ issues
+noted above. Many thanks to Dan Pemstein for helping with the
+cross-compilation, and to Kurt Hornik and Fritz Leisch for their
+help with debugging and service to the R community.
+
+//
+// Acknowledgments
+//
+
+We gratefully acknowledge support from:
+
+* National Science Foundation, Program in Methodology, Measurement, and
+Statistics, Grants SES-0350646 and SES-0350613
+
+* Washington University, Department of Political Science and the
+Weidenbaum Center on the Economy, Government, and Public Policy
+http://wc.wustl.edu
+
+* Harvard University, Department of Government and the
+Center for Basic Research in the Social Sciences
+http://cbrss.harvard.edu}
+
+Neither the National Science Foundation, Washington University, or
+Harvard University bear any responsibility for the content of this
+package.
+
+Please contact Andrew D. Martin <admartin at wustl.edu> if
+you have any problems or questions.
+
+--
+Andrew D. Martin, Ph.D.
+Department of Political Science
+Washington University
+Campus Box 1063
+One Brookings Drive
+St. Louis, MO 63130
+(314) 935-5863 (Office)
+(314) 753-8377 (Cell)
+(314) 935-5856 (Fax)
+
+Office: Eliot Hall 326
+Email: admartin at wustl.edu
+WWW: http://adm.wustl.edu
diff --git a/cleanup b/cleanup
new file mode 100755
index 0000000..bc672f4
--- /dev/null
+++ b/cleanup
@@ -0,0 +1,3 @@
+#! /bin/sh
+rm -f config.log
+
diff --git a/config.status b/config.status
new file mode 100755
index 0000000..7826a67
--- /dev/null
+++ b/config.status
@@ -0,0 +1,712 @@
+#! /bin/sh
+# Generated by configure.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+SHELL=${CONFIG_SHELL-/bin/sh}
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+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
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+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
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ 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
+
+# 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
+
+
+ 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
+
+ # 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.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\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;}
+ { (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
+ # 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= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+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='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
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# 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'"
+
+# Sed expression to map a string onto a valid variable name.
+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
+# 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
+
+This file was extended by $as_me, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ CONFIG_FILES = $CONFIG_FILES
+ CONFIG_HEADERS = $CONFIG_HEADERS
+ CONFIG_LINKS = $CONFIG_LINKS
+ CONFIG_COMMANDS = $CONFIG_COMMANDS
+ $ $0 $@
+
+_CSEOF
+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+echo >&5
+config_files=" src/Makevars"
+
+ac_cs_usage="\
+\`$as_me' instantiates files from templates according to the
+current configuration.
+
+Usage: $0 [OPTIONS] [FILE]...
+
+ -h, --help print this help, then exit
+ -V, --version print version number, 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
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
+
+Configuration files:
+$config_files
+
+Report bugs to <bug-autoconf at gnu.org>."
+ac_cs_version="\
+config.status
+configured by ./configure, generated by GNU Autoconf 2.59,
+ with options \"\"
+
+Copyright (C) 2003 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=.
+# If no file are specified by the user, then we need to provide default
+# value. By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test $# != 0
+do
+ case $1 in
+ --*=*)
+ 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.
+ -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 )
+ 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;;
+ -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;}
+ { (exit 1); exit 1; }; } ;;
+
+ *) ac_config_targets="$ac_config_targets $1" ;;
+
+ esac
+ shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+ exec 6>/dev/null
+ ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+if $ac_cs_recheck; then
+ echo "running /bin/sh ./configure " $ac_configure_extra_args " --no-create --no-recursion" >&6
+ exec /bin/sh ./configure $ac_configure_extra_args --no-create --no-recursion
+fi
+
+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" ;;
+ *) { { 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
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+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,
+# creating and moving files from /tmp can sometimes cause problems.
+# Create a temporary directory, and hook for its removal unless debugging.
+$debug ||
+{
+ trap 'exit_status=$?; rm -rf $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` &&
+ test -n "$tmp" && test -d "$tmp"
+} ||
+{
+ tmp=./confstat$$-$RANDOM
+ (umask 077 && mkdir $tmp)
+} ||
+{
+ echo "$me: cannot create a temporary directory in ." >&2
+ { (exit 1); exit 1; }
+}
+
+
+#
+# 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@,/bin/sh,;t t
+s, at PATH_SEPARATOR@,:,;t t
+s, at PACKAGE_NAME@,,;t t
+s, at PACKAGE_TARNAME@,,;t t
+s, at PACKAGE_VERSION@,,;t t
+s, at PACKAGE_STRING@,,;t t
+s, at PACKAGE_BUGREPORT@,,;t t
+s, at exec_prefix@,${prefix},;t t
+s, at prefix@,/usr/local,;t t
+s, at program_transform_name@,s,x,x,,;t t
+s, at bindir@,${exec_prefix}/bin,;t t
+s, at sbindir@,${exec_prefix}/sbin,;t t
+s, at libexecdir@,${exec_prefix}/libexec,;t t
+s, at datadir@,${prefix}/share,;t t
+s, at sysconfdir@,${prefix}/etc,;t t
+s, at sharedstatedir@,${prefix}/com,;t t
+s, at localstatedir@,${prefix}/var,;t t
+s, at libdir@,${exec_prefix}/lib,;t t
+s, at includedir@,${prefix}/include,;t t
+s, at oldincludedir@,/usr/include,;t t
+s, at infodir@,${prefix}/info,;t t
+s, at mandir@,${prefix}/man,;t t
+s, at build_alias@,,;t t
+s, at host_alias@,,;t t
+s, at target_alias@,,;t t
+s, at DEFS@,-DPACKAGE_NAME=\"\" -DPACKAGE_TARNAME=\"\" -DPACKAGE_VERSION=\"\" -DPACKAGE_STRING=\"\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_TRUNC=1 ,;t t
+s, at ECHO_C@,,;t t
+s, at ECHO_N@,-n,;t t
+s, at ECHO_T@,,;t t
+s, at LIBS@,,;t t
+s, at CXX@,g++,;t t
+s, at CXXFLAGS@,-g -O2,;t t
+s, at LDFLAGS@,,;t t
+s, at CPPFLAGS@,,;t t
+s, at ac_ct_CXX@,,;t t
+s, at EXEEXT@,,;t t
+s, at OBJEXT@,o,;t t
+s, at CC@,gcc,;t t
+s, at CFLAGS@,-g -O2,;t t
+s, at ac_ct_CC@,gcc,;t t
+s, at CPP@,gcc -E,;t t
+s, at EGREP@,grep -E,;t t
+s, at MV_HAVE_IEEEFP_H@,,;t t
+s, at MV_HAVE_TRUNC@,-DHAVE_TRUNC,;t t
+s, at LIBOBJS@,,;t t
+s, at LTLIBOBJS@,,;t t
+CEOF
+
+ # 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
+ fi
+fi # test -n "$CONFIG_FILES"
+
+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 ;;
+ esac
+
+ # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ 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"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ 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'`
+ 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;}
+ { (exit 1); exit 1; }; }; }
+
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ 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
+
+case $srcdir in
+ .) # No --srcdir option. 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_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;;
+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
+
+
+
+ # 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; }
+
+ 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
+ sed "/^[ ]*VPATH[ ]*=/{
+s/:*\$(srcdir):*/:/;
+s/:*\${srcdir}:*/:/;
+s/:*@srcdir@:*/:/;
+s/^\([^=]*=[ ]*\):*/\1/;
+s/:*$//;
+s/^[^=]*=[ ]*$//;
+}
+
+: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
+
+done
+
+{ (exit 0); exit 0; }
diff --git a/configure b/configure
new file mode 100755
index 0000000..10a7769
--- /dev/null
+++ b/configure
@@ -0,0 +1,4253 @@
+#! /bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.59.
+#
+# Copyright (C) 2003 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
+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
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+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
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ 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
+
+# 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
+
+
+ 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: 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
+
+ # 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.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$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
+ # 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= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+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='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
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# 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'"
+
+# Sed expression to map a string onto a valid variable name.
+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
+
+
+# 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_config_libobj_dir=.
+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=
+PACKAGE_VERSION=
+PACKAGE_STRING=
+PACKAGE_BUGREPORT=
+
+ac_unique_file="DESCRIPTION"
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#if HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#if HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#if STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# if HAVE_STDLIB_H
+# include <stdlib.h>
+# endif
+#endif
+#if HAVE_STRING_H
+# if !STDC_HEADERS && HAVE_MEMORY_H
+# include <memory.h>
+# endif
+# include <string.h>
+#endif
+#if HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+# include <stdint.h>
+# endif
+#endif
+#if 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_files=''
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# 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.
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+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'
+
+ac_prev=
+for ac_option
+do
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case $ac_option in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir=$ac_optarg ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build_alias ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build_alias=$ac_optarg ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file=$ac_optarg ;;
+
+ --config-cache | -C)
+ cache_file=config.cache ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir=$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 &&
+ { 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" ;;
+
+ -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 &&
+ { 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'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix=$ac_optarg ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he | -h)
+ ac_init_help=long ;;
+ -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+ ac_init_help=recursive ;;
+ -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+ ac_init_help=short ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host_alias ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host_alias=$ac_optarg ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir=$ac_optarg ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir=$ac_optarg ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir=$ac_optarg ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir=$ac_optarg ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir=$ac_optarg ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir=$ac_optarg ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c | -n)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir=$ac_optarg ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix=$ac_optarg ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix=$ac_optarg ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix=$ac_optarg ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name=$ac_optarg ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir=$ac_optarg ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir=$ac_optarg ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site=$ac_optarg ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir=$ac_optarg ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir=$ac_optarg ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target_alias ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target_alias=$ac_optarg ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers | -V)
+ ac_init_version=: ;;
+
+ -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 &&
+ { 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'" ;;
+
+ -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 &&
+ { 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" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes=$ac_optarg ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries=$ac_optarg ;;
+
+ -*) { echo "$as_me: error: unrecognized option: $ac_option
+Try \`$0 --help' for more information." >&2
+ { (exit 1); exit 1; }; }
+ ;;
+
+ *=*)
+ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+ # Reject names that are not valid shell variable names.
+ 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'"
+ export $ac_envvar ;;
+
+ *)
+ # FIXME: should be removed in autoconf 3.0.
+ echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+ echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+ { echo "$as_me: error: missing argument to $ac_option" >&2
+ { (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
+do
+ eval ac_val=$`echo $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; }; };;
+ esac
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+ if test "x$build_alias" = x; then
+ cross_compiling=maybe
+ echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+ If a cross compiler is detected then cross compile mode will be used." >&2
+ elif test "x$build_alias" != "x$host_alias"; then
+ cross_compiling=yes
+ fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+# 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 ||
+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$0" : 'X\(//\)[^/]' \| \
+ X"$0" : 'X\(//\)$' \| \
+ 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'`
+ srcdir=$ac_confdir
+ 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
+ { (exit 1); exit 1; }; }
+ else
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&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
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat <<_ACEOF
+\`configure' configures this package to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE. See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+ -h, --help display this help and exit
+ --help=short display options specific to this package
+ --help=recursive display the short help of all the included packages
+ -V, --version display version information and exit
+ -q, --quiet, --silent do not print \`checking...' messages
+ --cache-file=FILE cache test results in FILE [disabled]
+ -C, --config-cache alias for \`--cache-file=config.cache'
+ -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]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+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]
+_ACEOF
+
+ cat <<\_ACEOF
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+
+ cat <<\_ACEOF
+
+Some influential environment variables:
+ CXX C++ compiler command
+ 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>
+ CC C compiler command
+ CFLAGS C compiler flags
+ CPP C preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+_ACEOF
+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
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ 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
+
+case $srcdir in
+ .) # No --srcdir option. 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_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;;
+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
+ else
+ echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi
+ cd "$ac_popdir"
+ done
+fi
+
+test -n "$ac_init_help" && exit 0
+if $ac_init_version; then
+ cat <<\_ACEOF
+
+Copyright (C) 2003 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
+fi
+exec 5>config.log
+cat >&5 <<_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
+
+ $ $0 $@
+
+_ACEOF
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X = `(/bin/uname -X) 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`
+/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`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ echo "PATH: $as_dir"
+done
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_sep=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+ for ac_arg
+ do
+ case $ac_arg in
+ -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+ -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
+ 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 2)
+ ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ if test $ac_must_keep_next = true; then
+ ac_must_keep_next=false # Got value, back to normal.
+ else
+ case $ac_arg in
+ *=* | --config-cache | -C | -disable-* | --disable-* \
+ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+ | -with-* | --with-* | -without-* | --without-* | --x)
+ case "$ac_configure_args0 " in
+ "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+ esac
+ ;;
+ -* ) 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=" "
+ ;;
+ esac
+ done
+done
+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+
+# 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.
+trap 'exit_status=$?
+ # Save into config.log some information that might help in debugging.
+ {
+ echo
+
+ cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+ echo
+ # The following way of writing the cache mishandles newlines in values,
+{
+ (set) 2>&1 |
+ case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ sed -n \
+ "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"
+ ;;
+ esac;
+}
+ echo
+
+ cat <<\_ASBOX
+## ----------------- ##
+## Output variables. ##
+## ----------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_vars
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+
+ if test -n "$ac_subst_files"; then
+ cat <<\_ASBOX
+## ------------- ##
+## Output files. ##
+## ------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_files
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+ fi
+
+ if test -s confdefs.h; then
+ cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+ echo
+ sed "/^$/d" confdefs.h | sort
+ 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 &&
+ exit $exit_status
+ ' 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
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_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
+fi
+for ac_site_file in $CONFIG_SITE; 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;}
+ sed 's/^/| /' "$ac_site_file" >&5
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ # Some versions of bash will fail to source /dev/null (special
+ # files actually), so we avoid doing that.
+ if test -f "$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;;
+ esac
+ fi
+else
+ { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+echo "$as_me: creating cache $cache_file" >&6;}
+ >$cache_file
+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
+ 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"
+ 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
+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,set)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,);;
+ *)
+ if test "x$ac_old_val" != "x$ac_new_val"; then
+ { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
+echo "$as_me: former value: $ac_old_val" >&2;}
+ { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
+echo "$as_me: current value: $ac_new_val" >&2;}
+ ac_cache_corrupted=:
+ fi;;
+ esac
+ # 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=$ac_new_val ;;
+ esac
+ case " $ac_configure_args " in
+ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
+ *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ esac
+ fi
+done
+if $ac_cache_corrupted; then
+ { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+ { (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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+: ${R_HOME=`R RHOME`}
+if test -z "${R_HOME}"; then
+ echo "could not determine R_HOME"
+ exit 1
+fi
+CXX=`${R_HOME}/bin/R CMD config CXX`
+
+ac_ext=cc
+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
+ 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
+if test "${ac_cv_prog_CXX+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CXX"; then
+ ac_cv_prog_CXX="$CXX" # 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_CXX="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CXX=$ac_cv_prog_CXX
+if test -n "$CXX"; then
+ 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
+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
+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
+if test "${ac_cv_prog_ac_ct_CXX+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CXX"; then
+ ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # 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_CXX="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+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
+else
+ 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
+fi
+
+
+# Provide some information about the compiler.
+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_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_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_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+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
+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
+ 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
+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.
+ ;;
+ [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
+ break;;
+ * )
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: C++ compiler cannot create executables
+See \`config.log' for more details." >&5
+echo "$as_me: error: C++ compiler cannot create executables
+See \`config.log' for more details." >&2;}
+ { (exit 77); exit 77; }; }
+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
+# 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
+# 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
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { echo "$as_me:$LINENO: error: cannot run C++ compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot run C++ compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ fi
+fi
+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
+# 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
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+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_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
+else
+ { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest$ac_cv_exeext
+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
+if test "${ac_cv_objext+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&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
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+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
+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
+if test "${ac_cv_cxx_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_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_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
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
+fi
+rm -f 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
+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
+if test "${ac_cv_prog_cxx_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_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_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
+ 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
+/* 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
+ 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
+ :
+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
+/* 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
+ 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
+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
+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
+
+
+if test "${GXX}" = yes; then
+ gxx_version=`${CXX} -v 2>&1 | grep "^.*g.. version" | \
+ sed -e 's/^.*g.. version *//'`
+ case ${gxx_version} in
+ 1.*|2.*)
+ { echo "$as_me:$LINENO: WARNING: Only g++ version 3.0 or greater can be used with MCMCpack." >&5
+echo "$as_me: WARNING: Only g++ version 3.0 or greater can be used with MCMCpack." >&2;}
+ { { echo "$as_me:$LINENO: error: Please use a different compiler." >&5
+echo "$as_me: error: Please use a different compiler." >&2;}
+ { (exit 1); exit 1; }; }
+ ;;
+ esac
+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
+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
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$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_CC="${ac_tool_prefix}gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+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 "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
+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="gcc"
+ 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
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+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.
+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
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$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_CC="${ac_tool_prefix}cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+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
+else
+ 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
+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
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ ac_prog_rejected=no
+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
+ if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# != 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+ fi
+fi
+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 "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ for ac_prog in cl
+ 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
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$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_CC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+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
+
+ test -n "$CC" && break
+ done
+fi
+if test -z "$CC"; then
+ ac_ct_CC=$CC
+ for ac_prog in cl
+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
+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="$ac_prog"
+ 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
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_CC" && break
+done
+
+ CC=$ac_ct_CC
+fi
+
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH
+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
+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_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_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_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
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_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
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
+fi
+rm -f 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
+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
+if test "${ac_cv_prog_cc_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_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
+ 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
+/* 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
+ 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
+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
+/* 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
+ 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
+ :
+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
+/* 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
+ 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
+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
+fi
+
+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'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+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
+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=
+fi
+if test -z "$CPP"; then
+ if test "${ac_cv_prog_CPP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ # Double quotes because CPP needs to be expanded
+ for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+ do
+ ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#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
+ 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
+ :
+else
+ echo "$as_me: failed program was:" >&5
+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
+ # can be detected and how.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+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
+ 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
+ # Broken: success on invalid input.
+continue
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+ break
+fi
+
+ done
+ ac_cv_prog_CPP=$CPP
+
+fi
+ CPP=$ac_cv_prog_CPP
+else
+ ac_cv_prog_CPP=$CPP
+fi
+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
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#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
+ 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
+ :
+else
+ echo "$as_me: failed program was:" >&5
+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
+ # can be detected and how.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+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
+ 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
+ # Broken: success on invalid input.
+continue
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+ :
+else
+ { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." >&5
+echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." >&2;}
+ { (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
+
+
+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 $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'
+ 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: 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
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_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
+ ac_cv_header_stdc=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_header_stdc=no
+fi
+rm -f 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.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "memchr" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "free" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+ if test "$cross_compiling" = yes; then
+ :
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <ctype.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+ (('a' <= (c) && (c) <= 'i') \
+ || ('j' <= (c) && (c) <= 'r') \
+ || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+ int i;
+ for (i = 0; i < 256; i++)
+ if (XOR (islower (i), ISLOWER (i))
+ || toupper (i) != TOUPPER (i))
+ exit(2);
+ exit (0);
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&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
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+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
+fi
+fi
+fi
+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
+#define STDC_HEADERS 1
+_ACEOF
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+
+
+
+
+
+
+
+
+
+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 $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$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
+ 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
+ eval "$as_ac_Header=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_Header=no"
+fi
+rm -f 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
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+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
+ 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
+else
+ # Is the header compilable?
+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
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$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
+ 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_header_compiler=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+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
+
+# Is the header present?
+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
+cat confdefs.h >>conftest.$ac_ext
+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
+ 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
+ ac_header_preproc=yes
+else
+ echo "$as_me: failed program was:" >&5
+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
+
+# So? What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
+ yes:no: )
+ { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
+ ac_header_preproc=yes
+ ;;
+ no:yes:* )
+ { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
+echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
+echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
+echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
+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 $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
+
+fi
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+ MV_HAVE_IEEEFP_H="-DHAVE_IEEEFP_H"
+else
+ MV_HAVE_IEEFP_H=""
+fi
+
+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 $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#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)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $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
+ 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
+ eval "$as_ac_var=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+ 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
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+ MV_HAVE_TRUNC="-DHAVE_TRUNC"
+else
+ MV_HAVE_TRUNC=""
+fi
+done
+
+
+
+ ac_config_files="$ac_config_files src/Makevars"
+
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems. If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_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.
+# 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.
+{
+ (set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *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"
+ ;;
+ esac;
+} |
+ sed '
+ t 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"
+ cat confcache >$cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+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,
+# look for a macro that doesn't take arguments.
+cat >confdef2opt.sed <<\_ACEOF
+t clear
+: clear
+s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
+t quote
+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
+
+
+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'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: ${CONFIG_STATUS=./config.status}
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+echo "$as_me: creating $CONFIG_STATUS" >&6;}
+cat >$CONFIG_STATUS <<_ACEOF
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+SHELL=\${CONFIG_SHELL-$SHELL}
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+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
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+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
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ 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
+
+# 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
+
+
+ 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
+
+ # 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.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\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;}
+ { (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
+ # 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= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+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='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
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# 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'"
+
+# Sed expression to map a string onto a valid variable name.
+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
+# 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
+
+This file was extended by $as_me, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ CONFIG_FILES = $CONFIG_FILES
+ CONFIG_HEADERS = $CONFIG_HEADERS
+ CONFIG_LINKS = $CONFIG_LINKS
+ CONFIG_COMMANDS = $CONFIG_COMMANDS
+ $ $0 $@
+
+_CSEOF
+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+echo >&5
+_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
+
+if test -n "$ac_config_commands"; then
+ echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+ac_cs_usage="\
+\`$as_me' instantiates files from templates according to the
+current configuration.
+
+Usage: $0 [OPTIONS] [FILE]...
+
+ -h, --help print this help, then exit
+ -V, --version print version number, 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
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
+
+Configuration files:
+$config_files
+
+Report bugs to <bug-autoconf at gnu.org>."
+_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'`\\"
+
+Copyright (C) 2003 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
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If no file are specified by the user, then we need to provide default
+# value. By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test $# != 0
+do
+ case $1 in
+ --*=*)
+ 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 )
+ 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;;
+ -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;}
+ { (exit 1); exit 1; }; } ;;
+
+ *) ac_config_targets="$ac_config_targets $1" ;;
+
+ esac
+ shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+ exec 6>/dev/null
+ ac_configure_extra_args="$ac_configure_extra_args --silent"
+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
+fi
+
+_ACEOF
+
+
+
+
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+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" ;;
+ *) { { 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
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+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,
+# creating and moving files from /tmp can sometimes cause problems.
+# Create a temporary directory, and hook for its removal unless debugging.
+$debug ||
+{
+ trap 'exit_status=$?; rm -rf $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` &&
+ test -n "$tmp" && test -d "$tmp"
+} ||
+{
+ tmp=./confstat$$-$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.
+#
+
+# 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
+
+_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
+ fi
+fi # test -n "$CONFIG_FILES"
+
+_ACEOF
+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 ;;
+ esac
+
+ # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ 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"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ 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'`
+ 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;}
+ { (exit 1); exit 1; }; }; }
+
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ 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
+
+case $srcdir in
+ .) # No --srcdir option. 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_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;;
+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
+
+
+
+ # 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; }
+
+ 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
+_ACEOF
+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
+
+done
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+{ (exit 0); exit 0; }
+_ACEOF
+chmod +x $CONFIG_STATUS
+ac_clean_files=$ac_clean_files_save
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded. So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status. When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+ ac_cs_success=:
+ ac_config_status_args=
+ test "$silent" = yes &&
+ ac_config_status_args="$ac_config_status_args --quiet"
+ exec 5>/dev/null
+ $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+ exec 5>>config.log
+ # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+ # would make configure fail if this is the last instruction.
+ $ac_cs_success || { (exit 1); exit 1; }
+fi
+
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 0000000..dcb91cd
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,29 @@
+AC_PREREQ(2.50)
+AC_INIT([DESCRIPTION])
+
+: ${R_HOME=`R RHOME`}
+if test -z "${R_HOME}"; then
+ echo "could not determine R_HOME"
+ exit 1
+fi
+CXX=`${R_HOME}/bin/R CMD config CXX`
+
+AC_PROG_CXX
+
+if test "${GXX}" = yes; then
+ gxx_version=`${CXX} -v 2>&1 | grep "^.*g.. version" | \
+ sed -e 's/^.*g.. version *//'`
+ case ${gxx_version} in
+ 1.*|2.*)
+ AC_MSG_WARN([Only g++ version 3.0 or greater can be used with MCMCpack.])
+ AC_MSG_ERROR([Please use a different compiler.])
+ ;;
+ esac
+fi
+
+AC_CHECK_HEADERS(ieeefp.h, [MV_HAVE_IEEEFP_H="-DHAVE_IEEEFP_H"], [MV_HAVE_IEEFP_H=""])
+AC_CHECK_FUNCS(trunc, [MV_HAVE_TRUNC="-DHAVE_TRUNC"], [MV_HAVE_TRUNC=""])
+AC_SUBST(MV_HAVE_IEEEFP_H)
+AC_SUBST(MV_HAVE_TRUNC)
+AC_CONFIG_FILES([src/Makevars])
+AC_OUTPUT
diff --git a/data/PErisk.rda b/data/PErisk.rda
new file mode 100644
index 0000000..7688d70
Binary files /dev/null and b/data/PErisk.rda differ
diff --git a/data/Senate.rda b/data/Senate.rda
new file mode 100644
index 0000000..479c5e9
Binary files /dev/null and b/data/Senate.rda differ
diff --git a/data/SupremeCourt.rda b/data/SupremeCourt.rda
new file mode 100644
index 0000000..107e7ee
Binary files /dev/null and b/data/SupremeCourt.rda differ
diff --git a/man/MCMCdynamicEI.Rd b/man/MCMCdynamicEI.Rd
new file mode 100644
index 0000000..b93496e
--- /dev/null
+++ b/man/MCMCdynamicEI.Rd
@@ -0,0 +1,226 @@
+\name{MCMCdynamicEI}
+\alias{MCMCdynamicEI}
+\title{Markov chain Monte Carlo for Quinn's Dynamic Ecological
+ Inference Model}
+\description{
+ MCMCdynamicEI is used to fit Quinn's dynamic ecological inference
+ model for partially observed 2 x 2 contingency tables.
+ }
+
+\usage{
+MCMCdynamicEI(r0, r1, c0, c1, burnin=5000, mcmc=50000, thin=1,
+ verbose=FALSE, seed=NA, W=0, a0=0.825,
+ b0=0.0105, a1=0.825, b1=0.0105, ...)
+ }
+
+\arguments{
+ \item{r0}{\eqn{(ntables \times 1)}{(ntables * 1)} vector of row
+ sums from row 0.}
+
+ \item{r1}{\eqn{(ntables \times 1)}{(ntables * 1)} vector of row
+ sums from row 1.}
+
+ \item{c0}{\eqn{(ntables \times 1)}{(ntables * 1)} vector of
+ column sums from column 0.}
+
+ \item{c1}{\eqn{(ntables \times 1)}{(ntables * 1)} vector of
+ column sums from column 1.}
+
+ \item{burnin}{The number of burn-in scans for the sampler.}
+
+ \item{mcmc}{The number of mcmc scans to be saved.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ mcmc iterations must be divisible by this value.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. Information is printed
+ if TRUE.}
+
+ \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{W}{Weight (\emph{not precision}) matrix structuring the temporal
+ dependence among elements of \eqn{\theta_{0}}{theta0} and
+ \eqn{\theta_{1}}{theta1}. The default value of 0 will construct a
+ weight matrix that corresponds to random walk priors for
+ \eqn{\theta_{0}}{theta0} and \eqn{\theta_{1}}{theta1}. The default
+ assumes that the tables are equally spaced throughout time and that
+ the elements of \eqn{r0}, \eqn{r1}, \eqn{c0}, and \eqn{c1} are
+ temporally ordered.}
+
+ \item{a0}{\code{a0/2} is the shape parameter for the inverse-gamma
+ prior on the \eqn{\sigma^2_0}{sigma^2_0} parameter.}
+
+ \item{b0}{\code{b0/2} is the scale parameter for the inverse-gamma
+ prior on the \eqn{\sigma^2_0}{sigma^2_0} parameter.}
+
+ \item{a1}{\code{a1/2} is the shape parameter for the inverse-gamma
+ prior on the \eqn{\sigma^2_1}{sigma^2_1} parameter.}
+
+ \item{b1}{\code{b1/2} is the scale parameter for the inverse-gamma
+ prior on the \eqn{\sigma^2_1}{sigma^2_1} parameter.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample.
+ This object can be summarized by functions provided by the coda package.
+}
+
+\details{
+ Consider the following partially observed 2 by 2 contingency table for
+ unit \eqn{t} where \eqn{t=1,\ldots,ntables}{t=1,...,ntables}:\cr
+ \cr
+ \tabular{llll}{
+ \tab | \eqn{Y=0} \tab | \eqn{Y=1} \tab | \cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \eqn{X=0} \tab | \eqn{Y_{0t}}{Y0[t]} \tab | \tab | \eqn{r_{0t}}{r0[t]}\cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \eqn{X=1} \tab | \eqn{Y_{1t}}{Y1[t]} \tab | \tab | \eqn{r_{1t}}{r1[t]}\cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \tab | \eqn{c_{0t}}{c0[t]} \tab | \eqn{c_{1t}}{c1[t]} \tab | \eqn{N_t}{N[t]}\cr
+ }
+ Where \eqn{r_{0t}}{r0-t}, \eqn{r_{1t}}{r1[t]},
+ \eqn{c_{0t}}{c0[t]}, \eqn{c_{1t}}{c1[t]}, and
+ \eqn{N_t}{N[t]} are non-negative integers that are
+ observed. The interior cell entries are not observed. It is
+ assumed that \eqn{Y_{0t}|r_{0t} \sim \mathcal{B}inomial(r_{0t},
+ p_{0t})}{Y0[t]|r0[t] ~ Binomial(r0[t], p0[t])} and
+ \eqn{Y_{1t}|r_{1t} \sim \mathcal{B}inomial(r_{1t}, p_{1t})}{Y1[t]|r1[t] ~
+ Binomial(r1[t],p1[t])}. Let \eqn{\theta_{0t} =
+ log(p_{0t}/(1-p_{0t}))}{theta0[t] = log(p0[t]/(1-p0[t]))},
+ and \eqn{\theta_{1t} = log(p_{1t}/(1-p_{1t}))}{theta1[t] =
+ log(p1[t]/(1-p1[t]))}.
+
+ The following prior distributions are
+ assumed:
+ \deqn{p(\theta_0|\sigma^2_0) \propto \sigma_0^{-ntables}
+ \exp \left(-\frac{1}{2\sigma^2_0}
+ \theta'_{0} P \theta_{0}\right)}{p(theta0|sigma^2_0) propto
+ sigma^(-ntables)_0 exp(-1/(2*sigma^2_0) theta0' * P * theta0)}
+ and
+ \deqn{p(\theta_1|\sigma^2_1) \propto \sigma_1^{-ntables}
+ \exp \left(-\frac{1}{2\sigma^2_1}
+ \theta'_{1} P \theta_{1}\right)}{p(theta1|sigma^2_1) propto
+ sigma^(-ntables)_1 exp(-1/(2*sigma^2_1) theta1' * P * theta1)}
+ where \eqn{P_{ts}}{P[t,s]} = \eqn{-W_{ts}}{-W[t,s]} for \eqn{t} not
+ equal to \eqn{s} and \eqn{P_{tt}}{P[t,t]} =
+ \eqn{\sum_{s \ne t}W_{ts}}{sum(W[t,])}.
+ The \eqn{\theta_{0t}}{theta0[t]} is assumed to be a priori independent of
+ \eqn{\theta_{1t}}{theta1[t]} for all t.
+ In addition, the
+ following hyperpriors are assumed:
+ \eqn{\sigma^2_0 \sim \mathcal{IG}(a_0/2, b_0/2)}{\sigma^2_0 ~
+ InvGamma(a0/2, b0/2)}, and
+ \eqn{\sigma^2_1 \sim \mathcal{IG}(a_1/2, b_1/2)}{\sigma^2_1 ~
+ InvGamma(a1/2, b1/2)}.
+
+ Inference centers on \eqn{p_0}{p0}, \eqn{p_1}{p1},
+ \eqn{\sigma^2_0}{sigma^2_0}, and \eqn{\sigma^2_1}{sigma^2_1}.
+ Univariate slice sampling (Neal, 2003) together with Gibbs sampling
+ is used to sample from the posterior density.
+ }
+
+\references{
+
+Kevin Quinn. 2004. ``Ecological Inference in the Presence of Temporal
+Dependence." In \emph{Ecological Inference: New Methodological
+Strategies}. Gary King, Ori Rosen, and Martin A. Tanner (eds.). New
+York: Cambridge University Press.
+
+Jonathan C. Wakefield. 2003. ``Ecological inference for 2x2 tables." Read
+before the Royal Statistical Society, on November 12th, 2003.
+
+ Radford Neal. 2003. ``Slice Sampling" (with discussion). \emph{Annals of
+ Statistics}, 31: 705-767.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical
+ Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+\examples{
+ \dontrun{
+## simulated data example 1
+set.seed(3920)
+n <- 100
+r0 <- rpois(n, 2000)
+r1 <- round(runif(n, 100, 4000))
+p0.true <- pnorm(-1.5 + 1:n/(n/2))
+p1.true <- pnorm(1.0 - 1:n/(n/4))
+y0 <- rbinom(n, r0, p0.true)
+y1 <- rbinom(n, r1, p1.true)
+c0 <- y0 + y1
+c1 <- (r0+r1) - c0
+
+## plot data
+dtomogplot(r0, r1, c0, c1, delay=0.1)
+
+## fit dynamic model
+post1 <- MCMCdynamicEI(r0,r1,c0,c1, mcmc=40000, thin=5, verbose=TRUE,
+ seed=list(NA, 1))
+
+## fit exchangeable hierarchical model
+post2 <- MCMChierEI(r0,r1,c0,c1, mcmc=40000, thin=5, verbose=TRUE,
+ seed=list(NA, 2))
+
+p0meanDyn <- colMeans(post1)[1:n]
+p1meanDyn <- colMeans(post1)[(n+1):(2*n)]
+p0meanHier <- colMeans(post2)[1:n]
+p1meanHier <- colMeans(post2)[(n+1):(2*n)]
+
+## plot truth and posterior means
+pairs(cbind(p0.true, p0meanDyn, p0meanHier, p1.true, p1meanDyn, p1meanHier))
+
+
+## simulated data example 2
+set.seed(8722)
+n <- 100
+r0 <- rpois(n, 2000)
+r1 <- round(runif(n, 100, 4000))
+p0.true <- pnorm(-1.0 + sin(1:n/(n/4)))
+p1.true <- pnorm(0.0 - 2*cos(1:n/(n/9)))
+y0 <- rbinom(n, r0, p0.true)
+y1 <- rbinom(n, r1, p1.true)
+c0 <- y0 + y1
+c1 <- (r0+r1) - c0
+
+## plot data
+dtomogplot(r0, r1, c0, c1, delay=0.1)
+
+## fit dynamic model
+post1 <- MCMCdynamicEI(r0,r1,c0,c1, mcmc=40000, thin=5, verbose=TRUE,
+ seed=list(NA, 1))
+
+## fit exchangeable hierarchical model
+post2 <- MCMChierEI(r0,r1,c0,c1, mcmc=40000, thin=5, verbose=TRUE,
+ seed=list(NA, 2))
+
+p0meanDyn <- colMeans(post1)[1:n]
+p1meanDyn <- colMeans(post1)[(n+1):(2*n)]
+p0meanHier <- colMeans(post2)[1:n]
+p1meanHier <- colMeans(post2)[(n+1):(2*n)]
+
+## plot truth and posterior means
+pairs(cbind(p0.true, p0meanDyn, p0meanHier, p1.true, p1meanDyn, p1meanHier))
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link{MCMChierEI}},
+ \code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}}}
diff --git a/man/MCMCfactanal.Rd b/man/MCMCfactanal.Rd
new file mode 100644
index 0000000..29457c5
--- /dev/null
+++ b/man/MCMCfactanal.Rd
@@ -0,0 +1,196 @@
+\name{MCMCfactanal}
+\alias{MCMCfactanal}
+\title{Markov chain Monte Carlo for Normal Theory Factor Analysis Model}
+\description{
+ This function generates a posterior density sample from Normal theory
+ factor analysis model. Normal priors are assumed on the factor
+ loadings and factor scores while inverse Gamma priors are assumed for
+ the uniquenesses. The user supplies data and parameters for the prior
+ distributions, and a sample from the posterior density is returned as
+ an mcmc object, which can be subsequently analyzed with
+ functions provided in the coda package.
+}
+
+\usage{
+MCMCfactanal(x, factors, lambda.constraints=list(),
+ data=parent.environment(), burnin = 1000, mcmc = 20000,
+ thin=1, verbose = FALSE, seed = NA,
+ lambda.start = NA, psi.start = NA,
+ l0=0, L0=0, a0=0.001, b0=0.001,
+ store.scores = FALSE, std.var=TRUE, ... )
+ }
+
+\arguments{
+ \item{x}{Either a formula or a numeric matrix containing the
+ manifest variables.}
+
+ \item{factors}{The number of factors to be fitted.}
+
+ \item{lambda.constraints}{List of lists specifying possible simple equality
+ or inequality constraints on the factor loadings. A typical
+ entry in the list has one of three forms: \code{varname=list(d,c)} which
+ will constrain the dth loading for the variable named \code{varname} to
+ be equal to c, \code{varname=list(d,"+")} which will constrain the dth
+ loading for the variable named \code{varname} to be positive, and
+ \code{varname=list(d, "-")} which will constrain the dth loading for the
+ variable named \code{varname} to be negative. If x is a matrix without
+ column names defaults names of ``V1",``V2", ... , etc will be
+ used.}
+
+ \item{data}{A data frame.}
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of iterations for the sampler.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ iterations must be divisible by this value.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number and
+ the factor loadings and uniquenesses are printed to the screen.}
+
+ \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{lambda.start}{Starting values for the factor loading matrix
+ Lambda. If \code{lambda.start} is set to a scalar the starting value for
+ all unconstrained loadings will be set to that scalar. If
+ \code{lambda.start} is a matrix of the same dimensions as Lambda then the
+ \code{lambda.start} matrix is used as the starting values (except
+ for equality-constrained elements). If \code{lambda.start} is set to
+ \code{NA} (the default) then starting values for unconstrained
+ elements are set to 0, and starting values for inequality
+ constrained elements are set to either 0.5 or -0.5 depending on the
+ nature of the constraints.}
+
+ \item{psi.start}{Starting values for the uniquenesses. If
+ \code{psi.start} is set to a scalar then the starting value for all
+ diagonal elements of \code{Psi} are set to this value. If
+ \code{psi.start} is a \eqn{k}{k}-vector (where \eqn{k}{k} is the
+ number of manifest variables) then the staring value of \code{Psi}
+ has \code{psi.start} on the main diagonal. If \code{psi.start} is
+ set to \code{NA} (the default) the starting values of all the
+ uniquenesses are set to 0.5.}
+
+ \item{l0}{The means of the independent Normal prior on the factor
+ loadings. Can be either a scalar or a matrix with the same
+ dimensions as \code{Lambda}.}
+
+ \item{L0}{The precisions (inverse variances) of the independent Normal
+ prior on the factor loadings. Can be either a scalar or a matrix with
+ the same dimensions as \code{Lambda}.}
+
+ \item{a0}{Controls the shape of the inverse Gamma prior on the
+ uniqueness. The actual shape parameter is set to \code{a0/2}. Can be
+ either a scalar or a \eqn{k}{k}-vector.}
+
+ \item{b0}{Controls the scale of the inverse Gamma prior on the
+ uniquenesses. The actual scale parameter is set to \code{b0/2}. Can
+ be either a scalar or a \eqn{k}{k}-vector.}
+
+ \item{store.scores}{A switch that determines whether or not to
+ store the factor scores for posterior analysis.
+ \emph{NOTE: This takes an enormous amount of memory, so
+ should only be used if the chain is thinned heavily, or for
+ applications with a small number of observations}. By default, the
+ factor scores are not stored.}
+
+ \item{std.var}{If \code{TRUE} (the default) the manifest variables are
+ rescaled to have zero mean and unit variance. Otherwise, the manifest
+ variables are rescaled to have zero mean but retain their observed
+ variances.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{The model takes the following form:
+
+ \deqn{x_i = \Lambda \phi_i + \epsilon_i}{x_i = Lambda phi_i + epsilon_i}
+ \deqn{\epsilon_i \sim \mathcal{N}(0,\Psi)}{epsilon_i ~ N(0, Psi)}
+
+ where \eqn{x_i}{x_i} is the \eqn{k}{k}-vector of observed variables
+ specific to observation \eqn{i}{i}, \eqn{\Lambda}{Lambda} is the
+ \eqn{k \times d}{k by d} matrix of factor loadings, \eqn{\phi_i}{phi_i} is
+ the \eqn{d}{d}-vector of latent factor scores, and \eqn{\Psi}{Psi} is
+ a diagonal, positive definite matrix. Traditional factor analysis
+ texts refer to the diagonal elements of \eqn{\Psi}{Psi} as
+ uniquenesses.
+
+ The implementation used here assumes independent conjugate priors for
+ each element of \eqn{\Lambda}{Lambda}, each \eqn{\phi_i}{phi_i}, and
+ each diagonal element of \eqn{\Psi}{Psi}. More specifically we assume:
+
+ \deqn{\Lambda_{ij} \sim \mathcal{N}(l_{0_{ij}}, L_{0_{ij}}^{-1}),
+ i=1,\ldots,k, j=1,\ldots,d}{Lambda_ij ~ N(l0_ij, L0_ij^-1),
+ i=1,...,k, j=1,...,d}
+
+ \deqn{\phi_i \sim \mathcal{N}(0, I), i=1,\dots,n}{phi_i ~ N(0, I),
+ i=1,...,n}
+
+ \deqn{\Psi_{ii} \sim \mathcal{IG}(a_{0_i}/2, b_{0_i}/2),
+ i=1,\ldots,k}{Psi_ii ~ IG(a0_i/2, b0_i/2), i=1,...,k}
+
+ \code{MCMCfactanal} simulates from the posterior density using
+ standard Gibbs sampling. 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 density sample.
+ }
+}
+
+\references{
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+
+\examples{
+ \dontrun{
+ ### An example using the formula interface
+ data(swiss)
+ posterior <- MCMCfactanal(~Agriculture+Examination+Education+Catholic
+ +Infant.Mortality, factors=2,
+ lambda.constraints=list(Examination=list(1,"+"),
+ Examination=list(2,"-"), Education=c(2,0),
+ Infant.Mortality=c(1,0)),
+ verbose=FALSE, store.scores=FALSE, a0=1, b0=0.15,
+ data=swiss, burnin=5000, mcmc=50000, thin=20)
+ plot(posterior)
+ summary(posterior)
+
+ ### An example using the matrix interface
+ Y <- cbind(swiss$Agriculture, swiss$Examination,
+ swiss$Education, swiss$Catholic,
+ swiss$Infant.Mortality)
+ colnames(Y) <- c("Agriculture", "Examination", "Education", "Catholic",
+ "Infant.Mortality")
+ post <- MCMCfactanal(Y, factors=2,
+ lambda.constraints=list(Examination=list(1,"+"),
+ Examination=list(2,"-"), Education=c(2,0),
+ Infant.Mortality=c(1,0)),
+ verbose=FALSE, store.scores=FALSE, a0=1, b0=0.15,
+ burnin=5000, mcmc=50000, thin=20)
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}},\code{\link[mva]{factanal}}}
+
diff --git a/man/MCMChierEI.Rd b/man/MCMChierEI.Rd
new file mode 100644
index 0000000..081821d
--- /dev/null
+++ b/man/MCMChierEI.Rd
@@ -0,0 +1,189 @@
+\name{MCMChierEI}
+\alias{MCMChierEI}
+\title{Markov chain Monte Carlo for Wakefield's Hierarchial Ecological
+ Inference Model}
+\description{
+ `MCMChierEI' is used to fit Wakefield's hierarchical ecological inference
+ model for partially observed 2 x 2 contingency tables.
+ }
+
+\usage{
+MCMChierEI(r0, r1, c0, c1, burnin=5000, mcmc=50000, thin=1,
+ verbose=FALSE, seed=NA,
+ m0=0, M0=2.287656, m1=0, M1=2.287656, a0=0.825, b0=0.0105,
+ a1=0.825, b1=0.0105, ...)
+ }
+
+\arguments{
+ \item{r0}{\eqn{(ntables \times 1)}{(ntables * 1)} vector of row
+ sums from row 0.}
+
+ \item{r1}{\eqn{(ntables \times 1)}{(ntables * 1)} vector of row
+ sums from row 1.}
+
+ \item{c0}{\eqn{(ntables \times 1)}{(ntables * 1)} vector of
+ column sums from column 0.}
+
+ \item{c1}{\eqn{(ntables \times 1)}{(ntables * 1)} vector of
+ column sums from column 1.}
+
+ \item{burnin}{The number of burn-in scans for the sampler.}
+
+ \item{mcmc}{The number of mcmc scans to be saved.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ mcmc iterations must be divisible by this value.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. Information is printed
+ if TRUE.}
+
+ \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{m0}{Prior mean of the \eqn{\mu_0}{mu0} parameter.}
+
+ \item{M0}{Prior variance of the \eqn{\mu_0}{mu0} parameter.}
+
+ \item{m1}{Prior mean of the \eqn{\mu_1}{mu1} parameter.}
+
+ \item{M1}{Prior variance of the \eqn{\mu_1}{mu1} parameter.}
+
+ \item{a0}{\code{a0/2} is the shape parameter for the inverse-gamma
+ prior on the \eqn{\sigma^2_0}{sigma^2_0} parameter.}
+
+ \item{b0}{\code{b0/2} is the scale parameter for the inverse-gamma
+ prior on the \eqn{\sigma^2_0}{sigma^2_0} parameter.}
+
+ \item{a1}{\code{a1/2} is the shape parameter for the inverse-gamma
+ prior on the \eqn{\sigma^2_1}{sigma^2_1} parameter.}
+
+ \item{b1}{\code{b1/2} is the scale parameter for the inverse-gamma
+ prior on the \eqn{\sigma^2_1}{sigma^2_1} parameter.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample.
+ This object can be summarized by functions provided by the coda package.
+}
+
+\details{
+ Consider the following partially observed 2 by 2 contingency table for
+ unit \eqn{t} where \eqn{t=1,\ldots,ntables}:\cr
+ \cr
+ \tabular{llll}{
+ \tab | \eqn{Y=0} \tab | \eqn{Y=1} \tab | \cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \eqn{X=0} \tab | \eqn{Y_{0t}}{Y0[t]} \tab | \tab |\eqn{r_{0t}}{r0[t]}\cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \eqn{X=1} \tab | \eqn{Y_{1t}}{Y1[t]} \tab | \tab | \eqn{r_{1t}}{r1[t]}\cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \tab | \eqn{c_{0t}}{c0[t]} \tab | \eqn{c_{1t}}{c1[t]} \tab | \eqn{N_t}{N[t]}\cr
+ }
+ Where \eqn{r_{0t}}{r0[t]}, \eqn{r_{1t}}{r1[t]},
+ \eqn{c_{0t}}{c0[t]}, \eqn{c_{1t}}{c1[t]}, and
+ \eqn{N_t}{N[t]} are non-negative integers that are
+ observed. The interior cell entries are not observed. It is
+ assumed that \eqn{Y_{0t}|r_{0t} \sim \mathcal{B}inomial(r_{0t},
+ p_{0t})}{Y0[t]|r0[t] ~ Binomial(r0[t], p0[t])} and
+ \eqn{Y_{1t}|r_{1t} \sim \mathcal{B}inomial(r_{1t}, p_{1t})}{Y1[t]|r1[t] ~
+ Binomial(r1[t],p1[t])}. Let \eqn{\theta_{0t} =
+ log(p_{0t}/(1-p_{0t}))}{theta0[t] = log(p0[t]/(1-p0[t]))},
+ and \eqn{\theta_{1t} = log(p_{1t}/(1-p_{1t}))}{theta1[t] =
+ log(p1[t]/(1-p1[t]))}.
+
+ The following prior distributions are
+ assumed: \eqn{\theta_{0t} \sim \mathcal{N}(\mu_0,
+ \sigma^2_0)}{\theta0[t] ~ Normal(mu0, sigma^2_0)},
+ \eqn{\theta_{1t} \sim \mathcal{N}(\mu_1,
+ \sigma^2_1)}{\theta1[t] ~ Normal(mu1, sigma^2_1)}.
+ \eqn{\theta_{0t}}{theta0[t]} is assumed to be a priori independent of
+ \eqn{\theta_{1t}}{theta1[t]} for all t.
+ In addition, we assume the
+ following hyperpriors:
+ \eqn{\mu_0 \sim \mathcal{N}(m_0,
+ M_0)}{mu0 ~ Normal(m0, M0)},
+ \eqn{\mu_1 \sim \mathcal{N}(m_1,
+ M_1)}{mu1 ~ Normal(m1,
+ M1)},
+ \eqn{\sigma^2_0 \sim \mathcal{IG}(a_0/2, b_0/2)}{\sigma^2_0 ~
+ InvGamma(a0/2, b0/2)}, and
+ \eqn{\sigma^2_1 \sim \mathcal{IG}(a_1/2, b_1/2)}{\sigma^2_1 ~
+ InvGamma(a1/2, b1/2)}.
+
+ The default priors have been chosen to make the implied prior
+ distribution for \eqn{p_{0}}{p0} and \eqn{p_{1}}{p1}
+ \emph{approximately} uniform on (0,1).
+
+ Inference centers on \eqn{p_0}{p0}, \eqn{p_1}{p1}, \eqn{\mu_0}{mu0},
+ \eqn{\mu_1}{mu1}, \eqn{\sigma^2_0}{sigma^2_0}, and
+ \eqn{\sigma^2_1}{sigma^2_1}.
+ Univariate slice sampling (Neal, 2003) along with Gibbs sampling is
+ used to sample from the posterior density.
+
+ See Section 5.4 of Wakefield (2003) for discussion of the priors used
+ here. \code{MCMChierEI} departs from the Wakefield model in that the
+ \code{mu0} and \code{mu1} are here assumed to be drawn from
+ independent normal distributions whereas Wakefield assumes they are
+ drawn from logistic distributions.
+}
+
+\references{
+Jonathan C. Wakefield. 2003. ``Ecological inference for 2x2 tables." Read
+before the Royal Statistical Society, on November 12th, 2003.
+
+ Radford Neal. 2003. ``Slice Sampling" (with discussion). \emph{Annals of
+ Statistics}, 31: 705-767.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical
+ Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+\examples{
+ \dontrun{
+## simulated data example
+set.seed(3920)
+n <- 100
+r0 <- round(runif(n, 400, 1500))
+r1 <- round(runif(n, 100, 4000))
+p0.true <- pnorm(rnorm(n, m=0.5, s=0.25))
+p1.true <- pnorm(rnorm(n, m=0.0, s=0.10))
+y0 <- rbinom(n, r0, p0.true)
+y1 <- rbinom(n, r1, p1.true)
+c0 <- y0 + y1
+c1 <- (r0+r1) - c0
+
+## plot data
+tomogplot(r0, r1, c0, c1)
+
+## fit exchangeable hierarchical model
+post <- MCMChierEI(r0,r1,c0,c1, mcmc=40000, thin=5, verbose=TRUE,
+ seed=list(NA, 1))
+
+p0meanHier <- colMeans(post)[1:n]
+p1meanHier <- colMeans(post)[(n+1):(2*n)]
+
+## plot truth and posterior means
+pairs(cbind(p0.true, p0meanHier, p1.true, p1meanHier))
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link{MCMCdynamicEI}},
+ \code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}}}
+
diff --git a/man/MCMCirt1d.Rd b/man/MCMCirt1d.Rd
new file mode 100644
index 0000000..c6866c9
--- /dev/null
+++ b/man/MCMCirt1d.Rd
@@ -0,0 +1,210 @@
+\name{MCMCirt1d}
+\alias{MCMCirt1d}
+\title{Markov chain Monte Carlo for One Dimensional Item Response Theory
+ Model}
+\description{
+ This function generates a posterior density sample from a one
+ dimentional item response theory (IRT) model, with Normal
+ priors on the subject abilities (ideal points), and
+ multivariate Normal priors on the item parameters. The user
+ supplies data and priors, and a sample from the posterior
+ density is returned as an mcmc object, which can be
+ subsequently analyzed with functions provided in the coda
+ package.
+
+ If you are interested in fitting K-dimensional item response theory
+ models, or would rather identify the model by placing constraints
+ on the item parameters, please see \code{\link[MCMCpack]{MCMCirtKd}}.
+ }
+
+\usage{
+MCMCirt1d(datamatrix, theta.constraints=list(), burnin = 1000,
+ mcmc = 20000, thin=1, verbose = FALSE, seed = NA, theta.start = NA,
+ alpha.start = NA, beta.start = NA, t0 = 0, T0 = 1, ab0=0, AB0=.25,
+ store.item = FALSE, ... ) }
+
+\arguments{
+ \item{datamatrix}{The matrix of data. Must be 0, 1, or missing values.
+ The rows of \code{datamatrix} correspond to subjects and the
+ columns correspond to items.}
+
+ \item{theta.constraints}{A list specifying possible simple equality
+ or inequality constraints on the ability parameters. A typical
+ entry in the list has one of three forms: \code{varname=c} which
+ will constrain the ability parameter for the subject named
+ \code{varname} to be equal to c, \code{varname="+"} which will
+ constrain the ability parameter for the subject named \code{varname}
+ to be positive, and \code{varname="-"} which will constrain the
+ ability parameter for the subject named \code{varname} to be
+ negative. If x is a matrix without row names defaults names of
+ ``V1",``V2", ... , etc will be used. See Rivers (2003) for a
+ thorough discussion of identification of IRT models.}
+
+ \item{burnin}{The number of burn-in 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
+ Gibbs iterations must be divisible by this value.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number
+ is printed to the screen every 100 iterations.}
+
+ \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{theta.start}{The starting values for the subject
+ abilities (ideal points). This can either be a scalar or a
+ column vector with dimension equal to the number of voters.
+ If this takes a scalar value, then that value will serve as
+ the starting value for all of the thetas. The default value
+ of NA will choose the starting values based on an
+ eigenvalue-eigenvector decomposition of the aggreement score matrix
+ formed from the \code{datamatrix}.}
+
+ \item{alpha.start}{The starting values for the
+ \eqn{\alpha}{alpha} difficulty parameters. This can either be
+ a scalar or a column vector with dimension equal to the
+ number of items. If this takes a scalar value, then that
+ value will serve as the starting value for all of the alphas.
+ The default value of NA will set the starting values based on
+ a series of probit regressions that condition on the starting
+ values of theta.}
+
+ \item{beta.start}{The starting values for the
+ \eqn{\beta}{beta} discrimination parameters. This can either
+ be a scalar or a column vector with dimension equal to the
+ number of items. If this takes a scalar value, then that
+ value will serve as the starting value for all of the betas.
+ The default value of NA will set the starting values based on a
+ series of probit regressions that condition on the starting values
+ of theta.}
+
+ \item{t0}{A scalar parameter giving the prior mean of the subject
+ abilities (ideal points).}
+
+ \item{T0}{A scalar parameter giving the prior precision (inverse
+ variance) of the subject abilities (ideal points).}
+
+ \item{ab0}{The prior mean of \code{(alpha, beta)}. Can be either a
+ scalar or a 2-vector. If a scalar both means will be set to the
+ passed value. The prior mean is assumed to be the same across all
+ items.}
+
+ \item{AB0}{The prior precision of \code{(alpha, beta)}.This can
+ either be ascalar or a 2 by 2 matrix. If this takes a scalar
+ value, then that value times an identity matrix serves as the
+ prior precision. The prior precision is assumed to be the same
+ across all items.}
+
+ \item{store.item}{A switch that determines whether or not to
+ store the item parameters for posterior analysis.
+ \emph{NOTE: This takes an enormous amount of memory, so
+ should only be used if the chain is thinned heavily, or for
+ applications with a small number of items}. By default, the
+ item parameters are not stored.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{
+ \code{MCMCirt1d} simulates from the posterior density using
+ standard Gibbs sampling using data augmentation (a Normal draw
+ for the subject abilities, a multivariate Normal
+ draw for the item parameters, and a truncated Normal draw for
+ the latent utilities). 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 density sample.
+
+ The model takes the following form. We assume that each
+ subject has an subject ability (ideal point) denoted
+ \eqn{\theta_j}{theta_j} and that each item has a difficulty
+ parameter \eqn{\alpha_i}{alpha_i} and discrimination parameter
+ \eqn{\beta_i}{beta_i}. The observed choice by subject
+ \eqn{j}{j} on item \eqn{i}{i} is the observed data matrix which
+ is \eqn{(I \times J)}{(I * J)}. We assume that the choice is
+ dictated by an unobserved utility: \deqn{z_{i,j} = -\alpha_i +
+ \beta_i \theta_j + \varepsilon_{i,j}}{z_ij = -alpha_i +
+ beta_i*theta_j + epsilon_ij} Where the errors are assumed to be
+ distributed standard Normal. The parameters of interest are
+ the subject abilities (ideal points) and the item parameters.
+
+ We assume the following priors. For the subject abilities (ideal points):
+ \deqn{\theta_j \sim \mathcal{N}(t_{0},T_{0}^{-1})}{theta_j ~ N(t0, T0^{-1})}
+ For the item parameters, the prior is:
+ \deqn{\left[\alpha_i, \beta_i \right]' \sim \mathcal{N}_2
+ (ab_{0},AB_{0}^{-1})}{[alpha_i beta_i]' ~ N_2 (ab0, AB0^{-1})}
+
+ The model is identified by the proper priors on the item parameters
+ and constraints placed on the ability parameters.
+}
+
+\references{
+ James H. Albert. 1992. ``Bayesian Estimation of Normal Ogive Item Response
+ Curves Using Gibbs Sampling." \emph{Journal of Educational Statistics}.
+ 17: 251-269.
+
+ Joshua Clinton, Simon Jackman, and Douglas Rivers. 2004. ``The Statistical
+ Analysis of Roll Call Data." \emph{American Political Science Review}.
+ 98: 355-370.
+
+ Valen E. Johnson and James H. Albert. 1999. ``Ordinal Data Modeling."
+ Springer: New York.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+
+ Douglas Rivers. 2004. ``Identification of Multidimensional Item-Response
+ Models." Stanford University, typescript.
+}
+
+
+\examples{
+ \dontrun{
+ ## US Supreme Court Example with inequality constraints
+ data(SupremeCourt)
+ posterior1 <- MCMCirt1d(t(SupremeCourt),
+ theta.constraints=list(Scalia="+", Ginsburg="-"),
+ B0.alpha=.2, B0.beta=.2,
+ burnin=500, mcmc=100000, thin=20, verbose=TRUE,
+ store.item=TRUE)
+ geweke.diag(posterior1)
+ plot(posterior1)
+ summary(posterior1)
+
+ ## US Senate Example with equality constraints
+ data(Senate)
+ Sen.rollcalls <- Senate[,6:677]
+ rownames(Sen.rollcalls) <- as.character(Senate$member)
+ posterior2 <- MCMCirt1d(Sen.rollcalls,
+ theta.constraints=list(KENNEDY=-2, HELMS=2),
+ burnin=2000, mcmc=100000, thin=20, verbose=TRUE)
+ geweke.diag(posterior2)
+ plot(posterior2)
+ summary(posterior2)
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}},
+\code{\link[MCMCpack]{MCMCirtKd}}}
+
diff --git a/man/MCMCirtKd.Rd b/man/MCMCirtKd.Rd
new file mode 100644
index 0000000..d52b888
--- /dev/null
+++ b/man/MCMCirtKd.Rd
@@ -0,0 +1,229 @@
+\name{MCMCirtKd}
+\alias{MCMCirtKd}
+\title{Markov chain Monte Carlo for K-Dimensional Item Response Theory
+ Model}
+\description{
+ This function generates a posterior density sample from a
+ K-dimensional item response theory (IRT) model, with standard
+ Normal priors on the subject abilities (ideal points), and
+ Normal priors on the item parameters. The user
+ supplies data and priors, and a sample from the posterior
+ density is returned as an mcmc object, which can be
+ subsequently analyzed with functions provided in the coda
+ package.
+}
+
+\usage{
+MCMCirtKd(datamatrix, dimensions, item.constraints=list(),
+ burnin = 1000, mcmc = 10000, thin=1, verbose = FALSE, seed = NA,
+ alphabeta.start = NA, b0 = 0, B0=0, store.item = FALSE,
+ store.ability=TRUE, drop.constantvars=TRUE, ... ) }
+
+\arguments{
+ \item{datamatrix}{The matrix of data. Must be 0, 1, or missing values.
+ It is of dimensionality items by subjects.}
+
+ \item{dimensions}{The number of dimensions in the latent space.}
+
+ \item{item.constraints}{List of lists specifying possible equality
+ or simple inequality constraints on the item parameters. A typical
+ entry in the list has one of three forms: \code{rowname=list(d,c)}
+ which will constrain the dth item parameter for the item named
+ rowname to be equal to c, \code{rowname=list(d,"+")} which will
+ constrain the dth item parameter for the item named rowname to be
+ positive, and\code{rowname=list(d, "-")} which will constrain the dth
+ item parameter for the item named varname to be negative. If x is a
+ matrix without row names defaults names of ``V1", ``V2", ... , etc
+ will be used. In a d dimensional model, the first item parameter for
+ item \eqn{i}{i} is the difficulty parameter (\eqn{\alpha_i}{alpha_i}),
+ the second item parameter is the discrimation parameter on dimension
+ 1 (\eqn{\beta_{i,1}{beta_{i,1}}}), the third item parameter is the
+ discrimation parameter on dimension 2
+ (\eqn{\beta_{i,2}{beta_{i,2}}}), ..., and the (d+1)th item parameter
+ is the discrimation parameter on dimension d
+ (\eqn{\beta_{i,1}{beta_{i,1}}}).
+ The item difficulty parameters (\eqn{\alpha}{alpha}) should
+ generally not be constrained.
+ }
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of iterations for the sampler.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ iterations must be divisible by this value.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number and
+ the subject abilities (ideal points) are printed to the screen.}
+
+ \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{alphabeta.start}{The starting values for the
+ \eqn{\alpha}{alpha} and \eqn{\beta}{beta} difficulty and
+ discrimination parameters. If \code{alphabeta.start} is set to a
+ scalar the starting value for all unconstrained item parameters will
+ be set to that scalar. If \code{alphabeta.start} is a matrix of
+ dimension \eqn{(K+1) \times items}{(K+1) x items} then the
+ \code{alphabeta.start} matrix is used as the starting values (except
+ for equality-constrained elements). If \code{alphabeta.start} is set
+ to \code{NA} (the default) then starting values for unconstrained
+ elements are set to values generated from a series of proportional
+ odds logistic regression fits, and starting values for inequality
+ constrained elements are set to either 1.0 or -1.0 depending on the
+ nature of the constraints. }
+
+ \item{b0}{The prior means of the
+ \eqn{\alpha}{alpha} and \eqn{\beta}{beta} difficulty and
+ discrimination parameters, stacked for all items.
+ If a scalar is passed, it
+ is used as the prior mean for all items.}
+
+ \item{B0}{The prior precisions (inverse variances) of the
+ independent Normal prior on the item parameters.
+ Can be either a scalar or a matrix of dimension
+ \eqn{(K+1) \times items}{(K+1) x items}.}
+
+ \item{store.item}{A switch that determines whether or not to
+ store the item parameters for posterior analysis.
+ \emph{NOTE: This takes an enormous amount of memory, so
+ should only be used if the chain is thinned heavily, or for
+ applications with a small number of items}. By default, the
+ item parameters are not stored.}
+
+ \item{store.ability}{A switch that determines whether or not to store
+ the subject abilities for posterior analysis. By default, the
+ item parameters are all stored.}
+
+ \item{drop.constantvars}{A switch that determines whether or not
+ items and subjects that have no variation
+ should be deleted before fitting the model. Default = TRUE.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{
+ \code{MCMCirtKd} simulates from the posterior density using
+ standard Gibbs sampling using data augmentation (a Normal draw
+ for the subject abilities, a multivariate Normal
+ draw for the item parameters, and a truncated Normal draw for
+ the latent utilities). 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 density sample.
+
+ The default number of burnin and mcmc iterations is much
+ smaller than the typical default values in MCMCpack. This is
+ because fitting this model is extremely computationally
+ expensive. It does not mean that this small of a number of
+ scans will yield good estimates. If the verbose option is
+ chosen, output will be printed to the screen every fifty
+ iterations. The priors of this model need to be proper for
+ identification purposes. The user is asked to provide prior
+ means and precisions \emph{(not variances)} for the item
+ parameters and the subject parameters.
+
+ The model takes the following form. We assume that each
+ subject has an subject ability (ideal point) denoted
+ \eqn{\theta_j}{theta_j} \eqn{(K \times 1)}{(K x 1)},
+ and that each item has a difficulty
+ parameter \eqn{\alpha_i}{alpha_i} and discrimination parameter
+ \eqn{\beta_i}{beta_i} \eqn{(K \times 1)}{(K x 1)}.
+ The observed choice by subject
+ \eqn{j}{j} on item \eqn{i}{i} is the observed data matrix which
+ is \eqn{(I \times J)}{(I * J)}. We assume that the choice is
+ dictated by an unobserved utility: \deqn{z_{i,j} = \alpha_i +
+ \beta_i' \theta_j + \varepsilon_{i,j}}{z_ij = alpha_i +
+ beta_i'*theta_j + epsilon_ij} Where the errors are assumed to be
+ distributed standard Normal. The parameters of interest are
+ the subject abilities (ideal points) and the item parameters.
+
+ We assume the following priors. For the subject abilities (ideal points)
+ we assume independent standard Normal priors:
+ \deqn{\theta_{j,k} \sim \mathcal{N}(0,1)}{theta_j,k ~ N(0, 1)}
+ These cannot be changed by the user.
+ For each item parameter, we assume independent Normal priors:
+ \deqn{\left[\alpha_i, \beta_i \right]' \sim \mathcal{N}_{(K+1)}
+ (b_{0,i},B_{0,i})}{[alpha_i beta_i]' ~ N_(K+1) (b_0,i, B_0,i)}
+ Where \eqn{B_{0,i}}{B_0,i} is a diagonal matrix.
+ One can specify a separate prior mean and precision
+ for each item parameter.
+
+ The model is identified by the constraints on the item parameters
+ (see Jackman 2001). The user cannot place constraints on the subect
+ abilities. This identification scheme differs from that in
+ \code{MCMCirt1d}, which uses a single directional constraint on
+ one subject ability. However, in our experience, using subject
+ ability constraints for models in greater than one dimension does not work
+ particularly well.
+ }
+
+\references{
+ James H. Albert. 1992. ``Bayesian Estimation of Normal Ogive Item Response
+ Curves Using Gibbs Sampling." \emph{Journal of Educational Statistics}.
+ 17: 251-269.
+
+ Joshua Clinton, Simon Jackman, and Douglas Rivers. 2000. ``The Statistical
+ Analysis of Legislative Behavior: A Unified Approach." Paper presented at
+ the Annual Meeting of the Political Methodology Society.
+
+ Simon Jackman. 2001. ``Multidimensional Analysis of Roll Call Data
+ via Bayesian Simulation.'' \emph{Political Analysis.} 9: 227-241.
+
+ Valen E. Johnson and James H. Albert. 1999. ``Ordinal Data Modeling."
+ Springer: New York.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+
+\examples{
+ \dontrun{
+ data(SupremeCourt)
+ # note that the rownames (the item names) are "1", "2", etc
+ posterior1 <- MCMCirtKd(SupremeCourt, dimensions=1,
+ burnin=5000, mcmc=50000, thin=10,
+ B0=.25, store.item=TRUE,
+ item.constraints=list("1"=list(2,"-")))
+ plot(posterior1)
+ summary(posterior1)
+
+
+ data(Senate)
+ rownames(Senate) <- Senate$member
+ # note that we need to transpose the data to get
+ # the bills on the rows
+ posterior2 <- MCMCirtKd(t(Senate[,6:677]), dimensions=2,
+ burnin=5000, mcmc=50000, thin=10,
+ item.constraints=list(rc2=list(2,"-"), rc2=c(3,0),
+ rc3=list(3,"-")),
+ B0=.25)
+ plot(posterior2)
+ summary(posterior2)
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}},
+\code{\link[MCMCpack]{MCMCirt1d}}, \code{\link[MCMCpack]{MCMCordfactanal}}
+}
+
diff --git a/man/MCMClogit.Rd b/man/MCMClogit.Rd
new file mode 100644
index 0000000..dd0070e
--- /dev/null
+++ b/man/MCMClogit.Rd
@@ -0,0 +1,126 @@
+\name{MCMClogit}
+\alias{MCMClogit}
+\title{Markov chain Monte Carlo for Logistic Regression}
+\description{
+ This function generates a posterior density sample
+ from a logistic regression model using a random walk Metropolis
+ algorithm. The user supplies data and priors,
+ and a sample from the posterior density is returned as an mcmc
+ object, which can be subsequently analyzed with functions
+ provided in the coda package.
+ }
+
+\usage{
+MCMClogit(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin=1, tune=1.1, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, ...) }
+
+\arguments{
+ \item{formula}{Model formula.}
+
+ \item{data}{Data frame.}
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of Metropolis 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{tune}{Metropolis tuning parameter. Can be either a positive
+ scalar or a \eqn{k}{k}-vector, where \eqn{k}{k} is the length of
+ \eqn{\beta}{beta}.Make sure that the
+ acceptance rate is satisfactory (typically between 0.20 and 0.5)
+ before using the posterior density sample for inference.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number,
+ the current beta vector, and the Metropolis acceptance rate are
+ printed to the screen every 500 iterations.}
+
+ \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{beta.start}{The starting value for the \eqn{\beta}{beta} vector.
+ 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
+ starting value for all of the betas. The default value of NA will
+ use the maximum likelihood estimate of \eqn{\beta}{beta} as the starting
+ value.}
+
+ \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 \eqn{\beta}{beta}. Default value of 0 is
+ equivalent to an improper uniform prior for beta.}
+
+ \item{\ldots}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{\code{MCMClogit} simulates from the posterior density of a logistic
+ regression model using a random walk Metropolis algorithm. 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 density sample.
+
+ The model takes the following form:
+ \deqn{y_i \sim \mathcal{B}ernoulli(\pi_i)}{y_i ~ Bernoulli(pi_i)}
+ Where the inverse link function:
+ \deqn{\pi_i = \frac{\exp(x_i'\beta)}{1 + \exp(x_i'\beta)}}{pi_i =
+ exp(x_i'beta) / [1 + exp(x_i'beta)]}
+ We assume a multivariate Normal prior on \eqn{\beta}{beta}:
+ \deqn{\beta \sim \mathcal{N}(b_0,B_0^{-1})}{beta ~ N(b0,B0^(-1))}
+
+ The Metropollis proposal distribution is centered at the current value of
+ \eqn{\theta}{theta} and has variance-covariance \eqn{V = T
+ (B_0 + C^{-1})^{-1} T }{V = T (B0 + C^{-1})^{-1} T}, where
+ \eqn{T}{T} is a the diagonal positive definite matrix formed from the
+ \code{tune}, \eqn{B_0}{B0} is the prior precision, and \eqn{C}{C} is
+ the large sample variance-covariance matrix of the MLEs. This last
+ calculation is done via an initial call to \code{glm}.
+ }
+
+\references{
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+
+\examples{
+ \dontrun{
+ data(birthwt)
+ posterior <- MCMClogit(low~age+as.factor(race)+smoke, data=birthwt)
+ plot(posterior)
+ summary(posterior)
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}}, \code{\link[base]{glm}}}
+
diff --git a/man/MCMCmetrop1R.Rd b/man/MCMCmetrop1R.Rd
new file mode 100644
index 0000000..378c2a0
--- /dev/null
+++ b/man/MCMCmetrop1R.Rd
@@ -0,0 +1,189 @@
+\name{MCMCmetrop1R}
+\alias{MCMCmetrop1R}
+\title{Metropolis Sampling from User-Written R function}
+\description{
+ This function allows a user to construct a sample from a user-defined
+ R function using a random walk Metropolis algorithm. It assumes the
+ parameters to be sampled are in a single block.
+}
+\usage{
+MCMCmetrop1R(fun, theta.init, burnin = 500, mcmc = 20000, thin = 1,
+ tune = 1, verbose = TRUE, seed=NA, logfun = TRUE,
+ optim.trace = 0, optim.REPORT = 10, optim.maxit = 500, ...)
+}
+\arguments{
+ \item{fun}{The (log)density from which to take a sample. This should
+ be a function defined in R and it should take a single
+ argument. Additional arguments can be passed implicitly by either
+ putting them in the global environment or by passing them as
+ additional arguments to \code{MCMCmetrop1R()}. The examples below
+ demonstrate both of these approaches. }
+ \item{theta.init}{Starting values for the sampling. Must be of the
+ appropriate dimension.}
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of MCMC iterations after burnin.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ MCMC iterations must be divisible by this value.}
+
+ \item{tune}{Can be either a positive scalar or a
+ \eqn{k}{k}-vector, where \eqn{k}{k} is the length of
+ \eqn{\theta}{theta}.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number, the
+ \eqn{\theta}{theta} vector, the function value, and the Metropolis
+ acceptance rate are sent to the screen every 500 iterations.}
+
+ \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{logfun}{Logical indicating whether \code{fun} returns the natural log
+ of a density function (TRUE) or a density (FALSE).}
+
+ \item{optim.trace}{The value of the \code{trace} parameter sent to
+ \code{optim} during an initial maximization of \code{fun}. }
+
+ \item{optim.REPORT}{The value of the \code{REPORT} parameter sent to
+ \code{optim} during an initial maximization of \code{fun}.}
+
+ \item{optim.maxit}{The value of the \code{maxit} parameter sent to
+ \code{optim} during an initial maximization of \code{fun}.}
+
+ \item{\dots}{Additional arguments.}
+}
+\details{
+MCMCmetrop1R produces a sample from a user-defined (log)density using a
+random walk Metropolis algorithm with multivariate normal proposal
+distribution. See Gelman et al. (2003) and Robert & Casella (2004) for
+details of the random walk Metropolis algorithm.
+
+The proposal distribution is centered at the current value of
+\eqn{\theta}{theta} and has variance-covariance \eqn{V = T
+ (-1\cdot H)^{-1} T }{V = T (-1*H)^{-1} T}, where \eqn{T}{T} is a the
+diagonal positive definite matrix formed from the \code{tune} and
+\eqn{H}{H} is the approximate Hessian of \code{fun} evaluated at it's
+mode. This last calculation is done via an initial call to
+\code{optim}.
+
+}
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+\examples{
+ \dontrun{
+
+ ## logistic regression with an improper uniform prior
+ ## X and y are passed as args to MCMCmetrop1R
+
+ logitfun <- function(beta){
+ eta <- X \%*\% beta
+ p <- 1.0/(1.0+exp(-eta))
+ sum( y * log(p) + (1-y)*log(1-p) )
+ }
+
+ x1 <- rnorm(1000)
+ x2 <- rnorm(1000)
+ Xdata <- cbind(1,x1,x2)
+ p <- exp(.5 - x1 + x2)/(1+exp(.5 - x1 + x2))
+ yvector <- rbinom(1000, 1, p)
+
+ post.samp <- MCMCmetrop1R(logitfun, theta.init=c(0,0,0),
+ X=Xdata, y=yvector,
+ thin=1, mcmc=40000, burnin=500,
+ tune=c(1.5, 1.5, 1.5),
+ verbose=TRUE, logfun=TRUE, optim.maxit=100)
+
+ raftery.diag(post.samp)
+ plot(post.samp)
+ summary(post.samp)
+ ## ##################################################
+
+
+ ## logistic regression with an improper uniform prior
+ ## X and y are now in the global environment
+
+ logitfun <- function(beta){
+ eta <- X \%*\% beta
+ p <- 1.0/(1.0+exp(-eta))
+ sum( y * log(p) + (1-y)*log(1-p) )
+ }
+
+ x1 <- rnorm(1000)
+ x2 <- rnorm(1000)
+ X <- cbind(1,x1,x2)
+ p <- exp(.5 - x1 + x2)/(1+exp(.5 - x1 + x2))
+ y <- rbinom(1000, 1, p)
+
+ post.samp <- MCMCmetrop1R(logitfun, theta.init=c(0,0,0),
+ thin=1, mcmc=40000, burnin=500,
+ tune=c(1.5, 1.5, 1.5),
+ verbose=TRUE, logfun=TRUE, optim.maxit=100)
+
+ raftery.diag(post.samp)
+ plot(post.samp)
+ summary(post.samp)
+ ## ##################################################
+
+
+ ## negative binomial regression with an improper unform prior
+ ## X and y are passed as args to MCMCmetrop1R
+ negbinfun <- function(theta){
+ k <- length(theta)
+ beta <- theta[1:(k-1)]
+ alpha <- exp(theta[k])
+ mu <- exp(X \%*\% beta)
+ log.like <- sum(
+ lgamma(y+alpha) - lfactorial(y) - lgamma(alpha) +
+ alpha * log(alpha/(alpha+mu)) +
+ y * log(mu/(alpha+mu))
+ )
+ }
+
+ n <- 1000
+ x1 <- rnorm(n)
+ x2 <- rnorm(n)
+ XX <- cbind(1,x1,x2)
+ mu <- exp(1.5+x1+2*x2)*rgamma(n,1)
+ yy <- rpois(n, mu)
+
+ post.samp <- MCMCmetrop1R(negbinfun, theta.init=c(0,0,0,0), y=yy, X=XX,
+ thin=1, mcmc=35000, burnin=1000,
+ tune=1.5, verbose=TRUE, logfun=TRUE,
+ optim.maxit=500, seed=list(NA,1))
+ raftery.diag(post.samp)
+ plot(post.samp)
+ summary(post.samp)
+ ## ##################################################
+
+ }
+}
+\references{
+ Andrew Gelman, John B. Carlin, Hal S. Stern, and Donald
+ B. Rubin. 2003. \emph{Bayesian Data Analysis}. 2nd Edition. Boca
+ Raton: Chapman & Hall/CRC.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+
+ Christian P. Robert and George Casella. 2004. \emph{Monte Carlo
+ Statistical Methods}. 2nd Edition. New York: Springer.
+}
+\seealso{\code{\link[coda]{plot.mcmc}},
+ \code{\link[coda]{summary.mcmc}}, \code{\link[stats]{optim}}}
+
+\keyword{models}
diff --git a/man/MCMCmixfactanal.Rd b/man/MCMCmixfactanal.Rd
new file mode 100644
index 0000000..cfff474
--- /dev/null
+++ b/man/MCMCmixfactanal.Rd
@@ -0,0 +1,282 @@
+\name{MCMCmixfactanal}
+\alias{MCMCmixfactanal}
+\title{Markov chain Monte Carlo for Mixed Data Factor Analysis Model}
+\description{
+ This function generates a posterior density sample from a mixed data
+ (both continuous and ordinal) factor analysis model. Normal priors are
+ assumed on the factor loadings and factor scores, improper
+ uniform priors are assumed on the cutpoints, and inverse gamma priors
+ are assumed for the error variances (uniquenesses). The user supplies
+ data and parameters for the prior distributions, and a sample from the
+ posterior density is returned as an mcmc object, which can be
+ subsequently analyzed with functions provided in the coda package.
+}
+
+\usage{
+MCMCmixfactanal(x, factors, lambda.constraints=list(),
+ data=parent.environment(), burnin = 1000, mcmc = 20000,
+ thin=1, tune=NA, verbose = FALSE, seed = NA,
+ lambda.start = NA, psi.start=NA,
+ l0=0, L0=0, a0=0.001, b0=0.001,
+ store.lambda=TRUE, store.scores=FALSE,
+ std.mean=TRUE, std.var=TRUE, ... )
+ }
+
+\arguments{
+ \item{x}{A one-sided formula containing the
+ manifest variables. Ordinal (including dichotomous) variables must
+ be coded as ordered factors. NOTE: data input is different in
+ \code{MCMCmixfactanal} than in either \code{MCMCfactanal} or
+ \code{MCMCordfactanal}.}
+
+ \item{factors}{The number of factors to be fitted.}
+
+ \item{lambda.constraints}{List of lists specifying possible equality
+ or simple inequality constraints on the factor loadings. A typical
+ entry in the list has one of three forms: \code{varname=list(d,c)} which
+ will constrain the dth loading for the variable named varname to
+ be equal to c, \code{varname=list(d,"+")} which will constrain the dth
+ loading for the variable named varname to be positive, and
+ \code{varname=list(d, "-")} which will constrain the dth loading for the
+ variable named varname to be negative. If x is a matrix without
+ column names defaults names of ``V1", ``V2", ... , etc will be
+ used. Note that, unlike \code{MCMCfactanal}, the
+ \eqn{\Lambda}{Lambda} matrix used here has \code{factors}+1
+ columns. The first column of \eqn{\Lambda}{Lambda} corresponds to
+ negative item difficulty parameters for ordinal manifest variables
+ and mean parameters for continuous manifest variables and should
+ generally not be constrained directly by the user.
+ }
+
+ \item{data}{A data frame.}
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of iterations for the sampler.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ iterations must be divisible by this value.}
+
+ \item{tune}{The tuning parameter for the Metropolis-Hastings
+ sampling. Can be either a scalar or a \eqn{k}{k}-vector (where
+ \eqn{k}{k} is the number of manifest variables). \code{tune} must be
+ strictly positive.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number and
+ the Metropolis-Hastings acceptance rate are printed to the screen.}
+
+ \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{lambda.start}{Starting values for the factor loading matrix
+ Lambda. If \code{lambda.start} is set to a scalar the starting value for
+ all unconstrained loadings will be set to that scalar. If
+ \code{lambda.start} is a matrix of the same dimensions as Lambda then the
+ \code{lambda.start} matrix is used as the starting values (except
+ for equality-constrained elements). If \code{lambda.start} is set to
+ \code{NA} (the default) then starting values for unconstrained
+ elements in the first column of Lambda are based on the observed
+ response pattern, the remaining unconstrained elements of Lambda are
+ set to 0, and starting values for inequality constrained elements
+ are set to either 1.0 or -1.0 depending on the nature of the
+ constraints.}
+
+ \item{psi.start}{Starting values for the error variance (uniqueness)
+ matrix. If \code{psi.start} is set to a scalar then the starting
+ value for all diagonal elements of \code{Psi} that represent error
+ variances for continuous variables are set to this value. If
+ \code{psi.start} is a \eqn{k}{k}-vector (where \eqn{k}{k} is the
+ number of manifest variables) then the staring value of \code{Psi}
+ has \code{psi.start} on the main diagonal with the exception that
+ entries corresponding to error variances for ordinal variables are
+ set to 1.. If \code{psi.start} is set to \code{NA} (the default) the
+ starting values of all the continuous variable uniquenesses are set
+ to 0.5. Error variances for ordinal response variables are always
+ constrained (regardless of the value of \code{psi.start} to have an
+ error variance of 1 in order to achieve identification.}
+
+ \item{l0}{The means of the independent Normal prior on the factor
+ loadings. Can be either a scalar or a matrix with the same
+ dimensions as \code{Lambda}.}
+
+ \item{L0}{The precisions (inverse variances) of the independent Normal
+ prior on the factor loadings. Can be either a scalar or a matrix with
+ the same dimensions as \code{Lambda}.}
+
+ \item{a0}{Controls the shape of the inverse Gamma prior on the
+ uniqueness. The actual shape parameter is set to \code{a0/2}. Can be
+ either a scalar or a \eqn{k}{k}-vector.}
+
+ \item{b0}{Controls the scale of the inverse Gamma prior on the
+ uniquenesses. The actual scale parameter is set to \code{b0/2}. Can
+ be either a scalar or a \eqn{k}{k}-vector.}
+
+ \item{store.lambda}{A switch that determines whether or not to store
+ the factor loadings for posterior analysis. By default, the factor
+ loadings are all stored.}
+
+ \item{store.scores}{A switch that determines whether or not to
+ store the factor scores for posterior analysis.
+ \emph{NOTE: This takes an enormous amount of memory, so
+ should only be used if the chain is thinned heavily, or for
+ applications with a small number of observations}. By default, the
+ factor scores are not stored.}
+
+ \item{std.mean}{If \code{TRUE} (the default) the continuous manifest
+ variables are rescaled to have zero mean.}
+
+ \item{std.var}{If \code{TRUE} (the default) the continuous manifest
+ variables are rescaled to have unit variance.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{The model takes the following form:
+
+ Let \eqn{i=1,\ldots,N}{1=1,...,n} index observations and
+ \eqn{j=1,\ldots,K}{j=1,...,K} index response variables within an
+ observation. An observed
+ variable \eqn{x_{ij}}{x_ij} can be either ordinal with a
+ total of \eqn{C_j}{C_j}
+ categories or continuous.
+ The distribution of \eqn{X}{X} is governed by a \eqn{N
+ \times K}{N by K} matrix of latent variables \eqn{X^*}{Xstar} and a
+ series of cutpoints \eqn{\gamma}{gamma}. \eqn{X^*}{Xstar} is assumed
+ to be generated according to:
+
+ \deqn{x^*_i = \Lambda \phi_i + \epsilon_i}{xstar_i = Lambda phi_i +
+ epsilon_i}
+ \deqn{\epsilon_i \sim \mathcal{N}(0,\Psi)}{epsilon_i ~ N(0, Psi)}
+
+ where \eqn{x^*_i}{xstar_i} is the \eqn{k}{k}-vector of latent variables
+ specific to observation \eqn{i}{i}, \eqn{\Lambda}{Lambda} is the
+ \eqn{k \times d}{k by d} matrix of factor loadings, and
+ \eqn{\phi_i}{phi_i} is
+ the \eqn{d}{d}-vector of latent factor scores. It is assumed that the
+ first element of \eqn{\phi_i}{phi_i} is equal to 1 for all
+ \eqn{i}{i}.
+
+ If the \eqn{j}{j}th variable is ordinal, the probability that it takes
+ the value \eqn{c}{c} in observation \eqn{i}{i} is:
+
+ \deqn{
+ \pi_{ijc} = \Phi(\gamma_{jc} - \Lambda'_j\phi_i) -
+ \Phi(\gamma_{j(c-1)} - \Lambda'_j\phi_i)
+ }{
+ pi_ijc = pnorm(gamma_jc - Lambda'_j phi_i) -
+ pnorm(gamma_j(c-1) - Lambda'_j phi_i)
+ }
+
+ If the \eqn{j}{j}th variable is continuous, it is assumed that
+ \eqn{x^*_{ij} = x_{ij}}{xstar_{ij} = x_{ij}} for all \eqn{i}{i}.
+
+ The implementation used here assumes independent conjugate priors for
+ each element of \eqn{\Lambda}{Lambda} and each
+ \eqn{\phi_i}{phi_i}. More specifically we assume:
+
+ \deqn{\Lambda_{ij} \sim \mathcal{N}(l_{0_{ij}}, L_{0_{ij}}^{-1}),
+ i=1,\ldots,k, j=1,\ldots,d}{Lambda_ij ~ N(l0_ij, L0_ij^-1),
+ i=1,...,k, j=1,...,d}
+
+ \deqn{\phi_{i(2:d)} \sim \mathcal{N}(0, I),
+ i=1,\dots,n}{phi_i(2:d) ~ N(0, I),
+ i=1,...,n}
+
+ \code{MCMCmixfactanal} simulates from the posterior density using
+ a Metropolis-Hastings within Gibbs sampling algorithm. The algorithm
+ employed is based on work by Cowles (1996). Note that
+ the first element of \eqn{\phi_i}{phi_i} is a 1. As a result, the
+ first column of \eqn{\Lambda}{Lambda} can be interpretated as negative
+ item difficulty parameters. Further, the first
+ element \eqn{\gamma_1}{gamma_1} is normalized to zero, and thus not
+ returned in the mcmc object.
+ 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 density
+ sample.
+ }
+}
+
+\references{
+ Kevin M. Quinn. 2004. ``Bayesian Factor Analysis for Mixed Ordinal and
+ Continuous Responses.'' \emph{Political Analysis}. 12: 338-353.
+
+ M. K. Cowles. 1996. ``Accelerating Monte Carlo Markov Chain Convergence for
+ Cumulative-link Generalized Linear Models." \emph{Statistics and Computing.}
+ 6: 101-110.
+
+ Valen E. Johnson and James H. Albert. 1999. ``Ordinal Data Modeling."
+ Springer: New York.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+
+\examples{
+\dontrun{
+library(MASS)
+data(Cars93)
+attach(Cars93)
+new.cars <- data.frame(Price, MPG.city, MPG.highway,
+ Cylinders, EngineSize, Horsepower,
+ RPM, Length, Wheelbase, Width, Weight, Origin)
+rownames(new.cars) <- paste(Manufacturer, Model)
+detach(Cars93)
+
+# drop obs 57 (Mazda RX 7) b/c it has a rotary engine
+new.cars <- new.cars[-57,]
+# drop 3 cylinder cars
+new.cars <- new.cars[new.cars$Cylinders!=3,]
+# drop 5 cylinder cars
+new.cars <- new.cars[new.cars$Cylinders!=5,]
+
+new.cars$log.Price <- log(new.cars$Price)
+new.cars$log.MPG.city <- log(new.cars$MPG.city)
+new.cars$log.MPG.highway <- log(new.cars$MPG.highway)
+new.cars$log.EngineSize <- log(new.cars$EngineSize)
+new.cars$log.Horsepower <- log(new.cars$Horsepower)
+
+new.cars$Cylinders <- ordered(new.cars$Cylinders)
+new.cars$Origin <- ordered(new.cars$Origin)
+
+
+
+posterior <- MCMCmixfactanal(~log.Price+log.MPG.city+
+ log.MPG.highway+Cylinders+log.EngineSize+
+ log.Horsepower+RPM+Length+
+ Wheelbase+Width+Weight+Origin, data=new.cars,
+ lambda.constraints=list(log.Horsepower=list(2,"+"),
+ log.Horsepower=c(3,0), weight=list(3,"+")),
+ factors=2,
+ burnin=5000, mcmc=500000, thin=100, verbose=TRUE,
+ L0=.25, tune=1.5)
+
+
+}
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}}, \code{\link[coda]{summary.mcmc}},
+ \code{\link[mva]{factanal}}, \code{\link[MCMCpack]{MCMCfactanal}},
+ \code{\link[MCMCpack]{MCMCordfactanal}},
+ \code{\link[MCMCpack]{MCMCirt1d}}, \code{\link[MCMCpack]{MCMCirtKd}}}
+
diff --git a/man/MCMCoprobit.Rd b/man/MCMCoprobit.Rd
new file mode 100644
index 0000000..9c375da
--- /dev/null
+++ b/man/MCMCoprobit.Rd
@@ -0,0 +1,137 @@
+\name{MCMCoprobit}
+\alias{MCMCoprobit}
+\title{Markov chain Monte Carlo for Ordered Probit Regression}
+\description{
+ This function generates a posterior density sample
+ from an ordered probit regression model using the data augmentation
+ approach of Cowles (1996). The user supplies data and priors,
+ and a sample from the posterior density is returned as an mcmc
+ object, which can be subsequently analyzed with functions
+ provided in the coda package.
+ }
+
+\usage{
+MCMCoprobit(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin=1, tune = NA, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, ...) }
+
+\arguments{
+ \item{formula}{Model formula.}
+
+ \item{data}{Data frame.}
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of MCMC iterations for the sampler.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ Gibbs iterations must be divisible by this value.}
+
+ \item{tune}{The tuning parameter for the Metropolis-Hastings
+ step. Default of NA corresponds to a choice of 0.05 divided by the
+ number of categories in the response variable.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration
+ number, the beta vector, and the Metropolis-Hastings acceptance rate
+ are printed to the screen every 500 iterations.}
+
+ \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{beta.start}{The starting value for the \eqn{\beta}{beta} vector.
+ 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 starting value for all of the betas. The
+ default value of NA will use rescaled estimates from an ordered
+ logit model.}
+
+ \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 \eqn{\beta}{beta}.
+ Default value of 0 is equivalent to an improper uniform prior on
+ \eqn{\beta}{beta}. }
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{
+\code{MCMCoprobit} simulates from the posterior density of a ordered probit
+ regression model using data augmentation. 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 density sample.
+
+ The observed variable \eqn{y_i}{y_i} is ordinal with a total of \eqn{C}{C}
+ categories, with distribution
+ governed by a latent variable:
+ \deqn{z_i = x_i'\beta + \varepsilon_i}{z_i = x_i'beta + epsilon_i}
+ The errors are assumed to be from a standard Normal distribution. The
+ probabilities of observing each outcome is governed by this latent
+ variable and \eqn{C-1}{C-1} estimable cutpoints, which are denoted
+ \eqn{\gamma_c}{gamma_c}. The probability that individual \eqn{i}{i}
+ is in category \eqn{c}{c} is computed by:
+ \deqn{
+ \pi_{ic} = \Phi(\gamma_c - x_i'\beta) - \Phi(\gamma_{c-1} - x_i'\beta)
+ }{
+ pi_ic = Phi(gamma_c - x_i'beta) - Phi(gamma_(c-1) - x_i'beta)
+ }
+ These probabilities are used to form the multinomial distribution
+ that defines the likelihoods.
+
+ The algorithm employed is discussed in depth by Cowles (1996). Note that
+ the model does include a constant in the data matrix. Thus, the first
+ element \eqn{\gamma_1}{gamma_1} is normalized to zero, and is not
+ returned in the mcmc object.
+}
+
+\references{
+ M. K. Cowles. 1996. ``Accelerating Monte Carlo Markov Chain Convergence for
+ Cumulative-link Generalized Linear Models." \emph{Statistics and Computing.}
+ 6: 101-110.
+
+ Valen E. Johnson and James H. Albert. 1999. ``Ordinal Data Modeling."
+ Springer: New York.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}
+}
+
+
+\examples{
+ \dontrun{
+ x1 <- rnorm(100); x2 <- rnorm(100);
+ z <- 1.0 + x1*0.1 - x2*0.5 + rnorm(100);
+ y <- z; y[z < 0] <- 0; y[z >= 0 & z < 1] <- 1;
+ y[z >= 1 & z < 1.5] <- 2; y[z >= 1.5] <- 3;
+ posterior <- MCMCoprobit(y ~ x1 + x2, tune=0.3, mcmc=20000)
+ plot(posterior)
+ summary(posterior)
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}}}
diff --git a/man/MCMCordfactanal.Rd b/man/MCMCordfactanal.Rd
new file mode 100644
index 0000000..a590921
--- /dev/null
+++ b/man/MCMCordfactanal.Rd
@@ -0,0 +1,228 @@
+\name{MCMCordfactanal}
+\alias{MCMCordfactanal}
+\title{Markov chain Monte Carlo for Ordinal Data Factor Analysis Model}
+\description{
+ This function generates a posterior density sample from an ordinal data
+ factor analysis model. Normal priors are assumed on the factor
+ loadings and factor scores while improper uniform priors are assumed
+ on the cutpoints. The user supplies data and parameters for the prior
+ distributions, and a sample from the posterior density is returned as
+ an mcmc object, which can be subsequently analyzed with
+ functions provided in the coda package.
+}
+
+\usage{
+MCMCordfactanal(x, factors, lambda.constraints=list(),
+ data=parent.environment(), burnin = 1000, mcmc = 20000,
+ thin=1, tune=NA, verbose = FALSE, seed = NA,
+ lambda.start = NA, l0=0, L0=0,
+ store.lambda=TRUE, store.scores=FALSE,
+ drop.constantvars=TRUE, ... )
+ }
+
+\arguments{
+ \item{x}{Either a formula or a numeric matrix containing the
+ manifest variables.}
+
+ \item{factors}{The number of factors to be fitted.}
+
+ \item{lambda.constraints}{List of lists specifying possible equality
+ or simple inequality constraints on the factor loadings. A typical
+ entry in the list has one of three forms: \code{varname=list(d,c)} which
+ will constrain the dth loading for the variable named varname to
+ be equal to c, \code{varname=list(d,"+")} which will constrain the dth
+ loading for the variable named varname to be positive, and
+ \code{varname=list(d, "-")} which will constrain the dth loading for the
+ variable named varname to be negative. If x is a matrix without
+ column names defaults names of ``V1", ``V2", ... , etc will be
+ used. Note that, unlike \code{MCMCfactanal}, the
+ \eqn{\Lambda}{Lambda} matrix used here has \code{factors}+1
+ columns. The first column of \eqn{\Lambda}{Lambda} corresponds to
+ negative item difficulty parameters and should generally not be
+ constrained.
+ }
+
+ \item{data}{A data frame.}
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of iterations for the sampler.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ iterations must be divisible by this value.}
+
+ \item{tune}{The tuning parameter for the Metropolis-Hastings
+ sampling. Can be either a scalar or a \eqn{k}{k}-vector. Must be
+ strictly positive.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number and
+ the Metropolis-Hastings acceptance rate are printed to the screen.}
+
+ \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{lambda.start}{Starting values for the factor loading matrix
+ Lambda. If \code{lambda.start} is set to a scalar the starting value for
+ all unconstrained loadings will be set to that scalar. If
+ \code{lambda.start} is a matrix of the same dimensions as Lambda then the
+ \code{lambda.start} matrix is used as the starting values (except
+ for equality-constrained elements). If \code{lambda.start} is set to
+ \code{NA} (the default) then starting values for unconstrained
+ elements in the first column of Lambda are based on the observed
+ response pattern, the remaining unconstrained elements of Lambda are
+ set to , and starting values for inequality constrained elements are
+ set to either 1.0 or -1.0 depending on the nature of the constraints.}
+
+ \item{l0}{The means of the independent Normal prior on the factor
+ loadings. Can be either a scalar or a matrix with the same
+ dimensions as \code{Lambda}.}
+
+ \item{L0}{The precisions (inverse variances) of the independent Normal
+ prior on the factor loadings. Can be either a scalar or a matrix with
+ the same dimensions as \code{Lambda}.}
+
+ \item{store.lambda}{A switch that determines whether or not to store
+ the factor loadings for posterior analysis. By default, the factor
+ loadings are all stored.}
+
+ \item{store.scores}{A switch that determines whether or not to
+ store the factor scores for posterior analysis.
+ \emph{NOTE: This takes an enormous amount of memory, so
+ should only be used if the chain is thinned heavily, or for
+ applications with a small number of observations}. By default, the
+ factor scores are not stored.}
+
+ \item{drop.constantvars}{A switch that determines whether or not
+ manifest variables that have no variation should be deleted
+ before fitting the model. Default = TRUE.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{The model takes the following form:
+
+ Let \eqn{i=1,\ldots,N}{1=1,...,n} index observations and
+ \eqn{j=1,\ldots,K}{j=1,...,K} index response variables within an
+ observation. The typical observed
+ variable \eqn{x_{ij}}{x_ij} is ordinal with a total of \eqn{C_j}{C_j}
+ categories. The distribution of \eqn{X}{X} is governed by a \eqn{N
+ \times K}{N by K} matrix of latent variables \eqn{X^*}{Xstar} and a
+ series of cutpoints \eqn{\gamma}{gamma}. \eqn{X^*}{Xstar} is assumed
+ to be generated according to:
+
+ \deqn{x^*_i = \Lambda \phi_i + \epsilon_i}{xstar_i = Lambda phi_i +
+ epsilon_i}
+ \deqn{\epsilon_i \sim \mathcal{N}(0,I)}{epsilon_i ~ N(0, I)}
+
+ where \eqn{x^*_i}{xstar_i} is the \eqn{k}{k}-vector of latent variables
+ specific to observation \eqn{i}{i}, \eqn{\Lambda}{Lambda} is the
+ \eqn{k \times d}{k by d} matrix of factor loadings, and
+ \eqn{\phi_i}{phi_i} is
+ the \eqn{d}{d}-vector of latent factor scores. It is assumed that the
+ first element of \eqn{\phi_i}{phi_i} is equal to 1 for all
+ \eqn{i}{i}.
+
+ The probability that the \eqn{j}{j}th variable in observation
+ \eqn{i}{i} takes the value \eqn{c}{c} is:
+
+ \deqn{
+ \pi_{ijc} = \Phi(\gamma_{jc} - \Lambda'_j\phi_i) -
+ \Phi(\gamma_{j(c-1)} - \Lambda'_j\phi_i)
+ }{
+ pi_ijc = pnorm(gamma_jc - Lambda'_j phi_i) -
+ pnorm(gamma_j(c-1) - Lambda'_j phi_i)
+ }
+
+ The implementation used here assumes independent conjugate priors for
+ each element of \eqn{\Lambda}{Lambda} and each
+ \eqn{\phi_i}{phi_i}. More specifically we assume:
+
+ \deqn{\Lambda_{ij} \sim \mathcal{N}(l_{0_{ij}}, L_{0_{ij}}^{-1}),
+ i=1,\ldots,k, j=1,\ldots,d}{Lambda_ij ~ N(l0_ij, L0_ij^-1),
+ i=1,...,k, j=1,...,d}
+
+ \deqn{\phi_{i(2:d)} \sim \mathcal{N}(0, I),
+ i=1,\dots,n}{phi_i(2:d) ~ N(0, I),
+ i=1,...,n}
+
+
+ The standard two-parameter item response theory model with probit
+ link is a special case of the model sketched above.
+
+ \code{MCMCordfactanal} simulates from the posterior density using
+ a Metropolis-Hastings within Gibbs sampling algorithm. The algorithm
+ employed is based on work by Cowles (1996). Note that
+ the first element of \eqn{\phi_i}{phi_i} is a 1. As a result, the
+ first column of \eqn{\Lambda}{Lambda} can be interpretated as item
+ difficulty parameters. Further, the first
+ element \eqn{\gamma_1}{gamma_1} is normalized to zero, and thus not
+ returned in the mcmc object.
+ 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 density
+ sample.
+ }
+}
+
+\references{
+ Shawn Treier and Simon Jackman. 2003. ``Democracy as a Latent Variable."
+ Paper presented at the Midwest Political Science Association Annual Meeting.
+
+ M. K. Cowles. 1996. ``Accelerating Monte Carlo Markov Chain Convergence for
+ Cumulative-link Generalized Linear Models." \emph{Statistics and Computing.}
+ 6: 101-110.
+
+ Valen E. Johnson and James H. Albert. 1999. ``Ordinal Data Modeling."
+ Springer: New York.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+
+\examples{
+ \dontrun{
+ data(painters)
+ new.painters <- painters[,1:4]
+ cuts <- apply(new.painters, 2, quantile, c(.25, .50, .75))
+ for (i in 1:4){
+ new.painters[new.painters[,i]<cuts[1,i],i] <- 100
+ new.painters[new.painters[,i]<cuts[2,i],i] <- 200
+ new.painters[new.painters[,i]<cuts[3,i],i] <- 300
+ new.painters[new.painters[,i]<100,i] <- 400
+ }
+
+ posterior <- MCMCordfactanal(~Composition+Drawing+Colour+Expression,
+ data=new.painters, factors=1,
+ lambda.constraints=list(Drawing=list(2,"+")),
+ burnin=5000, mcmc=500000, thin=200, verbose=TRUE,
+ L0=0.5, store.lambda=TRUE,
+ store.scores=TRUE, tune=1.2)
+ plot(posterior)
+ summary(posterior)
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}}, \code{\link[coda]{summary.mcmc}},
+ \code{\link[mva]{factanal}}, \code{\link[MCMCpack]{MCMCfactanal}},
+ \code{\link[MCMCpack]{MCMCirt1d}}, \code{\link[MCMCpack]{MCMCirtKd}}}
+
diff --git a/man/MCMCpanel.Rd b/man/MCMCpanel.Rd
new file mode 100644
index 0000000..555a2a6
--- /dev/null
+++ b/man/MCMCpanel.Rd
@@ -0,0 +1,157 @@
+\name{MCMCpanel}
+\alias{MCMCpanel}
+\title{Markov chain Monte Carlo for the General Linear Panel Model}
+\description{
+ MCMCpanel generates a posterior density sample from 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 density 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 = FALSE, 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 TRUE, the iteration number
+ and parameters are printed to the screen.}
+
+ \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 density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{
+ \code{MCMCpanel} simulates from the posterior density 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 density 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.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004. \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/man/MCMCpoisson.Rd b/man/MCMCpoisson.Rd
new file mode 100644
index 0000000..bbaca67
--- /dev/null
+++ b/man/MCMCpoisson.Rd
@@ -0,0 +1,129 @@
+\name{MCMCpoisson}
+\alias{MCMCpoisson}
+\title{Markov chain Monte Carlo for Poisson Regression}
+\description{
+ This function generates a posterior density sample
+ from a Poisson regression model using a random walk Metropolis
+ algorithm. The user supplies data and priors,
+ and a sample from the posterior density is returned as an mcmc
+ object, which can be subsequently analyzed with functions
+ provided in the coda package.
+ }
+
+\usage{
+MCMCpoisson(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin = 1, tune = 1.1, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, ...) }
+
+\arguments{
+ \item{formula}{Model formula.}
+
+ \item{data}{Data frame.}
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of Metropolis 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{tune}{Metropolis tuning parameter. Can be either a positive
+ scalar or a \eqn{k}{k}-vector, where \eqn{k}{k} is the length of
+ \eqn{\beta}{beta}.Make sure that the
+ acceptance rate is satisfactory (typically between 0.20 and 0.5)
+ before using the posterior density sample for inference.}
+
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number,
+ the current beta vector, and the Metropolis acceptance rate are
+ printed to the screen every 500 iterations.}
+
+ \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{beta.start}{The starting value for the \eqn{\beta}{beta} vector.
+ 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
+ starting value for all of the betas. The default value of NA will
+ use the maximum likelihood estimate of \eqn{\beta}{beta} as the starting
+ value.}
+
+ \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 \eqn{\beta}{beta}. Default value of 0 is
+ equivalent to an improper uniform prior for beta.}
+
+ \item{\ldots}{further arguments to be passed}
+
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{\code{MCMCpoisson} simulates from the posterior density of a Poisson
+ regression model using a random walk Metropolis algorithm. 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 density sample.
+
+ The model takes the following form:
+ \deqn{y_i \sim \mathcal{P}oisson(\mu_i)}{y_i ~ Poisson(mu_i)}
+ Where the inverse link function:
+ \deqn{\mu_i = \exp(x_i'\beta)}{mu_i = exp(x_i'beta)}
+ We assume a multivariate Normal prior on \eqn{\beta}{beta}:
+ \deqn{\beta \sim \mathcal{N}(b_0,B_0^{-1})}{beta ~ N(b0,B0^(-1))}
+
+ The Metropois proposal distribution is centered at the current value of
+ \eqn{\theta}{theta} and has variance-covariance \eqn{V = T
+ (B_0 + C^{-1})^{-1} T }{V = T (B0 + C^{-1})^{-1} T}, where
+ \eqn{T}{T} is a the diagonal positive definite matrix formed from the
+ \code{tune}, \eqn{B_0}{B0} is the prior precision, and \eqn{C}{C} is
+ the large sample variance-covariance matrix of the MLEs. This last
+ calculation is done via an initial call to \code{glm}.
+ }
+
+\references{
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+
+\examples{
+ \dontrun{
+ counts <- c(18,17,15,20,10,20,25,13,12)
+ outcome <- gl(3,1,9)
+ treatment <- gl(3,3)
+ posterior <- MCMCpoisson(counts ~ outcome + treatment)
+ plot(posterior)
+ summary(posterior)
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}}, \code{\link[base]{glm}}}
+
diff --git a/man/MCMCprobit.Rd b/man/MCMCprobit.Rd
new file mode 100644
index 0000000..f470d2e
--- /dev/null
+++ b/man/MCMCprobit.Rd
@@ -0,0 +1,127 @@
+\name{MCMCprobit}
+\alias{MCMCprobit}
+\title{Markov chain Monte Carlo for Probit Regression}
+\description{
+ This function generates a posterior density sample
+ from a probit regression model using the data augmentation
+ approach of Albert and Chib (1993). The user supplies data and priors,
+ and a sample from the posterior density is returned as an mcmc
+ object, which can be subsequently analyzed with functions
+ provided in the coda package.
+ }
+
+\usage{
+MCMCprobit(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin = 1, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, bayes.resid = FALSE, ...) }
+
+\arguments{
+ \item{formula}{Model formula.}
+
+ \item{data}{Data frame.}
+
+ \item{burnin}{The number of burn-in 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
+ Gibbs iterations must be divisible by this value.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number and
+ the betas are printed to the screen.}
+
+ \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{beta.start}{The starting value for the \eqn{\beta}{beta} vector.
+ 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
+ starting value for all of the betas. The default value of NA will
+ use the maximum likelihood estimate of \eqn{\beta}{beta} as the starting
+ value.}
+
+ \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 \eqn{\beta}{beta}. Default value of 0 is
+ equivalent to
+ an improper uniform prior on \eqn{\beta}{beta}.}
+
+ \item{bayes.resid}{Should latent Bayesian residuals (Albert and Chib,
+ 1995) be returned? Default is FALSE meaning no residuals should be
+ returned. Alternatively, the user can specify an array of integers
+ giving the observation numbers for which latent residuals should be
+ calculated and returned. TRUE will return draws of
+ latent residuals for all observations.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{
+\code{MCMCprobit} simulates from the posterior density of a probit
+ regression model using data augmentation. 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 density sample.
+
+ The model takes the following form:
+ \deqn{y_i \sim \mathcal{B}ernoulli(\pi_i)}{y_i ~ Bernoulli(pi_i)}
+ Where the inverse link function:
+ \deqn{\pi_i = \Phi(x_i'\beta)}{pi_i = Phi(x_i'beta)}
+ We assume a multivariate Normal prior on \eqn{\beta}{beta}:
+ \deqn{\beta \sim \mathcal{N}(b_0,B_0^{-1})}{beta ~ N(b0,B0^(-1))}
+ See Albert and Chib (1993) for estimation details.
+
+ }
+
+\references{
+ Albert, J. H. and S. Chib. 1993. ``Bayesian Analysis of Binary and
+ Polychotomous Response Data.'' \emph{J. Amer. Statist. Assoc.} 88, 669-679
+
+ Albert, J. H. and S. Chib. 1995. ``Bayesian Residual Analysis for
+ Binary Response Regression Models.'' \emph{Biometrika.} 82, 747-759.
+
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+
+\examples{
+ \dontrun{
+ data(birthwt)
+ posterior <- MCMCprobit(low~age+as.factor(race)+smoke, data=birthwt)
+ plot(posterior)
+ summary(posterior)
+ }
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}},\code{\link[coda]{summary.mcmc}}, \code{\link[base]{glm}}}
+
diff --git a/man/MCMCregress.Rd b/man/MCMCregress.Rd
new file mode 100644
index 0000000..555577e
--- /dev/null
+++ b/man/MCMCregress.Rd
@@ -0,0 +1,136 @@
+\name{MCMCregress}
+\alias{MCMCregress}
+\title{Markov Chain Monte Carlo for Gaussian Linear Regression}
+\description{
+ This function generates a posterior density sample
+ from a linear regression model with Gaussian errors using
+ Gibbs sampling (with a multivariate Gaussian prior on the
+ beta vector, and an inverse Gamma prior on the conditional
+ error variance). The user supplies data and priors, and
+ a sample from the posterior density is returned as an mcmc
+ object, which can be subsequently analyzed with functions
+ provided in the coda package.
+ }
+
+\usage{
+MCMCregress(formula, data = parent.frame(), burnin = 1000, mcmc = 10000,
+ thin = 1, verbose = FALSE, seed = NA, beta.start = NA,
+ b0 = 0, B0 = 0, c0 = 0.001, d0 = 0.001, ...) }
+
+\arguments{
+ \item{formula}{Model formula.}
+
+ \item{data}{Data frame.}
+
+ \item{burnin}{The number of burn-in iterations for the sampler.}
+
+ \item{mcmc}{The number of MCMC iterations after burnin.}
+
+ \item{thin}{The thinning interval used in the simulation. The number of
+ MCMC iterations must be divisible by this value.}
+
+ \item{verbose}{A switch which determines whether or not the progress of
+ the sampler is printed to the screen. If TRUE, the iteration number, the
+ \eqn{\beta}{beta} vector, and the conditional error variance is printed to
+ the screen
+ every 500 iterations.}
+
+ \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{beta.start}{The starting values for the \eqn{\beta}{beta} vector.
+ This can either be a scalar or a
+ column vector with dimension equal to the number of betas.
+ The default value of of NA will use the OLS
+ estimate of \eqn{\beta}{beta} as the starting value. If this is a
+ scalar, that value will serve as the starting value
+ mean for all of the betas.}
+
+ \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{c0}{\eqn{c_0/2}{c0/2} is the shape parameter for the inverse
+ Gamma prior on \eqn{\sigma^2}{sigma^2} (the variance of the
+ disturbances). The amount of information in the inverse Gamma prior
+ is something like that from \eqn{c_0}{c0} pseudo-observations.}
+
+ \item{d0}{\eqn{d_0/2}{d0/2} is the scale parameter for the
+ inverse Gamma prior on \eqn{\sigma^2}{sigma^2} (the variance of the
+ disturbances). In constructing the inverse Gamma prior,
+ \eqn{d_0}{d0} acts like the sum of squared errors from the
+ \eqn{c_0}{c0} pseudo-observations.}
+
+ \item{...}{further arguments to be passed}
+}
+
+\value{
+ An mcmc object that contains the posterior density sample. This
+ object can be summarized by functions provided by the coda package.
+}
+
+\details{
+ \code{MCMCregress} simulates from the posterior density using
+ standard Gibbs sampling (a multivariate Normal draw for the betas, and an
+ inverse Gamma draw for the conditional error variance). 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 density sample.
+
+ The model takes the following form:
+ \deqn{y_i = x_i ' \beta + \varepsilon_{i}}{y_i = x_i'beta + epsilon_i}
+ Where the errors are assumed to be Gaussian:
+ \deqn{\varepsilon_{i} \sim \mathcal{N}(0, \sigma^2)}{epsilon_i ~ N(0,
+ sigma^2)}
+ We assume standard, semi-conjugate priors:
+ \deqn{\beta \sim \mathcal{N}(b_0,B_0^{-1})}{beta ~ N(b0,B0^(-1))}
+ And:
+ \deqn{\sigma^{-2} \sim \mathcal{G}amma(c_0/2, d_0/2)}{sigma^(-2) ~
+ Gamma(c0/2, d0/2)}
+ Where \eqn{\beta}{beta} and \eqn{\sigma^{-2}}{sigma^(-2)} are assumed
+ \emph{a priori} independent. Note that only starting values for
+ \eqn{\beta}{beta} are allowed because simulation is done using
+ Gibbs sampling with the conditional error variance
+ as the first block in the sampler.
+ }
+
+\references{
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+
+ 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/}.
+}
+
+
+\examples{
+\dontrun{
+line <- list(X = c(-2,-1,0,1,2), Y = c(1,3,3,3,5))
+posterior <- MCMCregress(Y~X, data=line, verbose=TRUE)
+plot(posterior)
+raftery.diag(posterior)
+summary(posterior)
+}
+}
+
+\keyword{models}
+
+\seealso{\code{\link[coda]{plot.mcmc}},
+ \code{\link[coda]{summary.mcmc}}, \code{\link[stats]{lm}}}
diff --git a/man/PErisk.Rd b/man/PErisk.Rd
new file mode 100644
index 0000000..df984d6
--- /dev/null
+++ b/man/PErisk.Rd
@@ -0,0 +1,50 @@
+\name{PErisk}
+\alias{PErisk}
+\docType{data}
+\title{Political Economic Risk Data from 62 Countries in 1987}
+\description{
+Political Economic Risk Data from 62 Countries in 1987.
+}
+\usage{data(CountryRisk)}
+\format{
+ A data frame with 62 observations on the following 9 variables. All
+ data points are from 1987. See Quinn (2004) for more details.
+ \describe{
+ \item{country}{a factor with levels \code{Argentina} \code{Australia} \code{Austria} \code{Bangladesh} \code{Belgium} \code{Bolivia} \code{Botswana} \code{Brazil} \code{Burma} \code{Cameroon} \code{Canada} \code{Chile} \code{Colombia} \code{Congo-Kinshasa} \code{Costa Rica} \code{Cote d'Ivoire} \code{Denmark} \code{Dominican Republic} \code{Ecuador} \code{Finland} \code{Gambia, The} \code{Ghana} \code{Greece} \code{Hungary} \code{India} \code{Indonesia} \code{Iran} \code{Ireland} \co [...]
+ \item{courts}{an ordered factor with levels \code{0} <
+ \code{1}.\code{courts} is an indicator of whether the country in
+ question is judged to have an independent judiciary. From Henisz
+ (2002).}
+ \item{barb2}{a numeric vector giving the natural log of the black
+ market premium in each country. The black market premium is coded
+ as the black market exchange rate (local currency per dollar)
+ divided by the official exchange rate minus 1. From Marshall,
+ Gurr, and Harff (2002). }
+ \item{prsexp2}{an ordered factor with levels \code{0} < \code{1} <
+ \code{2} < \code{3} < \code{4} < \code{5}, giving the lack of
+ expropriation risk. From Marshall, Gurr, and Harff (2002).}
+ \item{prscorr2}{an ordered factor with levels \code{0} < \code{1} <
+ \code{2} < \code{3} < \code{4} < \code{5}, measuring the lack of
+ corruption. From Marshall, Gurr, and Harff (2002).}
+ \item{gdpw2}{a numeric vector giving the natural log of real GDP per
+ worker in 1985 international prices. From Alvarez et al. (1999).}
+ }
+}
+\source{
+ Mike Alvarez, Jose Antonio Cheibub, Fernando Limongi, and Adam
+ Przeworski. 1999. ``ACLP Political and Economic Database.''
+ \url{http://www.ssc.upenn.edu/~cheibub/data/}.
+
+ Witold J. Henisz. 2002. ``The Political Constraint Index (POLCON)
+ Dataset.''
+ \url{http://www-management.wharton.upenn.edu/henisz/POLCON/ContactInfo.html}.
+
+ Monty G. Marshall, Ted Robert Gurr, and Barbara Harff. 2002. ``State
+ Failure Task Force Problem Set.''
+ \url{http://www.cidcm.umd.edu/inscr/stfail/index.htm}.
+}
+\references{
+ Kevin M. Quinn. 2004. ``Bayesian Factor Analysis for Mixed Ordinal
+ and Continuous Response.'' \emph{Political Analyis}. 12: 338-353.
+}
+\keyword{datasets}
diff --git a/man/Senate.Rd b/man/Senate.Rd
new file mode 100644
index 0000000..5b1ce9e
--- /dev/null
+++ b/man/Senate.Rd
@@ -0,0 +1,29 @@
+\name{Senate}
+\alias{Senate}
+
+\title{
+ 106th U.S. Senate Roll Call Vote Matrix
+}
+\description{
+ This dataframe contains a matrix of votes cast by U.S. Senators
+ in the 106th Congress.
+}
+\usage{
+data(Senate)
+}
+\format{
+ The dataframe contains roll call data for all Senators in the 106th
+ Senate. The first column (id) is the ICPSR member ID number, the
+ second column (statecode) is the ICPSR state code, the third column (party)
+ is the member's state name, and the fourth column (member) is the member's
+ name. This is followed by all roll call votes (including unanimous ones)
+ in the 106th. Nay votes are coded 0, yea votes are coded 1,
+ and NAs are missing votes.
+}
+
+\source{
+ Keith Poole. 2003. \emph{106th Roll Call Vote Data}.
+ \url{http://voteview.uh.edu/}.
+}
+
+\keyword{datasets}
diff --git a/man/SupremeCourt.Rd b/man/SupremeCourt.Rd
new file mode 100644
index 0000000..d5db85c
--- /dev/null
+++ b/man/SupremeCourt.Rd
@@ -0,0 +1,31 @@
+\name{SupremeCourt}
+\alias{SupremeCourt}
+\title{
+ U.S. Supreme Court Vote Matrix
+}
+\description{
+ This dataframe contains a matrix votes cast by U.S. Supreme
+ Court justices in all cases in the 2000 term.
+}
+\usage{
+data(SupremeCourt)
+}
+\format{
+ The dataframe has contains data for justices Rehnquist, Stevens,
+ O'Connor, Scalia, Kennedy, Souter, Thomas, Ginsburg, and Breyer
+ for the 2000 term of the U.S. Supreme Court. It contains data
+ from 43 non-unanimous cases. The votes are coded liberal (1)
+ and conservative
+ (0) using the protocol of Spaeth (2003). The unit of analysis
+ is the case citation (ANALU=0). We are concerned with formally
+ decided cases issued with written opinions, after full oral
+ argument and cases decided by an equally divided vote
+ (DECTYPE=1,5,6,7).
+}
+
+\source{
+ Harold J. Spaeth. 2003. \emph{Original United States Supreme Court Database:
+ 1953-2001 Terms.} \url{http://polisci.msu.edu/pljp/}.
+}
+
+\keyword{datasets}
diff --git a/man/dirichlet.Rd b/man/dirichlet.Rd
new file mode 100644
index 0000000..2bdf3df
--- /dev/null
+++ b/man/dirichlet.Rd
@@ -0,0 +1,43 @@
+\name{Dirichlet}
+\alias{Dirichlet}
+\alias{ddirichlet}
+\alias{rdirichlet}
+\title{The Dirichlet Distribution}
+\description{
+ Density function and random generation from the Dirichlet distribution.
+}
+\usage{
+ddirichlet(x, alpha)
+rdirichlet(n, alpha)
+}
+\arguments{
+ \item{x}{A vector containing a single deviate or matrix containing
+ one random deviate per row.}
+ \item{n}{Number of random vectors to generate. }
+ \item{alpha}{Vector of shape parameters, or matrix of shape
+ parameters corresponding to the number of draw.}
+}
+\details{
+ The Dirichlet distribution is the multidimensional generalization of
+ the beta distribution.
+}
+
+\value{
+ \code{ddirichlet} gives the density. \code{rdirichlet} returns a
+ matrix with \code{n} rows, each containing a single Dirichlet random
+ deviate.
+}
+\author{
+ Code is taken from Greg's Miscellaneous Functions (gregmisc). His
+ code was based on code posted by Ben Bolker to R-News on 15 Dec
+ 2000.
+}
+
+\seealso{ \code{\link[stats]{Beta}} }
+
+\examples{
+ density <- ddirichlet(c(.1,.2,.7), c(1,1,1))
+ draws <- rdirichlet(20, c(1,1,1) )
+}
+
+\keyword{distribution}
diff --git a/man/dtomog.Rd b/man/dtomog.Rd
new file mode 100644
index 0000000..e9774a1
--- /dev/null
+++ b/man/dtomog.Rd
@@ -0,0 +1,122 @@
+\name{dtomogplot}
+\alias{dtomogplot}
+\title{Dynamic Tomography Plot}
+\description{
+ dtomogplot is used to produce a tomography plot (see King, 1997) for a
+ series of temporally ordered, partially observed 2 x 2 contingency
+ tables.
+}
+
+\usage{
+dtomogplot(r0, r1, c0, c1, time.vec=NA, delay=0,
+ xlab="fraction of r0 in c0 (p0)",
+ ylab="fraction of r1 in c0 (p1)",
+ color.palette=heat.colors, bgcol="black", ...)
+}
+
+\arguments{
+ \item{r0}{An \eqn{(ntables \times 1)}{(ntables * 1)} vector of row sums from row 0.}
+
+ \item{r1}{An \eqn{(ntables \times 1)}{(ntables * 1)} vector of row sums from row 1.}
+
+ \item{c0}{An \eqn{(ntables \times 1)}{(ntables * 1)} vector of column sums from column 0.}
+
+ \item{c1}{An \eqn{(ntables \times 1)}{(ntables * 1)} vector of column sums from column 1.}
+
+ \item{time.vec}{Vector of time periods that correspond to the elements
+ of \eqn{r_0}{r0}, \eqn{r_1}{r1}, \eqn{c_0}{c0}, and \eqn{c_1}{c1}.}
+
+ \item{delay}{Time delay in seconds between the plotting of the
+ tomography lines. Setting a positive delay is useful for visualizing
+ temporal dependence.}
+
+ \item{xlab}{The x axis label for the plot.}
+
+ \item{ylab}{The y axis label for the plot.}
+
+ \item{color.palette}{Color palette to be used to encode temporal patterns.}
+
+ \item{bgcol}{The background color for the plot.}
+
+ \item{...}{further arguments to be passed}
+}
+
+
+\details{
+ Consider the following partially observed 2 by 2 contingency table:\cr
+ \cr
+ \tabular{llll}{
+ \tab | \eqn{Y=0} \tab | \eqn{Y=1} \tab | \cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \eqn{X=0} \tab | \eqn{Y_0}{Y0} \tab | \tab | \eqn{r_0}{r0}\cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \eqn{X=1} \tab | \eqn{Y_1}{Y1} \tab | \tab | \eqn{r_1}{r1}\cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \tab | \eqn{c_0}{c0} \tab | \eqn{c_1}{c1} \tab | \eqn{N}\cr
+ }
+
+ where \eqn{r_0}{r0}, \eqn{r_1}{r1}, \eqn{c_0}{c0}, \eqn{c_1}{c1}, and
+ \eqn{N} are non-negative integers that are
+ observed. The interior cell entries are not observed. It is
+ assumed that \eqn{Y_0|r_0 \sim \mathcal{B}inomial(r_0,
+ p_0)}{Y0|r0 ~ Binomial(r0, p0)} and
+ \eqn{Y_1|r_1 \sim \mathcal{B}inomial(r_1, p_1)}{Y1|r1 ~
+ Binomial(r1,p1)}.
+
+ This function plots the bounds on the maximum likelihood
+ estimates for (p0, p1) and color codes them by the elements of
+ time.vec.
+}
+
+\keyword{hplot}
+
+\references{
+ Gary King, 1997. \emph{A Solution to the Ecological Inference Problem}.
+ Princeton: Princeton University Press.
+
+ Jonathan Wakefield. 2001. ``Ecological Inference for 2 x 2 Tables,''
+ Center for Statistics and the Social Sciences Working Paper
+ no. 12. University of Washington.
+
+ Kevin M. Quinn. 2002. ``Ecological Inference in the Presence of
+ Temporal Dependence.'' Paper prepared for Ecological Inference
+ Conference, Harvard University, June 17-18, 2002.
+}
+
+\examples{
+\dontrun{
+## simulated data example 1
+set.seed(3920)
+n <- 100
+r0 <- rpois(n, 2000)
+r1 <- round(runif(n, 100, 4000))
+p0.true <- pnorm(-1.5 + 1:n/(n/2))
+p1.true <- pnorm(1.0 - 1:n/(n/4))
+y0 <- rbinom(n, r0, p0.true)
+y1 <- rbinom(n, r1, p1.true)
+c0 <- y0 + y1
+c1 <- (r0+r1) - c0
+
+## plot data
+dtomogplot(r0, r1, c0, c1, delay=0.1)
+
+## simulated data example 2
+set.seed(8722)
+n <- 100
+r0 <- rpois(n, 2000)
+r1 <- round(runif(n, 100, 4000))
+p0.true <- pnorm(-1.0 + sin(1:n/(n/4)))
+p1.true <- pnorm(0.0 - 2*cos(1:n/(n/9)))
+y0 <- rbinom(n, r0, p0.true)
+y1 <- rbinom(n, r1, p1.true)
+c0 <- y0 + y1
+c1 <- (r0+r1) - c0
+
+## plot data
+dtomogplot(r0, r1, c0, c1, delay=0.1)
+}
+}
+
+\seealso{\code{\link{MCMChierEI}},
+ \code{\link{MCMCdynamicEI}},\code{\link{tomogplot}}
+}
diff --git a/man/invgamma.Rd b/man/invgamma.Rd
new file mode 100644
index 0000000..17667d5
--- /dev/null
+++ b/man/invgamma.Rd
@@ -0,0 +1,35 @@
+\name{InvGamma}
+\alias{dinvgamma}
+\alias{rinvgamma}
+\alias{InvGamma}
+\title{The Inverse Gamma Distribution}
+\description{
+ Density function and random generation from the inverse Gamma distribution.
+}
+
+\usage{
+rinvgamma(n, shape, rate = 1)
+dinvgamma(x, shape, rate = 1)
+}
+
+\arguments{
+ \item{x}{Scalar location to evaluate density.}
+ \item{n}{Number of draws from the distribution.}
+ \item{shape}{Scalar shape parameter.}
+ \item{rate}{Scalar rate parameter (default value one).}
+}
+
+\value{
+ \code{dinvgamma} evaluates the density at \code{x}. \code{rinvgamma} takes
+ \code{n} draws from the inverse Gamma distribution. The parameterization is
+ consistent with the Gamma Distribution in the stats package.
+}
+
+\examples{
+density <- dinvgamma(4.2, 1.1)
+draws <- rinvgamma(10, 3.2)
+}
+
+\keyword{distribution}
+
+\seealso{\code{\link[stats]{GammaDist}}}
diff --git a/man/iwishart.Rd b/man/iwishart.Rd
new file mode 100644
index 0000000..f31b163
--- /dev/null
+++ b/man/iwishart.Rd
@@ -0,0 +1,33 @@
+\name{InvWishart}
+\alias{diwish}
+\alias{riwish}
+\alias{InvWishart}
+\title{The Inverse Wishart Distribution}
+\description{
+ Density function and random generation from the Inverse Wishart distribution.
+}
+
+\usage{
+ diwish(W, v, S)
+ riwish(v, S)
+}
+
+\arguments{
+ \item{W}{Positive definite matrix W \eqn{(p \times p)}{(p x p)}.}
+ \item{v}{Inverse Wishart degrees of freedom (scalar).}
+ \item{S}{Inverse Wishart scale matrix \eqn{(p \times p)}{(p x p)}.}}
+
+\value{
+ \code{diwish} evaluates the density at positive definite matrix W.
+ \code{riwish} generates one random draw from the distribution.
+}
+
+\examples{
+density <- diwish(matrix(c(2,-.3,-.3,4),2,2), 3, matrix(c(1,.3,.3,1),2,2))
+draw <- riwish(3, matrix(c(1,.3,.3,1),2,2))
+}
+
+\keyword{distribution}
+
+
+
diff --git a/man/noncenhypergeom.Rd b/man/noncenhypergeom.Rd
new file mode 100644
index 0000000..688975e
--- /dev/null
+++ b/man/noncenhypergeom.Rd
@@ -0,0 +1,57 @@
+\name{NoncenHypergeom}
+\alias{NoncenHypergeom}
+\alias{rnoncenhypergeom}
+\alias{dnoncenhypergeom}
+\title{The Noncentral Hypergeometric Distribution}
+\description{
+ Evaluates the density at a single point or all points, and generate random
+ draws from the Noncentral Hypergeometric distribution.
+}
+
+\usage{
+dnoncenhypergeom(x=NA, n1, n2, m1, psi)
+rnoncenhypergeom(n, n1, n2, m1, psi)
+}
+
+\arguments{
+ \item{x}{The location to evaluate the density. If \code{x} is NA,
+ then a matrix is returned with the density evaluated at all possible
+ points.}
+ \item{n}{The number of draws to make from the distribution.}
+ \item{n1}{The size of group one.}
+ \item{n2}{The size of group two.}
+ \item{m1}{The observed number of positive outcomes (in both groups).}
+ \item{psi}{Odds ratio.}
+}
+
+\value{
+ \code{dnoncenhypergeom} evaluates the density at point \code{x},
+ or a matrix with
+ the first column containing the possible values of the random
+ variable, and the second column containing the probabilities.
+ \code{rnoncenhypergeom} returns a list of \code{n} random draws from
+ the distribution.
+}
+
+\details{
+ The Noncentral Hypergeometric is particularly useful for conditional
+ inference for \eqn{(2 \times 2)}{(2 x 2)} tables. We use the
+ parameterization and algorithms of Liao and Rosen (2001). The
+ underlying R code is based on their published code. See their
+ article for details of the parameterization.
+}
+
+\source{
+ J. G. Liao and Ori Rosen. 2001. ``Fast and Stable Algorithms for Computing
+ and Sampling From the Noncentral Hypergeometric Distribution." \emph{The
+ American Statistician.} 55: 366-369.
+}
+
+\examples{
+ density <- dnoncenhypergeom(NA, 500, 500, 500, 6.0)
+ draws <- rnoncenhypergeom(10, 500, 500, 500, 6.0)
+}
+
+\keyword{distribution}
+
+
diff --git a/man/readscythe.Rd b/man/readscythe.Rd
new file mode 100644
index 0000000..7d55b7d
--- /dev/null
+++ b/man/readscythe.Rd
@@ -0,0 +1,34 @@
+\name{read.Scythe}
+\alias{read.Scythe}
+\title{Read a Matrix from a File written by Scythe}
+\description{
+ This function reads a matrix from an ASCII file in the form produced
+ by the Scythe Statistical Library. Scythe
+ output files contain the number of rows and columns in the first row,
+ followed by the data.
+}
+
+\usage{
+ read.Scythe(infile=NA)
+}
+
+\arguments{
+ \item{infile}{The file to be read. This can include path information.}
+}
+
+\value{
+ A matrix containing the data stored in the read file.
+}
+
+\examples{
+ \dontrun{mymatrix <- read.Scythe("myfile.txt")}
+}
+
+\references{
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+}
+
+\keyword{file}
+
+\seealso{\code{\link{write.Scythe}}}
diff --git a/man/tomog.Rd b/man/tomog.Rd
new file mode 100644
index 0000000..8a815c8
--- /dev/null
+++ b/man/tomog.Rd
@@ -0,0 +1,81 @@
+\name{tomogplot}
+\alias{tomogplot}
+\title{Tomography Plot}
+\description{
+ tomogplot is used to produce a tomography plot (see King, 1997) for a
+ series of partially observed 2 x 2 contingency tables.
+}
+
+\usage{
+tomogplot(r0, r1, c0, c1, xlab="fraction of r0 in c0 (p0)",
+ ylab="fraction of r1 in c0 (p1)", bgcol="white", ...)
+ }
+
+\arguments{
+ \item{r0}{An \eqn{(ntables \times 1)}{(ntables * 1)} vector of row sums from row 0.}
+
+ \item{r1}{An \eqn{(ntables \times 1)}{(ntables * 1)} vector of row sums from row 1.}
+
+ \item{c0}{An \eqn{(ntables \times 1)}{(ntables * 1)} vector of column sums from column 0.}
+
+ \item{c1}{An \eqn{(ntables \times 1)}{(ntables * 1)} vector of column sums from column 1.}
+
+ \item{xlab}{The x axis label for the plot.}
+
+ \item{ylab}{The y axis label for the plot.}
+
+ \item{bgcol}{The background color for the plot.}
+
+ \item{...}{further arguments to be passed}
+}
+
+
+\details{
+ Consider the following partially observed 2 by 2 contingency table:\cr
+ \cr
+ \tabular{llll}{
+ \tab | \eqn{Y=0} \tab | \eqn{Y=1} \tab | \cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \eqn{X=0} \tab | \eqn{Y_0}{Y0} \tab | \tab | \eqn{r_0}{r0}\cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \eqn{X=1} \tab | \eqn{Y_1}{Y1} \tab | \tab | \eqn{r_1}{r1}\cr
+ - - - - - \tab - - - - - \tab - - - - - \tab - - - - - \cr
+ \tab | \eqn{c_0}{c0} \tab | \eqn{c_1}{c1} \tab | \eqn{N}\cr
+ }
+
+ where \eqn{r_0}{r0}, \eqn{r_1}{r1}, \eqn{c_0}{c0}, \eqn{c_1}{c1}, and
+ \eqn{N} are non-negative integers that are
+ observed. The interior cell entries are not observed. It is
+ assumed that \eqn{Y_0|r_0 \sim \mathcal{B}inomial(r_0,
+ p_0)}{Y0|r0 ~ Binomial(r0, p0)} and
+ \eqn{Y_1|r_1 \sim \mathcal{B}inomial(r_1, p_1)}{Y1|r1 ~
+ Binomial(r1,p1)}.
+
+ This function plots the bounds on the maximum likelihood
+ estimatess for (p0, p1).
+ }
+
+ \keyword{hplot}
+
+ \references{
+ Gary King, 1997. \emph{A Solution to the Ecological Inference Problem}.
+ Princeton: Princeton University Press.
+
+ Jonathan Wakefield. 2001. ``Ecological Inference for 2 x 2 Tables,''
+ Center for Statistics and the Social Sciences Working Paper
+ no. 12. University of Washington.
+}
+
+\examples{
+r0 <- rpois(100, 500)
+r1 <- rpois(100, 200)
+c0 <- rpois(100, 100)
+c1 <- (r0 + r1) - c0
+tomogplot(r0, r1, c0, c1)
+}
+
+\seealso{\code{\link{MCMCbaselineEI}}, \code{\link{MCMChierEI}},
+ \code{\link{MCMCdynamicEI}}, \code{\link{dtomogplot}}
+}
+
+
diff --git a/man/vech.Rd b/man/vech.Rd
new file mode 100644
index 0000000..233a7bb
--- /dev/null
+++ b/man/vech.Rd
@@ -0,0 +1,38 @@
+\name{vech}
+\alias{vech}
+\title{Extract Lower Triangular Elements from a Symmetric Matrix}
+
+\description{
+ This function takes a symmetric matrix and extracts
+ a list of all lower triangular elements.
+}
+
+\usage{
+ vech(x)
+}
+
+\arguments{
+ \item{x}{A symmetric matrix.}
+}
+
+\value{
+ A list of the lower triangular elements.
+}
+
+\details{
+ This function checks to make sure the matrix is square, but it does
+ not check for symmetry (it just pulls the lower
+ triangular elements). The elements are stored in column major order.
+ The original matrix can be restored using the \code{xpnd}
+ command.
+}
+
+
+\examples{
+ symmat <- matrix(c(1,2,3,4,2,4,5,6,3,5,7,8,4,6,8,9),4,4)
+ vech(symmat)
+}
+
+\keyword{manip}
+
+\seealso{\code{\link{xpnd}}}
diff --git a/man/wishart.Rd b/man/wishart.Rd
new file mode 100644
index 0000000..5f4b274
--- /dev/null
+++ b/man/wishart.Rd
@@ -0,0 +1,33 @@
+\name{Wishart}
+\alias{dwish}
+\alias{rwish}
+\alias{Wishart}
+\title{The Wishart Distribution}
+\description{
+ Density function and random generation from the Wishart distribution.
+}
+
+\usage{
+ dwish(W, v, S)
+ rwish(v, S)
+}
+
+\arguments{
+ \item{W}{Positive definite matrix W \eqn{(p \times p)}{(p x p)}.}
+ \item{v}{Wishart degrees of freedom (scalar).}
+ \item{S}{Wishart scale matrix \eqn{(p \times p)}{(p x p)}.}}
+
+\value{
+ \code{dwish} evaluates the density at positive definite matrix W.
+ \code{rwish} generates one random draw from the distribution.
+}
+
+\examples{
+density <- dwish(matrix(c(2,-.3,-.3,4),2,2), 3, matrix(c(1,.3,.3,1),2,2))
+draw <- rwish(3, matrix(c(1,.3,.3,1),2,2))
+}
+
+\keyword{distribution}
+
+
+
diff --git a/man/writescythe.Rd b/man/writescythe.Rd
new file mode 100644
index 0000000..bfdd788
--- /dev/null
+++ b/man/writescythe.Rd
@@ -0,0 +1,40 @@
+\name{write.Scythe}
+\alias{write.Scythe}
+\title{Write a Matrix to a File to be Read by Scythe}
+\description{
+ This function writes a matrix to an ASCII file that can be
+ read by the Sycthe Statistical Library. Scythe requires that
+ input files contain the number of rows and columns in the first
+ row, followed by the data.
+}
+
+\usage{
+ write.Scythe(outmatrix, outfile=NA, overwrite=FALSE)
+}
+
+\arguments{
+ \item{outmatrix}{The matrix to be written to a file.}
+ \item{outfile}{The file to be written. This can include path information.}
+ \item{overwrite}{A logical that determines whether an existing file
+ should be over-written. By default, it protects the user from
+ over-writing existing files.}
+}
+
+\value{
+ A zero if the file is properly written.
+}
+
+\examples{
+ \dontrun{write.Scythe(mymatrix, "myfile.txt")}
+}
+
+\references{
+ Andrew D. Martin, Kevin M. Quinn, and Daniel Pemstein. 2004.
+ \emph{Scythe Statistical Library 1.0.} \url{http://scythe.wustl.edu}.
+}
+
+\keyword{file}
+
+\seealso{\code{\link{write.Scythe}}}
+
+
diff --git a/man/xpnd.Rd b/man/xpnd.Rd
new file mode 100644
index 0000000..dd7d997
--- /dev/null
+++ b/man/xpnd.Rd
@@ -0,0 +1,37 @@
+\name{xpnd}
+\alias{xpnd}
+\title{Expand a Vector into a Symmetric Matrix}
+
+\description{
+ This function takes a vector of appropriate length (typically
+ created using \code{vech}) and creates a symmetric matrix.
+}
+
+\usage{
+ xpnd(x, nrow)
+}
+
+\arguments{
+ \item{x}{A list of elements to expand into symmetric matrix.}
+ \item{nrow}{The number of rows (and columns) in the returned matrix.}
+}
+
+\value{
+ An \eqn{(nrows \times nrows)}{(nrows * nrows)} symmetric matrix.
+}
+
+\details{
+ This function is particularly useful when dealing with variance
+ covariance matrices. Note that R stores matrices in column major
+ order, and that the items in \code{x} will be recycled to fill the
+ matrix if need be.
+}
+
+
+\examples{
+ xpnd(c(1,2,3,4,4,5,6,7,8,9),4)
+}
+
+\keyword{manip}
+
+\seealso{\code{\link{vech}}}
diff --git a/src/MCMCdynamicEI.cc b/src/MCMCdynamicEI.cc
new file mode 100644
index 0000000..46b1793
--- /dev/null
+++ b/src/MCMCdynamicEI.cc
@@ -0,0 +1,418 @@
+// fits a model derived from Wakefield's baseline model for
+// ecological inference in which logit(p_i) follows a random walk in time
+// a priori. The model is fit using Wakefield's normal approximation
+// to the binomial convolution likelihood and the Metropolis-Hastings
+// algorithm to sample from the posterior
+//
+// evolution variances are estimated
+//
+// KQ 3/9/2002
+// 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]
+
+#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 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){
+ 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)));
+ 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&,
+ 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 x0 = theta[index];
+ double theta_L[2];
+ double theta_R[2];
+ theta_L[0] = theta_R[0] = theta[0];
+ theta_L[1] = theta_R[1] = theta[1];
+ L = x0 - w*U;
+ theta_L[index] = L;
+ R = L + w;
+ theta_R[index] = R;
+ int K = p;
+ 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();
+ if (V < 0.5){
+ L = L - (R - L);
+ theta_L[index] = L;
+ }
+ else {
+ R = R + (R - L);
+ theta_R[index] = R;
+ }
+ --K;
+ }
+}
+
+// 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){
+
+ double Lhat = L;
+ double Rhat = R;
+ bool D = false;
+ while ((Rhat - Lhat ) > 1.1 * w){
+ double M = (Lhat + Rhat) / 2.0;
+ if ( (x0 < M && theta[index] >= M) || (x0 >= M && theta[index] < M)){
+ D = true;
+ }
+ if (theta[index] < M){
+ Rhat = M;
+ }
+ else {
+ Lhat = M;
+ }
+ int ind0;
+ if (index==0){
+ ind0 = 1;
+ }
+ else {
+ ind0 = 0;
+ }
+ double theta_L[2];
+ double theta_R[2];
+ theta_L[ind0] = theta_R[ind0] = theta[ind0];
+ theta_L[index] = Lhat;
+ theta_R[index] = Rhat;
+ if (D && z >= logfun(theta_L, r0, r1, c0, mu0, mu1, sigma0, sigma1) &&
+ z >= logfun(theta_R, r0, r1, c0, mu0, mu1, sigma0, sigma1)){
+ return(false);
+ }
+ }
+ return(true);
+}
+
+
+// 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){
+
+ double Lbar = L;
+ double Rbar = R;
+ int ind0;
+ if (index==0){
+ ind0 = 1;
+ }
+ else {
+ ind0 = 0;
+ }
+ double theta_x1[2];
+ theta_x1[0] = theta[0];
+ theta_x1[1] = theta[1];
+ const double x0 = theta[index];
+ for (;;){
+ 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) &&
+ Accept(logfun, theta_x1, index, x0, z, w,
+ r0, r1, c0, mu0, mu1,
+ sigma0, sigma1, L, R)){
+ return(x1);
+ }
+ if (x1 < x0){
+ Lbar = x1;
+ }
+ else {
+ Rbar = x1;
+ }
+ } // end infinite loop
+}
+
+
+
+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);
+
+ 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;
+
+
+ // sum of weights across each row
+ Matrix<double> 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];
+
+
+ // 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];
+
+ // 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);
+
+ //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);
+
+ if (iter >= warmup_burnin){
+ widthmat(iter- warmup_burnin, index) = R - L;
+ }
+
+ 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 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);
+
+ 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);
+ }
+ // @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+
+
+ // 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];
+
+ // 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 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);
+
+ 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;
+ }
+
+
+ // print output to screen
+ if (verbose==1 && (iter%1000)==0){
+ Rprintf("\nMCMCdynamicEI iteration %i of %i \n", (iter+1),
+ tot_iter);
+ }
+
+ // allow user interrupts
+ void R_CheckUserInterrupt(void);
+ }
+
+ 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];
+
+ }
+
+} // extern "C"
+
diff --git a/src/MCMCfactanal.cc b/src/MCMCfactanal.cc
new file mode 100644
index 0000000..5e4c200
--- /dev/null
+++ b/src/MCMCfactanal.cc
@@ -0,0 +1,187 @@
+// MCMCfactanal.cc is C++ code to estimate a factor analysis model
+//
+// 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
+//
+// revised version of older MCMCfactanal 5/11/2004 KQ
+// updated to new verion of scythe 7/25/2004 ADM
+
+
+#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 std;
+
+// ADD USER-DEFINED FUNCTIONS HERE
+
+extern "C" {
+
+ // BRIEF FUNCTION DESCRIPTION
+ 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 *seedarray, const int *lecuyerstream,
+ const int *verbose, const double *Lambdadata,
+ const int *Lambdarow, const int *Lambdacol,
+ const double *Psidata, const int *Psirow,
+ const int *Psicol, 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 *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);
+ }
+
+
+ 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 (iter % 500 == 0 && verbose[0] == 1){
+ 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
+ void R_CheckUserInterrupt(void);
+ } // 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];
+
+ }
+
+}
+
+
+
+
+
+
+
diff --git a/src/MCMCfcds.cc b/src/MCMCfcds.cc
new file mode 100644
index 0000000..55ad9d8
--- /dev/null
+++ b/src/MCMCfcds.cc
@@ -0,0 +1,400 @@
+// 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
new file mode 100644
index 0000000..013dbf4
--- /dev/null
+++ b/src/MCMCfcds.h
@@ -0,0 +1,100 @@
+// MCMCfcds.h is the header file for MCMCfcds.cc. It contains declarations
+// 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
+
+
+#ifndef MCMCFCDS_H
+#define MCMCFCDS_H
+
+#include "matrix.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 *);
+
+ // 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 *);
+
+ void irt_eta_update1(Matrix<double> &, const Matrix<double> &,
+ const Matrix<double> &, const Matrix<double> &,
+ const Matrix<double> &, rng *);
+
+ void irt_theta_update1(Matrix<double>&, const Matrix<double>&,
+ const Matrix<double>&, const double&,
+ const double&, const Matrix<double>&,
+ const Matrix<double>&, rng *);
+}
+#endif
diff --git a/src/MCMChierEI.cc b/src/MCMChierEI.cc
new file mode 100644
index 0000000..07a6f2c
--- /dev/null
+++ b/src/MCMChierEI.cc
@@ -0,0 +1,440 @@
+// fits Wakefield's hierarchical model for ecological inference using
+// Wakefield's normal approximation to the binomial convolution likelihood
+// and slice sampling and Gibbs sampling to sample from the posterior
+//
+// KQ 3/2/2002
+// 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 8/10/2004 bug fix and major overhaul of sampling scheme
+
+#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 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){
+ 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)));
+ 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&,
+ 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 x0 = theta[index];
+ double theta_L[2];
+ double theta_R[2];
+ theta_L[0] = theta_R[0] = theta[0];
+ theta_L[1] = theta_R[1] = theta[1];
+ L = x0 - w*U;
+ theta_L[index] = L;
+ R = L + w;
+ theta_R[index] = R;
+ int K = p;
+ 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();
+ if (V < 0.5){
+ L = L - (R - L);
+ theta_L[index] = L;
+ }
+ else {
+ R = R + (R - L);
+ theta_R[index] = R;
+ }
+ --K;
+ }
+}
+
+// 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){
+
+ double Lhat = L;
+ double Rhat = R;
+ bool D = false;
+ while ((Rhat - Lhat ) > 1.1 * w){
+ double M = (Lhat + Rhat) / 2.0;
+ if ( (x0 < M && theta[index] >= M) || (x0 >= M && theta[index] < M)){
+ D = true;
+ }
+ if (theta[index] < M){
+ Rhat = M;
+ }
+ else {
+ Lhat = M;
+ }
+ int ind0;
+ if (index==0){
+ ind0 = 1;
+ }
+ else {
+ ind0 = 0;
+ }
+ double theta_L[2];
+ double theta_R[2];
+ theta_L[ind0] = theta_R[ind0] = theta[ind0];
+ theta_L[index] = Lhat;
+ theta_R[index] = Rhat;
+ if (D && z >= logfun(theta_L, r0, r1, c0, mu0, mu1, sigma0, sigma1) &&
+ z >= logfun(theta_R, r0, r1, c0, mu0, mu1, sigma0, sigma1)){
+ return(false);
+ }
+ }
+ return(true);
+}
+
+
+// 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){
+
+ double Lbar = L;
+ double Rbar = R;
+ int ind0;
+ if (index==0){
+ ind0 = 1;
+ }
+ else {
+ ind0 = 0;
+ }
+ double theta_x1[2];
+ theta_x1[0] = theta[0];
+ theta_x1[1] = theta[1];
+ const double x0 = theta[index];
+ for (;;){
+ 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) &&
+ Accept(logfun, theta_x1, index, x0, z, w,
+ r0, r1, c0, mu0, mu1,
+ sigma0, sigma1, L, R)){
+ return(x1);
+ }
+ if (x1 < x0){
+ Lbar = x1;
+ }
+ else {
+ Rbar = x1;
+ }
+ } // end infinite loop
+}
+
+
+
+
+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,
+ const int* Rmcmc, const int* Rthin,
+ const double* Rmu0pm, const double* Rmu0pv,
+ 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){
+
+
+ // load data
+ // table notation is:
+ // --------------------
+ // Y0 | | r0
+ // --------------------
+ // 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;
+
+ // 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){
+
+ // 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);
+ }
+ // @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+
+
+ // 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 @@@@@@@@@@@@@@@
+ 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==1 && (iter%1000)==0){
+ Rprintf("\nMCMChierEI iteration %i of %i \n", (iter+1),
+ tot_iter);
+ }
+
+ // allow user interrupts
+ void R_CheckUserInterrupt(void);
+ }
+
+ 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];
+
+ }
+
+} // extern "C"
+
diff --git a/src/MCMCirt1d.cc b/src/MCMCirt1d.cc
new file mode 100644
index 0000000..7e753bc
--- /dev/null
+++ b/src/MCMCirt1d.cc
@@ -0,0 +1,155 @@
+// MCMCirt1d.cc is C++ code to estimate a one-dimensional item response
+// theory model.
+//
+// ADM and KQ 1/15/2003
+// ADM 7/28/2004 [updated to new Scythe version]
+// completely rewritten and optimized for the 1-d case 8/2/2004 KQ
+
+#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"{
+
+// 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* store
+ ) {
+
+ // 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 (row major order)
+ Matrix<double> theta_store = Matrix<double>(nsamp, J);
+ Matrix<double> eta_store = Matrix<double>(nsamp, K*2);
+
+ // starting values
+ Matrix<double> eta = cbind(alpha, beta);
+ Matrix<double> Z = Matrix<double>(J,K);
+
+ 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 == 1 && iter % 100 == 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
+ for (int l=0; l<J; ++l)
+ theta_store(count, l) = theta[l];
+
+ // store bill parameters
+ for (int l=0; l<K*2; ++l)
+ eta_store(count, l) = eta[l];
+ count++;
+ }
+
+ void R_CheckUserInterrupt(void); // allow user interrupts
+ } // end Gibbs loop
+
+ delete stream; // clean up random number stream
+
+ // return output
+ Matrix<double> output;
+ if(*store == 0) {
+ output = theta_store;
+ }
+ else {
+ output = cbind(theta_store, eta_store);
+ }
+
+ const int size = *samplerow * *samplecol;
+ for (int i=0; i<size; ++i)
+ sampledata[i] = output[i];
+
+ }
+}
+
+
diff --git a/src/MCMClogit.cc b/src/MCMClogit.cc
new file mode 100644
index 0000000..65b1b7c
--- /dev/null
+++ b/src/MCMClogit.cc
@@ -0,0 +1,154 @@
+// MCMClogit.cc is C++ code to estimate a logistic regression model with
+// a multivariate normal prior
+//
+// 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
+//
+// updated to the new version of Scythe 7/25/2004 KQ
+
+#include <iostream>
+#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 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){
+
+ // 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]);
+
+ // 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);
+}
+
+extern "C"{
+
+ 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) {
+
+ // 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);
+
+ // 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 = tune * invpd(B0 + invpd(V)) * tune;
+ const Matrix<double> propC = cholesky(propV) ;
+
+ 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 == 1 && iter % 500 == 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));
+ }
+
+ void R_CheckUserInterrupt(void); // 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];
+
+ 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");
+
+ }
+
+}
+
diff --git a/src/MCMCmetrop1R.cc b/src/MCMCmetrop1R.cc
new file mode 100644
index 0000000..c781019
--- /dev/null
+++ b/src/MCMCmetrop1R.cc
@@ -0,0 +1,178 @@
+// MCMCmetrop1R.cc samples from a user-written posterior code in R using a
+// random walk Metropolis algorithm
+//
+// 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/24/2004
+// updated to work with new Scythe and RNGs ADM 7/24/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
+
+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;
+ }
+
+
+ // 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
+ 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);
+
+ // 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 (iter % 500 == 0 && 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);
+ void R_CheckUserInterrupt(void); // 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");
+
+ // return the sample
+ return sample_SEXP;
+
+ }
+}
diff --git a/src/MCMCmixfactanal.cc b/src/MCMCmixfactanal.cc
new file mode 100644
index 0000000..e5a70be
--- /dev/null
+++ b/src/MCMCmixfactanal.cc
@@ -0,0 +1,366 @@
+// MCMCmixfactanal.cc is C++ code to estimate a mixed data
+// factor analysis model
+//
+// 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
+//
+// revised version of older MCMCordfactanal
+// 7/20/2004 KQ
+// updated to new version of Scythe 7/25/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
+
+using namespace SCYTHE;
+using namespace std;
+
+
+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* accepts
+ ) {
+
+ // 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);
+
+
+ /*
+ 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 = Matrix<int>(*ncatrow, *ncatcol);
+ for (int i=0; i<(*ncatrow * *ncatcol); ++i)
+ X[i] = static_cast<int>(ncatdata[i]);
+ 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
+ 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;
+ }
+
+ // starting values for phi and gamma_p
+ Matrix<double> phi = Matrix<double>(N,D-1);
+ phi = cbind(ones<double>(N,1), phi);
+ Matrix<double> gamma_p = gamma(_,0);
+
+ // 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));
+ }
+ }
+ 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 gamma
+ for (int j=0; j<K; ++j){ // do the sampling for each categ. var
+ 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));
+ }
+ }
+ 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 (int k=2; k<(ncateg[j]-1); ++k){
+ loggendenrat = loggendenrat
+ + log(pnorm(gamma(k+1,j), gamma(k,j), tune[j]) -
+ pnorm(gamma(k-1,j), gamma(k,j), tune[j]) )
+ - log(pnorm(gamma_p[k+1], gamma_p[k], tune[j]) -
+ pnorm(gamma_p[k-1], 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];
+ }
+ ++accepts[0];
+ }
+ }
+ }
+
+ // print results to screen
+ if (*verbose == 1 && iter % 500 == 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));
+ }
+ Rprintf("\n");
+ }
+ Rprintf("diag(Psi) = \n");
+ for (int i=0; i<K; ++i){
+ Rprintf("%10.5f", Psi(i,i));
+ }
+ Rprintf("\n");
+ Rprintf("\nMetropolis-Hastings acceptance rate = %10.5f\n",
+ static_cast<double>(*accepts)/(static_cast<double>((iter+1) *
+ n_ord_ge3)));
+ }
+
+ // 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 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 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
+ void R_CheckUserInterrupt(void);
+ } // end Gibbs loop
+
+ delete stream; // clean up random number stream
+
+ // 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];
+
+}
+
+}
+
+
diff --git a/src/MCMCoprobit.cc b/src/MCMCoprobit.cc
new file mode 100644
index 0000000..5a02404
--- /dev/null
+++ b/src/MCMCoprobit.cc
@@ -0,0 +1,190 @@
+// MCMCoprobit.cc is C++ code to estimate a ordinalprobit regression
+// model with a multivariate normal prior
+//
+// 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
+//
+// updated to the new version of Scythe 7/26/2004 KQ
+
+#include <iostream>
+#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 std;
+
+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);
+
+ // 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 int ncat = gamma.rows() - 1;
+ const Matrix<double> 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);
+
+ // initialize Z
+ Matrix<double> gamma_p = gamma;
+ Matrix<double> Z(N,1);
+ Matrix<double> Xbeta = X * beta;
+
+
+ // Gibbs loop
+ int count = 0;
+ int accepts = 0;
+ for (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]);
+ }
+ else {
+ gamma_p[i] = stream->rtnorm_combo(gamma[i], ::pow(tune[0], 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){
+ if (Y[i] == ncat){
+ loglikerat = loglikerat
+ + log(1.0 -
+ pnorm(gamma_p[Y[i]-1] - Xbeta[i]) )
+ - log(1.0 -
+ pnorm(gamma[Y[i]-1] - Xbeta[i]) );
+ }
+ else if (Y[i] == 1){
+ loglikerat = loglikerat
+ + log(pnorm(gamma_p[Y[i]] - Xbeta[i]) )
+ - log(pnorm(gamma[Y[i]] - Xbeta[i]) );
+ }
+ 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]) );
+ }
+ }
+ for (int j=2; j<(ncat-1); ++j){
+ loggendenrat = loggendenrat
+ + log(pnorm(gamma[j+1], gamma[j], tune[0]) -
+ pnorm(gamma[j-1], gamma[j], tune[0]) )
+ - log(pnorm(gamma_p[j+1], gamma_p[j], tune[0]) -
+ pnorm(gamma_p[j-1], gamma_p[j], tune[0]) );
+ }
+ double logacceptrat = loglikerat + loggendenrat;
+ 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]]);
+ }
+
+
+ // [beta|Z, gamma]
+ const Matrix<double> 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)
+ 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 == 1 && iter % 500 == 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]);
+ Rprintf("Metropolis acceptance rate for beta = %3.5f\n\n",
+ static_cast<double>(accepts) /
+ static_cast<double>(iter+1));
+ }
+
+
+ void R_CheckUserInterrupt(void); // 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];
+
+ 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");
+
+ }
+
+}
diff --git a/src/MCMCordfactanal.cc b/src/MCMCordfactanal.cc
new file mode 100644
index 0000000..100927e
--- /dev/null
+++ b/src/MCMCordfactanal.cc
@@ -0,0 +1,286 @@
+// MCMCordfactanal.cc is C++ code to estimate an ordinal data
+// factor analysis model
+//
+// 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
+//
+// revised version of older MCMCordfactanal
+// 7/16/2004 KQ
+// updated to new version of Scythe ADM 7/24/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
+
+using namespace SCYTHE;
+using namespace std;
+
+
+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 *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* accepts, const int* outswitch
+ ) {
+
+ // 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);
+
+
+ // 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);
+
+
+ // starting values for phi, Xstar, and gamma_p
+ Matrix<double> phi = Matrix<double>(N, D-1);
+ phi = cbind(ones<double>(N,1), phi);
+ Matrix<double> Xstar = Matrix<double>(N, K);
+ Matrix<double> gamma_p = gamma(_,0);
+
+ // storage matrices (row major order)
+ Matrix<double> Lambda_store;
+ if (storelambda[0]==1){
+ 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);
+ }
+
+ ///////////////////
+ // Gibbs Sampler //
+ ///////////////////
+ int count = 0;
+ for (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));
+ }
+ }
+ }
+
+
+ // 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];
+ }
+
+ // 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 manifest var
+ 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));
+ }
+ }
+ 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 (int k=2; k<(ncateg[j]-1); ++k){
+ loggendenrat = loggendenrat
+ + log(pnorm(gamma(k+1,j), gamma(k,j), tune[j]) -
+ pnorm(gamma(k-1,j), gamma(k,j), tune[j]) )
+ - log(pnorm(gamma_p[k+1], gamma_p[k], tune[j]) -
+ pnorm(gamma_p[k-1], gamma_p[k], tune[j]) );
+ }
+ double logacceptrat = loglikerat + loggendenrat;
+ if (stream->runif() <= exp(logacceptrat)){
+ for (int i=0; i<gamrow[0]; ++i){
+ if (gamma(i,j) == 300) break;
+ gamma(i,j) = gamma_p[i];
+ }
+ ++accepts[0];
+ }
+ }
+
+
+ // print results to screen
+ if (verbose[0] == 1 && iter % 500 == 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){
+ Rprintf("%10.5f", Lambda(i,j));
+ }
+ Rprintf("\n");
+ }
+ Rprintf("\nMetropolis-Hastings acceptance rate = %10.5f\n",
+ static_cast<double>(*accepts)/(static_cast<double>((iter+1)*K)));
+ }
+ if (verbose[0] == 1 && iter % 500 == 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))) {
+
+ // store Lambda
+ if (storelambda[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 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];
+
+ // 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];
+ }
+ count++;
+ }
+
+ // allow user interrupts
+ void R_CheckUserInterrupt(void);
+ } // end MCMC loop
+
+ delete stream; // clean up random number stream
+
+ // 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);
+ }
+ int size = *samplerow * *samplecol;
+ for (int i=0; i<size; ++i)
+ sampledata[i] = output[i];
+
+}
+
+}
+
+
diff --git a/src/MCMCpanel.cc b/src/MCMCpanel.cc
new file mode 100644
index 0000000..23fa7d9
--- /dev/null
+++ b/src/MCMCpanel.cc
@@ -0,0 +1,231 @@
+// 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 + (1/sigma2_sim) * beta_var_sum);
+ Matrix<double> beta_sim_mean = beta_sim_var * (MB0 * Mb0 + (1/sigma2_sim) * 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 == 1 && g % 500 == 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);
+ }
+
+
+ void R_CheckUserInterrupt(void); // allow user interrupts
+
+ }
+
+ 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
new file mode 100644
index 0000000..ce516f6
--- /dev/null
+++ b/src/MCMCpoisson.cc
@@ -0,0 +1,156 @@
+// MCMCpoisson.cc is C++ code to estimate a Poisson regression model with
+// a multivariate normal prior
+//
+// 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
+//
+// updated to the new version of Scythe 7/26/2004 KQ
+
+#include <iostream>
+#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 std;
+
+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){
+
+ // likelihood
+ const Matrix<double> eta = X * beta;
+ const Matrix<double> mu = exp(eta);
+ double loglike = 0.0;
+ for (int i=0; i<Y.rows(); ++i)
+ loglike += -mu[i] + Y[i] * eta[i];
+
+ // 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);
+}
+
+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);
+
+ // 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 = tune * invpd(B0 + invpd(V)) * tune;
+ const Matrix<double> 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){
+
+ // 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);
+
+ 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 == 1 && iter % 500 == 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));
+ }
+
+ void R_CheckUserInterrupt(void); // 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];
+
+ 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");
+
+ }
+
+}
+
diff --git a/src/MCMCprobit.cc b/src/MCMCprobit.cc
new file mode 100644
index 0000000..45e70bb
--- /dev/null
+++ b/src/MCMCprobit.cc
@@ -0,0 +1,119 @@
+// MCMCprobit.cc is C++ code to estimate a probit regression model with
+// a multivariate normal prior
+//
+// 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
+//
+// updated to the new version of Scythe 7/26/2004 KQ
+
+#include <iostream>
+#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 std;
+
+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);
+
+ // 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);
+
+ // storage matrix or matrices
+ Matrix<double> storemat(nstore, k);
+
+ // 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];
+ ++count;
+ }
+
+ // print output to stdout
+ if(*verbose == 1 && iter % 500 == 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]);
+ }
+
+ void R_CheckUserInterrupt(void); // 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];
+
+ }
+
+}
diff --git a/src/MCMCprobitres.cc b/src/MCMCprobitres.cc
new file mode 100644
index 0000000..2c1168c
--- /dev/null
+++ b/src/MCMCprobitres.cc
@@ -0,0 +1,128 @@
+// MCMCprobitres.cc is a program that simulates draws from the posterior
+// density of a probit regression model and returns latent residuals.
+//
+// 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
+//
+// updated to the new version of Scythe 7/26/2004 KQ
+
+#include <iostream>
+#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 std;
+
+extern "C"{
+
+ void MCMCprobitres(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 double *resvecdata, const int *resvecrow,
+ const int *resveccol, 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);
+ 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);
+
+ // 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 == 1 && iter % 500 == 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]);
+ }
+
+ void R_CheckUserInterrupt(void); // 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];
+ }
+
+}
diff --git a/src/MCMCregress.cc b/src/MCMCregress.cc
new file mode 100644
index 0000000..f0ca317
--- /dev/null
+++ b/src/MCMCregress.cc
@@ -0,0 +1,125 @@
+// MCMCregress.cc is a program that simualates draws from the posterior
+// density of a linear regression model with Gaussian errors.
+//
+// The initial version of this file was generated by the
+// auto.Scythe.call() function in the MCMCpack R package
+// written by:
+//
+// 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
+//
+// This file was initially generated on Fri Jul 23 15:07:21 2004
+//
+// ADM and KQ 10/10/2002 [ported to Scythe0.3]
+// 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]
+
+#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 std;
+
+extern "C" {
+
+ // simulate from posterior density and return an mcmc by parameters
+ // matrix of the posterior density sample
+ 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 *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) {
+
+ // 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 == 1 && iter % 500 == 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);
+ }
+
+ void R_CheckUserInterrupt(void); // 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 MCMCregress
+} // end extern "C"
+
diff --git a/src/MCMCrng.cc b/src/MCMCrng.cc
new file mode 100644
index 0000000..f3118da
--- /dev/null
+++ b/src/MCMCrng.cc
@@ -0,0 +1,59 @@
+// 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
new file mode 100644
index 0000000..b84fc1b
--- /dev/null
+++ b/src/MCMCrng.h
@@ -0,0 +1,42 @@
+// MCMCrng.h is the header file for MCMCrng.cc. It contains
+// functions 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/22/04
+
+#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
+
+
+#endif
diff --git a/src/Makevars b/src/Makevars
new file mode 100644
index 0000000..98c8c6d
--- /dev/null
+++ b/src/Makevars
@@ -0,0 +1,2 @@
+PKG_CXXFLAGS = -Wall -pedantic -DSCYTHE_COMPILE_DIRECT -DSCYTHE_NO_RANGE -O3 -fno-gcse -funroll-loops -DHAVE_TRUNC
+
diff --git a/src/Makevars.in b/src/Makevars.in
new file mode 100644
index 0000000..37e0a7e
--- /dev/null
+++ b/src/Makevars.in
@@ -0,0 +1,2 @@
+PKG_CXXFLAGS = -Wall -pedantic -DSCYTHE_COMPILE_DIRECT -DSCYTHE_NO_RANGE -O3 -fno-gcse -funroll-loops @MV_HAVE_IEEEFP_H@ @MV_HAVE_TRUNC@
+
diff --git a/src/distributions.cc b/src/distributions.cc
new file mode 100644
index 0000000..22d82fd
--- /dev/null
+++ b/src/distributions.cc
@@ -0,0 +1,2055 @@
+/*
+ * 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
new file mode 100644
index 0000000..77ca771
--- /dev/null
+++ b/src/distributions.h
@@ -0,0 +1,376 @@
+/*
+ * 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.h
+ *
+ * Provides definitions for PDFs, CDFs, and some common functions
+ * (gamma, beta, etc).
+ *
+ */
+
+
+#ifndef SCYTHE_DISTRIBUTIONS_H
+#define SCYTHE_DISTRIBUTIONS_H
+
+#include <cfloat>
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "matrix.h"
+#else
+#include "scythestat/matrix.h"
+#endif
+
+/* Fill in some defs from R that aren't in math.h */
+#ifndef M_PI
+#define M_PI 3.141592653589793238462643383280
+#endif
+#define M_LN_SQRT_2PI 0.918938533204672741780329736406
+#define M_LN_SQRT_PId2 0.225791352644727432363097614947
+#define M_1_SQRT_2PI 0.39894228040143267793994605993
+#define M_2PI 6.28318530717958647692528676655
+#define M_SQRT_32 5.656854249492380195206754896838
+
+namespace SCYTHE {
+
+ void throw_on_nonconv (bool);
+
+ /*************
+ * Functions *
+ *************/
+
+ /* The gamma function */
+ double gammafn (const double &);
+
+ /* The natural log of the absolute value of the gamma function */
+ double lngammafn (const double &);
+
+ /* The beta function */
+ double betafn (const double &, const double &);
+
+ /* The natrual log of the beta function */
+ double lnbetafn(const double &, const double &);
+
+ /* factorial */
+ int factorial (const int &n);
+
+ /* The natural log of the factorial */
+ double lnfactorial (const int &n);
+
+ /*********************************
+ * Fully Specified Distributions *
+ *********************************/
+
+ /**** 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 &);
+
+ Matrix<double> dbeta( const int &, const int &,
+ const double &, const double &,
+ const double &b);
+
+ /* Other */
+
+ /* 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 &);
+
+ /* PDFs */
+ double dbinom(const double &, const double &, const double &);
+
+ Matrix<double> dbinom(const int &, const int &,
+ const double &, const double &,
+ const double &);
+
+
+ /**** The Chi Square Distribution ****/
+
+ /* CDFs */
+ double pchisq(const double &, const double &);
+
+ Matrix<double> pchisq(const int &, const int &,
+ const double &, const double &);
+ /* PDFs */
+ double dchisq(const double &, const double &);
+
+ Matrix<double> dchisq(const int &, const int &,
+ const double &, const double &);
+
+ /**** The Exponential Distribution ****/
+
+ /* CDFs */
+ double pexp(const double &, const double &);
+
+ Matrix<double> pexp(const int &, const int &, const double &,
+ const double &);
+
+ /* PDFs */
+ double dexp(const double &, const double &);
+
+ Matrix<double> dexp(const int &, const int &, const double &,
+ const double &);
+
+ /**** The f Distribution ****/
+
+ /* CDFs */
+ double pf(const double &, const double &, const double &);
+
+ 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 &);
+
+ /**** The Gamma Distribution ****/
+
+ /* CDFs */
+ // note that this takes scale (or 1/rate for R-users)
+ double pgamma (double, const double &, const double &);
+
+ Matrix<double> pgamma(const int &, const int &, const double &,
+ const double &scale = 1);
+
+ /* PDFs */
+ // note that this takes scale (or 1/rate for R-users)
+ double dgamma(const double &, const double &,
+ const double &scale = 1);
+
+ Matrix<double> dgamma(const int &, const int &,
+ const double &, const double &scale = 1);
+
+ /**** The Logistic Distribution ****/
+
+ /* CDFs */
+ double plogis(const double &, const double &location = 0.0,
+ const double &scale = 1.0);
+
+ Matrix<double> plogis(const int &, const int &,
+ const double &, const double &location = 0.0,
+ const double &scale = 1.0);
+
+ /* 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);
+
+
+ /**** The Log Normal Distribution ****/
+
+ /* CDFs */
+ double plnorm(const double& x, const double& logmean = 0.0,
+ const double& logsd = 1.0);
+
+ Matrix<double> plnorm(const int& rows, const int& cols,
+ const double& x, const double& logmean = 0.0,
+ const double& logsd = 1.0);
+
+ /* PDFs */
+ double dlnorm(const double& x, const double& logmean = 0.0,
+ const double& logsd = 1.0);
+
+ Matrix<double> dlnorm(const int& rows, const int& cols,
+ const double& x, const double& logmean = 0.0,
+ const double& logsd = 1.0);
+
+ /**** The Negative Binomial Distribution ****/
+
+ /* CDFs */
+ double pnbinom(const double &, const double &, const double &);
+
+ Matrix<double> pnbinom( const int &, const int &,
+ const double &, const double &,
+ const double &);
+
+ /* PDFs */
+ double dnbinom(const double &, const double &, const double &);
+
+ Matrix<double> dnbinom( const int &, const int &,
+ const double &, const double &,
+ const double &);
+
+ /**** The Normal Distribution ****/
+
+ /* CDFs */
+ double pnorm (const double &x, const double &mu = 0.0,
+ const double &sigma = 1.0);
+
+ /* PDFs */
+ double dnorm( const double& x, const double& mu = 0.0,
+ const double& sigma = 1.0);
+
+ Matrix<double> dnorm( const int& rows, const int& cols,
+ const double& x, const double& mu = 0.0,
+ const double& sigma = 1.0);
+ /* Other */
+
+ /* 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);
+
+ /* Returns the quantile of the standard normal distribution
+ * associated with a given probability p
+ */
+ double qnorm1 (const double& in_p);
+
+ /* Returns the log of the univariate normal density ordinate
+ * evaluated at x
+ */
+ double lndnorm (const double& x, const double& mu = 0.0,
+ const double& sigma = 1.0);
+
+ /**** The Poison Distribution ****/
+
+ /* CDFs */
+
+ double ppois(const double &, const double &);
+
+ 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 &);
+
+ /**** The t Distribution ****/
+
+ /* CDFs */
+
+ double pt(const double &, const double &);
+
+ Matrix<double> pt(const int &, const int &, const double &,
+ const double &);
+ /* PDFs */
+ double dt(const double &, const double &);
+
+ Matrix<double> dt(const int &, const int &, const double &,
+ const double &);
+
+ /* Others */
+
+ /* Returns the univariate Student-t density evaluated at x
+ * with mean mu, scale sigma^2, and nu degrees of freedom
+ */
+ double dt1( const double &, const double &, const double &,
+ const double &);
+
+ /* 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 &);
+
+ /**** 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);
+
+ /* PDFs */
+ double dunif( const double &, const double &a = 0.0,
+ const double &b = 1.0);
+
+ Matrix<double> dunif( const int &, const int &,
+ const double &, const double &a = 0.0,
+ const double &b = 1.0);
+
+ /**** The Weibull Distribution ****/
+
+ /* CDFs */
+ double pweibull(const double &, const double &,
+ const double &scale = 1.0);
+
+ Matrix<double> pweibull(const int &, const int &,
+ const double &, const double &,
+ const double &scale = 1.0);
+
+ /* PDFs */
+ double dweibull(const double &, const double &,
+ const double &scale = 1.0);
+
+ Matrix<double> dweibull(const int &, const int &,
+ const double &, const double &,
+ const double &scale = 1.0);
+
+ /************************************
+ * 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 &);
+ }
+
+}
+
+#endif
diff --git a/src/error.h b/src/error.h
new file mode 100644
index 0000000..d9df83f
--- /dev/null
+++ b/src/error.h
@@ -0,0 +1,317 @@
+/*
+ * 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/error.h
+ *
+ * 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)
+ *
+ */
+
+#ifndef SCYTHE_ERROR_H
+#define SCYTHE_ERROR_H
+
+#include <exception>
+#include <string>
+#include <sstream>
+#include <iostream>
+
+namespace SCYTHE
+{
+
+ /**** This file-local variable holds the output of the last
+ * scythe_exception constructed.
+ ****/
+#ifdef __MINGW32__
+ static std::string serr;
+#else
+ namespace
+ {
+ std::string serr;
+ }
+#endif
+
+ /**** A replacement for the default terminate handler. This outputs
+ * the string held in serr before calling abort, thereby notifying
+ * the user of why the program crashed.
+ ****/
+ inline void scythe_terminate ();
+
+ /**** The scythe exception abstract base class ****/
+ class scythe_exception:public std::exception
+ {
+ public:
+ scythe_exception (const std::string & head,
+ const std::string & file,
+ const std::string & function,
+ const unsigned int &line,
+ const std::string & message = "",
+ const bool & halt = false) throw ()
+ : exception (),
+ head_ (head),
+ file_ (file),
+ function_ (function),
+ line_ (line),
+ message_ (message)
+ {
+ std::ostringstream os;
+ os << head_ << " in " << file_ << ", " << function_ << ", "
+ << line_ << ": " << message_ << "!";
+ serr = os.str ();
+ std::set_terminate (scythe_terminate);
+ if (halt)
+ std::terminate ();
+ }
+
+ scythe_exception (const scythe_exception & e) throw ()
+ : exception (),
+ head_ (e.head_),
+ file_ (e.file_),
+ function_ (e.function_),
+ line_ (e.line_),
+ message_ (e.message_)
+ {
+ }
+
+ scythe_exception & operator= (const scythe_exception & e) throw ()
+ {
+ head_ = e.head_;
+ file_ = e.file_;
+ function_ = e.function_;
+ line_ = e.line_;
+ message_ = e.message_;
+
+ return *this;
+ }
+
+ virtual ~ scythe_exception () throw ()
+ {
+ }
+
+ virtual const char *what () const throw ()
+ {
+ std::ostringstream os;
+ os << head_ << " in " << file_ << ", " << function_ << ", "
+ << line_ << ": " << message_ << "!";
+ return os.str ().c_str ();
+ }
+
+ virtual std::string message () const throw ()
+ {
+ return message_;
+ }
+
+ private:
+ std::string head_;
+ std::string file_;
+ std::string function_;
+ unsigned int line_;
+ std::string message_;
+ };
+
+
+ /**** Exception class types, added as needed ****/
+ class scythe_alloc_error:public scythe_exception
+ {
+ public:
+ scythe_alloc_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_ALLOCATION_ERROR", file, function,
+ line, message, halt)
+ {
+ }
+ };
+
+ class scythe_invalid_arg:public scythe_exception
+ {
+ public:
+ scythe_invalid_arg (const std::string & file,
+ const std::string & function,
+ const unsigned int &line,
+ const std::string & message = "",
+ const bool & halt = false) throw ()
+ : scythe_exception ("SCYTHE_INVALID ARGUMENT", file, function,
+ line, message, halt)
+ {
+ }
+ };
+
+ class scythe_file_error:public scythe_exception
+ {
+ public:
+ scythe_file_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 FILE ERROR", file, function, line,
+ message, halt)
+ {
+ }
+ };
+
+ class scythe_conformation_error:public scythe_exception
+ {
+ public:
+ scythe_conformation_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 CONFORMATION ERROR", file, function,
+ line, message, halt)
+ {
+ }
+ };
+
+ class scythe_dimension_error:public scythe_exception
+ {
+ public:
+ scythe_dimension_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 DIMENSION ERROR", file, function,
+ line, message, halt)
+ {
+ }
+ };
+
+ class scythe_null_error:public scythe_exception
+ {
+ public:
+ scythe_null_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 NULL ERROR", file, function, line,
+ message, halt)
+ {
+ }
+ };
+
+ class scythe_type_error:public scythe_exception
+ {
+ public:
+ scythe_type_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 TYPE ERROR", file, function, line,
+ message, halt)
+ {
+ }
+ };
+
+ class scythe_out_of_range_error:public scythe_exception
+ {
+ public:
+ scythe_out_of_range_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,
+ line, message, halt)
+ {
+ }
+ };
+
+ class scythe_convergence_error:public scythe_exception
+ {
+ public:
+ scythe_convergence_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 CONVERGENCE ERROR", file, function,
+ line, message, halt)
+ {
+ }
+ };
+
+ class scythe_range_error:public scythe_exception
+ {
+ public:
+ scythe_range_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 RANGE ERROR", file, function, line,
+ message, halt)
+ {
+ }
+ };
+
+ class scythe_precision_error:public scythe_exception
+ {
+ public:
+ scythe_precision_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 PRECISION ERROR", file, function,
+ line, message, halt)
+ {
+ }
+ };
+
+ 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)
+ {
+ }
+ };
+
+ class scythe_randseed_error:public scythe_exception
+ {
+ public:
+ scythe_randseed_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 RANDOM SEED 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 << std::endl;
+ abort ();
+ }
+
+} // end namspace SCYTHE
+
+#endif /* SCYTHE_ERROR_H */
diff --git a/src/ide.cc b/src/ide.cc
new file mode 100644
index 0000000..7b6b354
--- /dev/null
+++ b/src/ide.cc
@@ -0,0 +1,534 @@
+/*
+ * 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
new file mode 100644
index 0000000..8d6a9c1
--- /dev/null
+++ b/src/ide.h
@@ -0,0 +1,114 @@
+/*
+ * 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.h
+ *
+ * Provides definitions for inversion and decomposition
+ * template functions that operate on Scythe's Matrix class.
+ *
+ */
+
+#ifndef SCYTHE_IDE_H
+#define SCYTHE_IDE_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "matrix.h"
+#else
+#include "scythestat/matrix.h"
+#endif
+
+namespace SCYTHE {
+
+ /* Cholesky decomposition of a sym pos-def matrix */
+ template <class T>
+ Matrix<T>
+ cholesky (const Matrix<T> &);
+
+ /* 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
+ */
+ template <class T>
+ Matrix<T> chol_solve (const Matrix<T> &, const Matrix<T> &,
+ const Matrix<T> &);
+
+ /* Calculates the inverse of a Sym. Pos. Def. Matrix (NOTE: function
+ * is overloaded)
+ */
+ template <class T>
+ Matrix<T> invpd (const Matrix<T> &);
+
+ /* Calculates the inverse of a Sym. Pos. Def. Matrix (NOTE: function
+ * is overloaded)
+ */
+ template <class T>
+ Matrix<T> invpd (const Matrix<T> &, const Matrix<T> &);
+
+ /* 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)
+ */
+ 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)
+ */
+ template <class T>
+ Matrix<T> lu_solve (Matrix<T>, const Matrix<T> &, const Matrix<T> &,
+ const Matrix<T> &, const Matrix<int> &);
+
+ /* Interchanges the rows of A with those in vector p and returns the
+ * modified Matrix.
+ */
+ template <class T>
+ Matrix<T> row_interchange(Matrix<T>, const Matrix<int> &);
+
+ /* Calculate the Inverse of a square Matrix A via LU decomposition
+ *
+ * DEPRECATED: see operator^= in Scythe_Matrix
+ */
+ 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 */
+
+#endif /* SCYTHE_IDE_H */
diff --git a/src/la.cc b/src/la.cc
new file mode 100644
index 0000000..72b6c65
--- /dev/null
+++ b/src/la.cc
@@ -0,0 +1,371 @@
+/*
+ * 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 <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 = 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)
+ {
+ Matrix<T> temp(A.cols(), A.cols(), false);
+
+ for (int i = 0; i < A.cols(); ++i) {
+ for (int j = i; j < A.cols(); ++j) {
+ temp(i,j) = T (0);
+ for (int k = 0; k < A.rows(); ++k)
+ temp(j,i) = temp(i,j) += A(k,i) * A(k,j);
+ }
+ }
+
+ return temp;
+ }
+
+} // 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
new file mode 100644
index 0000000..16209d5
--- /dev/null
+++ b/src/la.h
@@ -0,0 +1,146 @@
+/*
+ * 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.h
+ *
+ * Provides definitions for functions that perform common
+ * linear algebra manipulations on Scythe matrices.
+ *
+ */
+
+#ifndef SCYTHE_LA_H
+#define SCYTHE_LA_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "matrix.h"
+#else
+#include "scythestat/matrix.h"
+#endif
+
+namespace SCYTHE {
+
+ /* Transpose - computes the transpose of a Matrix */
+ template <class T>
+ Matrix<T> t (const Matrix<T> &);
+
+ /* Ones - creates a Matrix of ones */
+ template <class T>
+ Matrix<T> ones (const int &, const int &);
+
+ /* Eye - creates an Identity Matrix of size k x k */
+ template <class T>
+ Matrix<T> eye (const int &);
+
+ /* Seqa - creates a vector additive sequence Matrix (size x 1) */
+ template <class T>
+ Matrix<T> seqa (T, const T &, const int &);
+
+ /* 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());
+ *
+ * Version two takes a compare function object while the first uses
+ * primitive comparison operators.
+ */
+ template <class T>
+ Matrix<T> sort (Matrix<T>);
+
+ /* 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
+ *
+ * Unlike sort, this function is not deprecated
+ */
+ template <class T>
+ Matrix<T> sortc (Matrix<T> A);
+
+ /* Cbind - Column bind 2 matrices */
+ template <class T>
+ Matrix<T> cbind (const Matrix<T> &, const Matrix<T> &);
+
+ /* FUNCTION: Rbind - Row bind 2 matrices */
+ template <class T>
+ Matrix<T> rbind (const Matrix<T> &, const Matrix<T> &);
+
+ /* 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> &);
+
+ /* 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> &);
+
+ /* Unique - Finds unique elements in a Matrix */
+ template <class T>
+ Matrix<T> unique(const Matrix<T> &);
+
+ /* Vecr - Turn Matrix into Column vector by stacking rows */
+ template <class T>
+ inline Matrix<T> vecr(const Matrix<T> &A)
+ {
+ return (Matrix<T> (A.size(), 1, A.getArray()));
+ }
+
+ /* Vecc - Turn Matrix into Column vector by stacking columns */
+ template <class T>
+ inline Matrix<T> vecc(const Matrix<T> &A)
+ {
+ Matrix<T> temp(A.size(), 1, false);
+
+ // 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());
+
+ return temp;
+ }
+
+ /* Reshape - Reshapes a row major order Matrix or Vector */
+ template <class T>
+ Matrix<T> reshape(const Matrix<T> &, const int &, const int &);
+
+ /* Vech - Make vector out of unique elements of a symmetric */
+ template <class T>
+ Matrix<T> vech(const Matrix<T> &);
+
+ /* Xpnd - Get symmetric Matrix B back from A = vech(B) */
+ template <class T>
+ Matrix<T> xpnd(const Matrix<T> &);
+
+ /* Diag - get the diagonal of a Matrix */
+ template <class T>
+ Matrix<T> diag(const Matrix<T> &);
+
+ /* Gaxpy - Fast calculation of A*B + C */
+ template <class T>
+ Matrix<T> gaxpy(const Matrix<T> &, const Matrix<T> &,
+ const Matrix<T> &);
+
+ /* Crossprod - Fast calculation of A'A */
+ template <class T>
+ Matrix<T> crossprod(const Matrix<T> &);
+
+} // 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/lecuyer.cc b/src/lecuyer.cc
new file mode 100644
index 0000000..59f10ac
--- /dev/null
+++ b/src/lecuyer.cc
@@ -0,0 +1,689 @@
+/*
+ * 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 ());
+ }
+
+}
+
+#endif /* SCYTHE_LECUYER_CC */
diff --git a/src/lecuyer.h b/src/lecuyer.h
new file mode 100644
index 0000000..806c8b0
--- /dev/null
+++ b/src/lecuyer.h
@@ -0,0 +1,132 @@
+/*
+ * 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.h
+ *
+ * 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, which was released under the following
+ * license:
+ *
+ * This software is Copyright (C) 2004 Pierre L'Ecuyer.
+ *
+ * License: this code can be used freely for personal, academic, or
+ * non-commercial purposes. For commercial licensing, please contact
+ * P. L'Ecuyer at lecuyer at iro.umontreal.ca.
+ *
+ * This code may also be redistributed and modified under the terms of
+ * the GNU General Public License as published by the Free Software
+ * Foundation; either version 2 of the License, or (at your option) any
+ * later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ * USA.
+ *
+ */
+
+#ifndef SCYTHE_LECUYER_H
+#define SCYTHE_LECUYER_H
+
+#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);
+
+
+ void GetState (unsigned long seed[6]) const;
+
+
+ void WriteState () const;
+
+
+ void WriteStateFull () const;
+
+
+ double runif ();
+
+ /* 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);
+ }
+
+ 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 ();
+
+ };
+
+ }
+
+#endif /* SCYTHE_LECUYER_H */
diff --git a/src/matrix.h b/src/matrix.h
new file mode 100644
index 0000000..52827b1
--- /dev/null
+++ b/src/matrix.h
@@ -0,0 +1,2014 @@
+/*
+ * 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.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
+ *
+ */
+
+#ifndef SCYTHE_MATRIX_H
+#define SCYTHE_MATRIX_H
+
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <sstream>
+#include <new>
+#include <numeric>
+#include <string>
+#include <climits>
+#include <cmath>
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "error.h"
+#include "util.h"
+#include "matrix_iterator.h"
+#else
+#include "scythestat/error.h"
+#include "scythestat/util.h"
+#include "scythestat/matrix_iterator.h"
+#endif
+
+namespace SCYTHE {
+
+ struct all_elements{
+ } const _ = {};
+
+
+ enum IN_TYPE {NORMAL, REPEAT, DIAG, UTRIANG, LTRIANG, BLOCK};
+
+ 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>;
+
+ 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");
+ }
+ }
+
+ /* 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");
+ }
+
+ 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.
+ */
+ 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");
+ }
+ }
+
+ /* 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();
+ }
+ }
+
+ /* 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];
+ }
+ }
+ }
+
+ 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];
+ }
+ }
+ }
+
+ /**** 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 ****/
+
+ /* 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");
+ }
+#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");
+ }
+#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");
+ }
+#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));
+ }
+#endif
+
+ int cnt = -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];
+
+ 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");
+ }
+#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_;
+ }
+
+ return temp;
+ }
+
+ /* 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");
+ }
+#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];
+ }
+
+ 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");
+ }
+ 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");
+ }
+ 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");
+ }
+ 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];
+ }
+ }
+ }
+ 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");
+ }
+ 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];
+ }
+ } else { // error A^=n not defined where n < -1
+ throw scythe_invalid_arg(__FILE__, __PRETTY_FUNCTION__,
+ __LINE__, "Invalid argument: -1");
+ }
+ return *this;
+ }
+
+ /**** Accessors ****/
+
+ /* Return total length of the matrix */
+ inline int size() const
+ {
+ return size_;
+ }
+
+ /* Return number of rows */
+ inline int rows() const
+ {
+ return rows_;
+ }
+
+ /* Return number of columns */
+ inline int cols() const
+ {
+ return cols_;
+ }
+
+ inline bool empty() const
+ {
+ // Equivalent to isNull but is the STL-compliant syntax
+ return (rows_ == 0);
+ }
+
+ // Our max size is the biggest int or the limits of your mem
+ inline int max_size () const {
+ return INT_MAX;
+ }
+
+ /* 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);
+ }
+
+ /* 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);
+ }
+
+ /* 1Xm Matrix? */
+ inline bool isRowVector() const
+ {
+ return (rows_ == 1);
+ }
+
+ /* 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;
+ }
+ }
+ 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;
+ }
+ }
+ 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;
+ }
+ }
+ 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;
+ }
+ }
+ 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;
+ }
+ }
+ return true;
+ }
+
+ /**** Utilities ****/
+
+ /* 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_;
+ }
+
+ /* 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();
+ }
+ }
+
+ s.str("");
+ if (dim) {
+ s << "Size: " << size_ << " (" << rows_ << " x " << cols_
+ << ")" << std::endl;
+ }
+ if (internal) {
+ s << "Object: " << this << ", Data: " << data_
+ << ", Allocation: " << alloc_ << std::endl;
+ }
+
+ 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 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;
+ }
+ }
+ 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;
+ }
+ if (! out || err) {
+ throw scythe_file_error(__FILE__, __PRETTY_FUNCTION__, __LINE__,
+ std::string("Could not open file ") & path);
+ return;
+ }
+ 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);
+ }
+ 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);
+ }
+
+ 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);
+ }
+
+ 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);
+ }
+
+ 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);
+ }
+
+ 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);
+ }
+
+ 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);
+ }
+
+ 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);
+ }
+
+ private:
+ /**** Helper Functions ****/
+ inline int ijIndex(const int &i, const int &j) const
+ {
+ return (i * cols_ + j);
+ }
+
+ inline void resize2Match (const Matrix<T> &m)
+ {
+ resize(m.size_, false);
+ rows_ = m.rows_;
+ cols_ = 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;
+ }
+
+ inline void grow (const int &s, const bool &fill=true)
+ {
+ alloc_ = alloc_ ? alloc_ : 1;
+ while (alloc_ < s)
+ alloc_ <<= 1;
+
+ 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");
+ }
+
+ if (fill) {
+ for (int i =0; i < size_; ++i)
+ data_[i] = temp[i];
+ }
+
+ 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_];
+
+ if (data_ == 0) {
+ throw scythe_alloc_error(__FILE__, __PRETTY_FUNCTION__,
+ __LINE__, "Failed to reallocate internal array");
+ }
+
+ if (fill) {
+ for (int i =0; i < alloc_; ++i)
+ data_[i] = temp[i];
+ }
+
+ delete[] temp;
+ }
+
+ /**** 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
+
+ }; /* class Matrix */
+
+ /***** (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;
+ }
+
+ template<class T>
+ bool operator== (const Matrix<T> &A,
+ const typename Matrix<T>::ttype &b)
+ {
+ return (A == Matrix<T>(b));
+ }
+
+ template <class T>
+ bool operator== (const typename Matrix<T>::ttype &a,
+ const Matrix<T> &B)
+ {
+ return (Matrix<T>(a) == B);
+ }
+
+ template <class T>
+ bool operator!= (const Matrix<T> &A, const Matrix<T> &B)
+ {
+ return !(A == B);
+ }
+
+ template<class T>
+ bool operator!= (const Matrix<T> &A,
+ const typename Matrix<T>::ttype &b)
+ {
+ return !(A == Matrix<T>(b));
+ }
+
+ template <class T>
+ bool operator!= (const typename Matrix<T>::ttype &a,
+ const Matrix<T> &B)
+ {
+ return !(Matrix<T>(a) == B);
+ }
+
+ 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));
+ }
+
+ template <class T>
+ bool operator< (const typename Matrix<T>::ttype &a,
+ const Matrix<T> &B)
+ {
+ return (Matrix<T>(a) < B);
+ }
+
+ 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));
+ }
+
+ template <class T>
+ bool operator> (const typename Matrix<T>::ttype &a,
+ const Matrix<T> &B)
+ {
+ return (Matrix<T>(a) > B);
+ }
+
+ 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));
+ }
+
+ template <class T>
+ bool operator<= (const typename Matrix<T>::ttype &a,
+ const Matrix<T> &B)
+ {
+ return (Matrix<T>(a) <= B);
+ }
+
+ 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));
+ }
+
+ 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
+ */
+
+ 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;
+ }
+
+ 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());
+ 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);
+ }
+
+ /**** 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.
+ */
+
+ /* 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;
+ }
+
+ /* 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)
+ {
+ return A -= Matrix<T>(b);
+ }
+
+ 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)
+ {
+ return A *= B;
+ }
+
+ // 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)
+ {
+ return A *= Matrix<T>(b);
+ }
+
+ template <class T>
+ Matrix<T> operator*(const typename Matrix<T>::ttype &a,
+ const Matrix<T> &B)
+ {
+ return Matrix<T>(a) *= B;
+ }
+
+ /* Kronecker Multiplication */
+ template <class T>
+ Matrix<T> operator% (Matrix<T>A, const Matrix<T> &B)
+ {
+ return A %= B;
+ }
+
+ // 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);
+ }
+
+ template <class T>
+ Matrix<T> operator%(const typename Matrix<T>::ttype &a,
+ const Matrix<T> &B)
+ {
+ return Matrix<T>(a) %= B;
+ }
+
+ /* Element-by-element division */
+ 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)
+ {
+ return A /= Matrix<T>(b);
+ }
+
+ template <class T>
+ Matrix<T> operator/ (const typename Matrix<T>::ttype &a,
+ const Matrix<T> &B)
+ {
+ return Matrix<T>(a) /= B;
+ }
+
+ /* Matrix power: ^0 returns identity matrix of this size, ^-1
+ * returns inverse, otherwise must be a positive int
+ */
+ template <class T>
+ Matrix<T> operator^ (Matrix<T> A, const int &i)
+ {
+ return A ^= i;
+ }
+
+ /* Return the transpose of this matrix */
+ template <class T>
+ Matrix<T> operator! (const Matrix<T> &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;
+ }
+
+ /* 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;
+ }
+ 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);
+ }
+ }
+ }
+
+ T det = 1;
+ for (int i = 0; i < A.rows(); ++i)
+ det *= A(i,i);
+
+ return sign * det;
+ }
+
+
+
+ template <class T>
+ inline Matrix<T>
+ r2scythe (const int &rows, const int &cols, const T *data)
+ {
+ Matrix<T> M(rows, 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];
+ }
+
+ return M;
+ }
+
+
+} // end namespace SCYTHE
+
+#endif /* SCYTHE_MATRIX_H */
diff --git a/src/matrix_iterator.h b/src/matrix_iterator.h
new file mode 100644
index 0000000..bd4205d
--- /dev/null
+++ b/src/matrix_iterator.h
@@ -0,0 +1,1842 @@
+/*
+ * 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/mersenne.cc b/src/mersenne.cc
new file mode 100644
index 0000000..cd734d1
--- /dev/null
+++ b/src/mersenne.cc
@@ -0,0 +1,125 @@
+/*
+ * 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
new file mode 100644
index 0000000..0417cfd
--- /dev/null
+++ b/src/mersenne.h
@@ -0,0 +1,117 @@
+/*
+ * 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.h
+ *
+ * Provides the class definition for the mersenne random number
+ * generator. This class extends the base rng class by providing an
+ * implementation of runif() based on an implementation of the
+ * mersenne twister, released under the following license:
+ *
+ * A C-program for MT19937, with initialization improved 2002/1/26.
+ * Coded by Takuji Nishimura and Makoto Matsumoto.
+ *
+ * Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above
+ * copyright
+ * notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ *
+ * 3. The names of its contributors may not be used to endorse or
+ * promote products derived from this software without specific
+ * prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
+ * CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+ * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ * For more information see:
+ * http://www.math.keio.ac.jp/matumoto/emt.html
+ *
+ */
+
+#ifndef SCYTHE_MERSENNE_H
+#define SCYTHE_MERSENNE_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "rng.h"
+#else
+#include "scythestat/rng.h"
+#endif
+
+namespace SCYTHE {
+
+ class mersenne: public rng
+ {
+ public:
+
+ mersenne ();
+
+ mersenne (const mersenne &);
+
+ ~mersenne ();
+
+ void initialize (const unsigned long &);
+
+ inline double runif()
+ {
+ return (((double) genrand_int32()) + 0.5) *
+ (1.0 / 4294967296.0);
+ }
+
+ /* 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);
+ }
+
+ unsigned long genrand_int32();
+
+ protected:
+ /* Period parameters */
+ static const int N = 624;
+ static const int M = 398;
+
+ /* the array for the state vector */
+ unsigned long mt[N];
+
+ /* mti==N+1 means mt[N] is not initialized */
+ int mti;
+ };
+
+}
+
+#endif /* SCYTHE_MERSENNE_H */
diff --git a/src/optimize.cc b/src/optimize.cc
new file mode 100644
index 0000000..4472e65
--- /dev/null
+++ b/src/optimize.cc
@@ -0,0 +1,642 @@
+/*
+ * 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
new file mode 100644
index 0000000..1f51ab7
--- /dev/null
+++ b/src/optimize.h
@@ -0,0 +1,171 @@
+/*
+ * 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.
+ * --------------------------------------------------------------------
+ * sythestat/optimization.h
+ *
+ * Provides definitions for various numerical optimization
+ * routines.
+ *
+ */
+
+#ifndef SCYTHE_OPTIMIZE_H
+#define SCYTHE_OPTIMIZE_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "matrix.h"
+#include "rng.h"
+#else
+#include "scythestat/matrix.h"
+#include "scythestat/rng.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
+ */
+ 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 *);
+
+ /* 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> &);
+
+
+ /* 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);
+
+ /* 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
+
+#if defined (SCYTHE_COMPILE_DIRECT) && \
+ (defined (__GNUG__) || defined (__MWERKS__) || \
+ defined (_MSC_VER) || defined (EXPLICIT_TEMPLATE_INSTANTIATION))
+#include "optimize.cc"
+#endif /* EXPLICIT_TEMPLATE_INSTANTIATION */
+
+#endif /* SCYTHE_OPTIMIZE_H */
diff --git a/src/rng.cc b/src/rng.cc
new file mode 100644
index 0000000..4d0fc72
--- /dev/null
+++ b/src/rng.cc
@@ -0,0 +1,1159 @@
+/*
+ * 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) {
+ 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 = (m+30.0)*s;
+ 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 = (m-30.0)*s;
+ 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
new file mode 100644
index 0000000..ced7623
--- /dev/null
+++ b/src/rng.h
@@ -0,0 +1,228 @@
+/*
+ * 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 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().
+ *
+ * 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.
+ * 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
+ *
+ */
+
+#ifndef SCYTHE_RNG_H
+#define SCYTHE_RNG_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "matrix.h"
+#else
+#include "scythestat/matrix.h"
+#endif
+
+namespace SCYTHE {
+
+ class rng
+ {
+ public:
+
+ /* Default (and only) constructor. */
+ rng ();
+
+ /* 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 &);
+
+ 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);
+
+ /* 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 &);
+
+ Matrix<double> rchisq ( const int &, const int &,
+ const double &);
+
+ /* Exponential distribution */
+ double rexp (const double &);
+
+ Matrix<double> rexp ( const int &rows, const int &cols,
+ const double &);
+
+ /* 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 &);
+
+ /* Logistic distribution */
+ double rlogis (const double &, const double &);
+
+ 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);
+
+ 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 &);
+
+ Matrix<double> rnbinom(const int &, const int &, const double &,
+ const double &);
+
+ /* Normal distribution */
+ double rnorm (const double &mu=0.0, const double &sigma=1.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 &);
+
+ Matrix<int> rpois (const int &, const int &, const double &);
+
+ /* Student's t distribution */
+ double rt (const double &, const double &, const double &);
+
+ Matrix<double> rt ( const int &, const int &,
+ const double &, const double &,
+ const double &);
+
+ /* Weibull distribution */
+ double rweibull (const double &, const double &scale = 1.0);
+
+ 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 &);
+
+ Matrix<double> rigamma( const int &, const int &,
+ const double &, const double &);
+
+ /* Wishart (Only for Matrix) distribution */
+ Matrix<double> rwish(const int &, const Matrix<double> &);
+
+ /* Dirichlet distribution */
+ Matrix<double> rdirich(const Matrix<double> &);
+
+ /* Multivariate Normal distribution */
+ Matrix<double> rmvnorm (const Matrix<double> &,
+ const Matrix<double> &);
+
+ /* Multivariate t distribution */
+ Matrix<double> rmvt (const Matrix<double> &, const double &);
+
+ /* Bernoulli distribution */
+ int rbern (const double &);
+
+ Matrix<double> rbern (const int &, const int &,
+ const double &);
+
+ /* Beta-Binomial distribution */
+ int rbetabin (const int &, const double &, const double &);
+
+ Matrix<double> rbetabin ( const int &, const int &,
+ const int &, const double &,
+ const double &);
+
+ /* 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 &);
+
+ double rtbnorm_slice( const double &, const double &,
+ const double &, const int &iter = 10);
+
+ double rtanorm_slice( const double &, const double &,
+ const double &, const int &iter = 10);
+
+ double rtbnorm_combo( const double &, const double &,
+ const double &, const int &iter=10);
+
+ double rtanorm_combo( const double &, const double &,
+ const double &, const int &iter=10);
+
+ protected:
+
+ double rgamma1 (const double &);
+
+ double rnorm1();
+
+ };
+
+}
+
+#endif /* SCYTHE_RNG_H */
diff --git a/src/smath.cc b/src/smath.cc
new file mode 100644
index 0000000..7628485
--- /dev/null
+++ b/src/smath.cc
@@ -0,0 +1,625 @@
+/*
+ * 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
new file mode 100644
index 0000000..6703456
--- /dev/null
+++ b/src/smath.h
@@ -0,0 +1,248 @@
+/*
+ * 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.h
+ *
+ * Provides definitions for the template wrapper functions
+ * that allow common math.h operations to be performed on
+ * Scythe matrices.
+ *
+ */
+
+#ifndef SCYTHE_MATH_H
+#define SCYTHE_MATH_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "matrix.h"
+#else
+#include "scythestat/matrix.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
+ */
+
+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>);
+
+ /* 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>);
+
+ /* atanh - inverse hyperbolic tangent function */
+ template <class T>
+ Matrix<T> atanh (Matrix<T>);
+
+ /* 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> &);
+
+ /* cbrt - cube root */
+ template <class T>
+ Matrix<T> cbrt (Matrix<T>);
+
+ /* ceil - ceiling of a floating point number */
+ template <class T>
+ Matrix<T> ceil (Matrix<T>);
+
+ /* 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>);
+
+ /* 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> &);
+
+ /* 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>);
+
+ /* 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.
+ */
+ 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.
+ */
+ template <class T>
+ Matrix<T> modf (Matrix<T>, Matrix<double> &);
+
+ /* Pow - Raise each Matrix element to the power of the 2nd arg
+ */
+ 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???
+ */
+ 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>);
+
+ /* sinh - return the hyperbolic sine of x */
+ template <class T>
+ Matrix<T> sinh (Matrix<T>);
+
+ /* Sqrt - Calculate the sqrt of each element of a Matrix */
+ template <class T>
+ Matrix<T> sqrt (Matrix<T>);
+
+ /* tan - return the tangent of x */
+ template <class T>
+ Matrix<T> tan (Matrix<T>);
+
+ /* 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)
+ */
+ 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 */
+
+#endif /* SCYTHE_MATH_H */
diff --git a/src/stat.cc b/src/stat.cc
new file mode 100644
index 0000000..147857c
--- /dev/null
+++ b/src/stat.cc
@@ -0,0 +1,431 @@
+/*
+ * 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 (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] = 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 (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] = 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
new file mode 100644
index 0000000..434cb4d
--- /dev/null
+++ b/src/stat.h
@@ -0,0 +1,144 @@
+/*
+ * 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.h
+ *
+ * Provides declarations for descriptive statistical
+ * functions.
+ *
+ */
+
+#ifndef SCYTHE_STAT_H
+#define SCYTHE_STAT_H
+
+#ifdef SCYTHE_COMPILE_DIRECT
+#include "matrix.h"
+#else
+#include "scythestat/matrix.h"
+#endif
+
+namespace SCYTHE {
+
+ /* Sum - Calculate the sum of a Matrix */
+ template <class T>
+ T sum (const Matrix<T> &);
+
+ /* Sumc - Calculate the sum of each column of a Matrix */
+ template <class T>
+ Matrix<T> sumc (const Matrix<T> &);
+
+ /* Prod - Calculate the product of a Matrix */
+ template <class T>
+ T prod (const Matrix<T> &);
+
+ /* Prodc - Calculate the product of each column of a Matrix */
+ template <class T>
+ Matrix<T> prodc (const Matrix<T> &);
+
+ /* Mean - Calculate the mean of a Matrix */
+ template <class T>
+ T mean (const Matrix<T> &);
+
+ /* Meanc - Calculate the mean of each column of a Matrix */
+ template <class T>
+ Matrix<T> meanc (const Matrix<T> &);
+
+ /* Median - Calculate the median of a Matrix */
+ template <class T>
+ T median (const Matrix<T> &);
+
+ /* Medianc - Calculate the median of each column of a Matrix */
+ template <class T>
+ Matrix<T> medianc (const Matrix<T> &);
+
+ /* Mode - Calcualte the mode of the Matrix */
+ template <class T>
+ T mode (const Matrix<T> &);
+
+ /* Modec - Calculate the mode of each column of a Matrix */
+ template <class T>
+ Matrix<T> modec (const Matrix<T> &);
+
+ /* Skew - Calcualte the skew of the Matrix */
+ template <class T>
+ T skew (const Matrix<T> &);
+
+ /* Skewc - Calculate the skew of each column of a Matrix */
+ template <class T>
+ Matrix<T> skewc (const Matrix<T> &);
+
+ /* Kurtosis - Calcualte the kurtosis of the Matrix */
+ template <class T>
+ T kurtosis (const Matrix<T> &);
+
+ /* Kurtosisc - Calculate the kurtosis of each column of a Matrix */
+ template <class T>
+ Matrix<T> kurtosisc (const Matrix<T> &);
+
+ /* Var - Calculate the variance of a Matrix */
+ template <class T>
+ T var (const Matrix<T> &);
+
+ /* Varc - Calculate the variance of each Matrix column */
+ template <class T>
+ Matrix<T> varc (const Matrix<T> &);
+
+ /* Std - Calculate the std deviation of a Matrix */
+ template <class T>
+ T sd (const Matrix<T> &);
+
+ /* Stdc - Calculate the std deviation of each Matrix column */
+ template <class T>
+ Matrix<T> stdc (const Matrix<T> &);
+
+ /* Max - Calculates the maximum element in a Matrix */
+ template <class T>
+ T max (const Matrix<T> &);
+
+ /* Min - Calculates the minimum element in a Matrix */
+ template <class T>
+ T min (const Matrix<T> &);
+
+ /* Maxind - Finds the index of the max element */
+ template <class T>
+ int maxind(const Matrix<T> &);
+
+ /* Minind - Finds the index of the min element */
+ template <class T>
+ int minind(const Matrix<T> &);
+
+ /* Maxc - Calculates the maximum of each Matrix column */
+ template <class T>
+ Matrix<T> maxc (const Matrix<T> &);
+
+ /* Minc - Calculates the minimum of each Matrix column */
+ template <class T>
+ Matrix<T> minc (const Matrix<T> &);
+
+ /* Maxindc - Finds the index of the max of each Matrix column */
+ template <class T>
+ Matrix<int> maxindc(const Matrix<T> &);
+
+ /* Minindc - Finds the index of the min of each Matrix column */
+ template <class T>
+ Matrix<int> minindc(const Matrix<T> &);
+
+} // 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
new file mode 100644
index 0000000..535ad7e
--- /dev/null
+++ b/src/util.h
@@ -0,0 +1,74 @@
+/*
+ * 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