stepan
/
dynare
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

SWZ: remove out of date code

time-shift
Houtan Bastani 2011-02-02 18:36:41 +01:00
parent 06fe0c850a
commit 39adf099c3
77 changed files with 0 additions and 55523 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
matlab/ms-sbvar/bin/.gitignore vendored
View File

@ -1,6 +0,0 @@
sbvar_draws
sbvar_init_file
sbvar_mhm_1
sbvar_mhm_2
sbvar_probabilities
sbvar_estimation

117
matlab/ms-sbvar/c-code/sbvar/switching/MarkovStateVariable.dat
View File

@ -1,117 +0,0 @@
//== Flat Independent Markov States and Simple Restrictions ==//
//-----------------------------------------------------------------------------//
//-- Read by CreateMarkovStateVariable_File() only if the passed number of --//
//-- observations is less than or equal to zero. Can be omitted if the --//
//-- passed number of observations is positive. --//
//-----------------------------------------------------------------------------//
//== Number Observations ==//
200
//== Number Independent State Variables ==//
2
//-----------------------------------------------------------------------------//
//-- state_variable[1] (1 <= i <= n_state_variables) --//
//-----------------------------------------------------------------------------//
//== Number of states for state_variable[1] ==//
3
//-----------------------------------------------------------------------------//
//-- Each column contains the parameters for a Dirichlet prior on the --//
//-- corresponding column of the transition matrix. Each element must be --//
//-- positive. For each column, the relative size of the prior elements --//
//-- determine the relative size of the elements of the transition matrix --//
//-- and overall larger sizes implies a tighter prior. --//
//-----------------------------------------------------------------------------//
//== Transition matrix prior for state_variable[1]. (n_states x n_states) ==//
10 1 1
1 10 1
1 1 10
//-----------------------------------------------------------------------------//
//-- An array of n_states integers with each entry between 1 and n_states, --//
//-- inclusive. Determines the number of quasi-free Dirichlet dimensions --//
//-- each column. Since the sum of the elements in a Dirichlet distribution --//
//-- must equal to one, the actual number of free dimensions is one less. --//
//-----------------------------------------------------------------------------//
//== Free Dirichet dimensions for state_variable[1] ==//
3 3 3
//-----------------------------------------------------------------------------//
//-- The jth restriction matrix is n_states x free[j]. Each row of the --//
//-- restriction matrix has at most one non-zero entry and the sum of each --//
//-- column of the restriction matrix must be one. If (x(1),...,x(free[j])) --//
//-- is the Dirichlet random variable for column j, then the jth column of --//
//-- the transition matrix Q is the jth restriction matrix times the --//
//-- Dirichlet random random variable. --//
//-----------------------------------------------------------------------------//
//== Column restrictions for state_variable[1] ==//
1 0 0
0 1 0
0 0 1
1 0 0
0 1 0
0 0 1
1 0 0
0 1 0
0 0 1
//-----------------------------------------------------------------------------//
//-- Allows for lagged values of the state variable to be encoded --//
//-----------------------------------------------------------------------------//
//== Number of lags encoded for state_variable[1] ==//
2
//-----------------------------------------------------------------------------//
//-- state_variable[2] --//
//-----------------------------------------------------------------------------//
//== Number of states for state_variable[2] ==//
2
//-----------------------------------------------------------------------------//
//-- Each column contains the parameters for a Dirichlet prior on the --//
//-- corresponding column of the transition matrix. Each element must be --//
//-- positive. For each column, the relative size of the prior elements --//
//-- determine the relative size of the elements of the transition matrix --//
//-- and overall larger sizes implies a tighter prior. --//
//-----------------------------------------------------------------------------//
//== Transition matrix prior for state_variable[2]. (n_states x n_states) ==//
5 1
1 5
//-----------------------------------------------------------------------------//
//-- An array of n_states integers with each entry between 1 and n_states, --//
//-- inclusive. Determines the number of quasi-free Dirichlet dimensions --//
//-- each column. Since the sum of the elements in a Dirichlet distribution --//
//-- must equal to one, the actual number of free dimensions is one less. --//
//-----------------------------------------------------------------------------//
//== Free Dirichet dimensions for state_variable[2] ==//
2 2
//-----------------------------------------------------------------------------//
//-- The jth restriction matrix is n_states x free[j]. Each row of the --//
//-- restriction matrix has at most one non-zero entry and the sum of each --//
//-- column of the restriction matrix must be one. If (x(1),...,x(free[j])) --//
//-- is the Dirichlet random variable for column j, then the jth column of --//
//-- the transition matrix Q is the jth restriction matrix times the --//
//-- Dirichlet random random variable. --//
//-----------------------------------------------------------------------------//
//== Column restrictions for state_variable[2] ==//
1 0
0 1
1 0
0 1
//-----------------------------------------------------------------------------//
//-- Allows for lagged values of the state variable to be encoded --//
//-----------------------------------------------------------------------------//
//== Number of lags encoded for state_variable[2] ==//
0

3015
matlab/ms-sbvar/c-code/sbvar/switching/switch.c
View File

File diff suppressed because it is too large Load Diff

605
matlab/ms-sbvar/c-code/sbvar/switching/switch.h
View File

@ -1,605 +0,0 @@
#ifndef __MARKOV_SWITCHING__
#define __MARKOV_SWITCHING__
#define __SWITCHING_VER_100__
#include "swzmatrix.h"
/* //=== Declaring structures so pointers can be defined === ansi-c*/
struct TStateModel_tag;
struct TParameters_tag;
/*******************************************************************************/
/**************************** TMarkovStateVariable *****************************/
/*******************************************************************************/
typedef struct TMarkovStateVariable_tag
{
/* //=== Flags === ansi-c*/
int valid_transition_matrix;
/* //=== Sizes === ansi-c*/
int nobs;
int nstates;
/* //=== State vector === ansi-c*/
int* S;
/* //=== Transition matrix ansi-c*/
TMatrix Q;
/* //=== Quasi-free transition matrix parameters === ansi-c*/
TVector *b; /* The elements of b[k] are non-negative and their sum equals one up to DimV(b[k])*MACHINE_EPSILON. ansi-c*/
TVector B; /* b stacked into single vector ansi-c*/
/* //=== Prior information === ansi-c*/
TMatrix Prior; /* Dirichlet prior on the columns of Q. Must be nstates x nstates with positive elements. ansi-c*/
TVector *Prior_b; /* Dirichlet prior on the quasi-free parameters b ansi-c*/
TVector Prior_B; /* Prior_b stacked into single vector ansi-c*/
/* //=== Lag information encoding === ansi-c*/
int nlags_encoded; /* Number of lags encoded in the restrictions ansi-c*/
int nbasestates; /* Number of base states nbasestates^(nlags_encoded) = nstates ansi-c*/
int** lag_index; /* nstates x (nlags_encoded + 1) lag_index[i][j] is the value of the jth lag when the overall state is k ansi-c*/
/* //=== Restrictions === ansi-c*/
int* FreeDim; /* ansi-c*/
int** NonZeroIndex; /* nstates x nstates ansi-c*/
TMatrix MQ; /* nstates x nstates ansi-c*/
/* //=== Parent Markov state variable === ansi-c*/
struct TMarkovStateVariable_tag *parent; /* either parent state variable or pointer to itself ansi-c*/
/* //=== Multiple state variables === ansi-c*/
int n_state_variables;
struct TMarkovStateVariable_tag **state_variable;
TMatrix *QA;
TVector *ba;
TVector *Prior_ba;
int** SA;
int** Index;
/* //=== Control variables === ansi-c*/
int UseErgodic;
/* //=== Workspace === ansi-c*/
PRECISION LogPriorConstant;
} TMarkovStateVariable;
/* //=== Destructors === ansi-c*/
void FreeMarkovStateVariable(TMarkovStateVariable *sv);
/* //=== Constructors === ansi-c*/
TMarkovStateVariable* CreateMarkovStateVariable_Single(int nstates, int nobs, TMatrix Prior, int* FreeDim, int** NonZeroIndex, TMatrix MQ);
TMarkovStateVariable* CreateMarkovStateVariable_Multiple(int nobs, int n_state_variables, TMarkovStateVariable **state_variable);
TMarkovStateVariable* CreateMarkovStateVariable_Mixture(int nstates, int nobs, TMatrix Prior);
TMarkovStateVariable* CreateMarkovStateVariable_NoRestrictions(int nstates, int nobs, TMatrix Prior);
TMarkovStateVariable* CreateMarkovStateVariable_Exclusion(int nstates, int nobs, TMatrix Prior, TMatrix Exclusion);
TMarkovStateVariable* CreateMarkovStateVariable_SimpleRestrictions(int nstates, int nobs, TMatrix Prior, TMatrix* Restriction);
TMarkovStateVariable* CreateMarkovStateVariable_ConstantState(int nobs);
TMarkovStateVariable* DuplicateMarkovStateVariable(TMarkovStateVariable *sv);
TMarkovStateVariable* RestrictMarkovStateVariable(TMarkovStateVariable *sv, int nstates);
/* //=== Encoding lagged states into Markov state variable === ansi-c*/
TMarkovStateVariable* CreateMarkovStateVariable_Lags(int nlags, TMarkovStateVariable *base);
int** CreateLagIndex(int nbasestates, int nlags, int nstates);
TMatrix ConvertBaseTransitionMatrix(TMatrix T, TMatrix bT, int nlags);
/* //=== Data extractions routines === ansi-c*/
TMatrix GetTransitionMatrix_SV(TMatrix Q, TMarkovStateVariable *sv);
TMatrix GetBaseTransitionMatrix_SV(TMatrix Q, TMarkovStateVariable *sv);
#define GetTransitionProbability_SV(sv,j,i) (ElementM((sv)->Q,N_E2I[i],N_E2I[j]))
#define DecomposeIndexInd_SV(sv,i,j) ((sv)->state_variable[j]->N_I2E[(sv)->Index[N_E2I[i]][j]])
#define DecomposeIndexLag_SV(sv,i,lag) ((sv)->baseN_I2E[(sv)->lag_index[N_E2I[i]][lag]])
/* //=== Normalization === ansi-c*/
void PropagateSwap_SV(TMarkovStateVariable *sv);
void Swap_SV(TMarkovStateVariable *sv, int i, int j);
/* //=== Prior routines === ansi-c*/
void SetLogPriorConstant_SV(TMarkovStateVariable *sv);
PRECISION LogPrior_SV(TMarkovStateVariable *sv);
/* //=== Simulation === ansi-c*/
void DrawTransitionMatrix_SV(TMarkovStateVariable *sv);
void DrawTransitionMatrixFromPrior_SV(TMarkovStateVariable *sv);
void SetTransitionMatrixToPriorMean_SV(TMarkovStateVariable *sv);
void DrawStatesFromTransitionMatrix_SV(TMarkovStateVariable *sv);
/* //=== Utility routines === ansi-c*/
void InvalidateTransitionMatrices_SV(TMarkovStateVariable *sv);
void ValidateTransitionMatrices_SV(TMarkovStateVariable *sv);
void PropagateStates_SV(TMarkovStateVariable *sv);
int PropagateTransitionMatrices_SV(TMarkovStateVariable *sv);
void Update_Q_from_B_SV(TMarkovStateVariable *sv);
int Update_B_from_Q_SV(TMarkovStateVariable *sv);
int TotalNumberStateVariables_SV(TMarkovStateVariable *sv);
int* CreateStateIndex(TMarkovStateVariable* sv, TMarkovStateVariable** list, int n);
int** CreateTranslationMatrix(TMarkovStateVariable ***list, TMarkovStateVariable *sv);
int** CreateTranslationMatrix_Flat(int **states, TMarkovStateVariable *sv);
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/******************************** ThetaRoutines ********************************/
/*******************************************************************************/
typedef struct
{
/* //=== Computes ln(P(y[t] | Y[t-1], Z[t], theta, s[t] = s)) === ansi-c*/
PRECISION (*pLogConditionalLikelihood)(int s, int t, struct TStateModel_tag *model);
/* //=== Computes E[y[t] | Y[t-1], Z[t], theta, Q, s[t]] ansi-c*/
TVector (*pExpectationSingleStep)(TVector y, int s, int t, struct TStateModel_tag *model);
/* //=== Destructs parameters === ansi-c*/
void (*pDestructor)(void *);
/* //=== Draws parameters conditional states and transition probability === ansi-c*/
void (*pDrawParameters)(struct TStateModel_tag *);
/* //=== Computes Log of the prior on the model specific parameters === ansi-c*/
PRECISION (*pLogPrior)(struct TStateModel_tag *);
/* //=== Converts between free parameters and model specific parameters === ansi-c*/
int (*pNumberFreeParametersTheta)(struct TStateModel_tag*);
void (*pConvertFreeParametersToTheta)(struct TStateModel_tag*, PRECISION*);
void (*pConvertThetaToFreeParameters)(struct TStateModel_tag*, PRECISION*);
/* //=== Notification routines === ansi-c*/
void (*pStatesChanged)(struct TStateModel_tag*);
void (*pThetaChanged)(struct TStateModel_tag*);
void (*pTransitionMatrixChanged)(struct TStateModel_tag*);
int (*pValidTheta)(struct TStateModel_tag*);
/* //=== Allows for initialization of data structures before forward recursion === ansi-c*/
void (*pInitializeForwardRecursion)(struct TStateModel_tag*);
/* //=== Permutes the elements of Theta. ansi-c*/
int (*pGetNormalization)(int*, struct TStateModel_tag*);
int (*pPermuteTheta)(int*, struct TStateModel_tag*);
} ThetaRoutines;
/* //=== Constructors === ansi-c*/
ThetaRoutines* CreateThetaRoutines_empty(void);
/*******************************************************************************/
/********************************* TStateModel *********************************/
/*******************************************************************************/
typedef struct TStateModel_tag
{
TMarkovStateVariable *sv;
ThetaRoutines *routines;
void *theta;
/* //=== Control variables === ansi-c*/
int ValidForwardRecursion;
int UseLogFreeParametersQ;
int NormalizeStates;
/* //=== Common work space === ansi-c*/
TVector* V; /* V[t][i] = P(s[t] = i | Y[t], Z[t], theta, Q) 0 <= t <= T and 0 <= i < nstates ansi-c*/
TVector* Z; /* Z[t][i] = P(s[t] = i | Y[t-1], Z[t-1], theta, Q) 0 < t <= T and 0 <= i < nstates ansi-c*/
PRECISION L; /* L = Sum(ln(Sum(P(y[t] | Y[t-1], Z[t], theta, s[t]) * P(s[t] | Y[t-1], Z[t-1], theta, Q),0 <= s[t] < nstates)),0 < t <= T) ansi-c*/
/* //=== Simulation status fields ansi-c*/
int n_degenerate_draws; /* counter for number of degenerate draws ansi-c*/
int *states_count; /* integer array of length nstates to count the number of each of the states ansi-c*/
/* //=== Obsolete fields retained for backward compatibility === ansi-c*/
void *parameters;
struct TParameters_tag *p;
} TStateModel;
/* //=== Destructors === ansi-c*/
void FreeStateModel(TStateModel *model);
/* //=== Constructors === ansi-c*/
TStateModel* CreateStateModel_new(TMarkovStateVariable *sv, ThetaRoutines *routines, void *theta);
/* //=== Notification routines === ansi-c*/
void StatesChanged(TStateModel *model);
void TransitionMatricesChanged(TStateModel *model);
void ThetaChanged(TStateModel *model);
#define ValidTheta(model) (((model)->routines->pValidTheta) ? (model)->routines->pValidTheta(model) : 1)
#define ValidTransitionMatrix(model) ((model)->sv->valid_transition_matrix)
/* //=== Simulation routines === ansi-c*/
void ForwardRecursion(TStateModel *model);
void DrawStates(TStateModel *model);
void DrawStatesFromTransitionMatrix(TStateModel *model);
void DrawTransitionMatrix(TStateModel *model);
void DrawTransitionMatrixFromPrior(TStateModel *model);
void SetTransitionMatrixToPriorMean(TStateModel *model);
void DrawTheta(TStateModel *model);
void DrawAll(TStateModel *model);
/* //=== Normalization === ansi-c*/
int SetStateNormalizationMethod(int (*pGetNormalization)(int*, struct TStateModel_tag*),int (*pPermuteTheta)(int*, struct TStateModel_tag*),TStateModel *model);
int NormalizeStates(TStateModel *model);
/* //=== Probability routines === ansi-c*/
/* // ln(P(y[t] | Y[t-1], Z[t], theta, Q, s[t])) ansi-c*/
#define LogConditionalLikelihood(s,t,model) ((model)->routines->pLogConditionalLikelihood(s,t,model))
/* // ln(P(y[t] | Y[t-1], Z[t], theta, Q)) ansi-c*/
PRECISION LogConditionalLikelihood_StatesIntegratedOut(int t, TStateModel *model);
/* // E[y[t] | Y[t-1], Z[t], theta, Q, s[t]] ansi-c*/
#define ExpectationSingleStep(y,s,t,model) ((model)->routines->pExpectationSingleStep(y,s,t,model))
/* // E[y[t] | Y[t-1], Z[t], theta, Q] ansi-c*/
TVector ExpectationSingleStep_StatesIntegratedOut(TVector y, int t, TStateModel *model);
/* // ln(P(Q)) ansi-c*/
#define LogPrior_Q(model) (LogPrior_SV((model)->sv))
/* // ln(P(theta)) ansi-c*/
#define LogPrior_Theta(model) ((model)->routines->pLogPrior(model))
/* // ln(P(theta, Q)) ansi-c*/
#define LogPrior(model) (LogPrior_Theta(model) + LogPrior_Q(model))
/* // ln(P(S[T] | theta, Q)) ansi-c*/
PRECISION LogConditionalPrior_S(TStateModel *model);
/* // ln(P(Y[T] | Z[T], theta, Q, S[T])) ansi-c*/
PRECISION LogLikelihood(TStateModel *model);
/* // ln(P(Y[T] | Z[T], theta, Q, S[T]) * P(S[T] | Theta, Q) * P(Theta, Q)) ansi-c*/
#define LogPosterior(model) (LogLikelihood(model) + LogConditionalPrior_S(model) + LogPrior(model))
/* // ln(P(Y[T] | Z[T], theta, Q)) ansi-c*/
PRECISION LogLikelihood_StatesIntegratedOut(TStateModel *model);
/* // ln(P(Y[T] | Z[T], theta, Q) * P(Theta, Q)) ansi-c*/
#define LogPosterior_StatesIntegratedOut(model) (LogLikelihood_StatesIntegratedOut(model) + LogPrior(model))
/* // ln(P(S[T] | Y[T], Z[T], theta, Q)) ansi-c*/
PRECISION LogConditionalProbabilityStates(int *S, TStateModel *model);
/* // P(s[t] | Y[t], Z[t], theta, Q) ansi-c*/
PRECISION ProbabilityStateConditionalCurrent(int s, int t, TStateModel *model);
/* // P(s[t] | Y[t-1], Z[t-1], theta, Q) ansi-c*/
PRECISION ProbabilityStateConditionalPrevious(int s, int t, TStateModel *model);
/* // P[t] = P(s[t] = s | Y[T], Z[T], theta, Q) ansi-c*/
TVector ProbabilitiesState(TVector P, int s, TStateModel *model);
/* //=== Free parameters routines === ansi-c*/
int NumberFreeParametersQ(TStateModel *model);
void ConvertQToFreeParameters(TStateModel *model, PRECISION *f); /* needs to be modified ansi-c*/
void ConvertFreeParametersToQ(TStateModel *model, PRECISION *f); /* needs to be modified ansi-c*/
void ConvertQToLogFreeParameters(TStateModel *model, PRECISION *f); /* needs to be modified ansi-c*/
void ConvertLogFreeParametersToQ(TStateModel *model, PRECISION *f); /* needs to be modified ansi-c*/
#define NumberFreeParametersTheta(model) ((model)->routines->pNumberFreeParametersTheta(model))
void ConvertFreeParametersToTheta(TStateModel *model, PRECISION *f);
#define ConvertThetaToFreeParameters(model,f) ((model)->routines->pConvertThetaToFreeParameters(model,f))
/* //=== Setup integrity routines === ansi-c*/
int CheckRestrictions(int* FreeDim, int** NonZeroIndex, TMatrix MP, int nstates);
int CheckPrior(TMatrix Prior, int nstates);
int CheckPriorOnFreeParameters(TMatrix Prior, int** NonZeroIndex, int nstates);
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/* //=== Utility routines === ansi-c*/
TVector Ergodic(TVector v, TMatrix P);
TVector Ergodic_SVD(TVector v, TMatrix P);
TVector* ErgodicAll_SVD(TMatrix P);
TVector DrawDirichletVector(TVector Q, TVector Alpha);
TVector* DrawIndependentDirichletVector(TVector *Q, TVector *A);
PRECISION LogDirichlet_pdf(TVector Q, TVector Alpha);
PRECISION LogIndependentDirichlet_pdf(TVector *Q, TVector *Alpha);
int DrawDiscrete(TVector p);
PRECISION AddLogs(PRECISION a, PRECISION b);
PRECISION AddScaledLogs(PRECISION x, PRECISION a, PRECISION y, PRECISION b);
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/****** Obsolete names and structures retained for backward compatibility ******/
/*******************************************************************************/
typedef struct TParameters_tag
{
/* //=== Computes ln(P(y[t] | Y[t-1], Z[t], theta, s[t] = s)) === ansi-c*/
PRECISION (*pLogConditionalLikelihood)(int s, int t, struct TStateModel_tag *model);
/* //=== Destructs parameters === ansi-c*/
void (*pParameterDestructor)(void *parameters);
/* //=== Draws parameters conditional states and transition probability === ansi-c*/
void (*pDrawParameters)(struct TStateModel_tag *);
/* //=== Computes Log of the prior on the model specific parameters === ansi-c*/
PRECISION (*pLogPrior)(struct TStateModel_tag *);
/* //=== Converts between free parameters and model specific parameters === ansi-c*/
int (*pNumberFreeParametersTheta)(struct TStateModel_tag*);
void (*pConvertFreeParametersToTheta)(struct TStateModel_tag*, PRECISION*);
void (*pConvertThetaToFreeParameters)(struct TStateModel_tag*, PRECISION*);
/* // Obsolete fields retained for backward compatibility ansi-c*/
void *p;
} TParameters;
/* //=== Constructors/Destructors === ansi-c*/
void FreeParameters(TParameters *p);
TParameters* CreateParameters(PRECISION (*)(int,int,struct TStateModel_tag*), /* pLogConditionalLikelihood ansi-c*/
void (*)(void*), /* Destructor for parameters ansi-c*/
PRECISION (*)(struct TStateModel_tag*), /* pLogPrior ansi-c*/
int (*)(struct TStateModel_tag*), /* pNumberFreeModelSpecificParameters ansi-c*/
void (*)(struct TStateModel_tag*, PRECISION*), /* pConvertFreeParametersToModelSpecificParameters ansi-c*/
void (*)(struct TStateModel_tag*, PRECISION*), /* pConvertModelSpecificParametersToFreeParameters ansi-c*/
void (*)(struct TStateModel_tag*), /* pDrawParameters ansi-c*/
void *); /* pointer to user defined parameters ansi-c*/
TStateModel* CreateStateModel(TMarkovStateVariable *sv, TParameters *p);
/* //=== Obsolete names === ansi-c*/
#define ProbabilityStateGivenCurrentData(s,t,model) ProbabilityStateConditionalCurrent(s,t,model)
#define ProbabilityStateGivenPreviousData(s,t,model) ProbabilityStateConditionalPrevious(s,t,model)
#define ProbabilityStateGivenAllData(P,s,model) ProbabilitiesState(P,s,model)
/* //PRECISION ProbabilityStatesGivenData(TStateModel *model); ansi-c*/
#define LogLikelihoodGivenParameters(model) LogLikelihood_StatesIntegratedOut(model);
/* //PRECISION LogMarginalPosterior(TStateModel *model); ansi-c*/
/* //void DrawAllParameters(TMarkovStateVariable *sv); ansi-c*/
/* //void DrawAllParametersAndNormalizeStates(TMarkovStateVariable *sv); ansi-c*/
/* //PRECISION ComputeMarginalLogLikelihood(TMarkovStateVariable *sv); ansi-c*/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
#endif
/***************************** TMarkovStateVariable *****************************
The TMarkovStateVariable type can represent either a single Markov state
variable or a collection of independent Markov state variables.
The transition matrix Q is generated for a single Markov state variable via
the routines DrawTransitionMatrixFromPrior_SV() or DrawTransitionMatrix_SV().
Calls to these functions by multiple independent Markov state variables result
in recursive call to these functions.
The vector of states S is generated only by a TStateModel type containing the
TMarkovStateVariable type. The state is only generated at the top level and
can be propagated downward with a call to PropagateStates_SV().
The following set of fields are set for both types.
===============================================================================
int UseErgodic
Uses the ergodic distribution if non-zero and use the uniform distribution
otherwise.
int nstates
Number of states. Always positive.
int nobs
Number of observations. Always positive.
int* S
S[t] is the state at time t, for 0 <= t <= nobs. S is created via a call
to dw_CreateArray_int(). It is guaranteed that 0 <= S[t] < nstates.
TMatrix Q
Markov transition matrix.
struct TMarkovStateVariable_tag *parent
Parent of the Markov state variable. If the Markov state variable has no
parent, then parent is a pointer to the structure itself.
int n_state_variables
Number of state variables. Will be equal to one for single Markov state
variables and larger than one in the case of multiple independent Markov
state variables
struct TMarkovStateVariable_tag **state_variable
An array of markov state variables of length n_state_variables. If
n_state_variables is equal to one, then state_variable[0] is a pointer to
the structure itself. Care must be taken to ensure that infinite loops do
not result when transversing through state variables. When creating a
mulitple Markov state variable via a call to the routine
CreateMarkovStateVariable_Multiple(), the last argument which is a pointer
to a pointer to a TMarkovStateVariable must have been created with
dw_CreateArray_pointer(n_state_variables,(void (*)(void*))FreeMarkovStateVariable);
Furthermore, the structure receives ownership of this argument and is
responsible for its freeing.
int** Index
This is a nstates x n_state_variables rectangular array of integers. State
s corresponds to state_variable[i] being equal to Index[s][i].
int** SA
An array of integer pointers of length n_state_variables. The pointers SA[i]
and state_variable[i]->S point to the same address.
TMatrix* QA
An array of matrices of length n_state_variables. The matrix QA[i] is
is the matrix state_variable[i]->Q.
TVector* ba
For single Markov state variables, ba[i] = b[i]. For multiple state
variables ba[i] = state_variable[k]->ba[j] where
i = j + dw_DimA(state_variable[0]->ba) + ... + dw_DimA(state_variable[k-1]->ba)
TVector* Prior_ba
For single Markov state variables, Prior_ba[i] = Prior_b[i]. For multiple
state variables Prior_ba[i] = state_variable[k]->Prior_ba[j] where
i = j + dw_DimA(state_variable[0]->Prior_ba) + ... + dw_DimA(state_variable[k-1]->Prior_ba)
===============================================================================
The following fields are set only for single Markov state variables and are
set to null for multiple independent Markov state variables.
TVector B
The vector B is the vector of quasi-free parameters.
TVector *b
Array of vectors of length DimA(FreeDim). The element b[k] is of length
FreeDim[k]. Non-standard memory management is used so that
&(b[k][i])=&B[FreeDim[0] + ... + FreeDim[k-1] + i])
The elements of b[k] are non-negative and their sum equals one up to
DimV(b[k])*MACHINE_EPSILON.
TMatrix Prior
Prior Dirichlet parameters for Q.
TVector *Prior_b
The Dirichlet prior parametrs for b. Array of vectors of length
DimA(FreeDim). The element Prior_b[k] is of length FreeDim[k].
Non-standard memory management is used so that
&(Prior_b[k][i])=&B[FreeDim[0] + ... + FreeDim[k-1] + i])
TVector Prior_B
The Dirichlet prior parameters for B. This vector is created and
initialized by CreateMarkovStateVariable(). The element B[k]-1 is the sum
of Prior[i][j]-1 over all (i,j) such that NonZeroIndex[i][j] == k.
int* FreeDim
FreeDim[k] is the length of the kth free Dirichlet vector. The length of B
must be equal to FreeDim[0] + ... + FreeDim[dw_DimA(FreeDim)-1].
int** NonZeroIndex
Defines the relationship between Q and B.
--
| MQ[i][j]*B[NonZeroIndex[i][j]] if NonZeroIndex[i][j] >= 0
Q[i][j] = |
| 0.0 if NonZeroIndex[i][j] == -1
--
TMatrix MQ
Coefficients for the elements of Q in terms of the free parameters B.
int nlags_encoded; // Number of lags encoded in the restrictions
int nbasestates; // Number of base states nbasestates^(nlags_encoded) = nstates
int** lag_index; // nstates x (nlags_encoded + 1) lag_index[i][j] is the value of the jth lag when the overall state is k
===============================================================================
===============================================================================
Normalization:
In general, a permutation of the states, together with the corresponding
permutation of the rows and columns of the transition matrix and the model
dependent parameters theta, does not change the value of the likelihood
function and so presents a normalization problem. However, some permutations
of the states are not permissible in that they may violate the restrictions
placed on the transition matrix or restrictions on the model dependent
parameters. Furthermore, even if a permutation did not cause a violation of
any restrictions, a non-symmetric prior on the model dependent parameters
could cause the value of the likelihood to change.
********************************************************************************/
/********************************************************************************
Constrained optimization
Because one of the tasks of this suite of programs is to find the maximum
likelihood estimate, constrained optimization routines are often called.
These routines almost always require a single or double precision array
containing the parameters to be optimized over to be passed. To facilitate
this, the TMarkovStateVariable type allows the memory being allocated for
parameters to be passed, which allows the user to control exactly how the
memory is laid out. Also, the TParameter type is defined which automates
some of this process. The goal is to allow different aspects of this suite
to access the common memory area for parameters in a manner appropriate to
the task at hand while minimizing the amount of memory copying.
Memory Management
Different parts of this suite of routines need to have the parameters
available in certain formats. However, copying parameters from one format to
another should be avoided. Our approach is as follows. We define a
structure TParameters which contains the following:
int n_real_parameters;
int n_integer_parameters;
int n_miscellaneous_parameters;
void* v;
void* extra;
The pointer v points to contiguous memory that contains all the
parameters. The first n_real_parameters*sizeof(PRECISION) bytes contains
floating point parameters. The next n_integer_parameters*sizeof(int)
bytes contain integer parameters. The next n_miscellaneous_parameters
bytes contain whatever parameters do not fit into the first two
catagories.
The idea is that many maximization routines work on a vector of floating
point numbers. The integer parameters are included to record the values
of Markov state variables, though they could certainly be used for other
purposes. The general purpose memory is to provide flexibility.
The pointer extra will point to some structure needed for the
implementation of model in each state.
Markov state variable parameter pointers
The Markov state variables require transition matrix parameters and the
values of the Markov state variables. For this two structures are defined.
int n_state_variables;
int T;
TVectorArray BA;
TMatrixArray QA;
TIntVectorArray SA;
All of pElementV(BA[i]), pElementM(QA[i]), and pElementIV(SA[i]) point to
memory positions in the vector v. Non-standard memory management
techniques are used and the following must be true.
All of pElementV(BA[i]), pElementM(QA[i]), and pElementIV(SA[i]) were
allocated with swzMalloc(), can be freed with swzFree(), and none of
FreeVector(BA[i]), FreeMatrix(QA[i]), or FreeIntMatrix(SA[i]) attempt
to free pElemementV(BA[i]), pElementM(QA[i]), or pElementIV(SA[i]) if
these are null pointers.
The default behavior is for the memory allocation of v is:
Theta
BA[0]
.
.
BA[n_state_variables-1]
QA[0]
.
.
QA[n_state_variables-1]
SA[0]
.
.
SA[n_state_variables-1]
The vector BA[i] stores the free parameters for the transition matrix
of the ith Markov state variable. The matrix QA[i] stores the full
transition matrix for the ith Markov state variable. The integer array
SA[i] stores the values of the ith Markov state variable. The number of
Markov state variables is n_state_variables and there are T+1 values
stored for each Markov state variable. The total number of states, which
is the product of the number of states for each state variables is
nstates. If there are no restrictions on the ith transition matrix other
than its elements being non-negative and the sum of its columns being
one, then BA[i] can be equal to QA[i].
*/

117
matlab/ms-sbvar/c-code/sbvar/switching/switch_opt.c
View File

@ -1,117 +0,0 @@
#include "switch_opt.h"
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include "modify_for_mex.h"
/* //====== Static Global Variables ====== ansi-c*/
static TStateModel *Model=(TStateModel*)NULL;
static PRECISION *buffer=(PRECISION*)NULL;
static PRECISION *ModifiedFreeParameters=(PRECISION*)NULL;
static PRECISION *FreeParameters_Q=(PRECISION*)NULL;
static int NumberFreeParameters_Q=0;
static PRECISION *FreeParameters_Theta=(PRECISION*)NULL;
static int NumberFreeParameters_Theta=0;
void SetupObjectiveFunction(TStateModel *model, PRECISION *Modified, PRECISION *FreeQ, PRECISION *FreeTheta)
{
if (buffer) swzFree(buffer);
Model=model;
FreeParameters_Q=FreeQ;
NumberFreeParameters_Q=NumberFreeParametersQ(model);
FreeParameters_Theta=FreeTheta;
NumberFreeParameters_Theta=model->routines->pNumberFreeParametersTheta(model);
ModifiedFreeParameters=Modified;
}
void SetupObjectiveFunction_new(TStateModel *model, int FreeTheta_Idx, int FreeQ_Idx, int Modified_Idx)
{
if (buffer) swzFree(buffer);
Model=model;
NumberFreeParameters_Q=NumberFreeParametersQ(model);
NumberFreeParameters_Theta=model->routines->pNumberFreeParametersTheta(model);
buffer=(PRECISION*)swzMalloc((NumberFreeParameters_Q + NumberFreeParameters_Theta)*sizeof(PRECISION));
FreeParameters_Q=buffer+FreeQ_Idx;
FreeParameters_Theta=buffer+FreeTheta_Idx;
ModifiedFreeParameters=buffer+Modified_Idx;
}
PRECISION PosteriorObjectiveFunction(PRECISION *x, int n)
{
if (x != ModifiedFreeParameters) memmove(ModifiedFreeParameters,x,n*sizeof(PRECISION));
ConvertFreeParametersToQ(Model,FreeParameters_Q);
ConvertFreeParametersToTheta(Model,FreeParameters_Theta);
return -LogPosterior_StatesIntegratedOut(Model);
/* //PRECISION lp_Q, lp_Theta, li; ansi-c*/
/* //FILE *f_out; ansi-c*/
/* //lp_Q=LogPrior_Q(Model); ansi-c*/
/* //lp_Theta=LogPrior_Theta(Model); ansi-c*/
/* //li=LogLikelihood_StatesIntegratedOut(Model); ansi-c*/
/* //if (isnan(lp_Q) || isnan(lp_Theta) || isnan(li)) ansi-c*/
/* // { ansi-c*/
/* // f_out=fopen("tmp.tmp","wt"); ansi-c*/
/* // Write_VAR_Specification(f_out,(char*)NULL,Model); ansi-c*/
/* // WriteTransitionMatrices(f_out,(char*)NULL,"Error: ",Model); ansi-c*/
/* // Write_VAR_Parameters(f_out,(char*)NULL,"Error: ",Model); ansi-c*/
/* // fprintf(f_out,"LogPrior_Theta(): %le\n",lp_Theta); ansi-c*/
/* // fprintf(f_out,"LogPrior_Q(): %le\n",lp_Q); ansi-c*/
/* // fprintf(f_out,"LogLikelihood_StatesIntegratedOut(): %le\n",li); ansi-c*/
/* // fprintf(f_out,"Posterior: %le\n\n",lp_Q+lp_Theta+li); ansi-c*/
/* // fclose(f_out); ansi-c*/
/* // swzExit(0); ansi-c*/
/* // } ansi-c*/
/* //return -(lp_Q+lp_Theta+li); ansi-c*/
}
PRECISION PosteriorObjectiveFunction_csminwel(double *x, int n, double **args, int *dims)
{
return PosteriorObjectiveFunction(x,n);
}
void PosteriorObjectiveFunction_npsol(int *mode, int *n, double *x, double *f, double *g, int *nstate)
{
*f=PosteriorObjectiveFunction(x,*n);
}
PRECISION MLEObjectiveFunction(PRECISION *x, int n)
{
if (x != ModifiedFreeParameters) memmove(ModifiedFreeParameters,x,n*sizeof(PRECISION));
ConvertFreeParametersToQ(Model,FreeParameters_Q);
ConvertFreeParametersToTheta(Model,FreeParameters_Theta);
return -LogLikelihood_StatesIntegratedOut(Model);
}
PRECISION MLEObjectiveFunction_csminwel(double *x, int n, double **args, int *dims)
{
return MLEObjectiveFunction(x,n);
}
void MLEObjectiveFunction_npsol(int *mode, int *n, double *x, double *f, double *g, int *nstate)
{
*f=MLEObjectiveFunction(x,*n);
}
PRECISION MLEObjectiveFunction_LogQ(PRECISION *x, int n)
{
if (x != ModifiedFreeParameters) memmove(ModifiedFreeParameters,x,n*sizeof(PRECISION));
ConvertLogFreeParametersToQ(Model,FreeParameters_Q);
ConvertFreeParametersToTheta(Model,FreeParameters_Theta);
return -LogLikelihood_StatesIntegratedOut(Model);
}
PRECISION MLEObjectiveFunction_LogQ_csminwel(double *x, int n, double **args, int *dims)
{
return MLEObjectiveFunction_LogQ(x,n);
}

21
matlab/ms-sbvar/c-code/sbvar/switching/switch_opt.h
View File

@ -1,21 +0,0 @@
#ifndef __MARKOV_SWITCHING_OPTIMIZATION__
#define __MARKOV_SWITCHING_OPTIMIZATION__
#include "switch.h"
void SetupObjectiveFunction(TStateModel *model, PRECISION *MFPparms, PRECISION *FTMparms, PRECISION *FMSparms);
PRECISION PosteriorObjectiveFunction(PRECISION *x, int n);
PRECISION PosteriorObjectiveFunction_csminwel(double *x, int n, double **args, int *dims);
void PosteriorObjectiveFunction_npsol(int *mode, int *n, double *x, double *f, double *g, int *nstate);
PRECISION MLEObjectiveFunction(PRECISION *x, int n);
PRECISION MLEObjectiveFunction_csminwel(double *x, int n, double **args, int *dims);
void MLEObjectiveFunction_npsol(int *mode, int *n, double *x, double *f, double *g, int *nstate);
PRECISION MLEObjectiveFunction_LogQ(PRECISION *x, int n);
PRECISION MLEObjectiveFunction_LogQ_csminwel(double *x, int n, double **args, int *dims);
#endif

1246
matlab/ms-sbvar/c-code/sbvar/switching/switchio.c
View File

File diff suppressed because it is too large Load Diff

38
matlab/ms-sbvar/c-code/sbvar/switching/switchio.h
View File

@ -1,38 +0,0 @@
#include "switch.h"
/*
Base routines for reading/writing Markov state variables and transition
matrices in native ascii format.
*/
TMarkovStateVariable* ReadMarkovSpecification_SV(FILE *f_in, char *idstring, int nobs);
int WriteMarkovSpecification_SV(FILE *f_out, TMarkovStateVariable *sv, char *idstring);
int ReadTransitionMatrices_SV(FILE *f_in, TMarkovStateVariable* sv, char *header, char *idstring);
int WriteTransitionMatrices_SV(FILE *f_out, TMarkovStateVariable* sv, char *header, char *idstring);
int ReadBaseTransitionMatrices_SV(FILE *f_out, TMarkovStateVariable *sv, char *header, char *idstring);
int WriteBaseTransitionMatrices_SV(FILE *f_out, TMarkovStateVariable *sv, char *header, char *idstring);
int ReadBaseTransitionMatricesFlat_SV(FILE *f_out, TMarkovStateVariable *sv);
int WriteBaseTransitionMatricesFlat_SV(FILE *f_out, TMarkovStateVariable *sv, char *fmt);
void WriteBaseTransitionMatricesFlat_Headers_SV(FILE *f_out, TMarkovStateVariable* sv, char *idstring);
/*
Routines for reading/writing Markov state variables and transition matrices
from TStateModel. Calls base routines.
*/
TMarkovStateVariable* ReadMarkovSpecification(FILE *f, char *filename);
int WriteMarkovSpecification(FILE *f, char *filename, TStateModel *model);
int ReadTransitionMatrices(FILE *f, char *filename, char *header, TStateModel *model);
int WriteTransitionMatrices(FILE *f, char *filename, char *header, TStateModel *model);
int ReadStates(FILE *f, char *filename, char *header, TStateModel *model);
int WriteStates(FILE *f, char *filename, char *header, TStateModel *model);
int ReadBaseTransitionMatrices(FILE *f, char *filename, char *header, TStateModel *model);
int WriteBaseTransitionMatrices(FILE *f, char *filename, char *header, TStateModel *model);
int ReadBaseTransitionMatricesFlat(FILE *f, TStateModel *model);
int WriteBaseTransitionMatricesFlat(FILE *f, TStateModel *model, char *fmt);
/*
Read flat markov state variable specification from file.
*/
TMarkovStateVariable* CreateMarkovStateVariable_File(FILE *f, char *filename, int nobs);

150
matlab/ms-sbvar/c-code/sbvar/var/PrintDraws.c
View File

@ -1,150 +0,0 @@
#include "swzmatrix.h"
#include "dw_rand.h"
#include "dw_parse_cmd.h"
#include "dw_ascii.h"
#include "VARbase.h"
#include "VARio.h"
#include "switch.h"
#include "switchio.h"
#include "command_line_VAR.h"
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <time.h>
#include "modify_for_mex.h"
int main(int nargs, char **args)
{
TStateModel *model;
T_VAR_Parameters *p;
FILE *f_out;
char *filename;
int count, begin_time, end_time, tuning, burn_in, iterations, check, period=1000, seed, output, thinning,
nd1;
TVARCommandLine *cmd=(TVARCommandLine*)NULL;
char *include_help[]={"-di","-do","-fs","-fp","-ph","-MLE",(char*)NULL},
*additional_help[]={
"-ft <tag>",
"Tag for input file. Input file name is est_final_<tag>.dat.",
"-fto <tag>",
"Tag for output file. Output file names are draws_<tag>.dat and headers_<tag>.dat. Default is -ft <tag>.",
"-mh <integer>",
"Tuning period for Metropolis-Hasting draws (default value = 30000)",
"-b <integer>",
"Burn-in period (default value = 0.1 * (number of iterations))",
"-i <integer>",
"Number of draw (default value = 1000), number saved is (-i)/(-t)",
"-t <integer>",
"Thinning factor. Only one in t draws are written to file.",
"-nd1",
"Normalize diagonal of A0 to one (flat output only)",
"-gs <integer>",
"Seed value for generator - 0 gets seed from clock (default value = 0)",
(char*)NULL,
(char*)NULL};
/* //=== Help Screen === ansi-c*/
if (dw_FindArgument_String(nargs,args,"h") != -1)
{
printf("print_draws <options>\n");
PrintHelpMessages(stdout,include_help,additional_help);
return 0;
}
/* //=== Get seed, tuning peroid, burn-in period, number of iterations, and thinning factor ansi-c*/
constant_seed=dw_ParseInteger_String(nargs,args,"cseed",0);
seed=dw_ParseInteger_String(nargs,args,"gs",0);
tuning=dw_ParseInteger_String(nargs,args,"mh",30000);
iterations=dw_ParseInteger_String(nargs,args,"i",1000);
burn_in=dw_ParseInteger_String(nargs,args,"b",iterations/10);
thinning=dw_ParseInteger_String(nargs,args,"t",1);
nd1=(dw_FindArgument_String(nargs,args,"nd1") >= 0) ? 1 : 0;
/* //=== Initialize random number generator ansi-c*/
dw_initialize_generator(seed);
/* //=== Setup model and initial parameters ansi-c*/
printf("Reading data...\n");
if (!(model=CreateTStateModelFromEstimateFinal(nargs,args,&cmd)))
{
swz_fprintf_err("Unable to read model or parameters\n");
swzExit(1);
}
p=(T_VAR_Parameters*)(model->theta);
/* //=== Open header file and print headers ansi-c*/
filename=CreateFilenameFromTag("%sheader_%s.dat",cmd->out_tag,cmd->out_directory);
f_out=fopen(filename,"wt");
swzFree(filename);
WriteBaseTransitionMatricesFlat_Headers_SV(f_out,model->sv,"");
Write_VAR_ParametersFlat_Headers(f_out,model);
fprintf(f_out,"\n");
fclose(f_out);
/* //=== Open output file ansi-c*/
filename=CreateFilenameFromTag("%sdraws_%s.dat",cmd->out_tag,cmd->out_directory);
f_out=fopen(filename,"wt");
swzFree(filename);
/* // Burn-in period with calibration of jumping parameters ansi-c*/
printf("Calibrating jumping parameters - %d draws\n",tuning);
begin_time=(int)time((time_t*)NULL);
AdaptiveMetropolisScale(model,tuning,1000,1,(FILE*)NULL); /* tuning iterations - 1000 iterations before updating - verbose ansi-c*/
end_time=(int)time((time_t*)NULL);
printf("Elapsed Time: %d seconds\n",end_time - begin_time);
/* // Reset parametrers ansi-c*/
if (!ReadTransitionMatrices((FILE*)NULL,cmd->parameters_filename_actual,cmd->parameters_header_actual,model)
|| !Read_VAR_Parameters((FILE*)NULL,cmd->parameters_filename_actual,cmd->parameters_header_actual,model))
printf("Unable to reset parameters after tuning\n");
/* // Burn-in period ansi-c*/
printf("Burn-in period - %d draws\n",burn_in);
for (check=period, count=1; count <= burn_in; count++)
{
DrawAll(model);
if (count == check)
{
check+=period;
printf("%d iterations completed out of %d\n",count,burn_in);
}
}
end_time=(int)time((time_t*)NULL);
printf("Elapsed Time: %d seconds\n",end_time - begin_time);
ResetMetropolisInformation(p);
/* // Simulation ansi-c*/
printf("Simulating - %d draws\n",iterations);
for (check=period, output=thinning, count=1; count <= iterations; count++)
{
DrawAll(model);
if (count == output)
{
WriteBaseTransitionMatricesFlat(f_out,model,"%lf ");
if (nd1)
Write_VAR_ParametersFlat_A0_Diagonal_One(f_out,model,"%lf ");
else
Write_VAR_ParametersFlat(f_out,model,"%lf ");
fprintf(f_out,"\n");
output+=thinning;
}
if (count == check)
{
check+=period;
printf("%d(%d) iterations completed out of %d(%d)\n",count,thinning,iterations,thinning);
}
}
end_time=(int)time((time_t*)NULL);
printf("Elapsed Time: %d seconds\n",end_time - begin_time);
/* // clean up ansi-c*/
fclose(f_out);
FreeStateModel(model);
Free_VARCommandLine(cmd);
}

4024
matlab/ms-sbvar/c-code/sbvar/var/VARbase.c
View File

File diff suppressed because it is too large Load Diff

442
matlab/ms-sbvar/c-code/sbvar/var/VARbase.h
View File

@ -1,442 +0,0 @@
#ifndef __VAR_BASE_MODEL__
#define __VAR_BASE_MODEL__
#include "switch.h"
#include "swzmatrix.h"
#include "dw_matrix_array.h"
#define standard_ordering 1 /* for future implementation ansi-c*/
#define SPEC_RANDOM_WALK 0x00000001
#define SPEC_SIMS_ZHA 0x00000002
/* //=== Normalization types (must be mutually exclusive) ===// ansi-c*/
#define VAR_NORMALIZATION_NONE 0x00000000
#define VAR_NORMALIZATION_WZ 0x00000001
typedef struct
{
/* //====== Model specification ====== ansi-c*/
int Specification;
int *IsIdentity_V;
/* //====== Free parameter specification (for future implementation) ====== ansi-c*/
int FreeParameterType;
/* //====== Sizes ====== ansi-c*/
int nvars;
int nlags;
int npre;
int nobs;
int nstates;
/* //====== State variable translation ====== ansi-c*/
int* n_var_states; /* nvars n_var_states[j] is the number of variance states for column j ansi-c*/
int** var_states; /* nvars x n_states translation table for variance states ansi-c*/
int* n_coef_states; /* nvars n_coef_states[j] is the number of coefficients states for column j ansi-c*/
int** coef_states; /* nvars x n_states translation table for coefficient states ansi-c*/
int n_A0_states; /* number of states for the matrix A0 ansi-c*/
int* A0_states; /* n_states translation table for the matrix A0 ansi-c*/
int** A0_column_states; /* nvars x n_A0_states translation table from determinant of A0 states to coefficient states ansi-c*/
/* //====== Parameters ====== ansi-c*/
PRECISION** Zeta; /* nvars x n_var_states[j] ansi-c*/
TVector** A0; /* nvars x n_coef_states[j] x nvars ansi-c*/
TVector** Aplus; /* nvars x n_coef_states[j] x npre ansi-c*/
/* //====== Free parameters ====== ansi-c*/
int* dim_b0;
TVector** b0;
int* dim_bplus;
TVector** bplus;
/* //====== Priors ====== ansi-c*/
TVector zeta_a_prior; /* ansi-c*/
TVector zeta_b_prior; /* ansi-c*/
TMatrix* A0_prior; /* A0_prior[j] = constant parameter variance of the normal prior on the jth column of A0 ansi-c*/
TMatrix* Aplus_prior; /* Aplus_prior[j] = constant parameter variance of the normal prior on the jth column of Aplus ansi-c*/
/* //====== Identifying restrictions ====== ansi-c*/
TMatrix *U;
TMatrix *V;
TMatrix *W;
/* //====== Sims-Zha specification parameters and workspace ====== ansi-c*/
TVector** lambda; /* nvars x n_coef_states[j] array of nvars-dimensional vectors ansi-c*/
TVector* constant; /* nvars x n_coef_states[j] -- constant[j][k] == psi[j][npre - 1 + k] ansi-c*/
TVector* psi; /* nvars x (npre - 1 + n_coef_states[j]) ansi-c*/
PRECISION lambda_prior; /* prior variance of each element of lambda ansi-c*/
PRECISION inverse_lambda_prior;
TMatrix* inverse_psi_prior;
/* //====== Normalization ====== ansi-c*/
int normalization_type; /* type of normalization used ansi-c*/
int normalized; /* type of normalization actually used to normalize current draw ansi-c*/
TVector** Target; /* nvar x n_coef_states[j] array of nvars-dimensional vectors ansi-c*/
int** flipped; /* nvar x n_coef_states[j] array of integers ansi-c*/
int WZ_inconsistancies;
/* //====== Workspace ====== ansi-c*/
PRECISION log_prior_constant; /* Constant of integrate for the log prior ansi-c*/
PRECISION minus_half_nvars_times_log2pi; /* Constant used in LogConditionalProbability functions ansi-c*/
TVector inverse_zeta_b_prior; /* inverse_zeta_b_prior = 1.0/zeta_b_prior ansi-c*/
TMatrix* inverse_b0_prior; /* inverse_b0_prior = U'[j]*Inverse(A0_prior[j])*U[j] ansi-c*/
TMatrix* inverse_bplus_prior; /* inverse_bplus_prior = V'[j]*Inverse(Aplus_prior[j])*V[j] ansi-c*/
TVector log_abs_det_A0; /* log(abs(det(A0[k]))) ansi-c*/
PRECISION*** A0_dot_products; /* A0_dot_products[t][j][k] = Y'[t] * A0[j][k] ansi-c*/
PRECISION*** Aplus_dot_products; /* Aplus_dot_products[t][j][k] = X'[t] * Aplus[j][k] ansi-c*/
/* // A0 Metropolis Info ansi-c*/
PRECISION** A0_Metropolis_Scale;
int Total_A0_Metropolis_Draws;
int** A0_Metropolis_Jumps;
/* // State dependent fields ansi-c*/
TMatrix* YY; /* YY[k] = sum(Y[t]*Y'[t], 1 <= t <= nobs and S[t] == k) ansi-c*/
TMatrix* XY; /* YX[k] = sum(X[t]*Y'[t], 1 <= t <= nobs and S[t] == k) ansi-c*/
TMatrix* XX; /* XX[k] = sum(X[t]*X'[t], 1 <= t <= nobs and S[t] == k) ansi-c*/
int* T; /* T[k] = number of t with 1 <= t <= nobs and S[t] == k ansi-c*/
int *S; /* S[t] = state variable used to compute YY, XY, XX, and T ansi-c*/
TMatrix* yy; /* yy[t] = Y[t]*Y'[t] ansi-c*/
TMatrix* xy; /* xy[t] = X[t]*Y'[t] ansi-c*/
TMatrix* xx; /* xx[t] = X[t]*X'[t] ansi-c*/
/* // Flags for validity of workspace fields ansi-c*/
int valid_log_abs_det_A0; /* Invalid after A0 changes ansi-c*/
int valid_dot_products; /* Invalid after A0 or Aplus changes ansi-c*/
int valid_state_dependent_fields; /* Invalid after states change ansi-c*/
int valid_state_dependent_fields_previous; /* Initially invalid. ansi-c*/
int valid_parameters; /* Initially invalid. Valid after successful read or draw of parameters. ansi-c*/
/* // Parametes are invalid if Zeta is negative or if they do not satisfy ansi-c*/
/* // the normalization. ansi-c*/
/* //=== Data === ansi-c*/
TVector* Y; /* Y[t] nvar vector of time t data for 1 <= t <= T ansi-c*/
TVector* X; /* X[t] npre vector of time t predetermined variables for 1 <= t <= T ansi-c*/
} T_VAR_Parameters;
/* // Constructors-Destructors ansi-c*/
void FreeTheta_VAR(T_VAR_Parameters *p);
ThetaRoutines* CreateRoutines_VAR(void);
T_VAR_Parameters* CreateTheta_VAR(int flag, int nvars, int nlags, int nexg, int nstates, int nobs, /* Specification and Sizes ansi-c*/
int **coef_states, int **var_states, /* Translation Tables ansi-c*/
TMatrix *U, TMatrix *V, TMatrix *W, /* Restrictions ansi-c*/
TMatrix Y, TMatrix X); /* Data ansi-c*/
int** CreateTranslationMatrix_Flat(int **states, TMarkovStateVariable *sv);
void SetPriors_VAR(T_VAR_Parameters *theta, TMatrix* A0_prior, TMatrix* Aplus_prior, TVector zeta_a_prior, TVector zeta_b_prior);
void SetPriors_VAR_SimsZha(T_VAR_Parameters *theta, TMatrix* A0_prior, TMatrix* Aplus_prior, TVector zeta_a_prior,
TVector zeta_b_prior, PRECISION lambda_prior);
TStateModel* CreateConstantModel(TStateModel *model);
TStateModel* ExpandModel_VAR(TStateModel *model, TStateModel *restricted_model, int s);
void SetupSimsZhaSpecification(T_VAR_Parameters *p, PRECISION lambda_prior);
PRECISION LogConditionalProbability_VAR(int i, int t, TStateModel *model);
TVector ExpectationSingleStep_VAR(TVector y, int s, int t, TStateModel *model);
void DrawParameters_VAR(TStateModel *model);
void InitializeParameters_VAR(T_VAR_Parameters *p);
/* // Priors ansi-c*/
void SetLogPriorConstant_VAR(T_VAR_Parameters *p);
PRECISION LogPrior_VAR(TStateModel *model);
/* // Normalization ansi-c*/
int IsNormalized_VAR(T_VAR_Parameters *p);
int Normalize_VAR(T_VAR_Parameters *p);
void Setup_No_Normalization(T_VAR_Parameters *p);
void Setup_WZ_Normalization(T_VAR_Parameters *p, TVector **A0);
int WZ_Normalize(T_VAR_Parameters *p);
/* // Notification ansi-c*/
void StatesChanged_VAR(TStateModel *model);
void ThetaChanged_VAR(TStateModel *model);
void InitializeForwardRecursion_VAR(TStateModel *model);
/* // Utility Routines ansi-c*/
int Reset_VAR_Improper_Distribution_Counter(void);
int Get_VAR_Improper_Distribution_Counter(void);
void Increment_Verbose(void);
void SetVerboseFile(FILE *f);
/* // Optimization ansi-c*/
int NumberFreeParametersVAR(TStateModel *model);
void FreeParametersToVAR(TStateModel *model, PRECISION *f);
void VARToFreeParameters(TStateModel *model, PRECISION *f);
int ZetaIndex(T_VAR_Parameters *p);
int ZetaLength(T_VAR_Parameters *p);
/* //PRECISION ComputeConstantSimsZha(TStateModel *model); ansi-c*/
/* // ansi-c*/
void PsiDeltaToAplus(TStateModel *model);
/* // Impulse Response ansi-c*/
TMatrix ComputeImpulseResponseReducedForm(TMatrix R, int h, TMatrix A0_Xi_inv, TMatrix B, int nlags);
TMatrix ComputeImpulseResponseStructural(TMatrix R, int h, TMatrix A0, TMatrix Aplus, TVector Xi, int nlags);
TMatrix ComputeImpulseResponse(TMatrix R, int h, int k, TStateModel *model);
TMatrix ComputeVarianceDecomposition(TMatrix X, TMatrix IR, int nvars);
/* // Simulation ansi-c*/
void DrawZeta_Aplus(TStateModel *model);
void DrawZeta_DotProducts(TStateModel *model);
void AdaptiveMetropolisScale(TStateModel *model, int iterations, int period, int verbose, FILE *f_posterior);
void SetupMetropolisInformation(PRECISION **Scale, T_VAR_Parameters *p);
void ResetMetropolisInformation(T_VAR_Parameters *p);
PRECISION LogKernel_A0_DotProducts(int j, int k, TStateModel *model);
PRECISION LogKernel_A0(int j, int k, TStateModel *model);
void DrawA0_Metropolis(TStateModel *model);
void DrawAplus(TStateModel *model);
void Draw_psi(TStateModel *model);
void Draw_lambda(TStateModel *model);
/* Forecasts */
TMatrix forecast_base(TMatrix forecast, int horizon, TVector initial, TVector *shocks, int *S, TStateModel *model);
/* //TVector* mean_conditional_forecast(TVector *F, PRECISION ***y, int h, int t0, TStateModel *model); ansi-c*/
/* //TVector* mean_unconditional_forecast(TVector *F, int h, int t0, TStateModel *model); ansi-c*/
/* Utilities */
void ComputeDotProducts_All(T_VAR_Parameters *p);
void ComputeLogAbsDetA0_All(T_VAR_Parameters *p);
void ComputeLogAbsDetA0(int j, int k, T_VAR_Parameters *p);
TMatrix MakeA0(TMatrix A0, int k, T_VAR_Parameters *p);
TMatrix* MakeA0_All(TMatrix *A0, T_VAR_Parameters *p);
TMatrix MakeAplus(TMatrix Aplus, int k, T_VAR_Parameters *p);
TMatrix* MakeAplus_All(TMatrix *Aplus, T_VAR_Parameters *p);
TMatrix MakeZeta(TMatrix Zeta, int k, T_VAR_Parameters *p);
TMatrix* MakeZeta_All(TMatrix *Zeta, T_VAR_Parameters *p);
TMatrix ConstructMatrixFromColumns(TMatrix X, TVector **, int k);
void UpdateStateDependentFields(T_VAR_Parameters *p, int *S);
void Update_aplus_from_bplus_a0(int j, int k, T_VAR_Parameters *p);
void Update_A0_from_b0(T_VAR_Parameters *p);
void Update_Aplus_from_bplus_A0(T_VAR_Parameters *p);
void Update_bplus_from_lambda_psi(T_VAR_Parameters *p);
void Update_b0_bplus_from_A0_Aplus(T_VAR_Parameters *p);
void Update_lambda_psi_from_bplus(T_VAR_Parameters *p);
int GetNumberStatesFromTranslationMatrix(int j, int **states);
int **CreateTranslationMatrix(TMarkovStateVariable ***list, TMarkovStateVariable *sv);
/* //PRECISION InnerProductSymmetric(TVector x, TMatrix S); ansi-c*/
/* //PRECISION InnerProductNonSymmetric(TVector x, TVector y, TMatrix S); ansi-c*/
void update_psi_quadratic_form(TMatrix S, int n, int m, int k, TVector lambda, TMatrix XX);
TMatrix MatrixInnerProductSymmetric(TMatrix X, TMatrix Y, TMatrix S);
PRECISION InnerProductSymmetric(TVector x, TMatrix S);
PRECISION InnerProductNonSymmetric(TVector x, TVector y, TMatrix S);
TVector DrawNormal_InverseVariance(TVector x, TVector b, TMatrix S);
TVector DrawNormal_InverseVariance_SVD(TVector x, TVector b, TMatrix S);
TVector DrawNormal_InverseUpperTriangular(TVector x, TVector b, TMatrix T);
/* // Obsolete routines ansi-c*/
#endif /* __VAR_BASE_MODEL__ ansi-c*/
/********************************************************************************
Notes:
The model:
y(t)' * A0(s(t)) = x(t)' * Aplus(s(t)) + epsilon(t)' * Inverse(Xi(s(t)))
where
y(t) is nvars x 1
x(t) is npre x 1
x(t)=[y(t-1),...,y(t-p),z(t)], where z(t) is exogenous
epsilon(t) is nvars x 1
A0(k) is nvars x nvars
Aplus(k) is npre x nvars
Xi(k) is an nvars x nvars diagonal matrix
s(t) is an integer with 0 <= s(t) < nstates
Furthermore
A0(j,k) = U(j) * b0(j,k)
Aplus(j,k) = V(j) * bplus(j,k) - W(j) * A0(j,k)
and
Zeta(j,k) = Xi(j,k)*Xi(j,k)
where
A0(j,k) is the jth column of A0(k)
Aplus(j,k) is the jth column of A0(k)
Xi(j,k) is the jth diagonal element of Xi(k)
b0(j,k) is q(j) x 1
bplus(j,k) is r(j) x 1
U(j) is nvars x q(j) with orthonormal columns
V(j) is npre x r(j) with orthonormal columns
W(j) is npre x nvar
e(j) is the jth column of an identity matrix
Sims-Zha Specification:
This specification imposes that r(j) == npre, V(j) is the identity matrix, and
W(j) is equal to a npre x nvars diagonal matrix with minus ones along the
diagonal. Further restrictions are imposed of the form.
bplus(j,k) = f(psi(j),lambda(j,k))
where
psi(j) is npre x 1
lambda(j,k) is nvars x 1
and f is the function
f(a,b) = diag(vec(a))
Random Walk Specification:
This specification imposes that W(j) is equal to a npre x nvars diagonal
matrix with minus ones along the diagonal. Though it is not imposed, we
usually want Aplus(j,k) to satisfy linear restrictions implicit in the
matrix V(j). This means that W(j) must be in the span of V(j) and hence
(I - V(j)*V'(j))*W(j) = 0.
Normalization:
We normalize by requiring Xi(0) to be the identity matrix and
delta(j,0) to be a vector of ones.
Prior:
A0(j,k) - The prior on A0(j,k) is normal with mean zero and covariance matrix
A0_Prior(j). This implies that the prior on b0(j,k) is normal with mean zero
and covariance matrix Inverse(U'[j]*Inverse(A0_prior[j])*U[j]).
Aplus(j,k) - The prior on Aplus(j,k) conditional on A0(j,k) is normal with mean
-W(j) * A0(j,k) and covariance Aplus_Prior(j). This implies that the prior on
bplus(j,k) is normal with mean zero and covariance matrix
Inverse(V'[j]*Inverse(Aplus_prior[j])*V[j])
Zeta(j,k) - The prior on Zeta(j,k) is Gamma(zeta_a_prior(j),zeta_b_prior(j)).
---------------------------------------------------------------------------------
TVector** A0
The length of A0 is nvars. The vector A0[j][k] is the jth column of A0 when
the jth coefficient state variable is equal to k. Note that when the Markov
state variable is equal to s, the jth coefficient state variable is equal to
coef_states[j][s]. The number of distinct values for the jth coefficient state
variable is equal to the dimension of A0[j]. This field is created with
dw_CreateArray_array() and freed with dw_FreeArray().
TVector** b0
The length of b0 is nvars. The vector b0[j][k] consists of the free parameters
in the jth column of A0 when the jth coefficient state variable is equal to k.
The dimension of b0[j][k] does not vary across k. Note that when the Markov
state variable is equal to s, the jth coefficient state variable is equal to
coef_states[j][s]. The dimension of b0[j] is equal to the dimension of A0[j].
This field is created with dw_CreateArray_array() and freed with
dw_FreeArray().
TVector** Aplus
The length of Aplus is nvars. The vector Aplus[j][k] is the jth column of
Aplus when the jth coefficient state variable is equal to k. Note that when
the Markov state variable is equal to s, the jth coefficient state variable is
equal to coef_states[j][s]. The dimension of Aplus[j] is equal to the
dimension of A0[j]. This field is created with dw_CreateArray_array() and
freed with dw_FreeArray().
TVector** bplus
The length of bplus is nvars. The vector bplus[j][k] consists of the free
parameters in the jth column of Aplus when the jth coefficient state variable
is equal to k. The dimension of bplus[j][k] does not vary across k. Note that
when the Markov state variable is equal to s, the jth coefficient state
variable is equal to coef_states[j][s]. The dimension of bplus[j] is equal to
the dimension of A0[j]. This field is created with dw_CreateArray_array() and
freed with dw_FreeArray().
PRECISION** Zeta
The length of Zeta is nvars. The value of Zeta[j][k] is the square of the
value of the jth diagonal element of Xi when the jth variance state variable is
equal to k. Note that the the Markov state variable is equal to s, the jth
variance state variable is equal to var_states[j][s]. The number of distinct
values for the jth variance state variable is equal to the dimension of
Zeta[j]. This field is created with dw_CreateArray_array() and freed with
dw_FreeArray().
TVector** delta
The length of delta is nvars. The vector bplus[j][k] is a non-linear function
of delta[j][k] and psi[k]. The length of delta[j][k] is nvars. This field is
non-null only when using the Sims-Zha specification.
TVector* psi
The length of psi is nvars. The vector bplus[j][k] is a non-linear function
of psi[k] and delta[j][k]. The length of psi[k] is npre. This field is non-
null only when using the Sims-Zha specification.
=============================== State Translation ===============================
int* n_var_states
An integer array of dimension nvars. The value of n_var_states[j] is the
number of variance states for column j.
int** var_states
An integer array of dimension nvars by nstates. The value of var_states[j][k]
is the value of the variance state for column j when the overall Markov state
variable is equal to k. It is used as an index into Xi[j]. It must be the
case that
0 <= var_states[j][k] < n_var_states[j].
int* n_coef_states
An integer arrary of dimension nvars. The value of n_coef_states[j] is the
number of coefficient states for column j.
int** coef_states
An integer array of dimension nvar by nstates. The value of coef_states[j][k]
is the value of the coefficient state for column j when the overall Markov
state variable is equal to k. It is used as an index into A0[j], b0[j],
Aplus[j] or bplus[j]. It must be the case that
0 <= coef_states[j][k] < n_coef_states[j].
int n_A0_states
The number of distinct values for the matrix A0.
int* A0_states
An integer array of dimension nstates. The value of A0_states[k] is the value
of the state variable controlling A0 when the value of the overall Markov state
variable is k. It is used as an index into the vector log_abs_det_A0. It must
be the case that
0 <= A0_states[k] < n_A0_states.
int** A0_column_states
An integer array of dimension nvars by n_A0_states. The value of
A0_column_states[j][k] is the value of the coefficient state for column j when
value of the state variable controlling the matrix A0 is k. It is used as an
index into A0[j]. It must be the case that
0 <= A0_column_states[j][k] < n_coef_states[j].
================================= Normalization =================================
For 0 <= k < n_A0_states, the contemporaneous coefficient matrix A[k] is formed.
For 0 <= j < nvars and 0 <= k < n_A0_states, the number
e[j]*Inverse(A[k])*Target[j][A0_column_states[j][k]]
is computed. If this number is negative, then the sign of
A0[j][A0_column_states[j][k]]
is flipped. If the sign of any element of A0[j][.] is flipped more than once,
this event is recorded.
********************************************************************************/

957
matlab/ms-sbvar/c-code/sbvar/var/VARio.c
View File

@ -1,957 +0,0 @@
#include "VARio.h"
#include "switchio.h"
#include "dw_error.h"
#include "dw_ascii.h"
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include "modify_for_mex.h"
static int strlen_int(int n)
{
int i, j;
for (i=1, j=10; n >= j; i++, j*=10);
return i;
}
static void ReadError_VARio(char *id)
{
char *errmsg, *fmt="Error after line identifier ""%s""";
sprintf(errmsg=(char*)swzMalloc(strlen(fmt) + strlen(id) - 1),fmt,id);
dw_UserError(errmsg);
swzFree(errmsg);
}
static int ReadInteger_VARio(FILE *f_in, char *id)
{
int i;
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %d ",&i) != 1)) ReadError_VARio(id);
return i;
}
static PRECISION ReadScalar_VARio(FILE *f_in, char *id)
{
double x;
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %lf ",&x) != 1)) ReadError_VARio(id);
return (PRECISION)x;
}
static void ReadMatrix_VARio(FILE *f_in, char *id, TMatrix X)
{
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,X)) ReadError_VARio(id);
}
static void ReadVector_VARio(FILE *f_in, char *id, TVector X)
{
if (!dw_SetFilePosition(f_in,id) || !dw_ReadVector(f_in,X)) ReadError_VARio(id);
}
static void ReadArray_VARio(FILE *f_in, char *id, void *X)
{
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,X)) ReadError_VARio(id);
}
static FILE* OpenFile_VARio(FILE *f, char *filename)
{
char *errmsg, *fmt="Unable to open %s";
if (!f)
if (!filename)
dw_UserError("Filename pointer is null.");
else
if (!(f=fopen(filename,"rt")))
{
sprintf(errmsg=(char*)swzMalloc(strlen(fmt) + strlen(filename) - 1),fmt,filename);
dw_UserError(errmsg);
swzFree(errmsg);
}
return f;
}
/*
Assumes:
f: valid file pointer or null
filename: pointer to null terminated string or null
Returns:
A pointer to a valid TStateModel upon success and null pointer upon failure.
Upon failure, the routine prints an error message if USER_ERR is a verbose
error and terminates if USER_ERR is a terminal error. The terminal errors
and verbose errors can be set with dw_SetTerminalErrors() and
dw_SetVerboseErrors().
Results:
Upon success, a valid TStateModel is created and initialized.
Notes:
One of f and filename must not be null.
*/
TStateModel* Read_VAR_Specification(FILE *f, char *filename)
{
TMarkovStateVariable *sv;
T_VAR_Parameters *p;
char *id, *fmt;
int *IV;
int j, spec, nvars, nlags, nexg, npre, nstates, nobs;
PRECISION lambda_prior;
TVector zeta_a_prior, zeta_b_prior;
TMatrix *U, *V, *W, *A0_prior, *Aplus_prior, Y, X;
int **coef_states, **var_states;
PRECISION** A0_Metropolis_Scale=(PRECISION**)NULL;
/* // Valid file ansi-c*/
FILE *f_in=OpenFile_VARio(f,filename);
if (!f_in) return (TStateModel*)NULL;
/* // Read Markov specifications ansi-c*/
sv=ReadMarkovSpecification(f_in,(char*)NULL);
/* //=== Sizes ===// ansi-c*/
nvars=ReadInteger_VARio(f_in,"//== Number Variables ==//");
nlags=ReadInteger_VARio(f_in,"//== Number Lags ==//");
nexg=ReadInteger_VARio(f_in,"//== Exogenous Variables ==//");
nstates=ReadInteger_VARio(f_in,"//== Number States ==//");
nobs=ReadInteger_VARio(f_in,"//== Number Observations ==//");
npre=nvars*nlags+nexg;
if ((nobs != sv->nobs) || (nstates != sv->nstates))
{
dw_UserError("Read_VAR_Specification(): different values for nobs or nstates.");
return (TStateModel*)NULL;
}
/* //=== Restrictions - U[j] ===// ansi-c*/
ReadArray_VARio(f_in,"//== Number of free parameters in each column of A0 ==//",IV=dw_CreateArray_int(nvars));
U=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
{
fmt="//== U[%d] ==//";
sprintf(id=(char*)swzMalloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
ReadMatrix_VARio(f_in,id,U[j]=CreateMatrix(nvars,IV[j]));
swzFree(id);
}
dw_FreeArray(IV);
/* //=== Restrictions - V[j] ===// ansi-c*/
ReadArray_VARio(f_in,"//== Number of free parameters in each column of Aplus ==//",IV=dw_CreateArray_int(nvars));
V=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
if (IV[j] > 0)
{
fmt="//== V[%d] ==//";
sprintf(id=(char*)swzMalloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
ReadMatrix_VARio(f_in,id,V[j]=CreateMatrix(npre,IV[j]));
swzFree(id);
}
dw_FreeArray(IV);
/* //=== Restrictions - W[j] ===// ansi-c*/
ReadArray_VARio(f_in,"//== Non-zero W[j] ==//",IV=dw_CreateArray_int(nvars));
W=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
if (IV[j])
{
fmt="//== W[%d] ==//";
sprintf(id=(char*)swzMalloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
ReadMatrix_VARio(f_in,id,W[j]=CreateMatrix(npre,nvars));
swzFree(id);
}
dw_FreeArray(IV);
/* //====== Priors ====== ansi-c*/
ReadVector_VARio(f_in,"//== Gamma prior on zeta - a ==//",zeta_a_prior=CreateVector(nvars));
ReadVector_VARio(f_in,"//== Gamma prior on zeta - b ==//",zeta_b_prior=CreateVector(nvars));
A0_prior=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
{
fmt="//== Variance of Gaussian prior on column %d of A0 ==//";
sprintf(id=(char*)swzMalloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
ReadMatrix_VARio(f_in,id,A0_prior[j]=CreateMatrix(nvars,nvars));
swzFree(id);
}
Aplus_prior=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
{
fmt="//== Variance of Gaussian prior on column %d of Aplus ==//";
sprintf(id=(char*)swzMalloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
ReadMatrix_VARio(f_in,id,Aplus_prior[j]=CreateMatrix(npre,npre));
swzFree(id);
}
/* //=== Specification ===// ansi-c*/
spec=ReadInteger_VARio(f_in,"//== Specification (0=default 1=Sims-Zha 2=Random Walk) ==//");
switch (spec)
{
case 0: spec=0; break;
case 1: spec=SPEC_SIMS_ZHA | SPEC_RANDOM_WALK; break;
case 2: spec=SPEC_RANDOM_WALK; break;
default: ReadError_VARio("//== Specification (0=default 1=Sims-Zha 2=Random Walk) ==//"); swzExit(0);
}
if (spec & SPEC_SIMS_ZHA)
lambda_prior=ReadScalar_VARio(f_in,"//== Variance of Gaussian prior on lambda ==//");
/* //====== coefficient and variance state variables ====== ansi-c*/
ReadArray_VARio(f_in,"//== Translation table for coefficient states ==//",coef_states=dw_CreateRectangularArray_int(nvars,nstates));
ReadArray_VARio(f_in,"//== Translation table for variance states ==//",var_states=dw_CreateRectangularArray_int(nvars,nstates));
/* //====== Metropolis jumping kernel info for A0 ====== ansi-c*/
if (dw_SetFilePosition(f_in,"//== Metropolis kernel scales for A0 ==//"))
{
A0_Metropolis_Scale=dw_CreateArray_array(nvars);
for (j=nvars-1; j >= 0; j--)
A0_Metropolis_Scale[j]=dw_CreateArray_scalar(GetNumberStatesFromTranslationMatrix(j,coef_states));
if (!dw_ReadArray(f_in,A0_Metropolis_Scale)) ReadError_VARio(id);
}
/* //=== Data === ansi-c*/
ReadMatrix_VARio(f_in,"//== Data Y (nobs x nvars) ==//",Y=CreateMatrix(nobs,nvars));
ReadMatrix_VARio(f_in,"//== Data X (nobs x npre) ==//",X=CreateMatrix(nobs,npre));
/* //=== Create T_VAR_Parameters structure === ansi-c*/
p=CreateTheta_VAR(spec,nvars,nlags,nexg,nstates,nobs,coef_states,var_states,U,V,W,Y,X);
if (spec & SPEC_SIMS_ZHA)
SetPriors_VAR_SimsZha(p,A0_prior,Aplus_prior,zeta_a_prior,zeta_b_prior,lambda_prior);
else
SetPriors_VAR(p,A0_prior,Aplus_prior,zeta_a_prior,zeta_b_prior);
if (A0_Metropolis_Scale) SetupMetropolisInformation(A0_Metropolis_Scale,p);
/* //=== Close output file === ansi-c*/
if (!f) fclose(f_in);
/* //=== Free memory === ansi-c*/
dw_FreeArray(U);
dw_FreeArray(V);
dw_FreeArray(W);
FreeVector(zeta_a_prior);
FreeVector(zeta_b_prior);
dw_FreeArray(A0_prior);
dw_FreeArray(Aplus_prior);
FreeMatrix(X);
FreeMatrix(Y);
dw_FreeArray(coef_states);
dw_FreeArray(var_states);
dw_FreeArray(A0_Metropolis_Scale);
/* //=== return TStateModel structure === ansi-c*/
return CreateStateModel_new(sv,CreateRoutines_VAR(),p);
}
/*
Writes the specification
*/
void Write_VAR_Specification(FILE *f, char *filename, TStateModel *model)
{
int j, t;
FILE *f_out=f ? f : dw_CreateTextFile(filename);
T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
/* // Write Markov specifications ansi-c*/
WriteMarkovSpecification(f_out,(char*)NULL,model);
/* //=== Sizes ===// ansi-c*/
fprintf(f_out,"//== Number Variables ==//\n%d\n\n",p->nvars);
fprintf(f_out,"//== Number Lags ==//\n%d\n\n",p->nlags);
fprintf(f_out,"//== Exogenous Variables ==//\n%d\n\n",p->npre - p->nvars * p->nlags);
fprintf(f_out,"//== Number States ==//\n%d\n\n",p->nstates);
fprintf(f_out,"//== Number Observations ==//\n%d\n\n",p->nobs);
/* //=== Restrictions - U[j] ===// ansi-c*/
fprintf(f_out,"//== Number of free parameters in each column of A0 ==//\n");
for (j=0; j < p->nvars; j++)
fprintf(f_out,"%d ",ColM(p->U[j]));
fprintf(f_out,"\n\n");
for (j=0; j < p->nvars; j++)
{
fprintf(f_out,"//== U[%d] ==//\n",j+1);
dw_PrintMatrix(f_out,p->U[j],"%22.14le ");
fprintf(f_out,"\n");
}
/* //=== Restrictions - V[j] ===// ansi-c*/
fprintf(f_out,"//== Number of free parameters in each column of Aplus ==//\n");
for (j=0; j < p->nvars; j++)
fprintf(f_out,"%d ",p->V[j] ? ColM(p->V[j]) : 0);
fprintf(f_out,"\n\n");
for (j=0; j < p->nvars; j++)
if (p->V[j])
{
fprintf(f_out,"//== V[%d] ==//\n",j+1);
dw_PrintMatrix(f_out,p->V[j],"%22.14le ");
fprintf(f_out,"\n");
}
/* //=== Restrictions - W[j] ===// ansi-c*/
fprintf(f_out,"//== Non-zero W[j] ==//\n");
for (j=0; j < p->nvars; j++)
fprintf(f_out,"%d ",p->W[j] ? 1 : 0);
fprintf(f_out,"\n\n");
for (j=0; j < p->nvars; j++)
if (p->W[j])
{
fprintf(f_out,"//== W[%d] ==//\n",j+1);
dw_PrintMatrix(f_out,p->W[j],"%22.14le ");
fprintf(f_out,"\n");
}
/* //====== Priors ====== ansi-c*/
fprintf(f_out,"//== Gamma prior on zeta - a ==//\n");
dw_PrintVector(f_out,p->zeta_a_prior,"%22.14le ");
fprintf(f_out,"\n");
fprintf(f_out,"//== Gamma prior on zeta - b ==//\n");
dw_PrintVector(f_out,p->zeta_b_prior,"%22.14le ");
fprintf(f_out,"\n");
for (j=0; j < p->nvars; j++)
{
fprintf(f_out,"//== Variance of Gaussian prior on column %d of A0 ==//\n",j+1);
dw_PrintMatrix(f_out,p->A0_prior[j],"%22.14le ");
fprintf(f_out,"\n");
}
for (j=0; j < p->nvars; j++)
{
fprintf(f_out,"//== Variance of Gaussian prior on column %d of Aplus ==//\n",j+1);
dw_PrintMatrix(f_out,p->Aplus_prior[j],"%22.14le ");
fprintf(f_out,"\n");
}
/* //=== Model specification ===// ansi-c*/
fprintf(f_out,"//== Specification (0=default 1=Sims-Zha 2=Random Walk) ==//\n");
if (p->Specification & SPEC_SIMS_ZHA)
fprintf(f_out,"1\n\n");
else
if (p->Specification & SPEC_RANDOM_WALK)
fprintf(f_out,"2\n\n");
else
fprintf(f_out,"0\n\n");
if ((p->Specification & SPEC_SIMS_ZHA) == SPEC_SIMS_ZHA)
fprintf(f_out,"//== Variance of Gaussian prior on lambda ==//\n%22.14le\n\n",p->lambda_prior);
/* //====== coefficient and variance state variables ====== ansi-c*/
fprintf(f_out,"//== Translation table for coefficient states ==//\n");
dw_PrintArray(f_out,p->coef_states,"%4d ");
fprintf(f_out,"//== Translation table for variance states ==//\n");
dw_PrintArray(f_out,p->var_states,"%4d ");
/* //====== Metropolis jumping kernel info for A0 ====== ansi-c*/
fprintf(f_out,"//== Metropolis kernel scales for A0 ==//\n");
dw_PrintArray(f_out,p->A0_Metropolis_Scale,"%22.14le ");
/* //=== Data === ansi-c*/
fprintf(f_out,"//== Data Y (nobs x nvars) ==//\n");
for (t=1; t <= p->nobs; t++)
dw_PrintVector(f_out,p->Y[t],"%22.14le ");
fprintf(f_out,"\n");
fprintf(f_out,"//== Data X (nobs x npre) ==//\n");
for (t=1; t <= p->nobs; t++)
dw_PrintVector(f_out,p->X[t],"%22.14le ");
fprintf(f_out,"\n");
/* //=== Close output file === ansi-c*/
if (!f) fclose(f_out);
}
/*
Assumes:
f: valid file pointer or null
filename: pointer to null terminated string or null
model: pointer to valid TStateModel structure
Returns:
One upon success. Upon failure, the routine prints an error message if
USER_ERR is a verbose error, terminates if USER_ERR is a terminal error and
returns zero if USER_ERR is not a terminal error. The terminal errors and
verbose errors can be set with dw_SetTerminalErrors() and
dw_SetVerboseErrors().
Results:
Upon success, the following fields of p will be filled:
A0, Aplus, Zeta, b0, bplus.
If the Sims-Zha specification is used, the following fields will also be
filled
lambda, psi.
The routine Thetahanged() will be called.
Notes:
One of f and filename must not be null.
The file must contain line identifiers of the form
//== A0[s] ==//
//== Aplus[s] ==//
//== Zeta[s] ==//
for 1 <= s <= p->nstates.
Zeta is checked for non-negativity. No checks are made to ensure that A0[s],
Aplus[s], or Zeta[s] satisfy any restrictions.
*/
int Read_VAR_Parameters(FILE *f, char *filename, char *header, TStateModel *model)
{
FILE *f_in;
char *idbuffer, *fmt;
TMatrix *A0, *Aplus, *Zeta;
int i, j, s;
T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
/* // Valid file ansi-c*/
f_in=OpenFile_VARio(f,filename);
if (!f_in) return 0;
if (!header) header="";
/* // Allocate memory ansi-c*/
A0=dw_CreateArray_matrix(p->nstates);
Aplus=dw_CreateArray_matrix(p->nstates);
Zeta=dw_CreateArray_matrix(p->nstates);
/* // Read File ansi-c*/
for (s=0; s < p->nstates; s++)
{
fmt="//== %sA0[%d] ==//";
sprintf(idbuffer=(char*)swzMalloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,A0[s]=CreateMatrix(p->nvars,p->nvars)))
{
ReadError_VARio(idbuffer);
swzFree(idbuffer);
return 0;
}
swzFree(idbuffer);
fmt="//== %sAplus[%d] ==//";
sprintf(idbuffer=(char*)swzMalloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,Aplus[s]=CreateMatrix(p->npre,p->nvars)))
{
ReadError_VARio(idbuffer);
swzFree(idbuffer);
return 0;
}
swzFree(idbuffer);
fmt="//== %sZeta[%d] ==//";
sprintf(idbuffer=(char*)swzMalloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,Zeta[s]=CreateMatrix(p->nvars,p->nvars)))
{
ReadError_VARio(idbuffer);
swzFree(idbuffer);
return 0;
}
swzFree(idbuffer);
}
/* // Set A0, Aplus, and Zeta ansi-c*/
for (j=0; j < p->nvars; j++)
for (s=0; s < p->nstates; s++)
{
for (i=0; i < p->nvars; i++)
ElementV(p->A0[j][p->coef_states[j][s]],i)=ElementM(A0[s],i,j);
for (i=0; i < p->npre; i++)
ElementV(p->Aplus[j][p->coef_states[j][s]],i)=ElementM(Aplus[s],i,j);
p->Zeta[j][p->var_states[j][s]]=ElementM(Zeta[s],j,j);
}
/* // Free memory ansi-c*/
dw_FreeArray(A0);
dw_FreeArray(Aplus);
dw_FreeArray(Zeta);
/* // Check Zeta non-negative ansi-c*/
for (j=p->nvars-1; j >= 0; j--)
for (s=p->n_var_states[j]-1; s >= 0; s--)
if (p->Zeta[j][s] < 0.0)
{
dw_UserError("Zeta has negative value.");
p->valid_parameters=0;
ThetaChanged(model);
return 0;
}
/* // Update b0, bplus, lambda, psi ansi-c*/
Update_b0_bplus_from_A0_Aplus(p);
if ((p->Specification & SPEC_SIMS_ZHA) == SPEC_SIMS_ZHA) Update_lambda_psi_from_bplus(p);
/* // Flags and notification that the VAR parameters have changed ansi-c*/
p->valid_parameters=1;
ThetaChanged(model);
return 1;
}
/*
Writes the VAR parameters to a file. The identifiers are
//== A0[s] ==//
//== Aplus[s] ==//
//== Zeta[s] ==//
for 1 <= s <= nstates
*/
int Write_VAR_Parameters(FILE *f, char *filename, char *header, TStateModel *model)
{
TMatrix X;
int s;
FILE *f_out;
T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
f_out=f ? f :dw_CreateTextFile(filename);
if (!header) header="";
for (s=0; s < p->nstates; s++)
{
X=MakeA0((TMatrix)NULL,s,p);
fprintf(f_out,"//== %sA0[%d] ==//\n",header,s+1);
dw_PrintMatrix(f_out,X,"%22.14le ");
fprintf(f_out,"\n");
FreeMatrix(X);
X=MakeAplus((TMatrix)NULL,s,p);
fprintf(f_out,"//== %sAplus[%d] ==//\n",header,s+1);
dw_PrintMatrix(f_out,X,"%22.14le ");
fprintf(f_out,"\n");
FreeMatrix(X);
X=MakeZeta((TMatrix)NULL,s,p);
fprintf(f_out,"//== %sZeta[%d] ==//\n",header,s+1);
dw_PrintMatrix(f_out,X,"%22.14le ");
fprintf(f_out,"\n");
FreeMatrix(X);
}
if (!f) fclose(f_out);
return 1;
}
/*
Writes the headers for Write_VAR_ParametersFlat(). This routine can
be used to give the ordering for Write_VAR_ParametersFlat().
*/
int Write_VAR_ParametersFlat_Headers(FILE *f_out, TStateModel *model)
{
int i, j, s;
T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
if (!f_out) return 0;
for (s=0; s < p->nstates; s++)
{
for (j=0; j < p->nvars; j++)
for (i=0; i < p->nvars; i++)
fprintf(f_out,"A0[%d](%d,%d) ",s+1,i+1,j+1);
for (j=0; j < p->nvars; j++)
for (i=0; i < p->npre; i++)
fprintf(f_out,"Aplus[%d](%d,%d) ",s+1,i+1,j+1);
for (j=0; j < p->nvars; j++)
fprintf(f_out,"Zeta[%d](%d,%d) ",s+1,j+1,j+1);
}
return 1;
}
int Read_VAR_ParametersFlat(FILE *f_in, TStateModel *model)
{
TMatrix *A0, *Aplus;
TVector *Zeta;
int i, j, s, rtrn=0;
T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
/* // Allocate memory ansi-c*/
A0=dw_CreateArray_matrix(p->nstates);
Aplus=dw_CreateArray_matrix(p->nstates);
Zeta=dw_CreateArray_vector(p->nstates);
/* // Read File ansi-c*/
for (s=0; s < p->nstates; s++)
{
A0[s]=CreateMatrix(p->nvars,p->nvars);
for (j=0; j < p->nvars; j++)
for (i=0; i < p->nvars; i++)
if (fscanf(f_in," %lf ",&ElementM(A0[s],i,j)) != 1)
goto ERROR;
Aplus[s]=CreateMatrix(p->npre,p->nvars);
for (j=0; j < p->nvars; j++)
for (i=0; i < p->npre; i++)
if (fscanf(f_in," %lf ",&ElementM(Aplus[s],i,j)) != 1)
goto ERROR;
Zeta[s]=CreateVector(p->nvars);
for (j=0; j < p->nvars; j++)
if (fscanf(f_in," %lf ",&ElementV(Zeta[s],j)) != 1)
goto ERROR;
else
if (ElementV(Zeta[s],j) < 0.0)
goto ERROR;
}
/* // Set A0, Aplus, and Zeta ansi-c*/
for (j=0; j < p->nvars; j++)
for (s=0; s < p->nstates; s++)
{
for (i=0; i < p->nvars; i++)
ElementV(p->A0[j][p->coef_states[j][s]],i)=ElementM(A0[s],i,j);
for (i=0; i < p->npre; i++)
ElementV(p->Aplus[j][p->coef_states[j][s]],i)=ElementM(Aplus[s],i,j);
p->Zeta[j][p->var_states[j][s]]=ElementV(Zeta[s],j);
}
/* // Update b0, bplus, lambda, psi ansi-c*/
Update_b0_bplus_from_A0_Aplus(p);
if ((p->Specification & SPEC_SIMS_ZHA) == SPEC_SIMS_ZHA) Update_lambda_psi_from_bplus(p);
/* // Flags and notification that the VAR parameters have changed ansi-c*/
p->valid_parameters=1;
ThetaChanged(model);
rtrn=1;
ERROR:
/* // Free memory ansi-c*/
dw_FreeArray(A0);
dw_FreeArray(Aplus);
dw_FreeArray(Zeta);
return rtrn;
}
/*
For each state the VAR parameters are printed as follows
A0 (by columns)
Aplus (by columns)
Zeta (diagonal)
*/
int Write_VAR_ParametersFlat(FILE *f, TStateModel *model, char *fmt)
{
TMatrix A0, Aplus;
int s, i, j;
T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
if (!f) return 0;
if (!fmt) fmt="%lf ";
A0=CreateMatrix(p->nvars,p->nvars);
Aplus=CreateMatrix(p->npre,p->nvars);
for (s=0; s < p->nstates; s++)
{
MakeA0(A0,s,p);
for (j=0; j < p->nvars; j++)
for (i=0; i < p->nvars; i++)
fprintf(f,fmt,ElementM(A0,i,j));
MakeAplus(Aplus,s,p);
for (j=0; j < p->nvars; j++)
for (i=0; i < p->npre; i++)
fprintf(f,fmt,ElementM(Aplus,i,j));
for (j=0; j < p->nvars; j++)
fprintf(f,fmt,p->Zeta[j][p->var_states[j][s]]);
}
FreeMatrix(Aplus);
FreeMatrix(A0);
return 1;
}
/*
For each state the VAR parameters are printed as follows
A0 (by columns)
Aplus (by columns)
Zeta (diagonal)
The system is normalized so that the diagonal of A0 is one.
*/
int Write_VAR_ParametersFlat_A0_Diagonal_One(FILE *f, TStateModel *model, char *fmt)
{
TMatrix A0, Aplus;
TVector i_diagonal, s_diagonal;
int s, i, j;
T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
PRECISION x;
if (!f) return 0;
if (!fmt) fmt="%lf ";
A0=CreateMatrix(p->nvars,p->nvars);
Aplus=CreateMatrix(p->npre,p->nvars);
s_diagonal=CreateVector(p->nvars);
i_diagonal=CreateVector(p->nvars);
for (s=0; s < p->nstates; s++)
{
MakeA0(A0,s,p);
for (i=p->nvars-1; i >= 0; i--)
{
ElementV(i_diagonal,i)=1.0/(x=ElementM(A0,i,i));
ElementV(s_diagonal,i)=x*x;
}
for (j=0; j < p->nvars; j++)
for (i=0; i < p->nvars; i++)
fprintf(f,fmt,ElementM(A0,i,j)*ElementV(i_diagonal,j));
MakeAplus(Aplus,s,p);
for (j=0; j < p->nvars; j++)
for (i=0; i < p->npre; i++)
fprintf(f,fmt,ElementM(Aplus,i,j)*ElementV(i_diagonal,j));
for (j=0; j < p->nvars; j++)
fprintf(f,fmt,p->Zeta[j][p->var_states[j][s]] * ElementV(s_diagonal,j));
}
FreeVector(i_diagonal);
FreeVector(s_diagonal);
FreeMatrix(Aplus);
FreeMatrix(A0);
return 1;
}
/*
Attempts to read all parameters. The identifiers are
//== <id>States ==//
//== <id>Transition matrix[] ==//
//== <id>A0[s] ==//
//== <id>Aplus[s] ==//
//== <id>Zeta[s] ==//
for 1 <= s <= nstates
*/
void ReadAllParameters(FILE *f, char *filename, char *id, TStateModel *model)
{
char *buffer, *fmt="//== %sStates ==//";
FILE *f_in=f ? f :dw_OpenTextFile(filename);
if (!id) id="";
sprintf(buffer=(char*)swzMalloc(strlen(fmt) + strlen(id) - 1),fmt,id);
ReadArray_VARio(f_in,buffer,model->sv->S);
swzFree(buffer);
ReadTransitionMatrices(f_in,(char*)NULL,id,model);
Read_VAR_Parameters(f_in,(char*)NULL,id,model);
}
/*
Attempts to write all parameters using a format readable by the routine
ReadAllParameters().
*/
void WriteAllParameters(FILE *f, char *filename, char *id, TStateModel *model)
{
FILE *f_in=f ? f : dw_CreateTextFile(filename);
if (!id) id="";
fprintf(f_in,"//== %sStates ==//\n",id);
dw_PrintArray(f_in,model->sv->S,(char*)NULL);
fprintf(f_in,"\n");
WriteTransitionMatrices(f_in,(char*)NULL,id,model);
Write_VAR_Parameters(f_in,(char*)NULL,id,model);
if(!f) fclose(f_in);
}
/*******************************************************************************/
/******************************** Input/Output *********************************/
/*******************************************************************************/
void Write_ReducedFormVAR_Parameters(FILE *f, char *filename, T_VAR_Parameters *p)
{
TMatrix A0, Aplus, Zeta, C, Sigma;
int k;
FILE *f_out;
f_out=f ? f :dw_CreateTextFile(filename);
A0=CreateMatrix(p->nvars,p->nvars);
Aplus=CreateMatrix(p->npre,p->nvars);
Zeta=CreateMatrix(p->nvars,p->nvars);
C=CreateMatrix(p->npre,p->nvars);
Sigma=CreateMatrix(p->nvars,p->nvars);
for (k=0; k < p->nstates; k++)
{
MakeA0(A0,k,p);
MakeAplus(Aplus,k,p);
MakeZeta(Zeta,k,p);
/* //ProductInverseMM(C,Aplus,A0); ansi-c*/
/* //ProductMM(A0,A0,Xi); ansi-c*/
/* //ProductTransposeMM(Sigma,A0,A0); ansi-c*/
/* //Inverse_LU(Sigma,Sigma); ansi-c*/
fprintf(f_out,"//== Reduced Form[%d] ==//\n",k+1);
dw_PrintMatrix(f_out,C,"%lf ");
fprintf(f_out,"\n");
fprintf(f_out,"//== Variance[%d] ==//\n",k+1);
dw_PrintMatrix(f_out,Sigma,"%lf ");
fprintf(f_out,"\n");
}
FreeMatrix(A0);
FreeMatrix(Aplus);
FreeMatrix(Zeta);
FreeMatrix(C);
FreeMatrix(Sigma);
if (!f) fclose(f_out);
}
/*
Create Model from data file. Assumes that the state variables have a flat
structure.
*/
void Write_VAR_Info(FILE *f, char *filename, T_VAR_Parameters *p)
{
FILE *f_out;
int j;
if (!f)
f_out=dw_CreateTextFile(filename);
else
f_out=f;
/* //=== Write sizes ===// ansi-c*/
fprintf(f_out,"//== Number Observations ==//\n%d\n\n",p->nobs);
fprintf(f_out,"//== Number Variables ==//\n%d\n\n",p->nvars);
fprintf(f_out,"//== Number Lags ==//\n%d\n\n",p->nlags);
fprintf(f_out,"//== Exogenous Variables ==//\n%d\n\n",p->npre - p->nvars * p->nlags);
/* //=== Restrictions - U[j] ===// ansi-c*/
fprintf(f_out,"//== Number of free parameters in jth column of A0 ==//\n");
for (j=0; j < p->nvars; j++)
fprintf(f_out,"%d ",ColM(p->U[j]));
fprintf(f_out,"\n\n");
fprintf(f_out,"//== U[j] 0 <= j < nvars ==//\n");
for (j=0; j < p->nvars; j++)
{
dw_PrintMatrix(f_out,p->U[j],"%lf ");
fprintf(f_out,"\n");
}
/* //=== Restrictions - V[j] ===// ansi-c*/
fprintf(f_out,"//== Number of free parameters in jth column of Aplus ==//\n");
for (j=0; j < p->nvars; j++)
fprintf(f_out,"%d ",p->V[j] ? ColM(p->V[j]) : 0);
fprintf(f_out,"\n\n");
fprintf(f_out,"//== V[j] 0 <= j < nvars ==//\n");
for (j=0; j < p->nvars; j++)
if (p->V[j])
{
dw_PrintMatrix(f_out,p->V[j],"%lf ");
fprintf(f_out,"\n");
}
/* //=== Restrictions - W[j] ===// ansi-c*/
fprintf(f_out,"//== Non-zero W[j] ==//\n");
for (j=0; j < p->nvars; j++)
fprintf(f_out,"%d ",p->W[j] ? 1 : 0);
fprintf(f_out,"\n\n");
fprintf(f_out,"//== W[j] 0 <= j < nvars ==//\n");
for (j=0; j < p->nvars; j++)
if (p->W[j])
{
dw_PrintMatrix(f_out,p->W[j],"%lf ");
fprintf(f_out,"\n");
}
/* //====== Priors ====== ansi-c*/
fprintf(f_out,"//== Gamma prior on Xi ==//\n");
for (j=0; j < p->nvars; j++)
fprintf(f_out,"%lf %lf\n",ElementV(p->zeta_a_prior,j),ElementV(p->zeta_b_prior,j));
fprintf(f_out,"\n");
fprintf(f_out,"//== Prior on jth column of A0 - Gaussian variance ==//\n");
for (j=0; j < p->nvars; j++)
{
dw_PrintMatrix(f_out,p->A0_prior[j],"%lf ");
fprintf(f_out,"\n");
}
fprintf(f_out,"//== Prior on jth column of Aplus - Gaussian variance ==//\n");
for (j=0; j < p->nvars; j++)
{
dw_PrintMatrix(f_out,p->Aplus_prior[j],"%lf ");
fprintf(f_out,"\n");
}
/* //====== coefficient/variance state variables ====== */
/* CStates=dw_CreateRegularArrayList_int(2,p->nvars,sv->n_state_variables); */
/* id="//== Controlling states variables for coefficients ==//"; */
/* if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,CStates)) dw_Error(PARSE_ERR); */
/* VStates=dw_CreateRegularArrayList_int(2,p->nvars,sv->n_state_variables); */
/* id="//== Controlling states variables for variance ==//"; */
/* if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,VStates)) dw_Error(PARSE_ERR); */
/* //=== Read Data === */
/* if (!dw_SetFilePosition(f_in,"//== Data Y (T x nvars) ==//") */
/* || !dw_SetFilePosition(f_in,"//== Data X (T x npre) ==//")) */
/* p->X=p->Y=(TVector*)NULL; */
/* else */
/* { */
/* // Initialize Y */
/* id="//== Data Y (T x nvars) ==//"; */
/* if (!dw_SetFilePosition(f_in,id)) dw_Error(PARSE_ERR); */
/* p->Y=dw_CreateArray_vector(p->nobs+1); */
/* for (t=1; t <= p->nobs; t++) */
/* if (!dw_ReadVector(f_in,p->Y[t]=CreateVector(p->nvars))) dw_Error(PARSE_ERR); */
/* // Initialize X */
/* id="//== Data X (T x npre) ==//"; */
/* if (!dw_SetFilePosition(f_in,id)) dw_Error(PARSE_ERR); */
/* p->X=dw_CreateArray_vector(p->nobs+1); */
/* for (t=1; t <= p->nobs; t++) */
/* if (!dw_ReadVector(f_in,p->X[t]=CreateVector(p->npre))) */
/* dw_Error(PARSE_ERR); */
/* } */
/* //=== Close output file === ansi-c*/
if (!f) fclose(f_out);
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*
Create Model from data file. Assumes that the state variables have a flat
structure.
*/
/**
TStateModel* CreateStateModel_VAR_File(FILE *f, char *filename)
{
TMarkovStateVariable *sv;
T_VAR_Parameters *p;
//=== Create Markov State Variable ===
sv=CreateMarkovStateVariable_File(f,filename,0);
//=== Create VAR Parameters
p=Create_VAR_Parameters_File(f,filename,sv);
//=== Create TStateModel ===
return CreateStateModel_new(sv,CreateRoutines_VAR(),p);
}
/**/

27
matlab/ms-sbvar/c-code/sbvar/var/VARio.h
View File

@ -1,27 +0,0 @@
#ifndef __VAR_INPUT_OUTPUT__
#define __VAR_INPUT_OUTPUT__
#include "switch.h"
#include "VARbase.h"
void Write_VAR_Specification(FILE *f, char *filename, TStateModel *model);
TStateModel* Read_VAR_Specification(FILE *f, char *filename);
int Write_VAR_Parameters(FILE *f, char *filename, char *id, TStateModel *model);
int Read_VAR_Parameters(FILE *f, char *filename, char *id, TStateModel *model);
int Read_VAR_ParametersFlat(FILE *f_in, TStateModel *model);
int Write_VAR_ParametersFlat(FILE *f, TStateModel *model, char *fmt);
int Write_VAR_ParametersFlat_Headers(FILE *f_out, TStateModel *model);
int Write_VAR_ParametersFlat_A0_Diagonal_One(FILE *f, TStateModel *model, char *fmt);
void ReadAllParameters(FILE *f, char *filename, char *id, TStateModel *model);
void WriteAllParameters(FILE *f, char *filename, char *id, TStateModel *model);
/* //T_VAR_Parameters* Create_VAR_Parameters_File(FILE *f, char *filename, TMarkovStateVariable *sv); ansi-c*/
/* //TStateModel* CreateStateModel_VAR_File(FILE *f, char *filename); ansi-c*/
/* //void PrintParametersVAR(FILE *f_out, TStateModel *model); ansi-c*/
/* //void Write_VAR_Info(FILE *f, char *filename, T_VAR_Parameters *p); ansi-c*/
#endif

512
matlab/ms-sbvar/c-code/sbvar/var/VARio_matlab.c
View File

@ -1,512 +0,0 @@
#include "VARio_matlab.h"
#include "switchio.h"
#include "dw_error.h"
#include "dw_ascii.h"
#include <stdlib.h>
#include <string.h>
#include "modify_for_mex.h"
static int ReadError_VARio_matlab(char *id)
{
char *errmsg, *fmt="Error after line identifier ""%s""";
sprintf(errmsg=(char*)swzMalloc(strlen(fmt) + strlen(id) - 1),fmt,id);
dw_UserError(errmsg);
swzFree(errmsg);
return 1;
}
TStateModel* Combine_matlab_standard(char *matlabfile, char *standardfile)
{
FILE *f_in;
TStateModel *model;
TMarkovStateVariable *sv, ***coef_sv, ***var_sv;
T_VAR_Parameters *p;
char *id;
int *IV, **States;
int nlags, nvars, nexg, npre, nstates, nobs, i, j, n, SimsZha=1, RandomWalk=1, flag;
PRECISION scalar_zeta_a_prior, scalar_zeta_b_prior, lambda_prior;
int **coef_states, **var_states;
TMatrix *U, *V, *W, *A0_prior, *Aplus_prior, X, Y, S;
TVector zeta_a_prior, zeta_b_prior;
/* //=== Open matlab input file ansi-c*/
f_in=dw_OpenTextFile(matlabfile);
/* //=== Read sizes ===// ansi-c*/
id="//== lags, nvar, nStates, T ==//";
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %d %d %d %d ",&nlags,&nvars,&nstates,&nobs) != 4)) ReadError_VARio_matlab(id);
/* //=== A single constant term ===// ansi-c*/
nexg=1;
npre=nvars * nlags + nexg;
/* //=== Restrictions - U[j] ===// ansi-c*/
IV=dw_CreateArray_int(nvars);
id="//== n0const: nvar-by-1 ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,IV)) ReadError_VARio_matlab(id);
id="//== Uiconst: cell(nvar,1) and nvar-by-n0const(i) for the ith cell (equation) ==//";
if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id);
U=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
if (!dw_ReadMatrix(f_in,U[j]=CreateMatrix(nvars,IV[j]))) ReadError_VARio_matlab(id);
dw_FreeArray(IV);
/* //=== Restrictions - V[j] (V[j] should be an npre x npre identity matrix) ===// ansi-c*/
IV=dw_CreateArray_int(nvars);
id="//== npconst: nvar-by-1 ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,IV)) ReadError_VARio_matlab(id);
for (j=nvars-1; j >= 0; j--)
if (IV[j] != npre) SimsZha=0;
V=dw_CreateArray_matrix(nvars);
if (SimsZha)
{
for (j=nvars-1; j >= 0; j--)
V[j]=IdentityMatrix((TMatrix)NULL,npre);
}
else
{
id="//== Viconst: cell(nvar,1) and ncoef-by-n0const(i) for the ith cell (equation) ==//";
if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id);
for (j=0; j < nvars; j++)
if (!dw_ReadMatrix(f_in,V[j]=CreateMatrix(npre,IV[j]))) ReadError_VARio_matlab(id);
}
dw_FreeArray(IV);
/* //=== Restrictions - W[j] (Random walk specification) ===// ansi-c*/
InitializeMatrix(S=CreateMatrix(npre,nvars),0.0);
for (j=nvars-1; j >= 0; j--) ElementM(S,j,j)=-1.0;
W=dw_CreateArray_matrix(nvars);
for (j=nvars-1; j >= 0; j--)
W[j]=EquateMatrix((TMatrix)NULL,S);
FreeMatrix(S);
/* //====== Priors ====== ansi-c*/
id="//== gxia: alpha parameter for gamma prior of xi ==//";
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %lf ",&scalar_zeta_a_prior) != 1)) ReadError_VARio_matlab(id);
id="//== gxib: beta parameter for gamma prior of xi ==//";
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %lf ",&scalar_zeta_b_prior) != 1)) ReadError_VARio_matlab(id);
zeta_a_prior=CreateVector(nvars);
zeta_b_prior=CreateVector(nvars);
for (j=nvars-1; j >= 0; j--)
{
ElementV(zeta_a_prior,j)=scalar_zeta_a_prior;
ElementV(zeta_b_prior,j)=scalar_zeta_b_prior;
}
id="//== H0barconstcell: cell(nvar,1) and n-by-n for the ith cell (equation) ==//";
if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id);
A0_prior=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
if (!dw_ReadMatrix(f_in,A0_prior[j]=CreateMatrix(nvars,nvars))) ReadError_VARio_matlab(id);
id="//== Hpbarconstcell: cell(nvar,1) and ncoef-by-ncoef for the ith cell (equation) ==//";
if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id);
Aplus_prior=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
if (!dw_ReadMatrix(f_in,Aplus_prior[j]=CreateMatrix(npre,npre))) ReadError_VARio_matlab(id);
/* // Initialize Y ansi-c*/
id="//== Yleft -- Y: T-by-nvar ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,Y=CreateMatrix(nobs,nvars))) ReadError_VARio_matlab(id);
/* // Initialize X ansi-c*/
id="//== Xright -- X: T-by-ncoef ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,X=CreateMatrix(nobs,npre))) ReadError_VARio_matlab(id);
/* //=== Sims-Zha specification === ansi-c*/
id="//== glamdasig: sigma parameter for normal prior of lamda ==//";
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %lf ",&lambda_prior) != 1)) ReadError_VARio_matlab(id);
lambda_prior*=lambda_prior;
/* //=== Close matlab input file === ansi-c*/
fclose(f_in);
/* //=== Open standard input file ansi-c*/
f_in=dw_OpenTextFile(standardfile);
/* //=== Create Markov state variable ===// ansi-c*/
sv=CreateMarkovStateVariable_File(f_in,(char*)NULL,nobs);
/* //====== coefficient/variance state variables ====== ansi-c*/
id="//== Controlling states variables for coefficients ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,States=dw_CreateRectangularArray_int(nvars,sv->n_state_variables)))
ReadError_VARio_matlab(id);
coef_sv=(TMarkovStateVariable ***)dw_CreateArray_array(nvars);
for (j=nvars-1; j >= 0; j--)
{
for (n=i=0; i < sv->n_state_variables; i++)
if (States[j][i]) n++;
if (n > 0)
{
coef_sv[j]=(TMarkovStateVariable **)dw_CreateArray_pointer(n,NULL);
for (n=i=0; i < sv->n_state_variables; i++)
if (States[j][i]) coef_sv[j][n++]=sv->state_variable[i];
}
}
coef_states=CreateTranslationMatrix(coef_sv,sv);
dw_FreeArray(States);
dw_FreeArray(coef_sv);
id="//== Controlling states variables for variance ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,States=dw_CreateRectangularArray_int(nvars,sv->n_state_variables)))
ReadError_VARio_matlab(id);
var_sv=(TMarkovStateVariable ***)dw_CreateArray_array(nvars);
for (j=nvars-1; j >= 0; j--)
{
for (n=i=0; i < sv->n_state_variables; i++)
if (States[j][i]) n++;
if (n > 0)
{
var_sv[j]=(TMarkovStateVariable **)dw_CreateArray_pointer(n,NULL);
for (n=i=0; i < sv->n_state_variables; i++)
if (States[j][i]) var_sv[j][n++]=sv->state_variable[i];
}
}
var_states=CreateTranslationMatrix(var_sv,sv);
dw_FreeArray(States);
dw_FreeArray(var_sv);
/* //=== Close standard input file === ansi-c*/
fclose(f_in);
/* //=== Create T_VAR_Parameters structure === ansi-c*/
flag=SimsZha ? SPEC_SIMS_ZHA : 0;
flag|=RandomWalk ? SPEC_RANDOM_WALK : 0;
p=CreateTheta_VAR(flag,nvars,nlags,nexg,sv->nstates,sv->nobs,coef_states,var_states,U,V,W,Y,X);
if (flag & SPEC_SIMS_ZHA)
SetPriors_VAR_SimsZha(p,A0_prior,Aplus_prior,zeta_a_prior,zeta_b_prior,lambda_prior);
else
SetPriors_VAR(p,A0_prior,Aplus_prior,zeta_a_prior,zeta_b_prior);
/* //p=Create_VAR_Parameters(nvars,nlags,nexg,sv->nstates,sv->nobs,U,V,W,Zeta_a_prior,Zeta_b_prior,A0_prior,Aplus_prior,Y,X,coef_states,var_states); ansi-c*/
/* //SetupSimsZhaSpecification(p,delta_prior*delta_prior); ansi-c*/
/* //=== Create TStateModel === ansi-c*/
model=CreateStateModel_new(sv,CreateRoutines_VAR(),p);
/* //=== Print Model specifications to file === ansi-c*/
/* //=== Free memory === ansi-c*/
FreeMatrix(X);
FreeMatrix(Y);
dw_FreeArray(Aplus_prior);
dw_FreeArray(A0_prior);
FreeVector(zeta_b_prior);
FreeVector(zeta_a_prior);
dw_FreeArray(W);
dw_FreeArray(V);
dw_FreeArray(U);
return model;
}
/*
This reads the constant parameters from filename, which was created
from Matlab and then sets all the parameters to the constant parameters.
*/
void ReadConstantParameters(char *filename, TStateModel *model)
{
char *id;
int i, j, s;
FILE *f_in;
TMatrix A0, Aplus;
T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
if (!(f_in=fopen(filename,"rt")))
{
printf("Unable to read the input data file: %s\n", filename);
swzExit(0);
}
/* // A0 ansi-c*/
id="//== A0hat: nvar-by-nvar ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,A0=CreateMatrix(p->nvars,p->nvars))) ReadError_VARio_matlab(id);
for (j=p->nvars-1; j >= 0; j--)
for (s=p->n_coef_states[j]-1; s >= 0; s--)
for (i=p->nvars-1; i >= 0; i--)
ElementV(p->A0[j][s],i)=ElementM(A0,i,j);
FreeMatrix(A0);
/* // Aplus ansi-c*/
id="//== Aphat: ncoef(lags*nvar+1)-by-nvar ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,Aplus=CreateMatrix(p->npre,p->nvars))) ReadError_VARio_matlab(id);
for (j=p->nvars-1; j >= 0; j--)
for (s=p->n_coef_states[j]-1; s >= 0; s--)
for (i=p->npre-1; i >= 0; i--)
ElementV(p->Aplus[j][s],i)=ElementM(Aplus,i,j);
FreeMatrix(Aplus);
/* // Zeta ansi-c*/
for (j=p->nvars-1; j >= 0; j--)
for (s=p->n_var_states[j]-1; s >= 0; s--)
p->Zeta[j][s]=1.0;
/* // b0, bplus, lambda, and psi ansi-c*/
Update_b0_bplus_from_A0_Aplus(p);
if (p->Specification & SPEC_SIMS_ZHA) Update_lambda_psi_from_bplus(p);
/* // Flags ansi-c*/
p->valid_parameters=1;
/* // Transition matrix ansi-c*/
SetTransitionMatrixToPriorMean(model);
ThetaChanged(model);
}
/*
Create Model from Matlab data file
*/
TStateModel* CreateStateModel_VAR_matlab(char *filename)
{
T_VAR_Parameters *p;
FILE *f_in;
char *id;
TMatrix PriorTransitionMatrix, S;
int *IV, **IM;
PRECISION scalar_Zeta_a_prior, scalar_Zeta_b_prior, lambda_prior;
int i, j, nvars, nlags, nexg, npre, nobs, nstates;
TMatrix *U, *V, *W;
TVector Zeta_a_prior, Zeta_b_prior;
TMatrix *A0_prior, *Aplus_prior;
TMatrix Y, X;
int **coef_states, **var_states;
TMarkovStateVariable *sv;
/* //=== Open file === ansi-c*/
if (!(f_in=fopen(filename,"rt")))
{
printf("Unable to read the input data file: %s\n", filename);
swzExit(0);
}
/* //=== Read sizes ===// ansi-c*/
id="//== lags, nvar, nStates, T ==//";
if (!dw_SetFilePosition(f_in,id)
|| (fscanf(f_in," %d %d %d %d ",&nlags,&nvars,&nstates,&nobs) != 4)) ReadError_VARio_matlab(id);
/* //=== A single constant term ===// ansi-c*/
nexg=1;
npre=nvars * nlags + nexg;
/* //=== Restrictions - U[j] ===// ansi-c*/
IV=dw_CreateArray_int(nvars);
id="//== n0const: nvar-by-1 ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,IV)) ReadError_VARio_matlab(id);
id="//== Uiconst: cell(nvar,1) and nvar-by-n0const(i) for the ith cell (equation) ==//";
if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id);
U=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
if (!dw_ReadMatrix(f_in,U[j]=CreateMatrix(nvars,IV[j]))) ReadError_VARio_matlab(id);
dw_FreeArray(IV);
/* //=== Restrictions - V[j] (V[j] should be an npre x npre identity matrix) ===// ansi-c*/
IV=dw_CreateArray_int(nvars);
id="//== npconst: nvar-by-1 ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,IV)) ReadError_VARio_matlab(id);
for (j=nvars-1; j >= 0; j--)
if (IV[j] != npre)
{
swz_fprintf_err("V[%d] not %d x %d\n",j,npre,npre);
swzExit(0);
}
V=dw_CreateArray_matrix(nvars);
for (j=nvars-1; j >= 0; j--)
V[j]=IdentityMatrix((TMatrix)NULL,npre);
dw_FreeArray(IV);
/* //=== Restrictions - W[j] (Random walk specification) ===// ansi-c*/
InitializeMatrix(S=CreateMatrix(npre,nvars),0.0);
for (j=nvars-1; j >= 0; j--) ElementM(S,j,j)=-1.0;
W=dw_CreateArray_matrix(nvars);
for (j=nvars-1; j >= 0; j--)
W[j]=EquateMatrix((TMatrix)NULL,S);
FreeMatrix(S);
/* //=== Create TMarkovStateVariable ===// ansi-c*/
PriorTransitionMatrix=CreateMatrix(nstates,nstates);
id="//== Galpha: nStates-by-nStates ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,PriorTransitionMatrix)) ReadError_VARio_matlab(id);
sv=CreateMarkovStateVariable_NoRestrictions(nstates,nobs,PriorTransitionMatrix);
FreeMatrix(PriorTransitionMatrix);
/* //====== regime/shock state variables ====== ansi-c*/
coef_states=dw_CreateRectangularArray_int(nvars,nstates);
var_states=dw_CreateRectangularArray_int(nvars,nstates);
IM=dw_CreateRectangularArray_int(nvars,2);
id="//== indxEqnTv_m: nvar-by-2 ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,IM)) ReadError_VARio_matlab(id);
for (j=nvars-1; j >= 0; j--)
switch (IM[j][1])
{
case 1:
for (i=nstates-1; i >= 0; i--)
coef_states[j][i]=var_states[j][i]=0;
break;
case 2:
for (i=nstates-1; i >= 0; i--)
{
coef_states[j][i]=0;
var_states[j][i]=i;
}
break;
case 3:
for (i=nstates-1; i >= 0; i--)
{
coef_states[j][i]=i;
var_states[j][i]=0;
}
break;
case 4:
swz_fprintf_err("Case %d not implimented.\n",4);
swzExit(0);
default:
swz_fprintf_err("Unknown type.\n");
swzExit(0);
}
dw_FreeArray(IM);
/* //====== Priors ====== ansi-c*/
id="//== gxia: alpha parameter for gamma prior of xi ==//";
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %lf ",&scalar_Zeta_a_prior) != 1)) ReadError_VARio_matlab(id);
id="//== gxib: beta parameter for gamma prior of xi ==//";
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %lf ",&scalar_Zeta_b_prior) != 1)) ReadError_VARio_matlab(id);
Zeta_a_prior=CreateVector(nvars);
Zeta_b_prior=CreateVector(nvars);
for (j=nvars-1; j >= 0; j--)
{
ElementV(Zeta_a_prior,j)=scalar_Zeta_a_prior;
ElementV(Zeta_b_prior,j)=scalar_Zeta_b_prior;
}
id="//== H0barconstcell: cell(nvar,1) and n-by-n for the ith cell (equation) ==//";
if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id);
A0_prior=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
if (!dw_ReadMatrix(f_in,A0_prior[j]=CreateMatrix(nvars,nvars))) ReadError_VARio_matlab(id);
id="//== Hpbarconstcell: cell(nvar,1) and ncoef-by-ncoef for the ith cell (equation) ==//";
if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id);
Aplus_prior=dw_CreateArray_matrix(nvars);
for (j=0; j < nvars; j++)
if (!dw_ReadMatrix(f_in,Aplus_prior[j]=CreateMatrix(npre,npre))) ReadError_VARio_matlab(id);
/* //=========================== Checks */
/* TMatrix *H0, *Ui; */
/* int *n0s; */
/* TMatrix Sigma, XX, YY, ZZ; */
/* int i, ii, jj; */
/* PRECISION max; */
/* id="//== n0s: nvar-by-1 ==//"; */
/* if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,n0s=dw_CreateArray_int(nvars))) ReadError_VARio_matlab(id); */
/* id="//== H0tldcell_inv: cell(nvar,1) and n0s(i)-by-n0s(i) for the ith cell ==//"; */
/* if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id); */
/* H0=dw_CreateArray_matrix(nvars); */
/* for (j=0; j < nvars; j++) */
/* if (!dw_ReadMatrix(f_in,H0[j]=CreateMatrix(n0s[j],n0s[j]))) ReadError_VARio_matlab(id); */
/* id="//== Ui: cell(nvar,1) and nvar*nStates-by-n0s(i) for the ith cell ==//"; */
/* if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id); */
/* Ui=dw_CreateArray_matrix(nvars); */
/* for (j=0; j < nvars; j++) */
/* if (!dw_ReadMatrix(f_in,Ui[j]=CreateMatrix(nvars*nstates,n0s[j]))) ReadError_VARio_matlab(id); */
/* Sigma=CreateMatrix(nvars*nstates,nvars*nstates); */
/* XX=CreateMatrix(nvars,nvars); */
/* for (j=0; j < nvars; j++) */
/* { */
/* InitializeMatrix(Sigma,0.0); */
/* Inverse_LU(XX,A0_prior[j]); */
/* for (i=0; i < nstates; i++) */
/* for (ii=0; ii < nvars; ii++) */
/* for (jj=0; jj < nvars; jj++) */
/* ElementM(Sigma,i*nvars+ii,i*nvars+jj)=ElementM(XX,ii,jj); */
/* YY=TransposeProductMM((TMatrix)NULL,Ui[j],Sigma); */
/* ZZ=ProductMM((TMatrix)NULL,YY,Ui[j]); */
/* printf("Computed[%d]\n",j); dw_PrintMatrix(stdout,ZZ,"%le "); printf("\n"); */
/* printf("File[%d]\n",j); dw_PrintMatrix(stdout,H0[j],"%le "); printf("\n"); */
/* max=0.0; */
/* for (ii=0; ii < RowM(ZZ); ii++) */
/* for (jj=0; jj < ColM(ZZ); jj++) */
/* if (max < fabs(ElementM(H0[j],ii,jj) - ElementM(ZZ,ii,jj))) max=fabs(ElementM(H0[j],ii,jj) - ElementM(ZZ,ii,jj)); */
/* printf("H0: max[%d] = %le\n",j,max); */
/* FreeMatrix(ZZ); */
/* FreeMatrix(YY); */
/* getc(stdin); */
/* } */
/* //swzExit(0); */
/* id="//== nps: nvar-by-1 ==//"; */
/* if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,n0s=dw_CreateArray_int(nvars))) ReadError_VARio_matlab(id); */
/* id="//== Hptldcell_inv: cell(nvar,1) and nps(i)-by-nps(i) for the ith cell ==//"; */
/* if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id); */
/* H0=dw_CreateArray_matrix(nvars); */
/* for (j=0; j < nvars; j++) */
/* if (!dw_ReadMatrix(f_in,H0[j]=CreateMatrix(n0s[j],n0s[j]))) ReadError_VARio_matlab(id); */
/* id="//== Vi: cell(nvar,1) and k*nStates-by-nps(i) for the ith cell ==//"; */
/* if (!dw_SetFilePosition(f_in,id)) ReadError_VARio_matlab(id); */
/* Ui=dw_CreateArray_matrix(nvars); */
/* for (j=0; j < nvars; j++) */
/* if (!dw_ReadMatrix(f_in,Ui[j]=CreateMatrix(npre*nstates,n0s[j]))) ReadError_VARio_matlab(id); */
/* Sigma=CreateMatrix(npre*nstates,npre*nstates); */
/* XX=CreateMatrix(npre,npre); */
/* for (j=0; j < nvars; j++) */
/* { */
/* InitializeMatrix(Sigma,0.0); */
/* Inverse_LU(XX,Aplus_prior[j]); */
/* for (i=0; i < nstates; i++) */
/* for (ii=0; ii < npre; ii++) */
/* for (jj=0; jj < npre; jj++) */
/* ElementM(Sigma,i*npre+ii,i*npre+jj)=ElementM(XX,ii,jj); */
/* YY=TransposeProductMM((TMatrix)NULL,Ui[j],Sigma); */
/* ZZ=ProductMM((TMatrix)NULL,YY,Ui[j]); */
/* max=0.0; */
/* for (ii=0; ii < RowM(ZZ); ii++) */
/* for (jj=0; jj < ColM(ZZ); jj++) */
/* if (max < fabs(ElementM(H0[j],ii,jj) - ElementM(ZZ,ii,jj))) max=fabs(ElementM(H0[j],ii,jj) - ElementM(ZZ,ii,jj)); */
/* printf("max[%d] = %le\n",j,max); */
/* FreeMatrix(ZZ); */
/* FreeMatrix(YY); */
/* getc(stdin); */
/* } */
/* swzExit(0); */
/* //=========================== Checks */
/* // Initialize Y ansi-c*/
id="//== Yleft -- Y: T-by-nvar ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,Y=CreateMatrix(nobs,nvars))) ReadError_VARio_matlab(id);
/* // Initialize X ansi-c*/
id="//== Xright -- X: T-by-ncoef ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,X=CreateMatrix(nobs,npre))) ReadError_VARio_matlab(id);
/* //=== Create T_VAR_Parameters structure === ansi-c*/
p=CreateTheta_VAR(SPEC_SIMS_ZHA | SPEC_RANDOM_WALK,nvars,nlags,nexg,nstates,nobs,coef_states,var_states,U,V,W,Y,X);
/* //=== Sims-Zha specification === ansi-c*/
id="//== glamdasig: sigma parameter for normal prior of lamda ==//";
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %lf ",&lambda_prior) != 1)) ReadError_VARio_matlab(id);
SetPriors_VAR_SimsZha(p,A0_prior,Aplus_prior,Zeta_a_prior,Zeta_b_prior,lambda_prior*lambda_prior);
/* //=== Close input file === ansi-c*/
fclose(f_in);
/* //=== Create TStateModel === ansi-c*/
return CreateStateModel_new(sv,CreateRoutines_VAR(),p);
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/

12
matlab/ms-sbvar/c-code/sbvar/var/VARio_matlab.h
View File

@ -1,12 +0,0 @@
#ifndef __VAR_INPUT_OUTPUT_MATLAB__
#define __VAR_INPUT_OUTPUT_MATLAB__
#include "switch.h"
#include "VARbase.h"
TStateModel* Combine_matlab_standard(char *inmatlab, char *instandard);
void ReadConstantParameters(char *filename, TStateModel *model);
TStateModel* CreateStateModel_VAR_matlab(char *filename);
#endif

552
matlab/ms-sbvar/c-code/sbvar/var/command_line_VAR.c
View File

@ -1,552 +0,0 @@
#include "command_line_VAR.h"
#include "VARio.h"
#include "switchio.h"
#include "dw_error.h"
#include "dw_parse_cmd.h"
#include "dw_ascii.h"
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "modify_for_mex.h"
/*
Allocates memory for filename. Assumes that fmt is of the form
%s*%s*
where the first %s will be filled with dir and the second will be
filled with tag. If either dir or tag is a null pointer, then the
the empty string will be used. The calling routine must free the
returned pointer.
*/
char* CreateFilenameFromTag(char *fmt, char *tag, char *dir)
{
char *filename;
if (!tag) tag="";
if (!dir) dir="";
sprintf(filename=(char*)swzMalloc(strlen(dir) + strlen(fmt) + strlen(tag) - 3),fmt,dir,tag);
return filename;
}
/*
Create a full path name by appending a "/" if necessary. The
returned pathname must be freed by he calling routine.
*/
char* CreatePath(char *path)
{
#define DIR_DELIMITER '\\'
char *fullpath;
int n;
if (!path) path="";
n=(int)strlen(path);
if (path[0] && path[n-1] != DIR_DELIMITER)
{
memcpy(fullpath=(char*)swzMalloc(n+2),path,n);
fullpath[n]=DIR_DELIMITER;
fullpath[n+1]='\0';
}
else
fullpath=dw_DuplicateString(path);
return fullpath;
#undef DIR_DELIMITER
}
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
static char *help_options[]={"-di","-do","-fs","-fp","-ph","-pho","-MLE","-ft","-fto",(char*)NULL};
static char *help_messages[]=
{
"-di <directory>",
"If this argument exists, then all input files are in specified directory.",
"-do <directory>",
"If this argument exists, then all output files are in specified directory.",
"-fs <filename>",
"If this argument exists, then the specification file name is <filename>.",
"-fp <filename>",
"If this argument exists, then the parameter file name is <filename>.",
"-ph <header>",
"If this argument exists, then the parameter header is <header>. The default value is \"Posterior mode: \", unless -MLE is in the command line, in which case it is \"MLE: \".",
"-pho <header>",
"If this argument exists, then the parameter header used for output is <header>. The default value is -ph <header>.",
"-MLE",
"If this augument exists, them \"MLE: \" is the default value for -ph.",
"-ft <tag>",
"The input file tag. Used to create input filenames if the -fs or -fp options are not present.",
"-fto <tag>",
"The output file tag. Used to create output filenames. The default value is -ft <tag>.",
(char*)NULL,
(char*)NULL
};
static int Match(char *option, char **list, int step)
{
int n=0, i=0;
while (option[n] && !isspace(option[n])) n++;
if (n > 0)
while (list[i])
if (memcmp(option,list[i],n))
i+=step;
else
return i;
return -1;
}
static void PrintMessage(FILE *f, char *msg)
{
#define LL 76
int k;
char line[LL];
while (1)
{
while (*msg && isspace(*msg)) msg++;
if (!(*msg)) return;
strncpy(line,msg,LL);
k=LL-1;
if (!line[k])
{
fprintf(f," %s\n",line);
return;
}
if (isspace(line[k]))
{
line[k]='\0';
msg+=k+1;
}
else
{
for ( ; k > 0 && !isspace(line[k-1]); k--);
if (k == 0) k=LL-1;
line[k]='\0';
msg+=k;
}
fprintf(f," %s\n",line);
}
#undef LL
}
void PrintHelpMessages(FILE *f, char **include, char **additional)
{
int i, j;
if (!f) return;
if (include)
{
i=0;
while (include[i])
if ((j=Match(include[i++],help_messages,2)) != -1)
{
fprintf(f," %s\n",help_messages[j]);
PrintMessage(f,help_messages[j+1]);
}
}
else
{
i=0;
while (help_messages[i])
{
fprintf(f," %s\n",help_messages[i++]);
PrintMessage(f,help_messages[i++]);
}
}
if (additional)
{
i=0;
while (additional[i])
{
fprintf(f," %s\n",additional[i++]);
PrintMessage(f,additional[i++]);
}
}
}
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
TVARCommandLine* Create_VARCommandLine(void)
{
TVARCommandLine *cmd=(TVARCommandLine*)swzMalloc(sizeof(TVARCommandLine));
if (cmd)
{
cmd->out_directory=(char*)NULL;
cmd->in_directory=(char*)NULL;
cmd->in_tag=(char*)NULL;
cmd->out_tag=(char*)NULL;
cmd->out_header=(char*)NULL;
cmd->specification_filename=(char*)NULL;
cmd->parameters_filename=(char*)NULL;
cmd->parameters_header=(char*)NULL;
cmd->specification_filename_actual=(char*)NULL;
cmd->parameters_filename_actual=(char*)NULL;
cmd->parameters_header_actual=(char*)NULL;
}
return cmd;
}
void Free_VARCommandLine(TVARCommandLine *cmd)
{
if (cmd)
{
if (cmd->out_directory) swzFree(cmd->out_directory);
if (cmd->in_directory) swzFree(cmd->in_directory);
if (cmd->in_tag) swzFree(cmd->in_tag);
if (cmd->out_tag) swzFree(cmd->out_tag);
if (cmd->out_header) swzFree(cmd->out_header);
if (cmd->specification_filename) swzFree(cmd->specification_filename);
if (cmd->parameters_filename) swzFree(cmd->parameters_filename);
if (cmd->parameters_header) swzFree(cmd->parameters_header);
if (cmd->specification_filename_actual) swzFree(cmd->specification_filename_actual);
if (cmd->parameters_filename_actual) swzFree(cmd->parameters_filename_actual);
if (cmd->parameters_header_actual) swzFree(cmd->parameters_header_actual);
}
}
/*
-di <directory>
If this argument exists, then all input files are in specified directory.
-do <directory>
If this argument exists, then all output files are in specified directory.
-fs <filename>
If this argument exists, then the specification file name is <filename>.
The argument -fs takes precedence over -ft.
-fp <filename>
If this argument exists, then the parameter file name is <filename>. The
default value is the filename associated with the argument -fs or -ft.
-ph <header>
If this argument exists, then the header for the parameters is <header>.
The default value is "MLE: " if -MLE is in the command line and
"Posterior mode: " otherwise.
-pho <header>
If this argument exists, then the parameter header used for output is
<header>. The default value is -ph <header>.
-MLE
If this augument exists, default value for the parameters header is "MLE: ".
This assumes that the estimate file was produced via a maximum likelihood
estimate.
-ft <tag>
The input file tag. Used to create input filenames if the -fs or
-fp options are not present.
-fto <tag>
The output file tag. Used to create output filenames. The default
value is -ft <tag>.
*/
TVARCommandLine* Base_VARCommandLine(int nargs, char **args, TVARCommandLine *cmd)
{
if (!cmd && !(cmd=Create_VARCommandLine())) return (TVARCommandLine*)NULL;
/* // input directory ansi-c*/
cmd->in_directory=CreatePath(dw_ParseString_String(nargs,args,"di",""));
/* // output directory ansi-c*/
cmd->out_directory=CreatePath(dw_ParseString_String(nargs,args,"do",""));
/* // Specification file ansi-c*/
cmd->specification_filename=dw_DuplicateString(dw_ParseString_String(nargs,args,"fs",(char*)NULL));
/* // Parameters file ansi-c*/
cmd->parameters_filename=dw_DuplicateString(dw_ParseString_String(nargs,args,"fp",(char*)NULL));
/* // Parameter header ansi-c*/
cmd->parameters_header=dw_DuplicateString((dw_FindArgument_String(nargs,args,"MLE") == -1)
? dw_ParseString_String(nargs,args,"ph","Posterior mode: ")
: dw_ParseString_String(nargs,args,"ph","MLE: "));
/* // Output parameters header ansi-c*/
cmd->out_header=dw_DuplicateString(dw_ParseString_String(nargs,args,"ph",cmd->parameters_header));
/* // Input file tag ansi-c*/
cmd->in_tag=dw_DuplicateString(dw_ParseString_String(nargs,args,"ft",(char*)NULL));
/* // Output file tag ansi-c*/
cmd->out_tag=dw_DuplicateString(dw_ParseString_String(nargs,args,"fto",cmd->in_tag));
return cmd;
}
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
TStateModel* CreateTStateModelFromEstimateFinal(int nargs, char **args, TVARCommandLine **p_cmd)
{
TStateModel *model=(TStateModel*)NULL;
char *filename;
TVARCommandLine *cmd;
if (!(*p_cmd) && !(*p_cmd=Base_VARCommandLine(nargs,args,*p_cmd))) return (TStateModel*)NULL;
cmd=*p_cmd;
if (cmd->specification_filename)
{
filename=CreateFilenameFromTag("%s%s",cmd->specification_filename,cmd->in_directory);
if (!(model=Read_VAR_Specification((FILE*)NULL,filename)))
{
swzFree(filename);
return (TStateModel*)NULL;
}
}
else
if (cmd->in_tag)
{
filename=CreateFilenameFromTag("%sest_final_%s.dat",cmd->in_tag,cmd->in_directory);
if (!(model=Read_VAR_Specification((FILE*)NULL,filename)))
{
swzFree(filename);
return (TStateModel*)NULL;
}
}
else
return (TStateModel*)NULL;
if (cmd->specification_filename_actual) swzFree(cmd->specification_filename_actual);
cmd->specification_filename_actual=filename;
filename=(cmd->parameters_filename)
? CreateFilenameFromTag("%s%s",cmd->parameters_filename,cmd->in_directory)
: dw_DuplicateString(cmd->specification_filename_actual);
if (!ReadTransitionMatrices((FILE*)NULL,filename,cmd->parameters_header,model)
|| !Read_VAR_Parameters((FILE*)NULL,filename,cmd->parameters_header,model))
{
swzFree(filename);
FreeStateModel(model);
return (TStateModel*)NULL;
}
if (cmd->parameters_filename_actual) swzFree(cmd->parameters_filename_actual);
cmd->parameters_filename_actual=filename;
if (cmd->parameters_header_actual) swzFree(cmd->parameters_header_actual);
cmd->parameters_header_actual=dw_DuplicateString(cmd->parameters_header);
return model;
}
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
/*
Attempts to get the parameters from the last iteration in the intermediate
file. Returns one and sets cmd->parameters_file_actual,
cmd->parameters_header_actual and loads parameters upon success. Returns
zero upon failure.
*/
int GetLastIteration(TStateModel *model, TVARCommandLine *cmd)
{
char *filename, *header, *fmt="Iteration %d: ";
int rtrn=0, cont, terminal_errors, i, j, k=1;
FILE *f_in;
filename=CreateFilenameFromTag("%sest_intermediate_%s.dat",cmd->in_tag,cmd->in_directory);
if (!(f_in=fopen(filename,"rt")))
{
swzFree(filename);
return 0;
}
terminal_errors=dw_SetTerminalErrors(dw_GetTerminalErrors() & (~USER_ERR));
do
{
for (j=10, i=1; k >= j; j*=10, i++);
sprintf(header=(char*)swzMalloc(strlen(fmt) + i - 1),fmt,k);
if (ReadTransitionMatrices(f_in,(char*)NULL,header,model)
&& Read_VAR_Parameters(f_in,(char*)NULL,header,model))
{
cont=1;
swzFree(header);
k++;
}
else
cont=0;
}
while (cont);
if (k > 1)
{
k--;
for (j=10, i=1; k >= j; j*=10, i++);
sprintf(header=(char*)swzMalloc(strlen(fmt) + i - 1),fmt,k);
if (ReadTransitionMatrices(f_in,(char*)NULL,header,model) && Read_VAR_Parameters(f_in,(char*)NULL,header,model))
{
if (cmd->parameters_filename_actual) swzFree(cmd->parameters_filename_actual);
cmd->parameters_filename_actual=filename;
if (cmd->parameters_header_actual) swzFree(cmd->parameters_header_actual);
cmd->parameters_header_actual=header;
dw_SetTerminalErrors(terminal_errors);
return 1;
}
}
else
{
header="Initial: ";
if (ReadTransitionMatrices(f_in,(char*)NULL,header,model) && Read_VAR_Parameters(f_in,(char*)NULL,header,model))
{
if (cmd->parameters_filename_actual) swzFree(cmd->parameters_filename_actual);
cmd->parameters_filename_actual=filename;
if (cmd->parameters_header_actual) swzFree(cmd->parameters_header_actual);
cmd->parameters_header_actual=dw_DuplicateString(header);
dw_SetTerminalErrors(terminal_errors);
return 1;
}
}
swzFree(filename);
dw_SetTerminalErrors(terminal_errors);
return 0;
}
/*
Attempt to set up model from command line.
-ft <filename tag>
If this argument exists, then the following is attempted:
specification file name: est_final_<tag>.dat
init/restart file name: est_final_<tag>.dat with header="Posterior mode: "
specification file name: init_<tag>.dat
init/restart file name: est_intermediate_<tag>.dat with header="Iteration %d: "
(not yet implemented)
specification file name: init_<tag>.dat
init/restart file name: est_csminwel_<tag>.dat
specification file name: init_<tag>.dat
init/restart file name: init_<tag>.dat with header="Initial: "
Returns valid pointer to a TStateModel upon success and null upon failure.
*/
TStateModel* CreateTStateModelForEstimate(int nargs, char **args, TVARCommandLine **p_cmd)
{
TStateModel *model;
char *filename, *header;
int terminal_errors;
TVARCommandLine *cmd;
terminal_errors=dw_SetTerminalErrors(dw_GetTerminalErrors() & (~USER_ERR));
if (!(*p_cmd) && !(*p_cmd=Base_VARCommandLine(nargs,args,*p_cmd))) return (TStateModel*)NULL;
cmd=*p_cmd;
if (cmd->specification_filename)
{
filename=CreateFilenameFromTag("%s%s",cmd->specification_filename,cmd->in_directory);
if (!(model=Read_VAR_Specification((FILE*)NULL,filename)))
{
swzFree(filename);
dw_SetTerminalErrors(terminal_errors);
return (TStateModel*)NULL;
}
}
else
if (cmd->in_tag)
{
filename=CreateFilenameFromTag("%sest_final_%s.dat",cmd->in_tag,cmd->in_directory);
if (!(model=Read_VAR_Specification((FILE*)NULL,filename)))
{
swzFree(filename);
filename=CreateFilenameFromTag("%sinit_%s.dat",cmd->in_tag,cmd->in_directory);
if (!(model=Read_VAR_Specification((FILE*)NULL,filename)))
{
swzFree(filename);
dw_SetTerminalErrors(terminal_errors);
return (TStateModel*)NULL;
}
}
}
else
{
dw_SetTerminalErrors(terminal_errors);
return (TStateModel*)NULL;
}
if (cmd->specification_filename_actual) swzFree(cmd->specification_filename_actual);
cmd->specification_filename_actual=filename;
if (cmd->parameters_filename)
{
header=cmd->parameters_header;
filename=CreateFilenameFromTag("%s%s",cmd->parameters_filename,cmd->in_directory);
if (!ReadTransitionMatrices((FILE*)NULL,filename,header,model)
|| !Read_VAR_Parameters((FILE*)NULL,filename,header,model))
{
swzFree(filename);
FreeStateModel(model);
dw_SetTerminalErrors(terminal_errors);
return (TStateModel*)NULL;
}
}
else
if (cmd->specification_filename)
{
header=cmd->parameters_header;
filename=CreateFilenameFromTag("%s%s",cmd->specification_filename,cmd->in_directory);
if (!ReadTransitionMatrices((FILE*)NULL,filename,header,model)
|| !Read_VAR_Parameters((FILE*)NULL,filename,header,model))
{
swzFree(filename);
FreeStateModel(model);
dw_SetTerminalErrors(terminal_errors);
return (TStateModel*)NULL;
}
}
else
if (cmd->in_tag)
{
header=cmd->parameters_header;
filename=filename=CreateFilenameFromTag("%sest_final_%s.dat",cmd->in_tag,cmd->in_directory);
if (!ReadTransitionMatrices((FILE*)NULL,filename,header,model)
|| !Read_VAR_Parameters((FILE*)NULL,filename,header,model))
{
swzFree(filename);
if (GetLastIteration(model,cmd))
{
dw_SetTerminalErrors(terminal_errors);
return model;
}
else
{
header="Initial: ";
filename=filename=CreateFilenameFromTag("%sinit_%s.dat",cmd->in_tag,cmd->in_directory);
if (!ReadTransitionMatrices((FILE*)NULL,filename,header,model)
|| !Read_VAR_Parameters((FILE*)NULL,filename,header,model))
{
FreeStateModel(model);
dw_SetTerminalErrors(terminal_errors);
return (TStateModel*)NULL;
}
}
}
}
if (cmd->parameters_filename_actual) swzFree(cmd->parameters_filename_actual);
cmd->parameters_filename_actual=filename;
if (cmd->parameters_header_actual) swzFree(cmd->parameters_header_actual);
cmd->parameters_header_actual=dw_DuplicateString(header);
dw_SetTerminalErrors(terminal_errors);
return model;
}
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/

37
matlab/ms-sbvar/c-code/sbvar/var/command_line_VAR.h
View File

@ -1,37 +0,0 @@
#ifndef __command_line_VAR
#define __command_line_VAR
#include "switch.h"
#include <stdio.h>
char* CreateFilenameFromTag(char *fmt, char *tag, char *dir);
char* CreatePath(char *path);
void PrintHelpMessages(FILE *f, char **include, char **additional);
typedef struct
{
char *in_directory; /* -di ansi-c*/
char *in_tag; /* -ft ansi-c*/
char *specification_filename; /* -fs ansi-c*/
char *parameters_filename; /* -fp ansi-c*/
char *parameters_header; /* -ph ansi-c*/
char *specification_filename_actual;
char *parameters_filename_actual;
char *parameters_header_actual;
char *out_directory; /* -do ansi-c*/
char *out_tag; /* -fto (default from -ft) ansi-c*/
char *out_header; /* -pho (default from -ph) ansi-c*/
} TVARCommandLine;
TVARCommandLine* Create_VARCommandLine(void);
void Free_VARCommandLine(TVARCommandLine *cmd);
TVARCommandLine* Base_VARCommandLine(int nargs, char **args, TVARCommandLine *cmd);
void EstimateFinal_VARCommandLine_Help(FILE *f);
TStateModel* CreateTStateModelFromEstimateFinal(int nargs, char **args, TVARCommandLine **p_cmd);
TStateModel* CreateTStateModelForEstimate(int nargs, char **args, TVARCommandLine **p_cmd);
#endif

44
matlab/ms-sbvar/c-code/sbvar/var/create_init_file.c
View File

@ -1,44 +0,0 @@
#include "switch.h"
#include "switchio.h"
#include "VARbase.h"
#include "VARio.h"
#include "VARio_matlab.h"
#include "dw_error.h"
#include "dw_ascii.h"
#include <stdlib.h>
#include <string.h>
#include "modify_for_mex.h"
/*
Creates a standard initialization file from the matlab and specification file.
*/
int main(int nargs, char **args)
{
TStateModel *model;
FILE *f_out;
char *filename, *fmt="init_%s.dat", *header="Initial: ";
dw_SetTerminalErrors(ALL_ERRORS);
dw_SetVerboseErrors(ALL_ERRORS);
if (nargs != 4)
{
swz_fprintf_err("Syntax:\n create_init_file <matlab filename> <specs filename> <file tag>\n");
swzExit(0);
}
model=Combine_matlab_standard(args[1],args[2]);
ReadConstantParameters(args[1],model);
sprintf(filename=(char*)swzMalloc(strlen(fmt) + strlen(args[3]) - 1),fmt,args[3]);
f_out=dw_CreateTextFile(filename);
Write_VAR_Specification(f_out,(char*)NULL,model);
WriteTransitionMatrices(f_out,(char*)NULL,header,model);
Write_VAR_Parameters(f_out,(char*)NULL,header,model);
fclose(f_out);
FreeStateModel(model);
return 0;
}

722
matlab/ms-sbvar/c-code/sbvar/var/estimate.c
View File

@ -1,722 +0,0 @@
#include "switch.h"
#include "switchio.h"
#include "switch_opt.h"
#include "VARbase.h"
#include "VARio.h"
#include "dw_error.h"
#include "dw_ascii.h"
#include "dw_parse_cmd.h"
#include "dw_rand.h"
#include "command_line_VAR.h"
#include "optpackage.h"
/* //#include "csminwel.h" ansi-c*/
/* //#include "dw_csminwel.h" ansi-c*/
#include <time.h>
#include <string.h>
#include <stdlib.h>
#include <math.h>
#include "modify_for_mex.h"
#define FIND_POSTERIOR_MODE 1
#define FIND_LIKELIHOOD_MODE 2
typedef struct
{
int type;
TVARCommandLine *cmd;
char *csminwel_output_filename;
char *intermediate_output_filename;
PRECISION criterion_start;
PRECISION criterion_end;
PRECISION criterion_increment;
int max_iterations_start;
PRECISION max_iterations_increment;
int max_block_iterations;
} TEstimateInfo;
void FindMode_VAR_csminwel(TStateModel *model, TEstimateInfo *estimate)
{
int iteration, total_iteration, i, j, size_VAR, pos_VAR, size_Q, pos_Q;
double objective, objective_last, likelihood, prior;
int **block;
FILE *f_out;
char *header, *fmt="Iteration %d: ";
/* // csminwel arguments ansi-c*/
int itct, fcount, retcodeh, nit;
double *x, fh, crit;
TMatrix H;
TVector g;
f_out=dw_CreateTextFile(estimate->intermediate_output_filename);
/* //==== Allocate memory === ansi-c*/
size_VAR=NumberFreeParametersTheta(model);
size_Q=NumberFreeParametersQ(model);
pos_VAR=0;
pos_Q=size_VAR;
x=(double*)swzMalloc((size_VAR + size_Q)*sizeof(double));
/* //=== Set starting value === ansi-c*/
ConvertQToFreeParameters(model,x+pos_Q);
ConvertThetaToFreeParameters(model,x+pos_VAR);
/* //=== Set csminwel output file === ansi-c*/
csminwel_SetPrintFile(estimate->csminwel_output_filename);
/* //=== Print Initial Values === ansi-c*/
fprintf(f_out,"\n//=== Initial Values ===//\n");
fprintf(f_out,"Likelihood value: %22.14le\n",objective=likelihood=LogLikelihood_StatesIntegratedOut(model));
fprintf(f_out,"Prior value: %22.14le\n",prior=LogPrior(model));
fprintf(f_out,"Posterior value: %22.14le\n\n",likelihood+prior);
header="Initial: ";
WriteTransitionMatrices(f_out,(char*)NULL,header,model);
Write_VAR_Parameters(f_out,(char*)NULL,header,model);
fflush(f_out);
/* //=== Create blocking structure === ansi-c*/
block=dw_CreateRectangularArray_int(2,2);
block[0][0]=size_VAR; block[0][1]=pos_VAR;
block[1][0]=size_Q; block[1][1]=pos_Q;
/* //=== Objective === ansi-c*/
if (estimate->type == FIND_POSTERIOR_MODE)
objective=likelihood+prior;
else
objective=likelihood;
for (total_iteration=1, crit=estimate->criterion_start, nit=estimate->max_iterations_start;
crit >= estimate->criterion_end;
crit*=estimate->criterion_increment, nit*=(int)estimate->max_iterations_increment)
{
for (iteration=1; iteration <= estimate->max_block_iterations; total_iteration++, iteration++)
{
objective_last=objective;
fprintf(f_out,"\n\n//=== Iteration %d ===//\n",total_iteration);
fprintf(f_out,"Criterion/Max Iteration: %le %d\n",crit,nit);
fprintf(f_out,"Previous likelihood value: %22.14le\n",likelihood);
fprintf(f_out,"Previous prior value: %22.14le\n",prior);
fprintf(f_out,"Previous posterior value: %22.14le\n\n",prior+likelihood);
fflush(f_out);
for (i=0; i < dw_DimA(block); i++)
if (block[i][0] > 0)
{
g=CreateVector(block[i][0]);
H=IdentityMatrix((TMatrix)NULL,block[i][0]);
ProductMS(H,H,INI_H_CSMINWEL);
SetupObjectiveFunction(model,x+block[i][1],x+pos_Q,x+pos_VAR);
if (estimate->type == FIND_POSTERIOR_MODE)
csminwel(PosteriorObjectiveFunction_csminwel,x+block[i][1],block[i][0],pElementM(H),pElementV(g),NULL,
&fh,crit,&itct,nit,&fcount,&retcodeh,NULL,NULL);
else
csminwel(MLEObjectiveFunction_csminwel,x+block[i][1],block[i][0],pElementM(H),pElementV(g),NULL,
&fh,crit,&itct,nit,&fcount,&retcodeh,NULL,NULL);
ConvertFreeParametersToQ(model,x+pos_Q);
ConvertFreeParametersToTheta(model,x+pos_VAR);
FreeMatrix(H);
FreeVector(g);
fprintf(f_out,"Likelihood value after pass %d: %22.14le\n",i,likelihood=LogLikelihood_StatesIntegratedOut(model));
fprintf(f_out,"Prior value after pass %d: %22.14le\n",i,prior=LogPrior(model));
fprintf(f_out,"Posterior value after pass %d: %22.14le\n",i,likelihood+prior);
fprintf(f_out,"Csminwel return code: %d\n\n",retcodeh);
fflush(f_out);
}
for (j=10, i=1; total_iteration >= j; j*=10, i++);
sprintf(header=(char*)swzMalloc(strlen(fmt) + i - 1),fmt,total_iteration);
WriteTransitionMatrices(f_out,(char*)NULL,header,model);
Write_VAR_Parameters(f_out,(char*)NULL,header,model);
swzFree(header);
fflush(f_out);
if (estimate->type == FIND_POSTERIOR_MODE)
objective=likelihood+prior;
else
objective=likelihood;
if (fabs(objective - objective_last) <= crit) break;
}
objective_last=objective;
fprintf(f_out,"\n\n//=== Iteration %d ===//\n",++total_iteration);
fprintf(f_out,"Criterion/Max Iteration: %le %d\n",crit,nit);
fprintf(f_out,"Previous likelihood value: %22.14le\n",likelihood);
fprintf(f_out,"Previous prior value: %22.14le\n",prior);
fprintf(f_out,"Previous posterior value: %22.14le\n\n",prior+likelihood);
fflush(f_out);
g=CreateVector(pos_Q+pos_VAR);
H=IdentityMatrix((TMatrix)NULL,pos_Q+pos_VAR);
ProductMS(H,H,INI_H_CSMINWEL);
SetupObjectiveFunction(model,x,x+pos_Q,x+pos_VAR);
if (estimate->type == FIND_POSTERIOR_MODE)
csminwel(PosteriorObjectiveFunction_csminwel,x,pos_Q+pos_VAR,pElementM(H),pElementV(g),NULL,
&fh,crit,&itct,nit,&fcount,&retcodeh,NULL,NULL);
else
csminwel(MLEObjectiveFunction_csminwel,x,pos_Q+pos_VAR,pElementM(H),pElementV(g),NULL,
&fh,crit,&itct,nit,&fcount,&retcodeh,NULL,NULL);
ConvertFreeParametersToQ(model,x+pos_Q);
ConvertFreeParametersToTheta(model,x+pos_VAR);
FreeMatrix(H);
FreeVector(g);
fprintf(f_out,"Likelihood value: %22.14le\n",likelihood=LogLikelihood_StatesIntegratedOut(model));
fprintf(f_out,"Prior value: %22.14le\n",prior=LogPrior(model));
fprintf(f_out,"Posterior value: %22.14le\n",likelihood+prior);
fprintf(f_out,"Csminwel return code: %d\n\n",retcodeh);
fflush(f_out);
for (j=10, i=1; total_iteration >= j; j*=10, i++);
sprintf(header=(char*)swzMalloc(strlen(fmt) + i - 1),fmt,total_iteration);
WriteTransitionMatrices(f_out,(char*)NULL,header,model);
Write_VAR_Parameters(f_out,(char*)NULL,header,model);
swzFree(header);
fflush(f_out);
if (estimate->type == FIND_POSTERIOR_MODE)
objective=likelihood+prior;
else
objective=likelihood;
}
/* //=== Free memory === ansi-c*/
swzFree(x);
dw_FreeArray(block);
/* //=== Close File === ansi-c*/
fclose(f_out);
}
/*
filename -
*
char** ReadInputFile(char *filename)
{
char **args=(char**)NULL;
char ***X;
int i, j, n;
X=dw_ReadDelimitedFile((FILE*)NULL,filename,' ',REMOVE_EMPTY_FIELDS | STRIP_WHITESPACE);
if (X)
{
for (n=i=0; i < dw_DimA(X); i++)
if (X[i]) n+=dw_DimA(X[i]);
if (n > 0)
{
args=dw_CreateArray_string(n);
for (n=i=0; i < dw_DimA(X); i++)
if (X[i])
for (j=0; j < dw_DimA(X[i]); j++)
{
args[n]=X[i][j];
X[i][j]=(char*)NULL;
}
}
dw_FreeArray(X);
}
return args;
}*/
/*
Attempts to load parameters from given file.
*
int LoadParameters(FILE *f, char *filename, TStateModel *model)
{
int i, terminal_errors, rtrn=0;
char *header[5]={"","Initial: ","Current: ","Posterior mode: ","MLE: "};
FILE *f_in=f ? f : dw_OpenTextFile(filename);
terminal_errors=dw_SetTerminalErrors(ALL_ERRORS & (~USER_ERR));
for (i=0; i < 5; i++)
if (ReadTransitionMatrices(f_in,(char*)NULL,header[i],model) && Read_VAR_Parameters(f_in,(char*)NULL,header[i],model))
{
rtrn=1;
break;
}
dw_SetTerminalErrors(terminal_errors);
if (!f) fclose(f_in);
return rtrn;
}*/
/*
Attempts to get the parameters from the last iteration in the intermediate file.
*
int GetLastIteration(FILE *f_in, TStateModel *model, TEstimateInfo *estimate)
{
char *id, *header, *fmt="//=== Iteration %d ===//";
int terminal_errors, i, j, k=0;
while (1)
{
for (j=10, i=1; k+1 >= j; j*=10, i++);
sprintf(id=(char*)swzMalloc(strlen(fmt) + i - 1),fmt,k+1);
if (!dw_SetFilePosition(f_in,id))
{
swzFree(id);
terminal_errors=dw_SetTerminalErrors(ALL_ERRORS & (~USER_ERR));
fmt="Iteration %d: ";
while (k > 0)
{
for (j=10, i=1; k >= j; j*=10, i++);
sprintf(header=(char*)swzMalloc(strlen(fmt) + i - 1),fmt,k);
if (ReadTransitionMatrices(f_in,(char*)NULL,header,model) && Read_VAR_Parameters(f_in,(char*)NULL,header,model))
{
printf("Using intermediate output - %s\n",header);
estimate->initialization_header=header;
dw_SetTerminalErrors(terminal_errors);
return 1;
}
swzFree(header);
k--;
}
dw_SetTerminalErrors(terminal_errors);
return 0;
}
swzFree(id);
k++;
}
}
/*
Attempt to set up model from command line. Command line options are the following
-di <directory>
If this argument exists, then all input files are in specified directory.
-ft <filename tag>
If this argument exists, then the following is attempted:
specification file name: est_final_<tag>.dat
init/restart file name: est_final_<tag>.dat with header="Posterior mode: "
specification file name: init_<tag>.dat
init/restart file name: est_intermediate_<tag>.dat with header="Iteration %d: "
(not yet implemented)
specification file name: init_<tag>.dat
init/restart file name: est_csminwel_<tag>.dat
specification file name: init_<tag>.dat
init/restart file name: init_<tag>.dat with header="Initial: "
Failure to load both the specification and restart/init files causes the routine to exit.
-fs <filename>
If this argument exists, then the specification file name is <filename>. The argument -ft
takes precedence over -fs.
-fr <filename>
If this argument exists, then the init/restart file name is <filename>. Must be used in
conjunction with the argument -fs. The default value is the filename associated with the
argument -fs.
-rh <header>
If this argument exists, then the header for the init/restart file is <header>. Must be
used in conjuction with the arguments -fr or -fs. The default value is "".
If no command line options are given, then attemps to use a default input file
with the name "default.ini". Returns one valid pointer to a TStateModel upon
success and null upon failure.
*
TStateModel* GetModelFromCommandLine(int nargs, char **args, TEstimateInfo *estimate)
{
TStateModel *model;
char *d1, *d2, *tag, *header, *filename, *fmt;
FILE *f_in;
d1=dw_ParseString_String(nargs,args,"di","");
if (d1[0] && d1[strlen(d1)-1] != '/')
{
d2=(char*)swzMalloc(strlen(d1)+2);
strcat(strcpy(d2,d1),"/");
d1=d2;
}
else
d2=(char*)NULL;
if (tag=dw_ParseString_String(nargs,args,"ft",(char*)NULL))
{
fmt="%sest_final_%s.dat";
sprintf(filename=(char*)swzMalloc(strlen(d1) + strlen(fmt) + strlen(tag) - 3),fmt,d1,tag);
if (f_in=fopen(filename,"rt"))
{
model=Read_VAR_Specification(f_in,(char*)NULL);
header=dw_ParseString_String(nargs,args,"rh","Posterior mode: ");
ReadTransitionMatrices(f_in,(char*)NULL,header,model);
Read_VAR_Parameters(f_in,(char*)NULL,header,model);
fclose(f_in);
printf("Using final output\n");
estimate->specification_filename=filename;
estimate->initialization_filename=filename;
estimate->initialization_header=header;
if (d2) swzFree(d2);
return model;
}
swzFree(filename);
fmt="%sinit_%s.dat";
sprintf(filename=(char*)swzMalloc(strlen(d1) + strlen(fmt) + strlen(tag) - 3),fmt,d1,tag);
if (f_in=fopen(filename,"rt"))
{
model=Read_VAR_Specification(f_in,(char*)NULL);
estimate->specification_filename=filename;
fclose(f_in);
fmt="%sest_intermediate_%s.dat";
sprintf(filename=(char*)swzMalloc(strlen(d1) + strlen(fmt) + strlen(tag) - 3),fmt,d1,tag);
if (f_in=fopen(filename,"rt"))
{
if (GetLastIteration(f_in,model,estimate))
{
fclose(f_in);
estimate->initialization_filename=filename;
if (d2) swzFree(d2);
return model;
}
fclose(f_in);
}
swzFree(filename);
fmt="%sinit_%s.dat";
sprintf(filename=(char*)swzMalloc(strlen(d1) + strlen(fmt) + strlen(tag) - 3),fmt,d1,tag);
if (f_in=fopen(filename,"rt"))
{
header=dw_ParseString_String(nargs,args,"rh","Initial: ");
ReadTransitionMatrices(f_in,(char*)NULL,header,model);
Read_VAR_Parameters(f_in,(char*)NULL,header,model);
fclose(f_in);
printf("Using initial data\n");
estimate->initialization_filename=filename;
estimate->initialization_header=header;
if (d2) swzFree(d2);
return model;
}
FreeStateModel(model);
}
swzFree(filename);
//if (d2) swzFree(d2);
//swz_fprintf_err("GetModelFromCommandLine(): Unable to create model.\n");
goto ERROR;
}
if (tag=dw_ParseString_String(nargs,args,"fs",(char*)NULL))
{
sprintf(filename=(char*)swzMalloc(strlen(d1) + strlen(tag) + 1),"%s%s",d1,tag);
model=Read_VAR_Specification((FILE*)NULL,filename);
estimate->specification_filename=filename;
if (!(tag=dw_ParseString_String(nargs,args,"fr",(char*)NULL)))
tag=dw_ParseString_String(nargs,args,"fs",(char*)NULL);
sprintf(filename=(char*)swzMalloc(strlen(d1) + strlen(tag) + 1),"%s%s",d1,tag);
header=dw_ParseString_String(nargs,args,"rh","");
ReadTransitionMatrices((FILE*)NULL,filename,header,model);
Read_VAR_Parameters((FILE*)NULL,filename,header,model);
estimate->initialization_filename=filename;
estimate->initialization_header=header;
if (d2) swzFree(d2);
return model;
}
ERROR:
if (d2) swzFree(d2);
//swz_fprintf_err("GetModelFromCommandLine(): No specification file defined.\n");
return (TStateModel*)NULL;
}
/*
Attempt to set up model from command line. Command line options are the following
-do <directory>
If this argument exists, then all output files are put in the specified directory.
-fo <filename tag>
If this argument exists, then the output files are
est_csminwel_<tag>.dat
est_intermediate_<tag>.dat
est_final_<tag>.dat
The default value is the filename tag associated with the argument -ft if it exists. Otherwise
it is "default".
//--- this is yet to be implemented
-fa <filename>
Aux output file. The default value is est_aux_<filename tag>.dat.
-MLE
Find the maximum likelihood estimate
-PM (default)
Find the posterior mode
-cb <floating point number> (default = 1.0e-3)
Beginning csminwel exit criterion
-ce <floating point number> (default = 1.03-6)
Ending csminwel exit criterion
-ci <floating point number> (default = 0.1)
csminwel exit criterion increment multiplier
-ib <integer> (default = 50)
Beginning csminwel maximum iteration value
-ii <floating point number> (default = 2)
csminwel maximum interation increment multiplier
If no command line options are given, then attemps to use a default input file
with the name "default.ini". Returns one valid pointer to a TStateModel upon
success and null upon failure.
*
TEstimateInfo* GetEstimateInfoFromCommandLine(int nargs, char **args) //, TStateModel* model)
{
TEstimateInfo *estimate;
char *d1, *d2, *tag, *fmt;
estimate=(TEstimateInfo*)swzMalloc(sizeof(TEstimateInfo));
// Output directory
d1=dw_ParseString_String(nargs,args,"di","");
if (d1[0] && d1[strlen(d1)-1] != '/')
{
d2=(char*)swzMalloc(strlen(d1)+2);
strcat(strcpy(d2,d1),"/");
d1=d2;
}
else
d2=(char*)NULL;
// Output filenames
if (!(tag=dw_ParseString_String(nargs,args,"fo",(char*)NULL)))
tag=dw_ParseString_String(nargs,args,"ft","default");
fmt="%sest_csminwel_%s.dat";
sprintf(estimate->csminwel_output_filename=(char*)swzMalloc(strlen(d1) + strlen(fmt) + strlen(tag) - 3),fmt,d1,tag);
fmt="%sest_intermediate_%s.dat";
sprintf(estimate->intermediate_output_filename=(char*)swzMalloc(strlen(d1) + strlen(fmt) + strlen(tag) - 3),fmt,d1,tag);
fmt="%sest_final_%s.dat";
sprintf(estimate->final_output_filename=(char*)swzMalloc(strlen(d1) + strlen(fmt) + strlen(tag) - 3),fmt,d1,tag);
fmt="%sest_aux_%s.dat";
sprintf(estimate->aux_output_filename=(char*)swzMalloc(strlen(d1) + strlen(fmt) + strlen(tag) - 3),fmt,d1,tag);
if (d2) swzFree(d2);
// Posterior mode or MLE
estimate->type=(dw_FindArgument_String(nargs,args,"MLE") >= 0) ? FIND_LIKELIHOOD_MODE : FIND_POSTERIOR_MODE;
// Default values
estimate->criterion_start=dw_ParseFloating_String(nargs,args,"cb",1.0e-3);
estimate->criterion_end=dw_ParseFloating_String(nargs,args,"ce",1.0e-6);
estimate->criterion_increment=dw_ParseFloating_String(nargs,args,"ci",0.1);
estimate->max_iterations_start=dw_ParseInteger_String(nargs,args,"ib",50);
estimate->max_iterations_increment=dw_ParseFloating_String(nargs,args,"ii",2.0);
estimate->max_block_iterations=100;
return estimate;
}
/*
Creates TStateModel and reads parameters from command line. Other estimate info
is also obtained from command line.
*/
static TStateModel* SetupFromCommandLine(int nargs, char **args, TEstimateInfo **p_info)
{
TEstimateInfo *info;
if (!(*p_info)) *p_info=(TEstimateInfo*)swzMalloc(sizeof(TEstimateInfo));
info=*p_info;
info->cmd=Base_VARCommandLine(nargs,args,(TVARCommandLine*)NULL);
/* // Posterior mode or MLE ansi-c*/
info->type=(dw_FindArgument_String(nargs,args,"MLE") >= 0) ? FIND_LIKELIHOOD_MODE : FIND_POSTERIOR_MODE;
/* // Default values ansi-c*/
info->criterion_start=dw_ParseFloating_String(nargs,args,"cb",1.0e-3);
info->criterion_end=dw_ParseFloating_String(nargs,args,"ce",1.0e-6);
info->criterion_increment=dw_ParseFloating_String(nargs,args,"ci",0.1);
info->max_iterations_start=dw_ParseInteger_String(nargs,args,"ib",50);
info->max_iterations_increment=dw_ParseFloating_String(nargs,args,"ii",2.0);
info->max_block_iterations=100;
/* // Output filenames ansi-c*/
info->csminwel_output_filename=CreateFilenameFromTag("%sest_csminwel_%s.dat",info->cmd->out_tag,info->cmd->out_directory);
info->intermediate_output_filename=CreateFilenameFromTag("%sest_intermediate_%s.dat",info->cmd->out_tag,info->cmd->out_directory);
return CreateTStateModelForEstimate(nargs,args,&(info->cmd));
}
int main(int nargs, char **args)
{
TStateModel *model;
TEstimateInfo *estimate=(TEstimateInfo*)NULL;
char *filename;
FILE *f_out;
time_t begin_time, end_time;
int t, seed;
TVector y;
char *include_help[]={"-di","-do","-fs","-fp","-ph","-ft","-fto",(char*)NULL},
*additional_help[]={
"-MLE",
"Finds the maximum likelihood estimate",
"-PM",
"Finds the posterior mode (default option)",
"-cb <floating point number>",
"Beginning csminwel exit criterion (default = 1.0e-3)",
"-ce <floating point number>",
"Ending csminwel exit criterion (default = 1.03-6)",
"-ci <floating point number>",
"csminwel exit criterion increment multiplier (default = 0.1)",
"-ib <integer>",
"Beginning csminwel maximum iteration value (default = 50)",
"-ii <floating point number>",
"csminwel maximum interation increment multiplier (default = 2)",
"-nd1",
"Normalize diagonal of A0 to one (flat output only)",
"-gs <integer>",
"Seed value for generator - 0 gets seed from clock (default value = 0)",
(char*)NULL,
(char*)NULL};
/* //=== Help Screen === ansi-c*/
if (dw_FindArgument_String(nargs,args,"h") != -1)
{
printf("print_draws <options>\n");
PrintHelpMessages(stdout,include_help,additional_help);
return 0;
}
constant_seed=dw_ParseInteger_String(nargs,args,"cseed",0);
/* // Generator seed ansi-c*/
seed=dw_ParseInteger_String(nargs,args,"gs",0);
dw_initialize_generator(seed);
printf("Reading initial data...\n");
if (model=SetupFromCommandLine(nargs,args,&estimate))
{
/* // Estimation ansi-c*/
printf("Beginning estimation...\n");
begin_time=time((time_t*)NULL);
FindMode_VAR_csminwel(model,estimate);
end_time=time((time_t*)NULL);
/* // Write final output ansi-c*/
filename=CreateFilenameFromTag("%sest_final_%s.dat",estimate->cmd->out_tag,estimate->cmd->out_directory);
if (f_out=fopen(filename,"wt"))
{
Write_VAR_Specification(f_out,(char*)NULL,model);
fprintf(f_out,"Specification file: %s\n",estimate->cmd->specification_filename_actual);
fprintf(f_out,"Initialization file: %s\n",estimate->cmd->parameters_filename_actual);
fprintf(f_out,"Initialization header: \"%s\"\n",estimate->cmd->parameters_header_actual);
fprintf(f_out,"Number free parameters in transition matrix: %d\n",NumberFreeParametersQ(model));
fprintf(f_out,"Number free parameters in theta: %d\n",NumberFreeParametersTheta(model));
fprintf(f_out,"Time stamp: %s",ctime(&end_time));
fprintf(f_out,"Elapsed time: %d seconds\n",(int)end_time-(int)begin_time);
fprintf(f_out,"Likelihood Value: %g\n",LogLikelihood_StatesIntegratedOut(model));
fprintf(f_out,"Prior Value: %g\n",LogPrior(model));
fprintf(f_out,"Posterior Value: %g\n\n",LogPosterior_StatesIntegratedOut(model));
WriteTransitionMatrices(f_out,(char*)NULL,estimate->cmd->out_header,model);
Write_VAR_Parameters(f_out,(char*)NULL,estimate->cmd->out_header,model);
fclose(f_out);
}
swzFree(filename);
/* // Write flat file ansi-c*/
filename=CreateFilenameFromTag("%sest_flat_header_%s.dat",estimate->cmd->out_tag,estimate->cmd->out_directory);
if (f_out=fopen(filename,"wt"))
{
WriteBaseTransitionMatricesFlat_Headers_SV(f_out,model->sv,"");
Write_VAR_ParametersFlat_Headers(f_out,model);
fprintf(f_out,"\n");
fclose(f_out);
}
swzFree(filename);
filename=CreateFilenameFromTag("%sest_flat_%s.dat",estimate->cmd->out_tag,estimate->cmd->out_directory);
if (f_out=fopen(filename,"wt"))
{
WriteBaseTransitionMatricesFlat(f_out,model,"%lf ");
if (dw_FindArgument_String(nargs,args,"nd1") >= 0)
Write_VAR_ParametersFlat_A0_Diagonal_One(f_out,model,"%lf ");
else
Write_VAR_ParametersFlat(f_out,model,"%lf ");
fprintf(f_out,"\n");
fclose(f_out);
}
swzFree(filename);
/* // Write aux output ansi-c*/
filename=CreateFilenameFromTag("%sest_aux_%s.dat",estimate->cmd->out_tag,estimate->cmd->out_directory);
if (f_out=fopen(filename,"wt"))
{
fprintf(f_out,"""ln(P(y[t]|Y[t-1],Z[t],theta,Q))"",""E[y[t]|Y[t-1],Z[t],theta,Q]""\n");
y=CreateVector(((T_VAR_Parameters*)(model->theta))->nvars);
for (t=1; t <= model->sv->nobs; t++)
{
fprintf(f_out,"%le,",LogConditionalLikelihood_StatesIntegratedOut(t,model));
if (ExpectationSingleStep_StatesIntegratedOut(y,t,model))
dw_PrintVector(f_out,y,"%le,");
else
fprintf(f_out,"\n");
}
FreeVector(y);
fclose(f_out);
}
swzFree(filename);
/* // Free memory ansi-c*/
FreeStateModel(model);
Free_VARCommandLine(estimate->cmd);
}
else
{
/* // unable to create model ansi-c*/
if (estimate)
{
if (estimate->cmd) Free_VARCommandLine(estimate->cmd);
swzFree(estimate);
}
}
return 0;
}

488
matlab/ms-sbvar/c-code/sbvar/var/forecast.c
View File

@ -1,488 +0,0 @@
#include "switch.h"
#include "switchio.h"
#include "VARio.h"
#include "dw_parse_cmd.h"
#include "dw_ascii.h"
#include "dw_histogram.h"
#include <stdlib.h>
#include <string.h>
#include "modify_for_mex.h"
/*
Assumes
f_out : valid FILE pointer
percentiles : vector of numbers between 0 and 1 inclusive
draws : number of draws of shocks and regimes to make for each posterior draw
posterior_file : FILE pointer to file containing posterior draws. If null, current parameters are used.
T : last observation to treat as data. Usually equals model->nobs.
h : non-negative integer
model : point to valid TStateModel structure
Results:
Computes and prints to the file f_out the requested percentiles for forecasts
of the observables.
Returns:
One upon success and zero otherwise.
*/
int forecast_percentile(FILE *f_out, TVector percentiles, int draws, FILE *posterior_file, int T, int h, TStateModel *model)
{
T_VAR_Parameters *p;
int done=0, rtrn=0, *S, i=0, j, k, m, n=1000;
TVector init_prob, prob, *shocks, initial;
TMatrix forecast;
TMatrixHistogram *histogram;
/* // quick check of passed parameters ansi-c*/
if (!f_out || !percentiles || (draws <= 0) || (T < 0) || (h < 0) || !model) return 0;
p=(T_VAR_Parameters*)(model->theta);
if (T > p->nobs) return 0;
/* // allocate memory ansi-c*/
S=(int*)swzMalloc(h*sizeof(int));
forecast=CreateMatrix(h,p->nvars);
histogram=CreateMatrixHistogram(h,p->nvars,100,HISTOGRAM_VARIABLE);
initial=CreateVector(p->npre);
shocks=dw_CreateArray_vector(h);
for (i=h-1; i >= 0; i--) shocks[i]=CreateVector(p->nvars);
init_prob=CreateVector(p->nstates);
prob=CreateVector(p->nstates);
/* // Initial value ansi-c*/
EquateVector(initial,p->X[T]);
i=0;
while (!done)
{
/* // Read parameters and push them into model ansi-c*/
if (!posterior_file)
done=1;
else
if (!ReadBaseTransitionMatricesFlat(posterior_file,model) || !Read_VAR_ParametersFlat(posterior_file,model))
{
done=2;
printf("total posterior draws processed - %d\n",i);
}
else
if (i++ == n)
{
printf("%d posterior draws processed\n",i);
n+=1000;
}
if (done != 2)
{
/* // Get filtered probability at time T ansi-c*/
for (j=p->nstates-1; j >= 0; j--)
ElementV(init_prob,j)=ProbabilityStateConditionalCurrent(j,T,model);
for (k=draws; k > 0; k--)
{
/* // Draw time T regime ansi-c*/
m=DrawDiscrete(init_prob);
/* // Draw regimes from time T+1 through T+h inclusive ansi-c*/
for (j=0; j < h; j++)
{
ColumnVector(prob,model->sv->Q,m);
S[j]=m=DrawDiscrete(prob);
}
/* // Draw shocks ansi-c*/
for (j=h-1; j >= 0; j--) dw_NormalVector(shocks[j]); /* InitializeVector(shocks[i],0.0); ansi-c*/
/* // Compute forecast ansi-c*/
if (!forecast_base(forecast,h,initial,shocks,S,model))
goto ERROR_EXIT;
/* // Accumulate impulse response ansi-c*/
AddMatrixObservation(forecast,histogram);
}
}
}
for (i=0; i < DimV(percentiles); i++)
{
MatrixPercentile(forecast,ElementV(percentiles,i),histogram);
dw_PrintMatrix(f_out,forecast,"%lg ");
fprintf(f_out,"\n");
}
rtrn=1;
ERROR_EXIT:
FreeMatrixHistogram(histogram);
FreeMatrix(forecast);
swzFree(S);
FreeVector(initial);
FreeVector(prob);
FreeVector(init_prob);
dw_FreeArray(shocks);
return rtrn;
}
/*
Assumes
f_out : valid FILE pointer
percentiles : vector of numbers between 0 and 1 inclusive
draws : number of draws of shocks to make for each posterior draw
posterior_file : FILE pointer to file containing posterior draws. If null, current parameters are used.
s : base state
T : last observation to treat as data. Usually equals model->nobs.
h : non-negative integer
model : point to valid TStateModel/T_MSStateSpace structure
Results:
Computes and prints to the file f_out the requested percentiles for forecasts
of the observables.
Returns:
One upon success and zero otherwise.
Notes:
The regime at time T is drawn from the filtered probabilities at time t, and
is set to s there after.
*/
int forecast_percentile_regime(FILE *f_out, TVector percentiles, int draws,
FILE *posterior_file, int s, int T, int h, TStateModel *model)
{
T_VAR_Parameters *p;
int done=0, rtrn=0, *S, i=0, j, k, m, n=1000;
TVector init_prob, prob, *shocks, initial;
TMatrix forecast;
TMatrixHistogram *histogram;
/* // quick check of passed parameters ansi-c*/
if (!f_out || !percentiles || (draws <= 0) || (T < 0) || (h < 0) || !model) return 0;
p=(T_VAR_Parameters*)(model->theta);
if (T > p->nobs) return 0;
/* // allocate memory ansi-c*/
S=(int*)swzMalloc(h*sizeof(int));
for (i=0; i < h; i++) S[i]=s;
forecast=CreateMatrix(h,p->nvars);
histogram=CreateMatrixHistogram(h,p->nvars,100,HISTOGRAM_VARIABLE);
initial=CreateVector(p->npre);
shocks=dw_CreateArray_vector(h);
for (i=h-1; i >= 0; i--) shocks[i]=CreateVector(p->nvars);
init_prob=CreateVector(p->nstates);
prob=CreateVector(p->nstates);
/* // Initial value ansi-c*/
EquateVector(initial,p->X[T]);
i=0;
while (!done)
{
/* // Read parameters and push them into model ansi-c*/
if (!posterior_file)
done=1;
else
if (!ReadBaseTransitionMatricesFlat(posterior_file,model) || !Read_VAR_ParametersFlat(posterior_file,model))
{
done=2;
printf("total posterior draws processed - %d\n",i);
}
else
if (i++ == n)
{
printf("%d posterior draws processed\n",i);
n+=1000;
}
if (done != 2)
{
for (k=draws; k > 0; k--)
{
/* // Draw shocks ansi-c*/
for (j=h-1; j >= 0; j--) dw_NormalVector(shocks[j]); /* InitializeVector(shocks[i],0.0); ansi-c*/
/* // Compute forecast ansi-c*/
if (!forecast_base(forecast,h,initial,shocks,S,model))
goto ERROR_EXIT;
/* // Accumulate impulse response ansi-c*/
AddMatrixObservation(forecast,histogram);
}
}
}
for (i=0; i < DimV(percentiles); i++)
{
MatrixPercentile(forecast,ElementV(percentiles,i),histogram);
dw_PrintMatrix(f_out,forecast,"%lg ");
fprintf(f_out,"\n");
}
rtrn=1;
ERROR_EXIT:
FreeMatrixHistogram(histogram);
FreeMatrix(forecast);
swzFree(S);
FreeVector(initial);
FreeVector(prob);
FreeVector(init_prob);
dw_FreeArray(shocks);
return rtrn;
}
/*
Attempt to set up model from command line. Command line options are the
following
-ft <filename tag>
If this argument exists, then the following is attempted:
specification file name = est_final_<tag>.dat
output file name = ir_<tag>_regime_<k>.dat
parameters file name = est_final_<tag>.dat
header = "Posterior mode: "
-fs <filename>
If this argument exists, then the specification file name is <filename>.
The argument -fs takes precedence over -ft.
-fp <filename>
If this argument exists, then the parameters file name is <filename>. The
argument -fp takes precedence over -ft. The default value is the filename
associated with the argument -fs.
-ph <header>
If this argument exists, then the header for the parameters file is
<header>. The default value is "Posterior mode: ".
-horizon <integer>
If this argument exists, then the horizon of the impulse responses is given
by the passed integer. The default value is 12.
-error_bands
Output error bands. (default = off - only median is computed)
-percentiles n p_1 p_2 ... p_n
Percentiles to compute. The first parameter after percentiles must be the
number of percentiles and the following values are the actual percentiles.
default = 3 0.16 0.50 0.84 if error_bands flag is set
= 1 0.50 otherwise
-parameter_uncertainty
Apply parameter uncertainty when computing error bands.
-shocks_per_parameter <integer>
Number of shocks and regime paths to draw for each parameter draw. The
default value is 1 if parameter_uncertainty is set and 10,000 otherwise.
-thin
Thinning factor. Only 1/thin of the draws in posterior draws file are
used. The default value is 1.
-regimes
Produces forecasts as if each regime were permanent. (default = off)
-regime <integer>
Produces forecasts as if regime were permanent.
-mean
Produces mean forecast. (default = off)
*/
int main(int nargs, char **args)
{
char *spec=(char*)NULL, *parm=(char*)NULL, *head=(char*)NULL, *post=(char*)NULL, *out_filename, *tag, *buffer, *fmt;
TStateModel *model;
T_VAR_Parameters *p;
TVector percentiles=(TVector)NULL;
int s, horizon, thin, draws, i, j, n;
FILE *f_out, *posterior_file;
/* // specification filename ansi-c*/
if (buffer=dw_ParseString_String(nargs,args,"fs",(char*)NULL))
strcpy(spec=(char*)swzMalloc(strlen(buffer)+1),buffer);
/* // parameter filename ansi-c*/
if (buffer=dw_ParseString_String(nargs,args,"fp",(char*)NULL))
strcpy(parm=(char*)swzMalloc(strlen(buffer)+1),buffer);
/* // header ansi-c*/
if (buffer=dw_ParseString_String(nargs,args,"ph",(char*)NULL))
strcpy(head=(char*)swzMalloc(strlen(buffer)+1),buffer);
/* // file tag ansi-c*/
if (tag=dw_ParseString_String(nargs,args,"ft",(char*)NULL))
{
fmt="est_final_%s.dat";
/* // specification filename ansi-c*/
if (!spec)
sprintf(spec=(char*)swzMalloc(strlen(fmt) + strlen(tag) - 1),fmt,tag);
/* // parameter filename ansi-c*/
if (!parm)
sprintf(parm=(char*)swzMalloc(strlen(fmt) + strlen(tag) - 1),fmt,tag);
}
/* // horizon ansi-c*/
horizon=dw_ParseInteger_String(nargs,args,"horizon",12);
if (!spec)
{
swz_fprintf_err("No specification filename given\n");
swz_fprintf_err("Command line syntax:\n"
" -ft : file tag\n"
" -fs : specification filename (est_final_<tag>.dat)\n"
" -fp : parameters filename (specification filename)\n"
" -fh : parameter header (Posterior mode: )\n"
" -horizon : horizon for the forecast (12)\n"
);
swzExit(1);
}
if (!parm)
strcpy(parm=(char*)swzMalloc(strlen(spec)+1),spec);
if (!head)
{
buffer="Posterior mode: ";
strcpy(head=(char*)swzMalloc(strlen(buffer)+1),buffer);
}
model=Read_VAR_Specification((FILE*)NULL,spec);
ReadTransitionMatrices((FILE*)NULL,parm,head,model);
Read_VAR_Parameters((FILE*)NULL,parm,head,model);
p=(T_VAR_Parameters*)(model->theta);
swzFree(spec);
swzFree(head);
swzFree(parm);
/* //============================= Compute forecasts ============================= ansi-c*/
/* // Mean forecast ansi-c*/
/* if (dw_FindArgument_String(nargs,args,"mean") != -1) */
/* { */
/* fmt="forecasts_mean_%s.prn"; */
/* sprintf(out_filename=(char*)swzMalloc(strlen(fmt) + strlen(tag) - 1),fmt,tag); */
/* f_out=fopen(out_filename,"wt"); */
/* swzFree(out_filename); */
/* printf("Constructing mean forecast\n"); */
/* if (F=dw_state_space_mean_unconditional_forecast((TVector*)NULL,h,statespace->nobs,model)) */
/* for (i=0; i < h; i++) */
/* dw_PrintVector(f_out,F[i],"%le "); */
/* fclose(f_out); */
/* return; */
/* } */
/* // Parameter uncertainty ansi-c*/
if (dw_FindArgument_String(nargs,args,"parameter_uncertainity") != -1)
{
/* // Open posterior draws file ansi-c*/
fmt="draws_%s.dat";
sprintf(post=(char*)swzMalloc(strlen(fmt) + strlen(tag) - 1),fmt,tag);
if (!(posterior_file=fopen(post,"rt")))
{
printf("Unable to open draws file: %s\n",post);
swzExit(0);
}
/* // Get thinning factor from command line ansi-c*/
thin=dw_ParseInteger_String(nargs,args,"thin",1);
/* // Get shocks_per_parameter from command line ansi-c*/
draws=dw_ParseInteger_String(nargs,args,"shocks_per_parameter",1);
}
else
{
/* // Using posterior estimate ansi-c*/
posterior_file=(FILE*)NULL;
/* // thinning factor not used ansi-c*/
thin=1;
/* // Get shocks_per_parameter from command line ansi-c*/
draws=dw_ParseInteger_String(nargs,args,"shocks_per_parameter",10000);
}
/* // Setup percentiles ansi-c*/
if ((i=dw_FindArgument_String(nargs,args,"percentiles")) == -1)
if (dw_FindArgument_String(nargs,args,"error_bands") == -1)
{
percentiles=CreateVector(1);
ElementV(percentiles,0)=0.5;
}
else
{
percentiles=CreateVector(3);
ElementV(percentiles,0)=0.16; ElementV(percentiles,1)=0.5; ElementV(percentiles,2)=0.84;
}
else
if ((i+1 < nargs) && dw_IsInteger(args[i+1]) && ((n=atoi(args[i+1])) > 0) && (i+1+n < nargs))
{
percentiles=CreateVector(n);
for (j=0; j < n; j++)
if (!dw_IsFloat(args[i+2+j])|| ((ElementV(percentiles,j)=atof(args[i+2+j])) <= 0.0)
|| (ElementV(percentiles,j) >= 1.0)) break;
if (j < n)
{
FreeVector(percentiles);
printf("forecasting command line: Error parsing percentiles\n");
swzExit(0);
}
}
else
{
printf("forecasting command line(): Error parsing percentiles\n");
swzExit(0);
}
if (dw_FindArgument_String(nargs,args,"regimes") != -1)
for (s=0; s < p->nstates; s++)
{
rewind(posterior_file);
fmt="forecasts_percentiles_regime_%d_%s.prn";
sprintf(out_filename=(char*)swzMalloc(strlen(fmt) + strlen(tag) - 3),fmt,s,tag);
f_out=fopen(out_filename,"wt");
swzFree(out_filename);
printf("Constructing percentiles for forecasts - regime %d\n",s);
forecast_percentile_regime(f_out,percentiles,draws,posterior_file,s,p->nobs,horizon,model);
fclose(f_out);
}
else
if (((s=dw_ParseInteger_String(nargs,args,"regime",-1)) >= 0) && (s < p->nstates))
{
fmt="forecasts_percentiles_regime_%d_%s.prn";
sprintf(out_filename=(char*)swzMalloc(strlen(fmt) + strlen(tag) - 3),fmt,s,tag);
f_out=fopen(out_filename,"wt");
swzFree(out_filename);
printf("Constructing percentiles for forecasts - regime %d\n",s);
forecast_percentile_regime(f_out,percentiles,draws,posterior_file,s,p->nobs,horizon,model);
fclose(f_out);
}
else
{
fmt="forecasts_percentiles_%s.prn";
sprintf(out_filename=(char*)swzMalloc(strlen(fmt) + strlen(tag) - 1),fmt,tag);
f_out=fopen(out_filename,"wt");
swzFree(out_filename);
printf("Constructing percentiles for forecasts - %d draws of shocks/regimes per posterior value\n",draws);
forecast_percentile(f_out,percentiles,draws,posterior_file,p->nobs,horizon,model);
fclose(f_out);
}
if (posterior_file) fclose(posterior_file);
FreeVector(percentiles);
/* //============================================================================= ansi-c*/
return 0;
}

647
matlab/ms-sbvar/c-code/sbvar/var/mhm_VAR.c
View File

@ -1,647 +0,0 @@
#include "mhm_VAR.h"
#include "VARio.h"
#include "switch.h"
#include "switchio.h"
#include "dw_ascii.h"
#include "dw_rand.h"
#include "dw_matrix_rand.h"
#include "dw_error.h"
#include <stdlib.h>
#include <time.h>
#include <string.h>
#include "modify_for_mex.h"
/* // Compute psudo-inverse of mhm->variance ansi-c*/
static void PsudoInverse(TMatrix X, TMatrix Y)
{
int i, j, k;
TMatrix U, V;
TVector d;
PRECISION epsilon, tmp;
k=RowM(Y);
SVD(U=CreateMatrix(k,k),d=CreateVector(k),V=CreateMatrix(k,k),Y);
for (epsilon=ElementV(d,0),i=k-1; i > 0; i--)
if (ElementV(d,0) > epsilon) epsilon=ElementV(d,0);
epsilon*=SQRT_MACHINE_EPSILON;
for (j=k-1; j >= 0; j--)
{
tmp=(ElementV(d,j) > epsilon) ? 1.0/ElementV(d,j) : 0.0;
for (i=k-1; i >= 0; i--)
ElementM(V,i,j)*=tmp;
}
ProductTransposeMM(X,V,U);
FreeMatrix(U);
FreeVector(d);
FreeMatrix(V);
}
void ResetMHM(T_MHM *mhm)
{
mhm->N=0;
mhm->sum=mhm->sum_square=0.0;
mhm->max_log_posterior=mhm->max_log_likelihood=MINUS_INFINITY;
}
void FreeMHM(T_MHM *mhm)
{
if (mhm)
{
FreeVector(mhm->mean);
FreeVector(mhm->posterior_mode_VAR);
FreeMatrix(mhm->variance);
FreeMatrix(mhm->inverse_variance);
FreeVector(mhm->free_parameters_VAR);
dw_FreeArray(mhm->states);
dw_FreeArray(mhm->BaseAlpha);
dw_FreeArray(mhm->Alpha);
swzFree(mhm);
}
}
T_MHM* AddStateModel(TStateModel *model, T_MHM *mhm)
{
int i, nf_var=NumberFreeParametersTheta(model);
if (!mhm) mhm=CreateMHM();
/* // Allocate memory ansi-c*/
mhm->mean=CreateVector(nf_var);
mhm->posterior_mode_VAR=CreateVector(nf_var);
mhm->variance=CreateMatrix(nf_var,nf_var);
mhm->inverse_variance=CreateMatrix(nf_var,nf_var);
mhm->free_parameters_VAR=CreateVector(nf_var);
mhm->states=dw_CreateArray_int(model->sv->nstates);
mhm->BaseAlpha=dw_CreateArray_vector(dw_DimA(model->sv->ba));
for (i=dw_DimA(model->sv->ba)-1; i >= 0; i--)
mhm->BaseAlpha[i]=CreateVector(DimV(model->sv->ba[i]));
/* // model information ansi-c*/
mhm->model=model;
Setup_WZ_Normalization((T_VAR_Parameters*)mhm->model->theta,((T_VAR_Parameters*)mhm->model->theta)->A0);
ConvertThetaToFreeParameters(model,pElementV(mhm->posterior_mode_VAR));
mhm->log_likelihood_at_mode=LogLikelihood_StatesIntegratedOut(model);
mhm->log_prior_at_mode=LogPrior(model);
mhm->log_posterior_at_mode=mhm->log_likelihood_at_mode + mhm->log_prior_at_mode;
/* // Center ansi-c*/
mhm->center=mhm->posterior_mode_VAR;
return mhm;
}
T_MHM* AddDirichletScales(TVector alpha_scales, T_MHM *mhm)
{
if (!mhm) mhm=CreateMHM();
mhm->alpha_scales=EquateVector((TVector)NULL,alpha_scales);
return mhm;
}
T_MHM* CreateMHM(void)
{
int i, j;
T_MHM* mhm;
/* // Allocate structure ansi-c*/
mhm=(T_MHM*)swzMalloc(sizeof(T_MHM));
mhm->alpha_scales=(TVector)NULL;
mhm->mean=(TVector)NULL;
mhm->posterior_mode_VAR=(TVector)NULL;
mhm->variance=(TMatrix)NULL;
mhm->inverse_variance=(TMatrix)NULL;
mhm->free_parameters_VAR=(TVector)NULL;
mhm->BaseAlpha=(TVector*)NULL;
mhm->Alpha=(TVector**)NULL;
mhm->model=(TStateModel*)NULL;
mhm->f_out=(FILE*)NULL;
mhm->intermediate_output_filename=(char*)NULL;
mhm->final_output_filename=(char*)NULL;
mhm->intermediate_draws_output_filename=(char*)NULL;
mhm->draws_output_filename=(char*)NULL;
mhm->spec_filename=(char*)NULL;
mhm->parameter_filename=(char*)NULL;
mhm->parameter_header=(char*)NULL;
mhm->mhm_filename=(char*)NULL;
/* // Default values ansi-c*/
mhm->n_burn1=100000;
mhm->n_burn2=0;
mhm->n_mean_variance=200000;
mhm->n_mhm=1000000;
mhm->n_thin=1;
ResetMHM(mhm);
return mhm;
}
void BurnIn(T_MHM *mhm, int iterations, int period)
{
int count, begin_time, check=period;
printf("Beginning burn in -- %d iterations.\n",iterations);
begin_time=time((time_t*)NULL);
for (count=1; count <= iterations; count++)
{
DrawAll(mhm->model);
if (count == check)
{
check+=period;
if (mhm->f_out)
{
fprintf(mhm->f_out,"%d iterations completed out of %d\n",count,iterations);
PrintJumps(mhm->f_out,(T_VAR_Parameters*)(mhm->model->theta));
fflush(mhm->f_out);
}
printf("Total Elapsed Time: %d seconds\n",(int)time((time_t*)NULL) - begin_time);
printf("%d iterations completed out of %d\n",count,iterations);
PrintJumps(stdout,(T_VAR_Parameters*)(mhm->model->theta));
}
}
ResetMetropolisInformation((T_VAR_Parameters*)(mhm->model->theta));
}
void BurnIn_AdaptiveMetropolisScale(T_MHM *mhm, int iterations, int period)
{
int verbose=1;
AdaptiveMetropolisScale(mhm->model,iterations,period,verbose,mhm->f_out);
}
/*
Computes mean and variance and base alpha
*/
void ComputeMeanVariance_MHM(T_MHM *mhm, int iterations, int period)
{
int i, j, begin_time, count, check=period;
TVector *alpha;
TMatrix S;
PRECISION max, inc, tmp;
dw_InitializeArray_vector(mhm->BaseAlpha,0.0);
alpha=dw_CopyArray((void*)NULL,mhm->BaseAlpha);
S=CreateMatrix(RowM(mhm->variance),ColM(mhm->variance));
InitializeVector(mhm->mean,0.0);
InitializeMatrix(mhm->variance,0.0);
/* // loop and accumulate 1st and 2nd non-central moments ansi-c*/
printf("Beginning mean and variance estimation -- %d iterations.\n",iterations);
begin_time=time((time_t*)NULL);
for (count=1; count <= iterations; count++)
{
DrawAll(mhm->model);
ConvertThetaToFreeParameters(mhm->model,pElementV(mhm->free_parameters_VAR));
for (i=dw_DimA(alpha)-1; i >= 0; i--)
{
AddVV(mhm->BaseAlpha[i],mhm->BaseAlpha[i],mhm->model->sv->ba[i]);
for (j=DimV(alpha[i])-1; j >= 0; j--)
ElementV(alpha[i],j)+=ElementV(mhm->model->sv->ba[i],j)*ElementV(mhm->model->sv->ba[i],j);
}
AddVV(mhm->mean,mhm->mean,mhm->free_parameters_VAR);
OuterProduct(S,mhm->free_parameters_VAR,mhm->free_parameters_VAR);
AddMM(mhm->variance,mhm->variance,S);
if (count == check)
{
check+=period;
printf("Total Elapsed Time: %d seconds\n",(int)time((time_t*)NULL) - begin_time);
printf("%d iterations completed out of %d\n",count,iterations);
PrintJumps(stdout,(T_VAR_Parameters*)(mhm->model->theta));
}
}
/* // compute 1st and 2nd central moments for normal terms ansi-c*/
ProductVS(mhm->mean,mhm->mean,1.0/(PRECISION)iterations);
ProductMS(mhm->variance,mhm->variance,1.0/(PRECISION)iterations);
OuterProduct(S,mhm->mean,mhm->mean);
SubtractMM(mhm->variance,mhm->variance,S);
/* // Psudo variance ansi-c*/
SubtractVV(mhm->free_parameters_VAR,mhm->mean,mhm->posterior_mode_VAR);
OuterProduct(S,mhm->free_parameters_VAR,mhm->free_parameters_VAR);
AddMM(mhm->variance,mhm->variance,S);
/* // Compute psudo-inverse of mhm->variance ansi-c*/
PsudoInverse(mhm->inverse_variance,mhm->variance);
FreeMatrix(S);
/* // compute base alpha's for Dirichlet distribution ansi-c*/
for (i=dw_DimA(mhm->BaseAlpha)-1; i >= 0; i--)
ProductVS(mhm->BaseAlpha[i],mhm->BaseAlpha[i],1.0/(PRECISION)iterations);
for (i=dw_DimA(mhm->BaseAlpha)-1; i >= 0; i--)
for (j=DimV(mhm->BaseAlpha[i])-1; j >= 0; j--)
ElementV(alpha[i],j)=ElementV(alpha[i],j)/(PRECISION)iterations - ElementV(mhm->BaseAlpha[i],j)*ElementV(mhm->BaseAlpha[i],j);
for (i=dw_DimA(mhm->BaseAlpha)-1; i >= 0; i--)
{
for (max=0.0, j=DimV(mhm->BaseAlpha[i])-1; j >= 0; j--)
if ((tmp=ElementV(mhm->BaseAlpha[i],j)*(1.0-ElementV(mhm->BaseAlpha[i],j))/ElementV(alpha[i],j)) > max) max=tmp;
max-=1.0;
for (inc=0.0, j=DimV(mhm->BaseAlpha[i])-1; j >= 0; j--)
if ((tmp=1.1 - max*ElementV(mhm->BaseAlpha[i],j)) > inc) inc=tmp;
for (j=DimV(mhm->BaseAlpha[i])-1; j >= 0; j--)
ElementV(mhm->BaseAlpha[i],j)=max*ElementV(mhm->BaseAlpha[i],j)+inc;
}
/* // Create Alpha's ansi-c*/
mhm->Alpha=dw_CreateArray_array(DimV(mhm->alpha_scales));
for (i=dw_DimA(mhm->Alpha)-1; i >= 0; i--)
{
mhm->Alpha[i]=dw_CreateArray_vector(dw_DimA(mhm->BaseAlpha));
for (j=dw_DimA(mhm->Alpha[i])-1; j >= 0; j--)
mhm->Alpha[i][j]=ProductVS((TVector)NULL,mhm->BaseAlpha[j],ElementV(mhm->alpha_scales,i));
}
dw_FreeArray(alpha);
}
/* PRECISION UpdatePosteriorLikelihood(T_MHM *mhm) */
/* { */
/* PRECISION log_likelihood, log_posterior, difference; */
/* log_likelihood=LogLikelihood_StatesIntegratedOut(mhm->model); */
/* log_posterior=log_likelihood + LogPrior(mhm->model); */
/* if (mhm->N > 1) */
/* { */
/* mhm->sum+=(difference=log_posterior - mhm->old_log_posterior); */
/* mhm->sum_square+=difference*difference; */
/* } */
/* mhm->old_log_posterior=log_posterior; */
/* if (log_likelihood > mhm->max_log_likelihood) mhm->max_log_likelihood=log_likelihood; */
/* if (log_posterior > mhm->max_log_posterior) mhm->max_log_posterior=log_posterior; */
/* return log_posterior; */
/* } */
/* void UpdateModifiedHarmonicMean(T_MHM *mhm, int n_singular) */
/* { */
/* int j, k; */
/* PRECISION quadratic_form, log_posterior; */
/* // Increment total number of observations */
/* mhm->N++; */
/* // Log posterior - log likelihood corrected for normalization (this is now done in VARbase.c) */
/* log_posterior=UpdatePosteriorLikelihood(mhm); // + ((T_VAR_Parameters*)mhm->model->theta)->nvars*log(2); */
/* // Compute quadratic form */
/* ConvertThetaToFreeParameters(mhm->model,pElementV(mhm->free_parameters_VAR)); */
/* SubtractVV(mhm->free_parameters_VAR,mhm->free_parameters_VAR,mhm->center); */
/* quadratic_form=InnerProductSymmetric(mhm->free_parameters_VAR,mhm->inverse_variance); */
/* // Print log posterior and quadratic form */
/* fprintf(mhm->f_out,"%le %le",log_posterior,quadratic_form); */
/* // Print Dirichlet PDF's */
/* for (j=0; j < dw_DimA(mhm->Alpha); j++) */
/* fprintf(mhm->f_out," %le",LogIndependentDirichlet_pdf(mhm->model->sv->ba,mhm->Alpha[j])); */
/* // Print number of singular varinances */
/* fprintf(mhm->f_out," %d\n",Get_VAR_Improper_Distribution_Counter()-n_singular); */
/* // Print linefeed */
/* //fprintf(mhm->f_out,"\n"); */
/* // Tally states */
/* for (j=mhm->model->sv->nstates-1; j >= 0; j--) mhm->states[j]=0; */
/* for (j=mhm->model->sv->nobs; j > 1; j--) mhm->states[mhm->model->sv->S[j]]++; */
/* for (j=mhm->model->sv->nstates-1; j >= 0; j--) fprintf(mhm->f_out_regime_counts,"%d ",mhm->states[j]); */
/* fprintf(mhm->f_out_regime_counts,"\n"); */
/* } */
void UpdateModifiedHarmonicMean(T_MHM *mhm, int n_singular)
{
int j, k;
PRECISION quadratic_form, log_likelihood, log_likelihood_states_integrated_out,
log_prior_theta, log_prior_Q, log_posterior, difference;
/* // Increment total number of observations ansi-c*/
mhm->N++;
/* // Compute likelihoods and priors ansi-c*/
log_likelihood=LogLikelihood(mhm->model);
log_likelihood_states_integrated_out=LogLikelihood_StatesIntegratedOut(mhm->model);
log_prior_theta=LogPrior_Theta(mhm->model);
log_prior_Q=LogPrior_Q(mhm->model);
log_posterior=log_likelihood_states_integrated_out + log_prior_theta + log_prior_Q;
/* // Average change ansi-c*/
if (mhm->N > 1)
{
mhm->sum+=(difference=log_posterior - mhm->old_log_posterior);
mhm->sum_square+=difference*difference;
}
mhm->old_log_posterior=log_posterior;
/* // Maximum likelihoods and priors ansi-c*/
if (log_likelihood_states_integrated_out > mhm->max_log_likelihood) mhm->max_log_likelihood=log_likelihood_states_integrated_out;
if (log_posterior > mhm->max_log_posterior) mhm->max_log_posterior=log_posterior;
/* // Compute quadratic form ansi-c*/
ConvertThetaToFreeParameters(mhm->model,pElementV(mhm->free_parameters_VAR));
SubtractVV(mhm->free_parameters_VAR,mhm->free_parameters_VAR,mhm->center);
quadratic_form=InnerProductSymmetric(mhm->free_parameters_VAR,mhm->inverse_variance);
/*** Standard output ***/
/* // Print log posterior and quadratic form ansi-c*/
fprintf(mhm->f_out,"%le %le",log_posterior,quadratic_form);
/* // Print Dirichlet PDF's ansi-c*/
for (j=0; j < dw_DimA(mhm->Alpha); j++)
fprintf(mhm->f_out," %le",LogIndependentDirichlet_pdf(mhm->model->sv->ba,mhm->Alpha[j]));
/* // Print number of singular varinances ansi-c*/
fprintf(mhm->f_out," %d\n",Get_VAR_Improper_Distribution_Counter()-n_singular);
/*** States not integrated out output ***/
/* //if (mhm->f_states_not_integrated_out) ansi-c*/
/* // fprintf(mhm->f_states_not_integrated_out,"%le %le %le %le %le\n",quadratic_form,log_likelihood,log_prior_theta,log_prior_Q,log_posterior); ansi-c*/
/* // Tally states ansi-c*/
for (j=mhm->model->sv->nstates-1; j >= 0; j--) mhm->states[j]=0;
for (j=mhm->model->sv->nobs; j > 1; j--) mhm->states[mhm->model->sv->S[j]]++;
for (j=mhm->model->sv->nstates-1; j >= 0; j--) fprintf(mhm->f_out_regime_counts,"%d ",mhm->states[j]);
fprintf(mhm->f_out_regime_counts,"\n");
}
void ComputeModifiedHarmonicMean(T_MHM *mhm, int period)
{
FILE *f_tmp;
char *header;
int count, check=period, begin_time, i, n_singular;
printf("Beginning modified harmonic mean calculation -- %d iterations.\n",mhm->n_mhm);
begin_time=time((time_t*)NULL);
for (count=1; count <= mhm->n_mhm; count++)
{
n_singular=Get_VAR_Improper_Distribution_Counter();
for (i=mhm->n_thin; i > 0; i--)
{
DrawAll(mhm->model);
}
UpdateModifiedHarmonicMean(mhm,n_singular);
if (count == check)
{
check+=period;
printf("Total Elapsed Time: %d seconds\n",(int)time((time_t*)NULL) - begin_time);
printf("%d iterations completed out of %d\n",count,mhm->n_mhm);
PrintJumps(stdout,(T_VAR_Parameters*)(mhm->model->theta));
}
}
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/******************************** Input/Output *********************************/
/*******************************************************************************/
static int ReadError_MHMio(char *id)
{
char *errmsg, *fmt="Error involving line identifier \"%s\"";
sprintf(errmsg=(char*)swzMalloc(strlen(fmt) + strlen(id) - 1),fmt,id);
dw_UserError(errmsg);
swzFree(errmsg);
return 0;
}
void PrintJumps(FILE *f, T_VAR_Parameters *p)
{
if(f==stdout)
printf("Jumping counts - Total: %d\n",p->Total_A0_Metropolis_Draws);
else
fprintf(f,"Jumping counts - Total: %d\n",p->Total_A0_Metropolis_Draws);
dw_PrintArray(f,p->A0_Metropolis_Jumps,"%7d ");
}
void WriteMHM_Input(FILE *f_out, T_MHM *mhm)
{
fprintf(f_out,"//== scale values for Dirichlet distribution ==//\n%d\n",DimV(mhm->alpha_scales));
dw_PrintVector(f_out,mhm->alpha_scales,"%22.14le ");
fprintf(f_out,"\n");
fprintf(f_out,"//== number draws for first burn-in ==//\n%d\n\n",mhm->n_burn1);
fprintf(f_out,"//== number draws for second burn-in ==//\n%d\n\n",mhm->n_burn2);
fprintf(f_out,"//== number draws to estimate mean and variance ==//\n%d\n\n",mhm->n_mean_variance);
fprintf(f_out,"//== number draws for modified harmonic mean process ==//\n%d\n\n",mhm->n_mhm);
fprintf(f_out,"//== thinning factor for modified harmonic mean process ==//\n%d\n\n",mhm->n_thin);
}
T_MHM* ReadMHM_Input(FILE *f, char *filename, T_MHM *mhm)
{
T_MHM *rtrn=mhm ? mhm : CreateMHM();
FILE *f_in=f ? f : dw_OpenTextFile(filename);
char *id;
int m;
id="//== scale values for Dirichlet distribution ==//";
if (dw_SetFilePosition(f_in,id) && (fscanf(f_in," %d ",&m) == 1) && dw_ReadVector(f_in,rtrn->alpha_scales=CreateVector(m)))
{
id="//== number draws for first burn-in ==//";
if (dw_SetFilePosition(f_in,id) && (fscanf(f_in," %d ",&(rtrn->n_burn1)) == 1))
{
id="//== number draws for second burn-in ==//";
if (dw_SetFilePosition(f_in,id) && (fscanf(f_in," %d ",&(rtrn->n_burn2)) == 1))
{
id="//== number draws to estimate mean and variance ==//";
if (dw_SetFilePosition(f_in,id) && (fscanf(f_in," %d ",&(rtrn->n_mean_variance)) == 1))
{
id="//== number draws for modified harmonic mean process ==//";
if (dw_SetFilePosition(f_in,id) && (fscanf(f_in," %d ",&(rtrn->n_mhm)) == 1))
{
id="//== thinning factor for modified harmonic mean process ==//";
if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %d ",&(rtrn->n_thin)) != 1))
rtrn->n_thin=1;
if (!f) fclose(f_in);
return rtrn;
}
}
}
}
}
if (!mhm) FreeMHM(rtrn);
if (!f) fclose(f_in);
ReadError_MHMio(id);
return (T_MHM*)NULL;
}
void WriteMeanVariance(FILE *f_out, T_MHM *mhm)
{
fprintf(f_out,"//== Base Dirichlet parameters ==//\n");
dw_PrintArray(f_out,mhm->BaseAlpha,"%22.14le ");
fprintf(f_out,"//== Variance ==//\n");
dw_PrintMatrix(f_out,mhm->variance,"%22.14le ");
fprintf(f_out,"\n");
fprintf(f_out,"//== Center ==//\n");
dw_PrintVector(f_out,mhm->center,"%22.14le ");
fprintf(f_out,"\n");
fprintf(f_out,"//== Mean ==//\n");
dw_PrintVector(f_out,mhm->mean,"%22.14le ");
fprintf(f_out,"\n");
fprintf(f_out,"//== Posterior mode VAR parameters ==//\n");
dw_PrintVector(f_out,mhm->posterior_mode_VAR,"%22.14le ");
fprintf(f_out,"\n");
}
int ReadMeanVariance(FILE *f_in, T_MHM *mhm)
{
char *id;
int i, j;
id="//== Base Dirichlet parameters ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,mhm->BaseAlpha))
return ReadError_MHMio(id);
/* // Create alpha ansi-c*/
mhm->Alpha=dw_CreateArray_array(DimV(mhm->alpha_scales));
for (i=dw_DimA(mhm->Alpha)-1; i >= 0; i--)
{
mhm->Alpha[i]=dw_CreateArray_vector(dw_DimA(mhm->BaseAlpha));
for (j=dw_DimA(mhm->Alpha[i])-1; j >= 0; j--)
mhm->Alpha[i][j]=ProductVS((TVector)NULL,mhm->BaseAlpha[j],ElementV(mhm->alpha_scales,i));
}
id="//== Variance ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,mhm->variance))
return ReadError_MHMio(id);
PsudoInverse(mhm->inverse_variance,mhm->variance);
id="//== Center ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadVector(f_in,mhm->center))
return ReadError_MHMio(id);
id="//== Mean ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadVector(f_in,mhm->mean))
return ReadError_MHMio(id);
id="//== Posterior mode VAR parameters ==//";
if (!dw_SetFilePosition(f_in,id) || !dw_ReadVector(f_in,mhm->posterior_mode_VAR))
return ReadError_MHMio(id);
return 1;
}
/* T_MHM* Read_MHM(FILE *f, char *filename, TStateModel *model) */
/* { */
/* char *id; */
/* id="//== p-values for gaussian truncation ==//"; */
/* if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %d ",&n) != 1) || !dw_ReadVector(f_in,p_cuts=CreateVector(n))) dw_Error(PARSE_ERR); */
/* id="//== zeta truncation values ==//"; */
/* if (!dw_SetFilePosition(f_in,id) || !dw_ReadVector(f_in,zeta_cuts=CreateVector(2))) dw_Error(PARSE_ERR); */
/* id="//== scale values for Dirichlet distribution ==//"; */
/* if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %d ",&m) != 1) || !dw_ReadVector(f_in,dirichlet_scales=CreateVector(m))) dw_Error(PARSE_ERR); */
/* id="//== initial Metropolis scale values ==//"; */
/* if (!dw_SetFilePosition(f_in,id) || !dw_ReadVector(f_in,metropolis_scales=CreateVector(((T_VAR_Parameters*)(model->theta))->nvars))) dw_Error(PARSE_ERR); */
/* SetupMetropolisInformation(metropolis_scales,(T_VAR_Parameters*)(model->theta)); */
/* } */
/* void PrintMHM(FILE *f, char *filename, TStateModel *model, T_MHM *mhm) */
/* { */
/* int i, j; */
/* FILE *f_out; */
/* f_out=f ? f : dw_CreateTextFile(filename); */
/* fprintf(f_out,"Log of marginal data density \n"); */
/* for (i=0; i < RowM(mhm->log_sum); i++) */
/* { */
/* for (j=0; j < ColM(mhm->log_sum); j++) */
/* fprintf(f_out,"%le ",log(mhm->N) - ElementM(mhm->log_sum,i,j)); */
/* fprintf(f_out,"\n"); */
/* } */
/* fprintf(f_out,"\n"); */
/* fprintf(f_out,"Total number of draws used to compute marginal data density\n%d\n\n",mhm->N); */
/* fprintf(f_out,"For each p-value, percentage of non-zero terms in sum\n"); */
/* for (i=0; i < mhm->n; i++) */
/* if (mhm->N > 0) */
/* fprintf(f_out,"%5.2lf ",(double)mhm->K[i]/(double)mhm->N); */
/* else */
/* fprintf(f_out,"0 "); */
/* fprintf(f_out,"\n\n"); */
/* fprintf(f_out,"Log values of sums of h( )/(Loglikelihood*Prior)\n"); */
/* dw_PrintMatrix(f_out,mhm->log_sum,"%le "); */
/* fprintf(f_out,"\n"); */
/* fprintf(f_out,"Log value of the maximum of h( )/(Loglikelihood*Prior)\n"); */
/* dw_PrintMatrix(f_out,mhm->log_max,"%le "); */
/* fprintf(f_out,"\n"); */
/* fprintf(f_out,"p-values for gaussian distribution\n"); */
/* dw_PrintVector(f_out,mhm->p_values,"%5.3lf "); */
/* fprintf(f_out,"\n"); */
/* fprintf(f_out,"Cut points for the zeta\n"); */
/* dw_PrintVector(f_out,mhm->zeta_cuts,"%lf "); */
/* fprintf(f_out,"\n"); */
/* fprintf(f_out,"Scaling factor for zeta truncation\n"); */
/* dw_PrintVector(f_out,mhm->zeta_p_values,"%lf "); */
/* fprintf(f_out,"\n"); */
/* fprintf(f_out,"Log likelihood, posterior, and prior evauated at posterior peak\n"); */
/* fprintf(f_out,"%lf %lf %lf\n\n",mhm->log_likelihood_at_mode,mhm->log_posterior_at_mode,mhm->log_prior_at_mode); */
/* fprintf(f_out,"Maximum draw of log likelihood and posterior\n"); */
/* fprintf(f_out,"%lf %lf\n\n",mhm->max_log_likelihood,mhm->max_log_posterior); */
/* fprintf(f_out,"Mean and standard deviation of the log ratio of the posterior kernel of successive draws\n%le %lf\n\n", */
/* mhm->sum/(double)mhm->N,sqrt((mhm->sum_square - mhm->sum*mhm->sum/(double)mhm->N)/(double)mhm->N)); */
/* PrintJumps(f_out,(T_VAR_Parameters*)(model->theta)); */
/* fprintf(f_out,"Total number of draws: %d\n",mhm->N); */
/* fprintf(f_out,"Number of draws rejected because of zeta truncation: %d\n",mhm->zeta_truncations); */
/* fprintf(f_out,"Number of draws rejected because of gaussian truncation.\n"); */
/* dw_PrintArray(f_out,mhm->gaussian_truncations,"%d "); */
/* if (!f) fclose(f_out); */
/* } */
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/

88
matlab/ms-sbvar/c-code/sbvar/var/mhm_VAR.h
View File

@ -1,88 +0,0 @@
#ifndef __MODIFIED_HARMONIC_MEAN_
#define __MODIFIED_HARMONIC_MEAN_
#include "swzmatrix.h"
#include "switch.h"
#include "VARbase.h"
typedef struct
{
/* // Sample sizes to use in computations ansi-c*/
int n_burn1; /* set to negative of actual value if first burn-in has been completed ansi-c*/
int n_burn2; /* set to negative of actual value if second burn-in has been completed ansi-c*/
int n_mean_variance; /* set to negative of actual value if mean and variance have been computed ansi-c*/
int n_mhm; /* number of draws for computing the modified harmonic mean ansi-c*/
int n_thin; /* thinning factor ansi-c*/
/* // Accumulation fields ansi-c*/
int N; /* Total number observations ansi-c*/
PRECISION old_log_posterior;
PRECISION sum;
PRECISION sum_square;
PRECISION max_log_posterior;
PRECISION max_log_likelihood;
/* // mhm info ansi-c*/
TVector mean; /* Gaussian mean ansi-c*/
TMatrix variance; /* Gaussian variance ansi-c*/
TMatrix inverse_variance; /* Inverse of Gaussian variance ansi-c*/
TVector center; /* Used to center gaussian. Must be equal to posterior_mode_VAR or mean. ansi-c*/
TVector alpha_scales; /* scaling values for base dirichlet pdf parameters ansi-c*/
TVector* BaseAlpha; /* base dirichlet pdf parameters ansi-c*/
TVector** Alpha; /* base dirichlet pdf parameters times the scale factors ansi-c*/
/* // Model info ansi-c*/
TStateModel *model;
TVector posterior_mode_VAR;
PRECISION log_likelihood_at_mode;
PRECISION log_posterior_at_mode;
PRECISION log_prior_at_mode;
/* // Workspace ansi-c*/
TVector free_parameters_VAR; /* workspace for free parameters for VAR ansi-c*/
/* // Workspace for states ansi-c*/
int *states;
/* // Files ansi-c*/
FILE *f_out;
FILE *f_out_regime_counts;
char *regime_counts_filename;
char *intermediate_output_filename;
char *final_output_filename;
char *intermediate_draws_output_filename;
char *draws_output_filename;
char *spec_filename;
char *parameter_filename;
char *parameter_header;
char *mhm_filename;
} T_MHM;
/* // Constructors ansi-c*/
void FreeMHM(T_MHM *mhm);
T_MHM* CreateMHM(void);
T_MHM* AddDirichletScales(TVector alpha_scales, T_MHM *mhm);
T_MHM* AddStateModel(TStateModel *model, T_MHM *mhm);
void ResetMHM(T_MHM *mhm);
void BurnIn(T_MHM *mhm, int iterations, int period);
void BurnIn_AdaptiveMetropolisScale(T_MHM *mhm, int iterations, int period);
void ComputeMeanVariance_MHM(T_MHM *mhm, int iterations, int period);
int IsValidZeta(PRECISION* zeta, int n, PRECISION* gamma_cuts);
PRECISION UpdatePosteriorLikelihood(T_MHM *mhm);
void UpdateModifiedHarmonicMean(T_MHM *mhm, int n_singular);
void ComputeModifiedHarmonicMean(T_MHM *mhm, int period);
void WriteMHM_Input(FILE *f_out, T_MHM *mhm);
T_MHM* ReadMHM_Input(FILE *f_in, char *filename, T_MHM *mhm);
void WriteMeanVariance(FILE *f_out, T_MHM *mhm);
int ReadMeanVariance(FILE *f_in, T_MHM *mhm);
void PrintJumps(FILE *f, T_VAR_Parameters *p);
void PrintMHM(FILE *f, char *filename, TStateModel *model, T_MHM *mhm);
#endif

535
matlab/ms-sbvar/c-code/sbvar/var/mhm_VAR_main_1.c
View File

@ -1,535 +0,0 @@
#include "mhm_VAR.h"
#include "VARbase.h"
#include "VARio.h"
#include "switch.h"
#include "switchio.h"
#include "dw_rand.h"
#include "dw_error.h"
#include "dw_ascii.h"
#include "dw_parse_cmd.h"
#include <time.h>
#include <string.h>
#include <ctype.h>
#include <stdlib.h>
#include "modify_for_mex.h"
static void ReadError_MHMio(char *id)
{
char *errmsg, *fmt="Error after line identifier ""%s""";
sprintf(errmsg=(char*)swzMalloc(strlen(fmt) + strlen(id) - 1),fmt,id);
dw_UserError(errmsg);
swzFree(errmsg);
}
/*
Creates a copy of d and adds a trailing '/' if necessary. The returned
pointer, if not null, must be freed by calling routine.
*/
static char* AddSlash(char *d)
{
char *d_out;
int k=strlen(d);
if (d[0] && d[k-1] != '/')
{
d_out=(char*)swzMalloc(k+2);
strcat(strcpy(d_out,d),"/");
}
else
{
d_out=(char*)swzMalloc(k+2);
strcpy(d_out,d);
}
return d_out;
}
T_MHM* RestartFromFinalFile(char *filename, T_MHM *mhm)
{
FILE *f_in;
char *id;
TStateModel *model;
if (f_in=fopen(filename,"rt"))
{
id="//== Specification after mhm draws ==//";
if (dw_SetFilePosition(f_in,id))
{
if (!mhm)
{
mhm=ReadMHM_Input(f_in,(char*)NULL,(T_MHM*)NULL);
mhm->mhm_filename=filename;
}
mhm->spec_filename=mhm->parameter_filename=filename;
model=Read_VAR_Specification(f_in,(char*)NULL);
mhm->parameter_header="Posterior mode: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
AddStateModel(model,mhm);
mhm->parameter_header="Final draw: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
mhm->n_burn1=-mhm->n_burn1;
mhm->n_burn2=-mhm->n_burn2;
mhm->n_mean_variance=-mhm->n_mean_variance;
ReadMeanVariance(f_in,mhm);
return mhm;
}
}
return (T_MHM*)NULL;
}
/*
*/
T_MHM* RestartFromIntermediateFile(char *filename, T_MHM *mhm)
{
FILE *f_in;
char *id;
TStateModel *model;
if (f_in=fopen(filename,"rt"))
{
if (!mhm)
{
mhm=ReadMHM_Input(f_in,(char*)NULL,(T_MHM*)NULL);
mhm->mhm_filename=filename;
}
mhm->spec_filename=mhm->parameter_filename=filename;
id="//== Specification after mhm draws ==//";
if (dw_SetFilePosition(f_in,id))
{
model=Read_VAR_Specification(f_in,(char*)NULL);
mhm->parameter_header="Posterior mode: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
AddStateModel(model,mhm);
mhm->parameter_header="Final draw: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
mhm->n_burn1=-mhm->n_burn1;
mhm->n_burn2=-mhm->n_burn2;
mhm->n_mean_variance=-mhm->n_mean_variance;
ReadMeanVariance(f_in,mhm);
}
else
{
id="//== Specification after mean-variance estimation ==//";
if (dw_SetFilePosition(f_in,id))
{
model=Read_VAR_Specification(f_in,(char*)NULL);
mhm->parameter_header="Posterior mode: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
AddStateModel(model,mhm);
mhm->parameter_header="Mean-variance: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
mhm->n_burn1=-mhm->n_burn1;
mhm->n_burn2=-mhm->n_burn2;
mhm->n_mean_variance=-mhm->n_mean_variance;
ReadMeanVariance(f_in,mhm);
}
else
{
id="//== Specification after second burn-in ==//";
if (dw_SetFilePosition(f_in,id))
{
model=Read_VAR_Specification(f_in,(char*)NULL);
mhm->parameter_header="Posterior mode: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
AddStateModel(model,mhm);
mhm->parameter_header="Second burn-in: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
mhm->n_burn1=-mhm->n_burn1;
mhm->n_burn2=-mhm->n_burn2;
}
else
{
id="//== Specification after first burn-in ==//";
if (dw_SetFilePosition(f_in,id))
{
model=Read_VAR_Specification(f_in,(char*)NULL);
mhm->parameter_header="Posterior mode: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
AddStateModel(model,mhm);
mhm->parameter_header="First burn-in: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
mhm->n_burn1=-mhm->n_burn1;
}
else
{
model=Read_VAR_Specification(f_in,(char*)NULL);
mhm->parameter_header="Posterior mode: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
AddStateModel(model,mhm);
}
}
}
}
fclose(f_in);
return (mhm);
}
return (T_MHM*)NULL;
}
/*
Attempt to set up model from command line. Command line options are the
following
-di <directory>
If this argument exists, then all input files are in specified directory.
-do <directory>
If this argument exists, then all output files are in specified directory.
-ft <filename tag>
If this argument exists, then the following is attempted:
1) specification file name: mhm_final_<tag>.dat
mhm arguments file name: mhm_final_<tag>.dat
2) specification file name: mhm_intermediate_<tag>.dat
mhm arguments file name: mhm_intermediate_<tag>.dat
3) specification file name: est_final_<tag>.dat
mhm arguments file name: -fi <filename>
-fi <filename>
If this argument exists, then additional mhm arguments are read from the
input file with the given filename.
-fs <filename>
If this argument exists, then the specification file name is <filename>.
The argument -ft takes precedence over -fs.
-fp <filename>
If this argument exists, then the posterior is read from <filename>. Must
be used in conjunction with the argument -fs. The default value is the
filename associated with the argument -fs.
-ph <header>
If this argument exists, then the header for the posterior file is
<header>. Must be used in conjuction with the arguments -fp or -fs. The
default value is "Posterior mode: ".
-cm
If this argument exists, then the mean of the posterior draws are used to
center the quadratic form.
If no command line options are given, then attemps to use a default input file
with the name "default.ini". Returns one valid pointer to a TStateModel upon
success and null upon failure.
*/
#define LOG_TWO_PI 1.837877066409345
T_MHM* CreateMHM_CommandLine(int nargs, char **args)
{
TStateModel *model;
T_MHM *mhm=(T_MHM*)NULL, *rtrn=(T_MHM*)NULL;
char *d_in, *d_out, *tag, *filename, *spec_filename, *mhm_filename, *id, *fmt;
FILE *f_in;
TVector alpha_scales;
d_in=AddSlash(dw_ParseString_String(nargs,args,"di",""));
d_out=AddSlash(dw_ParseString_String(nargs,args,"do",""));
if (filename=dw_ParseString_String(nargs,args,"fi",(char*)NULL))
{
fmt="%s%s";
sprintf(mhm_filename=(char*)swzMalloc(strlen(d_in) + strlen(fmt) + strlen(filename) - 3),fmt,d_in,filename);
mhm=ReadMHM_Input((FILE*)NULL,mhm_filename,(T_MHM*)NULL);
mhm->mhm_filename=mhm_filename;
}
if (tag=dw_ParseString_String(nargs,args,"ft",(char*)NULL))
{
fmt="%smhm_final_%s.dat";
sprintf(spec_filename=(char*)swzMalloc(strlen(d_in) + strlen(fmt) + strlen(tag) - 3),fmt,d_in,tag);
if (rtrn=RestartFromFinalFile(spec_filename,mhm))
mhm=rtrn;
else
{
swzFree(spec_filename);
fmt="%smhm_intermediate_%s.dat";
sprintf(spec_filename=(char*)swzMalloc(strlen(d_in) + strlen(fmt) + strlen(tag) - 3),fmt,d_in,tag);
if (rtrn=RestartFromIntermediateFile(spec_filename,mhm))
mhm=rtrn;
else
{
swzFree(spec_filename);
fmt="%sest_final_%s.dat";
sprintf(spec_filename=(char*)swzMalloc(strlen(d_in) + strlen(fmt) + strlen(tag) - 3),fmt,d_in,tag);
if (!(f_in=fopen(spec_filename,"rt")))
{
swz_fprintf_err("CreateMHM_CommandLine: Unable to create model from %s tag.\n",tag);
if (mhm) FreeMHM(mhm);
}
else
if (mhm)
{
mhm->parameter_filename=mhm->spec_filename=spec_filename;
model=Read_VAR_Specification(f_in,(char*)NULL);
mhm->parameter_header="Posterior mode: ";
ReadTransitionMatrices(f_in,(char*)NULL,mhm->parameter_header,model);
Read_VAR_Parameters(f_in,(char*)NULL,mhm->parameter_header,model);
AddStateModel(model,mhm);
fclose(f_in);
}
}
}
}
else
if (filename=dw_ParseString_String(nargs,args,"fs",(char*)NULL))
{
if (mhm)
{
fmt="%s%s";
sprintf(mhm->spec_filename=(char*)swzMalloc(strlen(d_in) + strlen(fmt) + strlen(filename) - 3),fmt,d_in,filename);
model=Read_VAR_Specification((FILE*)NULL,mhm->spec_filename);
if (!(filename=dw_ParseString_String(nargs,args,"fp",(char*)NULL)))
filename=dw_ParseString_String(nargs,args,"fs",(char*)NULL);
sprintf(mhm->parameter_filename=(char*)swzMalloc(strlen(d_in) + strlen(fmt) + strlen(filename) - 3),fmt,d_in,filename);
mhm->parameter_header=dw_ParseString_String(nargs,args,"ph","Posterior mode: ");
ReadTransitionMatrices((FILE*)NULL,mhm->parameter_filename,mhm->parameter_header,model);
Read_VAR_Parameters((FILE*)NULL,mhm->parameter_filename,mhm->parameter_header,model);
AddStateModel(model,mhm);
}
}
else
{
swz_fprintf_err("CreateMHM_CommandLine(): No specification file given.\n");
if (mhm) FreeMHM(mhm);
swzExit(0);
}
if (!mhm)
{
swz_fprintf_err("CreateMHM_CommandLine: No mhm input data file specified.\n");
swzExit(0);
}
/* // Output filenames ansi-c*/
if (!(tag=dw_ParseString_String(nargs,args,"fo",(char*)NULL)))
tag=dw_ParseString_String(nargs,args,"ft","default");
fmt="%smhm_intermediate_%s.dat";
sprintf(mhm->intermediate_output_filename=(char*)swzMalloc(strlen(d_out) + strlen(fmt) + strlen(tag) - 3),fmt,d_out,tag);
fmt="%smhm_final_%s.dat";
sprintf(mhm->final_output_filename=(char*)swzMalloc(strlen(d_out) + strlen(fmt) + strlen(tag) - 3),fmt,d_out,tag);
fmt="%smhm_intermediate_draws_%s.dat";
sprintf(mhm->intermediate_draws_output_filename=(char*)swzMalloc(strlen(d_out) + strlen(fmt) + strlen(tag) - 3),fmt,d_out,tag);
fmt="%smhm_draws_%s.dat";
sprintf(mhm->draws_output_filename=(char*)swzMalloc(strlen(d_out) + strlen(fmt) + strlen(tag) - 3),fmt,d_out,tag);
fmt="%smhm_regime_counts_%s.dat";
sprintf(mhm->regime_counts_filename=(char*)swzMalloc(strlen(d_out) + strlen(fmt) + strlen(tag) - 3),fmt,d_out,tag);
/* //fmt="%smhm_draws_states_not_integrated_%s.dat"; ansi-c*/
/* //sprintf(mhm->states_not_integrated_out_filename=(char*)swzMalloc(strlen(d_out) + strlen(fmt) + strlen(tag) - 3),fmt,d_out,tag); ansi-c*/
swzFree(d_in);
swzFree(d_out);
return mhm;
}
#undef LOG_TWO_PI
int main(int nargs, char **args)
{
T_MHM *mhm;
char *header, *buffer[256];
int initial_time, begin_time, end_time;
FILE *f_out_intermediate, *f_out_final, *f_out_intermediate_draws;
constant_seed=dw_ParseInteger_String(nargs,args,"cseed",0);
if (mhm=CreateMHM_CommandLine(nargs,args))
{
/* //=== Random seed ===// ansi-c*/
dw_initialize_generator(0);
/* //=== Test new normalization code ===// ansi-c*/
/**
TVector** A0;
PRECISION x1, x2, x3, x4;
A0=dw_CopyArray((TVector**)NULL,((T_VAR_Parameters*)mhm->model->theta)->A0);
dw_initialize_generator(-1);
// burn-in
initial_time=begin_time=time((time_t*)NULL);
BurnIn_AdaptiveMetropolisScale(mhm,0,1000);
end_time=time((time_t*)NULL);
// test
while (1)
{
Setup_WZ_Normalization((T_VAR_Parameters*)mhm->model->theta,A0);
printf("Likelihood = %lg (WZ normalization)\n",LogLikelihood_StatesIntegratedOut(mhm->model));
printf("Prior = %lg (WZ normalization)\n",x2=LogPrior(mhm->model));
printf("Posterior = %lg (WZ normalization)\n",x4=LogPosterior_StatesIntegratedOut(mhm->model));
Setup_No_Normalization((T_VAR_Parameters*)mhm->model->theta);
printf("Likelihood = %lg (no normalization)\n",LogLikelihood_StatesIntegratedOut(mhm->model));
printf("Prior = %lg (no normalization)\n",x1=LogPrior(mhm->model));
printf("Posterior = %lg (no normalization)\n",x3=LogPosterior_StatesIntegratedOut(mhm->model));
printf("Difference %lg %lg %lg\n\n",x2-x1,x4-x3,((T_VAR_Parameters*)mhm->model->theta)->nvars*log(2));
//Setup_WZ_Normalization((T_VAR_Parameters*)mhm->model->theta,A0);
DrawAll(mhm->model);
getchar();
}
/**/
/* //=== End test new normalization code ===// ansi-c*/
/* // Use WZ normalization ansi-c*/
Setup_WZ_Normalization((T_VAR_Parameters*)mhm->model->theta,((T_VAR_Parameters*)mhm->model->theta)->A0);
/* // Posterior mode - Initial specification ansi-c*/
f_out_intermediate=dw_AppendTextFile(mhm->intermediate_output_filename);
fprintf(f_out_intermediate,"//== Initial Specification ==//\n\n");
Write_VAR_Specification(f_out_intermediate,(char*)NULL,mhm->model);
((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies=0;
Reset_VAR_Improper_Distribution_Counter();
header="Posterior mode: ";
WriteTransitionMatrices(f_out_intermediate,(char*)NULL,header,mhm->model);
Write_VAR_Parameters(f_out_intermediate,(char*)NULL,header,mhm->model);
fclose(f_out_intermediate);
/* f_out_final=dw_CreateTextFile(mhm->final_output_filename); */
/* header="Posterior mode: "; */
/* WriteTransitionMatrices(f_out_final,(char*)NULL,header,mhm->model); */
/* Write_VAR_Parameters(f_out_final,(char*)NULL,header,mhm->model); */
/* fclose(f_out_final); */
f_out_intermediate_draws=dw_CreateTextFile(mhm->intermediate_draws_output_filename);
/* // First burn-in ansi-c*/
if (mhm->n_burn1 > 0)
{
mhm->f_out=f_out_intermediate_draws;
initial_time=begin_time=time((time_t*)NULL);
BurnIn_AdaptiveMetropolisScale(mhm,mhm->n_burn1,1000);
end_time=time((time_t*)NULL);
printf("Elapsed Time: %d seconds\n",end_time - begin_time);
}
/* // After first burn-in ansi-c*/
f_out_intermediate=dw_AppendTextFile(mhm->intermediate_output_filename);
fprintf(f_out_intermediate,"//== Specification after first burn-in ==//\n");
fprintf(f_out_intermediate,"Number inconsistent normalizations: %d\n",((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies);
fprintf(f_out_intermediate,"Number singular inverse variances: %d\n\n",Get_VAR_Improper_Distribution_Counter());
((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies=0;
header="First burn-in: ";
WriteTransitionMatrices(f_out_intermediate,(char*)NULL,header,mhm->model);
Write_VAR_Parameters(f_out_intermediate,(char*)NULL,header,mhm->model);
fclose(f_out_intermediate);
/* // Second burn-in ansi-c*/
if (mhm->n_burn2 > 0)
{
mhm->f_out=f_out_intermediate_draws;
initial_time=begin_time=time((time_t*)NULL);
BurnIn(mhm,mhm->n_burn2,1000);
end_time=time((time_t*)NULL);
printf("Elapsed Time: %d seconds\n",end_time - begin_time);
printf("Number inconsistent normalizations: %d\n",((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies);
printf("Number singular inverse variances: %d\n\n",Get_VAR_Improper_Distribution_Counter());
}
fclose(f_out_intermediate_draws);
/* // After second burn-in ansi-c*/
f_out_intermediate=dw_AppendTextFile(mhm->intermediate_output_filename);
fprintf(f_out_intermediate,"//== Specification after second burn-in ==//\n");
fprintf(f_out_intermediate,"Number inconsistent normalizations: %d\n",((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies);
fprintf(f_out_intermediate,"Number singular inverse variances: %d\n\n",Get_VAR_Improper_Distribution_Counter());
((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies=0;
header="Second burn-in: ";
WriteTransitionMatrices(f_out_intermediate,(char*)NULL,header,mhm->model);
Write_VAR_Parameters(f_out_intermediate,(char*)NULL,header,mhm->model);
fclose(f_out_intermediate);
/* // Mean-variance estimation ansi-c*/
if (mhm->n_mean_variance > 0)
{
begin_time=time((time_t*)NULL);
ComputeMeanVariance_MHM(mhm,mhm->n_mean_variance,10000);
end_time=time((time_t*)NULL);
printf("Elapsed Time: %d seconds\n",end_time - begin_time);
printf("Number inconsistent normalizations: %d\n",((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies);
printf("Number singular inverse variances: %d\n\n",Get_VAR_Improper_Distribution_Counter());
}
/* // Set center to mean if necessary ansi-c*/
if (dw_FindArgument_String(nargs,args,"cm") >= 0)
{
printf("Using mean for center\n");
mhm->center=mhm->mean;
}
else
printf("Using posterior mode for center\n");
/* // After mean-variance estimation ansi-c*/
f_out_intermediate=dw_AppendTextFile(mhm->intermediate_output_filename);
fprintf(f_out_intermediate,"//== Specification after mean-variance estimation ==//\n");
fprintf(f_out_intermediate,"Number inconsistent normalizations: %d\n",((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies);
fprintf(f_out_intermediate,"Number singular inverse variances: %d\n\n",Get_VAR_Improper_Distribution_Counter());
((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies=0;
header="Mean-variance: ";
WriteTransitionMatrices(f_out_intermediate,(char*)NULL,header,mhm->model);
Write_VAR_Parameters(f_out_intermediate,(char*)NULL,header,mhm->model);
WriteMeanVariance(f_out_intermediate,mhm);
fclose(f_out_intermediate);
/* // Open draw file and states file ansi-c*/
mhm->f_out=dw_CreateTextFile(mhm->draws_output_filename);
WriteMHM_Input(mhm->f_out,mhm);
WriteMeanVariance(mhm->f_out,mhm);
/* //mhm->f_states_not_integrated_out=dw_CreateTextFile(mhm->states_not_integrated_out_filename); ansi-c*/
/* //WriteMHM_Input(mhm->f_states_not_integrated_out,mhm); ansi-c*/
/* //WriteMeanVariance(mhm->f_states_not_integrated_out,mhm); ansi-c*/
mhm->f_out_regime_counts=dw_CreateTextFile(mhm->regime_counts_filename);
/* // Modified harmonic mean draws ansi-c*/
fprintf(mhm->f_out,"\n//== Draws ==//\n");
/* //fprintf(mhm->f_states_not_integrated_out,"\n//== Draws ==//\n"); ansi-c*/
begin_time=time((time_t*)NULL);
ComputeModifiedHarmonicMean(mhm,10000);
end_time=time((time_t*)NULL);
printf("Elapsed Time: %d seconds\n",end_time - begin_time);
printf("Number inconsistent normalizations: %d\n",((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies);
printf("Number singular inverse variances: %d\n\n",Get_VAR_Improper_Distribution_Counter());
fclose(mhm->f_out_regime_counts);
fclose(mhm->f_out);
/* // After modified harmonic mean draws ansi-c*/
f_out_intermediate=dw_AppendTextFile(mhm->intermediate_output_filename);
fprintf(f_out_intermediate,"//== Specification after mhm draws ==//\n");
fprintf(f_out_intermediate,"Number inconsistent normalizations: %d\n",((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies);
fprintf(f_out_intermediate,"Number singular inverse variances: %d\n\n",Get_VAR_Improper_Distribution_Counter());
fprintf(f_out_intermediate,"//== RNG State ==//\n");
dw_print_generator_state(f_out_intermediate);
fprintf(f_out_intermediate,"\n");
((T_VAR_Parameters*)mhm->model->theta)->WZ_inconsistancies=0;
header="Final draw: ";
WriteTransitionMatrices(f_out_intermediate,(char*)NULL,header,mhm->model);
Write_VAR_Parameters(f_out_intermediate,(char*)NULL,header,mhm->model);
fclose(f_out_intermediate);
}
return 0;
}

2052
matlab/ms-sbvar/c-code/sbvar/var/mhm_VAR_main_2.c
View File

File diff suppressed because it is too large Load Diff

139
matlab/ms-sbvar/c-code/sbvar/var/probabilities.c
View File

@ -1,139 +0,0 @@
#include "switch.h"
#include "switchio.h"
#include "VARio.h"
#include "dw_parse_cmd.h"
#include "dw_ascii.h"
#include <stdlib.h>
#include "modify_for_mex.h"
/*
Attempt to set up model from command line. Command line options are the
following
-ft <filename tag>
If this argument exists, then the following is attempted:
specification file name = est_final_<tag>.dat
output file name = probabilites_<tag>.dat
parameters file name = est_final_<tag>.dat
header = "Posterior mode: "
-fs <filename>
If this argument exists, then the specification file name is <filename>.
The argument -fs takes precedence over -ft.
-fo <filename>
If this argument exists, then the output file name is <filename>. The
argument -fo takes precedence over -ft. The default value is
parameters.dat.
-fp <filename>
If this argument exists, then the parameters file name is <filename>. The
argument -fp takes precedence over -ft. The default value is the filename
associated with the argument -fs.
-ph <header>
If this argument exists, then the header for the parameters file is
<header>. The default value is "Posterior mode: ".
*/
int main(int nargs, char **args)
{
char *spec=(char*)NULL, *parm=(char*)NULL, *head=(char*)NULL, *out=(char*)NULL, *buffer, *fmt;
TStateModel *model;
TVector *probabilities;
int s, t;
FILE *f_out;
/* // specification filename ansi-c*/
if (buffer=dw_ParseString_String(nargs,args,"fs",(char*)NULL))
strcpy(spec=(char*)swzMalloc(strlen(buffer)+1),buffer);
/* // output filename ansi-c*/
if (buffer=dw_ParseString_String(nargs,args,"fo",(char*)NULL))
strcpy(out=(char*)swzMalloc(strlen(buffer)+1),buffer);
/* // parameter filename ansi-c*/
if (buffer=dw_ParseString_String(nargs,args,"fp",(char*)NULL))
strcpy(parm=(char*)swzMalloc(strlen(buffer)+1),buffer);
/* // header ansi-c*/
if (buffer=dw_ParseString_String(nargs,args,"ph",(char*)NULL))
strcpy(head=(char*)swzMalloc(strlen(buffer)+1),buffer);
/* // file tag ansi-c*/
if (buffer=dw_ParseString_String(nargs,args,"ft",(char*)NULL))
{
fmt="est_final_%s.dat";
/* // specification filename ansi-c*/
if (!spec)
sprintf(spec=(char*)swzMalloc(strlen(fmt) + strlen(buffer) - 1),fmt,buffer);
/* // parameter filename ansi-c*/
if (!parm)
sprintf(parm=(char*)swzMalloc(strlen(fmt) + strlen(buffer) - 1),fmt,buffer);
/* // output filename ansi-c*/
if (!out)
{
fmt="probabilities_%s.dat";
sprintf(out=(char*)swzMalloc(strlen(fmt) + strlen(buffer) - 1),fmt,buffer);
}
}
if (!spec)
{
swz_fprintf_err("No specification filename given\n");
swz_fprintf_err("Command line syntax:\n"
" -ft : file tag\n"
" -fs : specification filename\n"
" -fo : output filename (probablities.dat)\n"
" -fp : parameters filename (specification filename)\n"
" -fh : parameter header (Posterior mode: )\n"
);
swzExit(1);
}
if (!parm)
strcpy(parm=(char*)swzMalloc(strlen(spec)+1),spec);
if (!head)
{
buffer="Posterior mode: ";
strcpy(head=(char*)swzMalloc(strlen(buffer)+1),buffer);
}
if (!out)
{
buffer="probabilities.dat";
strcpy(out=(char*)swzMalloc(strlen(buffer)+1),buffer);
}
model=Read_VAR_Specification((FILE*)NULL,spec);
ReadTransitionMatrices((FILE*)NULL,parm,head,model);
Read_VAR_Parameters((FILE*)NULL,parm,head,model);
probabilities=dw_CreateArray_vector(model->sv->nstates);
for (s=model->sv->nstates-1; s >= 0; s--)
probabilities[s]=ProbabilitiesState((TVector)NULL,s,model);
f_out=dw_CreateTextFile(out);
for (t=0; t <= model->sv->nobs; t++)
{
for (s=0; s < model->sv->nstates; s++)
fprintf(f_out,"%lf ",ElementV(probabilities[s],t));
fprintf(f_out,"\n");
}
fclose(f_out);
swzFree(spec);
swzFree(out);
swzFree(head);
swzFree(parm);
}

650
matlab/ms-sbvar/c-code/utilities/DWCcode/arrays/dw_array.c
View File

@ -1,650 +0,0 @@
#include "dw_array.h"
#include "dw_error.h"
#include <stdlib.h>
#include <string.h>
#ifdef __APPLE__
#include <sys/malloc.h>
#else
#include <malloc.h>
#endif
#include <stdarg.h>
#include "modify_for_mex.h"
/* //================================== Macros ===================================// ansi-c*/
#define dw_ElementSizeA(a) (dw_SpecsA(a)->size)
#define dw_GetOffsetA(a) (dw_SpecsA(a)->offset)
#define dw_IsSameTypeA(a1,a2) (!memcmp(dw_SpecsA(a1),dw_SpecsA(a2),sizeof(TElementSpecification)))
#define dw_IsPointerA(a) (dw_SpecsA(a)->flag & dw_ARRAY_POINTER)
#define dw_UseMemcpyA(a) (dw_SpecsA(a)->flag & dw_ARRAY_USE_MEMCPY)
#define dw_DeleteSpecsA(a) (dw_SpecsA(a)->flag & dw_ARRAY_DELETE_SPECS)
#define dw_GetDestructorA(a) (dw_SpecsA(a)->destructor)
#define dw_GetDefaultConstructorA(s) (dw_SpecsA(a)->default_constructor)
#define dw_GetPointerCopyConstructorA(a) (dw_SpecsA(a)->pointer_copy_constructor)
#define dw_GetStaticCopyConstructorA(a) (dw_SpecsA(a)->static_copy_constructor)
#define dw_GetPrintRoutineA(a) (dw_SpecsA(a)->print_routine)
#define dw_GetReadRoutineA(a) (dw_SpecsA(a)->read_routine)
/*******************************************************************************/
/********************** C-style multi-dimensional arrays ***********************/
/*******************************************************************************/
/*
Frees a C-style multi-dimensional array. The pointer a must point to a valid
array created via a call to dw_CreateArray() or be a null pointer.
*/
void dw_FreeArray(void* a)
{
int i, size, offset;
void (*Destructor)(void*);
if (a)
{
if (Destructor=dw_GetDestructorA(a))
if (dw_IsPointerA(a))
for (i=dw_DimA(a)-1; i >= 0; i--)
Destructor(((void**)a)[i]);
else
for (i=(size=dw_ElementSizeA(a))*(dw_DimA(a)-1); i >= 0; i-=size)
Destructor((void*)(((char*)a) + i));
offset=dw_GetOffsetA(a);
if (dw_DeleteSpecsA(a)) swzFree(dw_SpecsA(a));
swzFree((void*)(((char*)a) - offset));
}
}
/*
Assumes:
specs: Pointer to a valid TElementSpecification structure.
dim: Positive integer
Returns:
A pointer to a valid array of lenth dim upon success and a null pointer upon
failure.
Notes:
The return value should be type cast to the appropriate pointer type.
*/
void* dw_CreateArray(TElementSpecification *specs, int dim)
{
void *a=(void*)NULL;
int i;
if (dim <= 0)
dw_Error(ARG_ERR);
else
if (!(a=swzMalloc(dim*specs->size + specs->offset)))
dw_Error(MEM_ERR);
else
{
a=(void*)(((char*)a)+specs->offset);
dw_DimA(a)=dim;
dw_SpecsA(a)=specs;
if (specs->default_constructor)
for (i=(specs->size)*(dim-1); i >= 0; i-=specs->size)
specs->default_constructor((void*)(((char*)a) + i));
}
return a;
}
/*
Assumes:
specs: Pointer to a valid TElementSpecification structure.
depth: Positive integer
dim: Array of positive integers of length at least depth
Returns:
A pointer to a valid multidimensiona array. The dimensions of the array are
determined by depth and dim.
Notes:
The return value should be type cast to the appropriate pointer type.
*/
void* dw_CreateMultidimensionalArray(TElementSpecification *specs, int depth, int *dim)
{
int i;
void *a;
if (depth == 1) return dw_CreateArray(specs,dim[0]);
if (a=dw_CreateArray_array(dim[0]))
for (i=dim[0]-1; i >= 0; i--)
if (!(((void**)a)[i]=dw_CreateMultidimensionalArray(specs,depth-1,dim+1)))
{
dw_FreeArray(a);
return (void*)NULL;
}
return a;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/**************************** Default Constructors *****************************/
/*******************************************************************************/
void DefaultPointerConstructor(void *element)
{
*((void**)element)=(void*)NULL;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/******************************* Print Functions *******************************/
/*******************************************************************************/
int dw_PrintArray(FILE *f, void *a, char *format)
{
int i, size;
int (*PrintRoutine)(FILE*, void*, char*);
if (f && a)
if (PrintRoutine=dw_GetPrintRoutineA(a))
{
if (dw_IsPointerA(a))
for (i=0; i < dw_DimA(a); i++)
{ if (!PrintRoutine(f,((void**)a)[i],format)) return 0; }
else
for (size=dw_ElementSizeA(a), i=0; i < dw_DimA(a); i++)
{ if (!PrintRoutine(f,(void*)(((char*)a) + i*size),format)) return 0; }
if(f==stdout)
printf("\n");
else
fprintf(f,"\n");
return 1;
}
return 0;
}
static int dw_PrintInt(FILE* f, void* element, char *format)
{
if(f==stdout)
{
printf(format ? format : "%d ",*((int*)element));
return 1;
}
else
return (fprintf(f,format ? format : "%d ",*((int*)element)) < 0) ? 0 : 1;
}
static int dw_PrintDouble(FILE* f, void* element, char *format)
{
if(f==stdout)
{
printf(format ? format : "%lf ",*((double*)element));
return 1;
}
else
return (fprintf(f,format ? format : "%lf ",*((double*)element)) < 0) ? 0 : 1;
}
static int dw_PrintFloat(FILE* f, void* element, char *format)
{
if(f==stdout)
{
printf(format ? format : "%f ",*((float*)element));
return 1;
}
else
return (fprintf(f,format ? format : "%f ",*((float*)element)) < 0) ? 0 : 1;
}
static int dw_PrintChar(FILE* f, void* element, char *format)
{
if(f==stdout)
{
printf(format ? format : "%c ",*((char*)element));
return 1;
}
else
return (fprintf(f,format ? format : "%c ",*((char*)element)) < 0) ? 0 : 1;
}
static int dw_PrintString(FILE* f, void* element, char *format)
{
if(f==stdout)
{
printf(format ? format : "%s\t",(char*)element);
return 1;
}
else
return (fprintf(f,format ? format : "%s\t",(char*)element) < 0) ? 0 : 1;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/******************************* Read Functions ********************************/
/*******************************************************************************/
int dw_ReadArray(FILE *f, void *a)
{
int i, size;
int (*ReadRoutine)(FILE*, void*);
if (f && a)
if (ReadRoutine=dw_GetReadRoutineA(a))
{
if (dw_IsPointerA(a))
for (i=0; i < dw_DimA(a); i++)
{ if (!ReadRoutine(f,((void**)a)[i])) return 0; }
else
for (size=dw_ElementSizeA(a), i=0; i < dw_DimA(a); i++)
{ if (!ReadRoutine(f,(void*)(((char*)a) + i*size))) return 0; }
return 1;
}
return 0;
}
static int dw_ReadInt(FILE* f, void* element)
{
return (fscanf(f," %d ",(int*)element) != 1) ? 0 : 1;
}
static int dw_ReadDouble(FILE* f, void* element)
{
return (fscanf(f," %lf ",(double*)element) != 1) ? 0 : 1;
}
static int dw_ReadFloat(FILE* f, void* element)
{
return (fscanf(f," %f ",(float*)element) != 1) ? 0 : 1;
}
static int dw_ReadChar(FILE* f, void* element)
{
return (fscanf(f," %c ",(char*)element) != 1) ? 0 : 1;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/****************************** Copy Constructors ******************************/
/*******************************************************************************/
/*
Assumes
*/
static int FullCopyAttempt(void **d, void *s, void* (*copy)(void*, void*), void (*destructor)(void*))
{
if (s)
if (*d)
{
if (!copy(*d,s))
{
if (destructor) destructor(*d);
if (!(*d=copy((void*)NULL,s))) return 0;
}
}
else
{
if (!(*d=copy((void*)NULL,s))) return 0;
}
else
if (*d)
{
if (destructor) destructor(*d);
*d=(void*)NULL;
}
return 1;
}
/*
Assumes:
d: A valid array or null pointer
s: A valid array
Returns:
Upon success returns a copy of the array s. If d is null, then the array is
created. Upon failure, a null pointer is returned.
Notes:
If d is
*/
void* dw_CopyArray(void* d, void* s)
{
int i, size;
void* original_d=d;
if (!s) return (void*)NULL;
if (s == d) return d;
if (!d)
{ if (!(d=dw_CreateArray(dw_SpecsA(s),dw_DimA(s)))) return (void*)NULL; }
else
{ if ((dw_DimA(s) != dw_DimA(d)) || !dw_IsSameTypeA(d,s)) return (void*)NULL; }
if (dw_UseMemcpyA(s))
{
memcpy(d,s,dw_DimA(s)*dw_ElementSizeA(s));
}
else if (dw_GetPointerCopyConstructorA(s))
{
for (i=dw_DimA(s)-1; i >= 0; i--)
if (!FullCopyAttempt(((void**)d)+i,((void**)s)[i],dw_GetPointerCopyConstructorA(s),dw_GetDestructorA(d)))
{
if (!original_d) dw_FreeArray(d);
return (void*)NULL;
}
}
else if (dw_GetStaticCopyConstructorA(s))
{
for (i=(size=dw_ElementSizeA(s))*(dw_DimA(s)-1); i >= 0; i-=size)
if (!dw_GetStaticCopyConstructorA(s)((void*)(((char*)d) + i),(void*)(((char*)s) + i)))
{
if (!original_d) dw_FreeArray(d);
return (void*)NULL;
}
}
else
{
if (!original_d) dw_FreeArray(d);
return (void*)NULL;
}
return d;
}
/*
Assumes
Both d and s are valid pointers and both *d and *s are either null or a
null terminated string. If *d is a null terminated string, then it must
have been created via a call to swzMalloc(), swzCalloc() or swzRealloc().
Returns
Returns one upon success and zero upon failure.
Results
If is *s is null, then *d is freed if it is non-null and is then set to
null. If *s is null terminated string, then *d is reallocated if more
memory is required and then *s is copied into *d.
Notes
It is critical that this function be called only if the destination string
was dynamically created via a call to swzMalloc(), swzCalloc() or swzRealloc(). If
this is not the case, then servere memory problems can result.
*/
static int dw_CopyString(void *d, void *s)
{
char* dest;
if (*((char**)s))
if (dest=swzRealloc(*((char**)d),strlen(*((char**)s))+1))
strcpy(*((char**)d)=dest,*((char**)s));
else
return 0;
else
if (*((char**)d))
{
swzFree(*((char**)d));
*((char**)d)=(char*)NULL;
}
return 1;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/********* Multidimensional Arrays Create Via Variable Argument Lists **********/
/*******************************************************************************/
/*
Assumes:
specs: Pointer to a valid TElementSpecification structure.
depth: Positive integer
Returns:
A pointer to a valid multidimensiona array. The dimensions of the array are
determined by depth the variable list of arguments.
Notes:
The return value should be type cast to the appropriate pointer type. The
variable list of arguments must be at least of length depth and consist of
positive integers.
*/
void* dw_CreateMultidimensionalArrayList(TElementSpecification *specs, int depth, ...)
{
va_list ap;
int i, *dim;
void *a=(void*)NULL;
if (dim=(int*)swzMalloc(depth*sizeof(int)))
{
va_start(ap,depth);
for (i=0; i < depth; i++) dim[i]=va_arg(ap,int);
va_end(ap);
a=dw_CreateMultidimensionalArray(specs,depth,dim);
swzFree(dim);
}
return a;
}
void* dw_CreateMultidimensionalArrayList_string(int depth, ...)
{
va_list ap;
int i, *dim;
void *a=(void*)NULL;
if (dim=(int*)swzMalloc(depth*sizeof(int)))
{
va_start(ap,depth);
for (i=0; i < depth; i++) dim[i]=va_arg(ap,int);
va_end(ap);
a=dw_CreateMultidimensionalArray_string(depth,dim);
swzFree(dim);
}
return a;
}
void* dw_CreateMultidimensionalArrayList_int(int depth, ...)
{
va_list ap;
int i, *dim;
void *a=(void*)NULL;
if (dim=(int*)swzMalloc(depth*sizeof(int)))
{
va_start(ap,depth);
for (i=0; i < depth; i++) dim[i]=va_arg(ap,int);
va_end(ap);
a=dw_CreateMultidimensionalArray_int(depth,dim);
swzFree(dim);
}
return a;
}
void* dw_CreateMultidimensionalArrayList_double(int depth, ...)
{
va_list ap;
int i, *dim;
void *a=(void*)NULL;
if (dim=(int*)swzMalloc(depth*sizeof(int)))
{
va_start(ap,depth);
for (i=0; i < depth; i++) dim[i]=va_arg(ap,int);
va_end(ap);
a=dw_CreateMultidimensionalArray_double(depth,dim);
swzFree(dim);
}
return a;
}
void* dw_CreateMultidimensionalArrayList_float(int depth, ...)
{
va_list ap;
int i, *dim;
void *a=(void*)NULL;
if (dim=(int*)swzMalloc(depth*sizeof(int)))
{
va_start(ap,depth);
for (i=0; i < depth; i++) dim[i]=va_arg(ap,int);
va_end(ap);
a=dw_CreateMultidimensionalArray_float(depth,dim);
swzFree(dim);
}
return a;
}
void* dw_CreateMultidimensionalArrayList_char(int depth, ...)
{
va_list ap;
int i, *dim;
void *a=(void*)NULL;
if (dim=(int*)swzMalloc(depth*sizeof(int)))
{
va_start(ap,depth);
for (i=0; i < depth; i++) dim[i]=va_arg(ap,int);
va_end(ap);
a=dw_CreateMultidimensionalArray_char(depth,dim);
swzFree(dim);
}
return a;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/****************************** Initialize Arrays ******************************/
/*******************************************************************************/
int dw_InitializeArray(void *a, void *x)
{
int i, size;
if (a)
{
if (dw_IsArrayA(a))
{
for (i=dw_DimA(a)-1; i >= 0; i--)
if (!dw_InitializeArray(((void**)a)[i],x)) return 0;
}
else if (dw_UseMemcpyA(a))
{
for (size=dw_ElementSizeA(a), i=size*(dw_DimA(a)-1); i >= 0; i-=size)
memcpy((void*)(((char*)a) + i),x,size);
}
else if (dw_GetPointerCopyConstructorA(a))
{
for (i=dw_DimA(a)-1; i >= 0; i--)
if (!FullCopyAttempt(((void**)a)+i,x,dw_GetPointerCopyConstructorA(a),dw_GetDestructorA(a))) return 0;
}
else if (dw_GetStaticCopyConstructorA(a))
{
for (i=(size=dw_ElementSizeA(a))*(dw_DimA(a)-1); i >= 0; i-=size)
if (!dw_GetStaticCopyConstructorA(a)((void*)(((char*)a)+i),x)) return 0;
}
else
return 0;
return 1;
}
return 0;
}
int dw_InitializeArray_int(void *a, int x) { return dw_InitializeArray(a,&x); }
int dw_InitializeArray_double(void *a, double x) { return dw_InitializeArray(a,&x); }
int dw_InitializeArray_float(void *a, float x) { return dw_InitializeArray(a,&x); }
int dw_InitializeArray_char(void *a, char x) { return dw_InitializeArray(a,&x); }
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/**************************** TElementSpecification ****************************/
/*******************************************************************************/
TElementSpecification* CreateArraySpecification_pointer(void (*destructor)(void *))
{
TElementSpecification *specs;
if (specs=(TElementSpecification*)swzMalloc(sizeof(TElementSpecification)))
{
specs->flag=dw_ARRAY_POINTER | dw_ARRAY_DELETE_SPECS;
specs->size=sizeof(void*);
specs->offset=sizeof(void*)*((sizeof(int)+sizeof(TElementSpecification*)+sizeof(void*)-1)/sizeof(void*)),
specs->destructor=destructor;
specs->default_constructor=NULL;
specs->pointer_copy_constructor=NULL;
specs->static_copy_constructor=NULL;
specs->print_routine=NULL;
specs->read_routine=NULL;
}
return specs;
}
TElementSpecification dw_IntSpecs =
{
dw_ARRAY_USE_MEMCPY,
sizeof(int),
sizeof(int)*((sizeof(int)+sizeof(TElementSpecification*)+sizeof(int)-1)/sizeof(int)),
NULL,
NULL,
NULL,
NULL,
dw_PrintInt,
dw_ReadInt
};
TElementSpecification dw_DoubleSpecs =
{
dw_ARRAY_USE_MEMCPY,
sizeof(double),
sizeof(double)*((sizeof(int)+sizeof(TElementSpecification*)+sizeof(double)-1)/sizeof(double)),
NULL,
NULL,
NULL,
NULL,
dw_PrintDouble,
dw_ReadDouble
};
TElementSpecification dw_FloatSpecs =
{
dw_ARRAY_USE_MEMCPY,
sizeof(float),
sizeof(float)*((sizeof(int)+sizeof(TElementSpecification*)+sizeof(float)-1)/sizeof(float)),
NULL,
NULL,
NULL,
NULL,
dw_PrintFloat,
dw_ReadFloat
};
TElementSpecification dw_CharSpecs =
{
dw_ARRAY_USE_MEMCPY,
sizeof(char),
sizeof(char)*((sizeof(int)+sizeof(TElementSpecification*)+sizeof(char)-1)/sizeof(char)),
NULL,
NULL,
NULL,
NULL,
dw_PrintChar,
dw_ReadChar
};
TElementSpecification dw_StringSpecs =
{
dw_ARRAY_POINTER,
sizeof(char*),
sizeof(char*)*((sizeof(int)+sizeof(TElementSpecification*)+sizeof(char*)-1)/sizeof(char*)),
swzFree,
DefaultPointerConstructor,
NULL,
dw_CopyString,
dw_PrintString,
NULL
};
TElementSpecification dw_ArraySpecs =
{
dw_ARRAY_POINTER | dw_ARRAY_ARRAY,
sizeof(void*),
sizeof(void*)*((sizeof(int)+sizeof(TElementSpecification*)+sizeof(void*)-1)/sizeof(void*)),
dw_FreeArray,
DefaultPointerConstructor,
dw_CopyArray,
NULL,
dw_PrintArray,
dw_ReadArray
};
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/

205
matlab/ms-sbvar/c-code/utilities/DWCcode/arrays/dw_array.h
View File

@ -1,205 +0,0 @@
#ifndef __TARRAY__
#define __TARRAY__
/******************************** C-style arrays ********************************
Attempts to implement a C++ class template for multidimensional arrays. The goal
is to allow access through the bracket operator (a[i_1][i_2]...[i_n]) but provide
mechanisms for creating, destroying, and determining the dimensions of the array.
In this implementation, an array is a pointer to void. The exact behavior of the
implementation is determined by structure TElementSpecification. This, together
with the dimension of the array are stored before the first element of the array.
The dimension of the array can be obtained with the macro dw_DimA().
Additionally, mechanisms are provided for copying, initializing, printing, and
writing arrays. If the array uses non-standard mechanisms for creating or
destroying its elements, the functions dw_CopyArray() and dw_InitializeArray()
should not be used.
=================================================================================
Specification of functions avaiable to arrays
Destructor
void Destructor(void*)
The destructor is called to destroy each element of the array. It is assumed
that each element of the array is in a valid state. If the flag bit
dw_ARRAY_POINTER set, the calling syntax from an array is
Destructor(((void**)a)[i])
and the destructor should free the passed pointer if it is not null.
Otherwise the calling syntax is
Destructor((void*)(((char*)a) + i*size))
and the destructor must not free the passed pointer.
---------------------------------------------------------------------------------
Default Constructor
void DefaultConstructor(void *)
The default constructor is called to initialize each element of the array.
The default constructor must not fail in the since that after a call to the
default constructor, the element is in a valid state. The calling syntax is
DefaultConstructor((void*)(((char*)a) + i*size))
Note that calling syntax is the same for static and pointer arrays. This
allows memory to be allocated to pointers.
---------------------------------------------------------------------------------
Pointer Copy Constructor
void* PointerCopyConstructor(void*, void*)
The pointer copy constructor is called when coping or initializing elements.
The calling syntax is
CopyConstructor(((void**)d)[i],((void**)s)[i])
The pointer copy constructor returns a pointer to the destination. If the
destination was null, an attempt to create it can be made, and if successful
a pointer to the newly allocated destination is returned. Upon failure, a
null pointer is returned. In the event of failure, the pointer copy
constructor should leave the contents of the destination in a valid state.
It is assumed that source is in a valid state.
---------------------------------------------------------------------------------
Static Copy Constructor
int StaticCopyConstructor(void*, void*)
The static copy constructor is called when coping or initializing elements.
The calling syntax is
CopyConstructor((void*)(((char*)d) + i*size),(void*)(((char*)s) + i*size)
The static copy constrctor should return one upon success and zero upon
failure. In the event of failure, the static copy constructor should leave
the contents of the destination in a state such that a call to the destructor
will behave as expected. The source is assume to be properly initialized.
---------------------------------------------------------------------------------
Print Routine
int Print(FILE*, void*, char*)
The print routine prints an element to the file f using the formating
information in the character string. If the flag bit dw_ARRAY_POINTER is
set, the calling syntax is
Print(f,((void**)a)[i],format)
and otherwise is
Print(f,(void*)(((char*)a) + i*size),format)
---------------------------------------------------------------------------------
Read Routine
int Read(FILE*, void*)
The read routine reads an element from the file f. If the flag bit
dw_ARRAY_POINTER is set, the calling syntax is
Read(f,((void**)a)[i])
and otherwise is
Read(f,(void*)(((char*)a) + i*size))
********************************************************************************/
#include <stdio.h>
/* //=========================== TElementSpecification ===========================// ansi-c*/
#define dw_ARRAY_USE_MEMCPY 0x00000001
#define dw_ARRAY_POINTER 0x00000002
#define dw_ARRAY_ARRAY 0x00000004
#define dw_ARRAY_DELETE_SPECS 0x00000008
typedef struct
{
int flag;
int size;
int offset;
void (*destructor)(void*);
void (*default_constructor)(void *);
void* (*pointer_copy_constructor)(void*, void*);
int (*static_copy_constructor)(void*, void*);
int (*print_routine)(FILE*, void*, char*);
int (*read_routine)(FILE*, void*);
} TElementSpecification;
TElementSpecification* CreateArraySpecification_pointer(void (*destructor)(void *));
extern TElementSpecification dw_IntSpecs;
extern TElementSpecification dw_DoubleSpecs;
extern TElementSpecification dw_FloatSpecs;
extern TElementSpecification dw_CharSpecs;
extern TElementSpecification dw_StringSpecs;
extern TElementSpecification dw_ArraySpecs;
extern TElementSpecification dw_PointerSpecs;
/* //=============================================================================// ansi-c*/
/* //=== Macros === ansi-c*/
#define dw_DimA(a) (((int*)(a))[-1])
#define dw_SpecsA(a) (*((TElementSpecification**)(((char*)(a))-(sizeof(TElementSpecification*)+sizeof(int)))))
#define dw_IsArrayA(a) (dw_SpecsA(a)->flag & dw_ARRAY_ARRAY)
/* //=== Destructor ===// ansi-c*/
void dw_FreeArray(void* a);
/* //=== Constructors ===// ansi-c*/
void* dw_CreateArray(TElementSpecification *specs, int dim);
void* dw_CreateMultidimensionalArray(TElementSpecification *specs, int depth, int *dim);
void* dw_CreateMultidimensionalArrayList(TElementSpecification *specs, int depth, ...);
/* //=== Routines ===// ansi-c*/
void* dw_CopyArray(void* d, void* s);
int dw_PrintArray(FILE* f, void* a, char* format);
int dw_ReadArray(FILE* f, void* a);
/* // Array arrays ansi-c*/
#define dw_CreateArray_array(dim) dw_CreateArray(&dw_ArraySpecs,dim)
/* // Pointer arrays ansi-c*/
#define dw_CreateArray_pointer(dim,destructor) dw_CreateArray(CreateArraySpecification_pointer(destructor),dim)
void DefaultPointerConstructor(void*);
/* // String arrays ansi-c*/
#define dw_CreateArray_string(dim) (char**)dw_CreateArray(&dw_StringSpecs,dim)
#define dw_CreateMultidimensionalArray_string(depth,dim) dw_CreateMultidimensionalArray(&dw_StringSpecs,depth,dim)
void* dw_CreateMultidimensionalArrayList_string(int depth, ...);
#define dw_CreateRectangularArray_string(row,col) (char***)dw_CreateMultidimensionalArrayList_string(2,row,col)
#define dw_InitializeArray_string(a,x) dw_InitializeArray(a,x)
/* // Integer arrays ansi-c*/
#define dw_CreateArray_int(dim) (int*)dw_CreateArray(&dw_IntSpecs,dim)
#define dw_CreateMultidimensionalArray_int(depth,dim) dw_CreateMultidimensionalArray(&dw_IntSpecs,depth,dim)
void* dw_CreateMultidimensionalArrayList_int(int depth, ...);
#define dw_CreateRectangularArray_int(row,col) (int**)dw_CreateMultidimensionalArrayList_int(2,row,col)
int dw_InitializeArray_int(void *a, int x);
/* // Double arrays ansi-c*/
#define dw_CreateArray_double(dim) (double*)dw_CreateArray(&dw_DoubleSpecs,dim)
#define dw_CreateMultidimensionalArray_double(depth,dim) dw_CreateMultidimensionalArray(&dw_DoubleSpecs,depth,dim)
void* dw_CreateMultidimensionalArrayList_double(int depth, ...);
#define dw_CreateRectangularArray_double(row,col) (double**)dw_CreateMultidimensionalArrayList_double(2,row,col)
int dw_InitializeArray_double(void *a, double x);
/* // Float arrays ansi-c*/
#define dw_CreateArray_float(dim) (float*)dw_CreateArray(&dw_FloatSpecs,dim)
#define dw_CreateMultidimensionalArray_float(depth,dim) dw_CreateMultidimensionalArray(&dw_FloatSpecs,depth,dim)
void* dw_CreateMultidimensionalArrayList_float(int depth, ...);
#define dw_CreateRectangularArray_float(row,col) (float**)dw_CreateMultidimensionalArrayList_float(2,row,col)
int dw_InitializeArray_float(void *a, float x);
/* // Character arrays ansi-c*/
#define dw_CreateArray_char(dim) (float*)dw_CreateArray(&dw_CharSpecs,dim)
#define dw_CreateMultidimensionalArray_char(depth,dim) dw_CreateMultidimensionalArray(&dw_CharSpecs,depth,dim)
void* dw_CreateMultidimensionalArrayList_char(int depth, ...);
#define dw_CreateRectangularArray_char(row,col) (char**)dw_CreateMultidimensionalArrayList_char(2,row,col)
int dw_InitializeArray_char(void *a, char x);
#endif

253
matlab/ms-sbvar/c-code/utilities/DWCcode/arrays/dw_matrix_array.c
View File

@ -1,253 +0,0 @@
#include "dw_matrix_array.h"
#include "dw_error.h"
#include "bmatrix.h"
#include <stdlib.h>
#include "modify_for_mex.h"
TElementSpecification dw_VectorSpecs =
{
dw_ARRAY_POINTER,
sizeof(TVector),
sizeof(int)+sizeof(TElementSpecification*),
(void (*)(void*))FreeVector,
DefaultPointerConstructor,
(void* (*)(void*,void*))EquateVector,
NULL,
(int (*)(FILE*,void*,char*))dw_PrintVector,
(int (*)(FILE*,void*))dw_ReadVector
};
TElementSpecification dw_MatrixSpecs =
{
dw_ARRAY_POINTER,
sizeof(TMatrix),
sizeof(int)+sizeof(TElementSpecification*),
(void (*)(void*))FreeMatrix,
DefaultPointerConstructor,
(void* (*)(void*,void*))EquateMatrix,
NULL,
(int (*)(FILE*,void*,char*))dw_PrintMatrix,
(int (*)(FILE*,void*))dw_ReadMatrix
};
/******************************************************************************/
/******************************* Initializaton ********************************/
/******************************************************************************/
void* dw_InitializeArray_vector(void* x, PRECISION y)
{
int i;
if (!x)
dw_Error(NULL_ERR);
else
if (dw_IsArrayA(x))
for (i=dw_DimA(x)-1; i >= 0; i--) dw_InitializeArray_vector(((void**)x)[i],y);
else
for (i=dw_DimA(x)-1; i >= 0; i--) InitializeVector(((void**)x)[i],y);
return x;
}
void* dw_InitializeArray_matrix(void* X, PRECISION y)
{
int i;
if (!X)
dw_Error(NULL_ERR);
else
if (dw_IsArrayA(X))
for (i=dw_DimA(X)-1; i >= 0; i--) dw_InitializeArray_matrix(((void**)X)[i],y);
else
for (i=dw_DimA(X)-1; i >= 0; i--) InitializeMatrix(((void**)X)[i],y);
return X;
}
/******************************************************************************/
/****************************** Tensor Calculus *******************************/
/******************************************************************************/
/*
Assumes:
X - r x s matrix or null pointer
Y - k dimensional array of matrices
Returns:
The the tensor product
Y[0] x Y[1] x ... x Y[k-1]
If X is null, then space for the tensor product is allocated. If X is not
null, then the dimensions must match.
r=RowM(Y[0]) x ... x RowM(Y[k-1])
c=ColM(Y[0]) x ... x ColM(Y[k-1])
Notes:
Calls bMatrixTensor().
*/
TMatrix MatrixTensor(TMatrix X, TMatrix* Y)
{
int i, r=1, c=1;
PRECISION *Z, *U, *V, *W;
TMatrix rtrn;
if (!Y)
{
dw_Error(NULL_ERR);
return (TMatrix)NULL;
}
for (i=dw_DimA(Y)-1; i >= 0; i--)
if (!Y[i])
{
dw_Error(NULL_ERR);
return (TMatrix)NULL;
}
else
{
r*=RowM(Y[i]);
c*=ColM(Y[i]);
}
if (!X)
{
if (!(rtrn=CreateMatrix(r,c)))
return (TMatrix)NULL;
}
else
if ((r != RowM(X)) || (c != ColM(X)))
{
dw_Error(SIZE_ERR);
return (TMatrix)NULL;
}
else
rtrn=X;
if (dw_DimA(Y) > 2)
{
if (!(Z=(PRECISION*)swzMalloc(r*c*sizeof(PRECISION))))
{
if (!X) FreeMatrix(rtrn);
return (TMatrix)NULL;
}
if (dw_DimA(Y) % 2)
{
U=Z;
V=pElementM(rtrn);
}
else
{
U=pElementM(rtrn);
V=Z;
}
i=dw_DimA(Y)-2;
bMatrixTensor(U,pElementM(Y[i]),pElementM(Y[i+1]),RowM(Y[i]),ColM(Y[i]),RowM(Y[i+1]),
ColM(Y[i+1]),MajorForm(rtrn),MajorForm(Y[i]),MajorForm(Y[i+1]));
r=RowM(Y[i])*RowM(Y[i+1]);
c=ColM(Y[i])*ColM(Y[i+1]);
while (--i >= 0)
{
bMatrixTensor(V,pElementM(Y[i]),U,RowM(Y[i]),ColM(Y[i]),r,c,MajorForm(rtrn),MajorForm(Y[i]),MajorForm(rtrn));
r*=RowM(Y[i]);
c*=ColM(Y[i]);
W=U;
U=V;
V=W;
}
swzFree(Z);
}
else
if (dw_DimA(Y) > 1)
bMatrixTensor(pElementM(rtrn),pElementM(Y[0]),pElementM(Y[1]),RowM(Y[0]),ColM(Y[0]),RowM(Y[1]),
ColM(Y[1]),MajorForm(rtrn),MajorForm(Y[0]),MajorForm(Y[1]));
else
EquateMatrix(rtrn,Y[0]);
return rtrn;
}
/*
Assumes:
X - d dimensional vector or null pointer
Y - k dimensional array of vectors
Returns:
The the tensor product
y[0] x y[1] x ... x y[k-1]
If x is null, then space for the tensor product is allocated. If x is not
null, then the dimensions must match.
d=DimV(Y[0]) x ... x DimV(Y[k-1])
Notes:
Calls bVectorTensor().
*/
TVector VectorTensor(TVector x, TVector* y)
{
int i, d=1;
PRECISION *z, *u, *v, *w;
TVector rtrn;
if (!y)
{
dw_Error(NULL_ERR);
return (TVector)NULL;
}
for (i=dw_DimA(y)-1; i >= 0; i--)
if (!y[i])
{
dw_Error(NULL_ERR);
return (TVector)NULL;
}
else
d*=DimV(y[i]);
if (!x)
{
if (!(rtrn=CreateVector(d)))
return (TVector)NULL;
}
else
if (d != DimV(x))
{
dw_Error(SIZE_ERR);
return (TVector)NULL;
}
else
rtrn=x;
if (dw_DimA(y) > 2)
{
if (!(z=(PRECISION*)swzMalloc(d*sizeof(PRECISION))))
{
if (!x) FreeVector(rtrn);
return (TVector)NULL;
}
if (dw_DimA(y) % 2)
{
u=z;
v=pElementV(rtrn);
}
else
{
u=pElementV(rtrn);
v=z;
}
i=dw_DimA(y)-2;
bVectorTensor(u,pElementV(y[i]),pElementV(y[i+1]),DimV(y[i]),DimV(y[i+1]));
d=DimV(y[i])*DimV(y[i+1]);
while (--i >= 0)
{
bVectorTensor(v,pElementV(y[i]),u,DimV(y[i]),d);
d*=DimV(y[i]);
w=u;
u=v;
v=w;
}
swzFree(z);
}
else
if (dw_DimA(y) > 1)
bVectorTensor(pElementV(rtrn),pElementV(y[0]),pElementV(y[1]),DimV(y[0]),DimV(y[1]));
else
EquateVector(rtrn,y[0]);
return rtrn;
}
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/

34
matlab/ms-sbvar/c-code/utilities/DWCcode/arrays/dw_matrix_array.h
View File

@ -1,34 +0,0 @@
#ifndef __MATRIX_ARRAY__
#define __MATRIX_ARRAY__
#include "swzmatrix.h"
#include "dw_array.h"
extern TElementSpecification dw_VectorSpecs;
extern TElementSpecification dw_MatrixSpecs;
#define dw_CreateArray_vector(dim) (TVector*)dw_CreateArray(&dw_VectorSpecs,dim)
void* dw_InitializeArray_vector(void* x, PRECISION y);
#define dw_CreateArray_matrix(dim) (TMatrix*)dw_CreateArray(&dw_MatrixSpecs,dim)
void* dw_InitializeArray_matrix(void* X, PRECISION y);
#if (PRECISION_SIZE == 8)
#define dw_CreateArray_scalar(dim) (double*)dw_CreateArray(&dw_DoubleSpecs,dim)
#define dw_CreateMultidimensionalArray_scalar(depth,dim) dw_CreateMultidimensionalArray(&dw_DoubleSpecs,depth,dim)
#define dw_CreateMultidimensionalArrayList_scalar dw_CreateMultidimensionalArrayList_double
#define dw_CreateRectangularArray_scalar(row,col) (double**)dw_CreateMultidimensionalArrayList_double(2,row,col)
#define dw_InitializeArray_scalar(a,x) dw_InitializeArray_double(a,x)
#else
#define dw_CreateArray_scalar(dim) (float*)dw_CreateArray(&dw_FloatSpecs,dim)
#define dw_CreateMultidimensionalArray_scalar(depth,dim) dw_CreateMultidimensionalArray(&dw_FloatSpecs,depth,dim)
#define dw_CreateMultidimensionalArrayList_scalar dw_CreateMultidimensionalArrayList_float
#define dw_CreateRectangularArray_scalar(row,col) (float**)dw_CreateMultidimensionalArrayList_float(2,row,col)
#define dw_InitializeArray_scalar(a,x) dw_InitializeArray_float(a,x)
#endif
/* Tensor Calculus */
TMatrix MatrixTensor(TMatrix X, TMatrix* Y);
TVector VectorTensor(TVector x, TVector* y);
#endif

448
matlab/ms-sbvar/c-code/utilities/DWCcode/ascii/dw_ascii.c
View File

@ -1,448 +0,0 @@
#include "dw_ascii.h"
#include "dw_array.h"
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <stdarg.h>
#include "modify_for_mex.h"
/*
Attempts to open filename for reading. Returns pointer to file upon success
and prints error message and exits upon failure. The file must exist.
*/
FILE *dw_OpenTextFile(char *filename)
{
FILE *f=fopen(filename,"rt");
if (!f)
{
printf("Unable to open %s\n",filename);
swzExit(0);
}
return (f);
}
/*
Attempts to create filename for writing. Returns pointer to file upon success
and prints error message and exits upon failure. If the file exists, it is
overwritten.
*/
FILE *dw_CreateTextFile(char *filename)
{
FILE *f=fopen(filename,"wt");
if (!f)
{
printf("Unable to open %s\n",filename);
swzExit(0);
}
return (f);
}
/*
Attempts to create filename for writing. Returns pointer to file upon success
and prints error message and exits upon failure. The file is created if it
does not exist and is opened with the file pointer positioned at the end of
file if it does exist.
*/
FILE *dw_AppendTextFile(char *filename)
{
FILE *f=fopen(filename,"at");
if (!f)
{
printf("Unable to open %s\n",filename);
swzExit(0);
}
return (f);
}
/*
Assumes:
f : valid file pointer
buffer : pointer to character or null pointer
n : pointer to integer containing the length of buffer
Returns:
Pointer to null terminated string containing the characters from the file up
to and including the terminating new line character. A null pointer return
indicates that there was a memory error or no characters to be read. Call
dw_GetError() to determine if a error occured.
Results:
Reads line, beginning at current position from file f Returns a pointer to
the buffer containing the file and resets *n if necessary. The if the
passed buffer is null or is not large enough to contain the line, buffer is
freed and a new buffer is allocated. Because of this, the passed buffer
must either null or allocated with swzMalloc(), swzRealloc(), or swzCalloc() and the
calling routine is responsible for eventually freeing the memory if the
return value is not null.
Notes:
If buffer is null, then value pointed to by the pointer n is not used.
*/
#define SIZE_INCREMENT 1024
char* dw_ReadLine(FILE *f, char *buffer, int *n)
{
char *ptr, *nbuffer;
int i, k=0;
if (!buffer && !(buffer=(char*)swzMalloc(*n=SIZE_INCREMENT)))
{
*n=0;
return (char*)NULL;
}
ptr=buffer;
while (fgets(ptr,*n-k,f))
if (ptr[(i=(int)strlen(ptr))-1] == '\n')
return buffer;
else
if (!(nbuffer=(char*)swzRealloc(buffer,*n+=SIZE_INCREMENT)))
{
swzFree(buffer);
*n=0;
return (char*)NULL;
}
else
ptr=(buffer=nbuffer) + (k+=i);
if (ptr != buffer)
return buffer;
else
{
swzFree(buffer);
*n=0;
return (char*)NULL;
}
}
#undef SIZE_INCREMENT
char** dw_ParseDelimitedString(char *buffer, char delimiter, int flag)
{
struct StringList
{
struct StringList *next;
char *string;
int length;
} *head, *ptr;
int k=0, n, m;
char **v;
if (!buffer) return (char**)NULL;
for (head=ptr=(struct StringList*)NULL; *buffer; buffer+=buffer[n] ? n+1 : n)
{
if (flag & STRIP_LEADING_WHITESPACE)
while (*buffer && (*buffer != delimiter) && isspace(*buffer)) buffer++;
for (n=0; buffer[n] && (buffer[n] != delimiter); n++);
if (flag & STRIP_TRAILING_WHITESPACE)
for (m=n-1; (m >= 0) && isspace(buffer[m]); m--);
else
m=n-1;
if ((m >= 0) || !(flag & REMOVE_EMPTY_FIELDS))
{
ptr=(struct StringList*)swzMalloc(sizeof(struct StringList));
ptr->string=buffer;
ptr->length=m+1;
ptr->next=head;
head=ptr;
k++;
}
}
v=dw_CreateArray_string(k);
while (--k >= 0)
{
v[k]=(char*)swzMalloc(head->length+1);
if (head->length > 0) memcpy(v[k],head->string,head->length);
v[k][head->length]='\0';
ptr=head;
head=head->next;
swzFree(ptr);
}
return v;
}
/*
Assumes
f: valid file pointer
delimiter: field deliniter.
flag: one of the values defined in dw_ascii.h
Returns
One-dimensional string array of the delimited fields of the current line of
the file f or a null pointer.
Notes
The file is read starting from the current file position. If the file
contains no fields or there is a memory error, then a null pointer is
returned. The delimiter character defines the fields in each row and the
new line character defines the rows.
*/
char** dw_ReadDelimitedLine(FILE *f, char delimiter, int flag)
{
int n=0;
char **v=(char**)NULL, *buffer=dw_ReadLine(f,(char*)NULL,&n);
if (buffer)
{
v=dw_ParseDelimitedString(buffer,delimiter,flag);
swzFree(buffer);
}
return v;
}
/*
Assumes
f: valid file pointer or null pointer.
filename: pointer to null terminated string or null pointer.
delimiter: field deliniter.
flag: one of the values defined in dw_ascii.h
Returns
Two-dimensional string array of the deliminted fields of f or a null
pointer.
Notes
One of f and filename should be non-null. If f is non-null, the file is
read starting from the current file position. If f is null, an attempt is
made to open the file. If successful, the file is read from the beginning.
If the file does not exist or contains no fields, then a null pointer is
returned. The delimiter character defines the fields in each row and the
new line character defines the rows.
*/
char*** dw_ReadDelimitedFile(FILE *f, char* filename, char delimiter, int flag)
{
struct LineList
{
struct LineList *next;
char **line;
} *head=(struct LineList*)NULL, *ptr;
int n=0;
char **v, ***M=(char***)NULL, *buffer=(char*)NULL;
FILE *f_in=f ? f : fopen(filename,"rt");
if (f_in)
{
while (buffer=dw_ReadLine(f_in,buffer,&n))
if (v=dw_ParseDelimitedString(buffer,delimiter,flag))
{
ptr=(struct LineList*)swzMalloc(sizeof(struct LineList));
ptr->line=v;
ptr->next=head;
head=ptr;
n++;
}
if (!f) fclose(f_in);
if (n > 0)
{
M=(char***)dw_CreateArray_array(n);
while (--n >= 0)
{
M[n]=head->line;
ptr=head;
head=head->next;
swzFree(ptr);
}
}
}
return M;
}
int dw_PrintDelimitedArray(FILE *f, void* array, char delimiter)
{
char format[4];
format[0]='%';
format[1]='s';
format[2]=delimiter;
format[3]='\0';
return dw_PrintArray(f,array,format);
}
/*
Assumes:
f : valid file pointer
delimiter : field terminator
terminal : line terminator
flag : determine how characters are processed
buffer : pointer to pointer to character or null pointer
n : pointer to integer containing the length of buffer
Returns:
0 : memory error occured
1 : field read, terminated by delimiter
2 : field read, terminated by terminal
3 : field read, terminated by EOF
Results:
If necessary, memory ia reallocated. The length of this reallocated memory
is stored in n. It is the calling routines responsibility to free the
memory pointed to by *buffer.
Notes:
flag values
ALLOW_QUOTED_TEXT
If set the delimiter and terminal characters do not stop processing when
encountered between quotes. To produce a quote in quoted text, use two
consectutive quotes. Outside quoted text, a quote always begins quoted
text.
PRINTABLE_ONLY_IN_QUOTES
PRINTABLE_ONLY
STRIP_LEADING_WHITESPACE
STRIP_TRAILING_WHITESPACE
STRIP_WHITESPACE
*/
/* //#define INCREMENT 1024 ansi-c*/
/* //int dw_ReadDelimitedField(FILE *f, int delimiter, int terminal, int flag, char **buffer, int *n) ansi-c*/
/* //{ ansi-c*/
/* int ch; // next character read */
/* int k=0; // position to store next char, always less than *n */
/* int quoted=0; */
/* int leading=(flag & STRIP_LEADING_WHITESPACE) ? 1 : 0; */
/* char *ptr; */
/* ch=fgetc(f); */
/* while (ch != EOF) */
/* { */
/* //=== reallocate memory if necessary */
/* if (k+1 > *n) */
/* if (!(ptr=(char*)swzRealloc(buffer,*n+=INCREMENT))) */
/* { */
/* *n-=INCREMENT; */
/* return 0; */
/* } */
/* else */
/* buffer=ptr; */
/* //=== process character */
/* if (quoted) */
/* { */
/* if (ch == '"') */
/* if ((ch=fgets(f)) != '"') */
/* { */
/* quoted=0; */
/* continue; */
/* } */
/* if (!(flag & PRINTABLE_ONLY_IN_QUOTES) || isprint(ch)) */
/* buffer[k++]=ch; */
/* } */
/* else */
/* if ((ch == delimiter) || (ch == terminal)) */
/* break; */
/* else */
/* if ((ch == '"') && (flag & ALLOW_QUOTED_TEXT)) */
/* quoted=1; */
/* else */
/* if (!(flag & PRINTABLE_ONLY) || isprint(ch)) */
/* { */
/* if ((ch == "\r") && (terminal == '\n')) */
/* { */
/* if ((ch=fgetc(f)) == '\n') break; */
/* if (!leading) buffer[k++]='\r'; */
/* continue; */
/* } */
/* if (leading) */
/* if (isspace(ch)) */
/* { */
/* ch=fgetc(f); */
/* continue; */
/* } */
/* else */
/* leading=0; */
/* buffer[k++]=ch; */
/* } */
/* ch=fgets(f); */
/* } */
/* buffer[k]='\0'; */
/* return (ch == EOF) ? 3 : (ch == terminal) ? 2 : 1; */
/* //} ansi-c*/
/* //#undef INCREMENT ansi-c*/
/*
Returns 1 if the null terminated string id is found at the beginning of a line
in the file and 0 otherwise. The file pointer is set to the line immediately
after the line containing id. The search starts at the current position of
the file. If id is not found, then the file is rewound and the search is
continued until the initial file position is passed.
*/
int dw_SetFilePosition(FILE *f, char *id)
{
char *buffer=(char*)NULL;
int m, n, pos;
if ((n=(int)strlen(id)) > 0)
{
pos=ftell(f);
while (buffer=dw_ReadLine(f,buffer,&m))
if (!memcmp(buffer,id,n))
{
swzFree(buffer);
return 1;
}
if (pos > 0)
{
rewind(f);
while ((ftell(f) < pos) && (buffer=dw_ReadLine(f,buffer,&m)))
if (!memcmp(buffer,id,n))
{
swzFree(buffer);
return 1;
}
if (buffer) swzFree(buffer);
}
}
return 0;
}
/*
Returns 1 if the null terminated string id is found at the beginning of a line
in the file and 0 otherwise. The file pointer is set to the line immediately
after the line containing id. Compares a maximum of 1023 characters of id.
The file is not rewound so that the search starts at the current position.
*/
int dw_SetFilePositionNoRewind(FILE *f, char *id)
{
char buffer[1024], ch;
int n=(int)strlen(id);
if (n > 1023) n=1023;
while (fgets(buffer,1024,f))
{
if (buffer[strlen(buffer)-1] != '\n')
do
ch=fgetc(f);
while ((ch != '\n') && (ch != EOF));
if (!memcmp(buffer,id,n)) return 1;
}
return 0;
}
int dw_SetFilePositionBySection(FILE *f, int n, ...)
{
char *arg;
int i;
va_list ap;
rewind(f);
va_start(ap,n);
for (i=0; i < n; i++)
if (!(arg=va_arg(ap,char*)) || !dw_SetFilePositionNoRewind(f,arg))
{
va_end(ap);
return 0;
}
va_end(ap);
return 1;
}
char* dw_DuplicateString(char *buffer)
{
char *rtrn=(char*)NULL;
if (buffer && (rtrn=(char*)swzMalloc(strlen(buffer)+1))) strcpy(rtrn,buffer);
return rtrn;
}

34
matlab/ms-sbvar/c-code/utilities/DWCcode/ascii/dw_ascii.h
View File

@ -1,34 +0,0 @@
#ifndef __DW_ASCII_ROUTINES__
#define __DW_ASCII_ROUTINES__
#include <stdio.h>
/* // Flag codes. See ParseDelimitedString() for explanation. ansi-c*/
#define REMOVE_EMPTY_FIELDS 0x00000001
#define ALLOW_QUOTED_TEXT 0x00000002
#define STRIP_LEADING_WHITESPACE 0x00000004
#define STRIP_TRAILING_WHITESPACE 0x00000008
#define STRIP_WHITESPACE 0x0000000c
FILE *dw_OpenTextFile(char *filename);
FILE *dw_CreateTextFile(char *filename);
FILE *dw_AppendTextFile(char *filename);
int dw_SetFilePosition(FILE *f, char *id);
int dw_SetFilePositionNoRewind(FILE *f, char *id);
int dw_SetFilePositionBySection(FILE *f, int n, ...);
char* dw_ReadLine(FILE *f, char *buffer, int *n);
char** dw_ParseDelimitedString(char *buffer, char delimiter, int flag);
char** dw_ReadDelimitedLine(FILE *f, char delimiter, int flag);
char*** dw_ReadDelimitedFile(FILE *f, char* filename, char delimiter, int flag);
int dw_PrintDelimitedArray(FILE *f, void* array, char delimiter);
/* //int dw_ReadDelimitedField(FILE *f, char **buffer, int *n); ansi-c*/
int dw_ReadDelimitedField(FILE *f, int delimiter, int terminal, int flag, char **buffer, int *n);
char* dw_DuplicateString(char *buffer);
#endif

258
matlab/ms-sbvar/c-code/utilities/DWCcode/ascii/dw_parse_cmd.c
View File

@ -1,258 +0,0 @@
#include "dw_parse_cmd.h"
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "modify_for_mex.h"
#define ARGUMENT_ID '-'
/*
A floating point number is of the form
[white space][+/-]digits[.[digits]][E/e[+/-]digits]white space/null character
or
[white space][+/-].digits[E/e[+/-]digits]white space/null character
where characters in square brackets are optional.
Returns one if valid floating point number and zero otherwise.
*/
int dw_IsFloat(char *buffer)
{
int i=0;
if (!buffer) return 0;
/* Strip leading white space */
while (isspace(buffer[i])) i++;
/* Mantissa OK? */
if ((buffer[i] == '+') || (buffer[i] == '-')) i++;
if (isdigit(buffer[i]))
{
while (isdigit(buffer[++i]));
if ((buffer[i] == '.'))
while (isdigit(buffer[++i]));
}
else
if ((buffer[i] == '.'))
if (isdigit(buffer[++i]))
while (isdigit(buffer[++i]));
else
return 0;
else
return 0;
/* Is exponent OK? */
if ((buffer[i] == 'e') || (buffer[i] == 'E'))
{
if ((buffer[++i] == '+') || (buffer[i] == '-')) i++;
if (isdigit(buffer[i]))
while (isdigit(buffer[++i]));
else
return 0;
}
/* Is end of string or trailing white space */
if (buffer[i] && !isspace(buffer[i])) return 0;
return 1;
}
/*
Integers are of the form
[white space][+/-]digits[.]white space/null character
where characters in square brackets are optional.
Returns one if valid integer and zero otherwise.
*/
int dw_IsInteger(char *buffer)
{
int i=0;
if (!buffer) return 0;
/* Strip leading white space */
while (isspace(buffer[i])) i++;
/* Leading sign */
if ((buffer[i] == '+') || (buffer[i] == '-')) i++;
/* At least one digits possibly followed by decimal point */
if (isdigit(buffer[i]))
{
while (isdigit(buffer[++i]));
if ((buffer[i] == '.')) i++;
}
else
return 0;
/* Is end of string or trailing white space */
if (buffer[i] && !isspace(buffer[i])) return 0;
return 1;
}
/*
Searches args for a leading ARGUMENT_ID followed by the character opt. Returns
the index if found and -1 otherwise.
*/
int dw_FindArgument(int nargs, char **args, char opt)
{
int i;
for (i=nargs-1; i >= 0; i--)
if ((args[i][0] == ARGUMENT_ID) && (args[i][1] == opt)) break;
return i;
}
/*
Searches for the last argument whose leading character is ARGUMENT_ID
followed by the character opt. If such an argument is not found, then the
integer def is returned. If such an argument is found then:
Case 1: The string length of the found argument is greater than 2.
If the characters following the second form a valid integer, then this
integer is returned. Otherwise the integer def is returned.
Case 2: The string length of the found argument is equal to 2.
If there is an i+1 argument and its characters form a valid integer, then
this integer is returned. Otherwise the integer def is returned.
*/
int dw_ParseInteger(int nargs, char **args, char opt, int def)
{
int i=dw_FindArgument(nargs,args,opt);
if (i != -1)
if (dw_IsInteger(args[i]+2))
return atoi(args[i]+2);
else
if ((i+1 < nargs) && dw_IsInteger(args[i+1])) return atoi(args[i+1]);
return def;
}
/*
Searches for the last argument whose leading character is ARGUMENT_ID
followed by the character opt. If such an argument is not found, then the
double def is returned. If such an argument is found then:
Case 1: The string length of the found argument is greater than 2.
If the characters following the second form a valid floating point number,
then this value is returned. Otherwise def is returned.
Case 2: The string length of the found argument is equal to 2.
If there is an i+1 argument and its characters form a valid floating point
number, then this value is returned. Otherwise def is returned.
*/
double dw_ParseFloating(int nargs, char **args, char opt, double def)
{
int i=dw_FindArgument(nargs,args,opt);
if (i != -1)
if (dw_IsFloat(args[i]+2))
return atof(args[i]+2);
else
if ((i+1 < nargs) && dw_IsFloat(args[i+1])) return atof(args[i+1]);
return def;
}
/*
Searches for the last argument whose leading character is ARGUMENT_ID
followed by the character opt. If such an argument is not found, then the
pointer def is returned. If such an argument is found then:
Case 1: The string length of the found argument is greater than 2.
A pointer to the found argument plus two is returned.
Case 2: The string length of the found argument is equal to 2.
If there is an i+1 argument then a pointer to this argument is returned.
Otherwise the integer def is returned.
*/
char* dw_ParseString(int nargs, char **args, char opt, char *def)
{
int i=dw_FindArgument(nargs,args,opt);
if (i != -1)
if (args[i][2])
return args[i]+2;
else
if (i+1 < nargs) return args[i+1];
return def;
}
/*
Searches args for a leading ARGUMENT_ID followed by the string opt. Returns
the index if found and -1 otherwise.
*/
int dw_FindArgument_String(int nargs, char **args, char *opt)
{
int i;
for (i=nargs-1; i >= 0; i--)
if ((args[i][0] == ARGUMENT_ID) && !strcmp(args[i]+1,opt)) break;
return i;
}
/*
Searches for the last argument whose leading character is a ARGUMENT_ID
followed by the string opt. If such an argument is not found, then the
integer def is returned. If such an argument is found then:
Case 1: The string length of the found argument is greater than 1+strlen(opt).
If the characters following the second form a valid integer, then this
integer is returned. Otherwise the integer def is returned.
Case 2: The string length of the found argument is equal to 1+strlen(opt).
If there is an i+1 argument and its characters form a valid integer, then
this integer is returned. Otherwise the integer def is returned.
*/
int dw_ParseInteger_String(int nargs, char **args, char *opt, int def)
{
int i=dw_FindArgument_String(nargs,args,opt);
if ((i != -1) && (i+1 < nargs) && dw_IsInteger(args[i+1])) return atoi(args[i+1]);
return def;
}
/*
Searches for the last argument whose leading character is ARGUMENT_ID
followed by the string opt. If such an argument is not found, then the
double def is returned. If such an argument is found then:
Case 1: The string length of the found argument is greater than 1+strlen(opt).
If the characters following the second form a valid floating point number,
then this value is returned. Otherwise def is returned.
Case 2: The string length of the found argument is equal to 1+strlen(opt).
If there is an i+1 argument and its characters form a valid floating point
number, then this value is returned. Otherwise def is returned.
*/
double dw_ParseFloating_String(int nargs, char **args, char *opt, double def)
{
int i=dw_FindArgument_String(nargs,args,opt);
if ((i != -1) && (i+1 < nargs) && dw_IsFloat(args[i+1])) return atof(args[i+1]);
return def;
}
/*
Searches for the last argument whose leading character is ARGUMENT_ID
followed by the string opt. If such an argument is not found, then the
pointer def is returned. If such an argument is found then:
Case 1: The string length of the found argument is greater than 1+strlen(opt).
A pointer to the found argument plus two is returned.
Case 2: The string length of the found argument is equal to 1+strlen(opt).
If there is an i+1 argument, then a pointer to this argument is returned.
Otherwise the string def is returned.
*/
char* dw_ParseString_String(int nargs, char **args, char *opt, char *def)
{
int i=dw_FindArgument_String(nargs,args,opt);
if ((i != -1) && (i+1 < nargs)) return args[i+1];
return def;
}

24
matlab/ms-sbvar/c-code/utilities/DWCcode/ascii/dw_parse_cmd.h
View File

@ -1,24 +0,0 @@
#ifndef __PARSE_COMMAND_LINE__
#define __PARSE_COMMAND_LINE__
#ifdef __cplusplus
extern "C"
{
#endif
int dw_FindArgument(int nargs, char **args, char opt);
int dw_ParseInteger(int nargs, char **args, char opt, int def);
double dw_ParseFloating(int nargs, char **args, char opt, double def);
char* dw_ParseString(int nargs, char **args, char opt, char *def);
int dw_FindArgument_String(int nargs, char **args, char *opt);
int dw_ParseInteger_String(int nargs, char **args, char *opt, int def);
double dw_ParseFloating_String(int nargs, char **args, char *opt, double def);
char* dw_ParseString_String(int nargs, char **args, char *opt, char *def);
#ifdef __cplusplus
}
#endif
#endif

208
matlab/ms-sbvar/c-code/utilities/DWCcode/error/dw_error.c
View File

@ -1,208 +0,0 @@
#include "dw_error.h"
#include <stdlib.h>
#include <string.h>
#include "modify_for_mex.h"
#define ERROR_MESSAGE_BUFFER_LENGTH 256
static int ERROR=NO_ERR;
static char ERROR_MESSAGE[ERROR_MESSAGE_BUFFER_LENGTH]="";
static int TerminalErrors=ALL_ERRORS;
static int VerboseErrors=ALL_ERRORS;
static FILE* f_err=(FILE*)NULL;
/*
Returns the value of the current error flag.
*/
int dw_GetError(void)
{
return ERROR;
}
/*
Returns pointer to current error message. This buffer should not be modified
or freed.
*/
char* dw_GetErrorMessage(void)
{
return ERROR_MESSAGE;
}
/*
Clears the error flag and returns the value of the previous flag. This is the
most efficient way to clear the error flag and message.
*/
int dw_ClearError(void)
{
int rtrn=ERROR;
ERROR=NO_ERR;
ERROR_MESSAGE[0]='\0';
return rtrn;
}
/*
Sets the error flag to err, the error message to msg and returns the value of
the previous flag. If the null terminated string msg is longer than 255
characters, only the first 255 characters are used. If msg is null, then a
predefined error message is used.
*/
int dw_SetError(int err, char *msg)
{
int rtrn=ERROR;
if (msg)
switch (ERROR=err)
{
case MEM_ERR:
case FILE_ERR:
case PARSE_ERR:
case FLOAT_ERR:
case NULL_ERR:
case ARG_ERR:
case ITERATION_ERR:
case NOT_IMPLEMENTED_ERR:
case SIZE_ERR:
case SING_ERR:
case POSDEF_ERR:
case BLAS_LAPACK_ERR:
case USER_ERR:
strncpy(ERROR_MESSAGE,msg,ERROR_MESSAGE_BUFFER_LENGTH-1);
ERROR_MESSAGE[ERROR_MESSAGE_BUFFER_LENGTH-1]='\0';
break;
case NO_ERR:
ERROR_MESSAGE[0]='\0';
break;
default:
ERROR=UNKNOWN_ERR;
strcpy(ERROR_MESSAGE,"Unknown error.");
break;
}
else
switch (ERROR=err)
{
case MEM_ERR:
strcpy(ERROR_MESSAGE,"Out of memory.");
break;
case FILE_ERR:
strcpy(ERROR_MESSAGE,"File operation error.");
break;
case PARSE_ERR:
strcpy(ERROR_MESSAGE,"Error parsing data.");
break;
case FLOAT_ERR:
strcpy(ERROR_MESSAGE,"Floating point error.");
break;
case NULL_ERR:
strcpy(ERROR_MESSAGE,"Unexpected null pointer encountered.");
break;
case ARG_ERR:
strcpy(ERROR_MESSAGE,"Argument error.");
break;
case ITERATION_ERR:
strcpy(ERROR_MESSAGE,"Maximum iteration limit exceeded.");
break;
case NOT_IMPLEMENTED_ERR:
strcpy(ERROR_MESSAGE,"Feature not yet implemented.");
break;
case SIZE_ERR:
strcpy(ERROR_MESSAGE,"Matrices/vectors not conformable.");
break;
case SING_ERR:
strcpy(ERROR_MESSAGE,"Singular matrix.");
break;
case POSDEF_ERR:
strcpy(ERROR_MESSAGE,"Matrix not positive definite.");
break;
case BLAS_LAPACK_ERR:
strcpy(ERROR_MESSAGE,"Blas/Lapack error.");
break;
case USER_ERR:
strcpy(ERROR_MESSAGE,"Undocumented error.");
break;
case NO_ERR:
ERROR_MESSAGE[0]='\0';
break;
default:
ERROR=UNKNOWN_ERR;
strcpy(ERROR_MESSAGE,"Unknown error.");
break;
}
if (VerboseErrors & ERROR) fprintf(f_err ? f_err : stderr,"%s\n",ERROR_MESSAGE);
if (TerminalErrors & ERROR) swzExit(ERROR);
return rtrn;
}
/*
Sets the error flag and to err, sets the error message to the predefined error
message, and returns the value of the previous error flag.
*/
int dw_Error(int err)
{
return dw_SetError(err,(char*)NULL);
}
/*
Sets the error flag and to USER_ERR, sets the error message to msg, and
returns the value of the previous error flag.
*/
int dw_UserError(char *msg)
{
return dw_SetError(USER_ERR,msg);
}
/*
Sets errors which terminate program. The integer err should be a combination
of the error flags defined in dw_error.h.
*/
int dw_SetTerminalErrors(int err)
{
int rtrn=TerminalErrors;
TerminalErrors=err & ALL_ERRORS;
return rtrn;
}
/*
Returns the current terminal errors.
*/
int dw_GetTerminalErrors(void)
{
return TerminalErrors;
}
/*
Sets errors which causes program to print a error message to f_err. The
integer err should be a combination of the error flags defined in dw_error.h.
*/
int dw_SetVerboseErrors(int err)
{
int rtrn=VerboseErrors;
VerboseErrors=err & ALL_ERRORS;
return rtrn;
}
/*
Returns the current verbose errors.
*/
int dw_GetVerboseErrors(void)
{
return VerboseErrors;
}
/*
Sets the file to which errors messages will be sent. The file pointer f
must either be the null pointer or a valid printer to an open file. Passing a
null pointer has the same effect as redirecting output to stderr. To suppress
output of error messages, call dw_SetVerboseErrors(). Returns a pointer to
current error message file. When redirecting the error message, if is
critical that the error message file pointer point to an open file and that
this file not be closed as long as it is the current error message file.
*/
FILE* dw_SetErrorMessageFile(FILE *f)
{
FILE *rtrn=f_err;
f_err=f ? f : stderr;
return rtrn;
}

42
matlab/ms-sbvar/c-code/utilities/DWCcode/error/dw_error.h
View File

@ -1,42 +0,0 @@
#ifndef __ERROR_HANDLING__
#define __ERROR_HANDLING__
#include <stdio.h>
#define NO_ERR 0x00000000
#define ALL_ERRORS 0x000F03FF
/* //=== General Errors === ansi-c*/
#define MEM_ERR 0x00000001
#define FILE_ERR 0x00000002
#define PARSE_ERR 0x00000004
#define FLOAT_ERR 0x00000008
#define NULL_ERR 0x00000010
#define ARG_ERR 0x00000020
#define ITERATION_ERR 0x00000040
#define USER_ERR 0x00000080
#define NOT_IMPLEMENTED_ERR 0x00000100
#define UNKNOWN_ERR 0x00000200
/* //=== Matrix Errors === ansi-c*/
#define SIZE_ERR 0x00010000
#define SING_ERR 0x00020000
#define POSDEF_ERR 0x00040000
#define BLAS_LAPACK_ERR 0x00080000
/* //=== Error Routines === ansi-c*/
int dw_GetError(void);
char* dw_GetErrorMessage(void);
int dw_ClearError(void);
int dw_SetError(int err, char *msg);
int dw_Error(int err);
int dw_UserError(char *msg);
int dw_SetVerboseErrors(int errors);
int dw_GetVerboseErrors(void);
int dw_SetTerminalErrors(int errors);
int dw_GetTerminalErrors(void);
FILE* dw_SetMessageFile(FILE *f);
#endif

751
matlab/ms-sbvar/c-code/utilities/DWCcode/histogram/dw_histogram.c
View File

@ -1,751 +0,0 @@
#include <math.h>
#include <string.h>
#include <stdlib.h>
#include "dw_histogram.h"
#include "dw_error.h"
#include "modify_for_mex.h"
static void Resize(PRECISION x, int *h, PRECISION *min, PRECISION *max, int intervals);
static void AddObservationVariable(PRECISION x, int *h, PRECISION *min, PRECISION *max, int intervals);
static void AddObservationFixed(PRECISION x, int *low, int *h, int *high, PRECISION min, PRECISION max, int intervals);
static PRECISION Cumulative(PRECISION level, int low, int *h, PRECISION min, PRECISION max, int intervals, int sample_size);
static PRECISION Percentile(PRECISION percentile, int low, int *h, PRECISION min, PRECISION max, int intervals, int sample_size);
static TMatrix MakeHistogram(int low, int *h, PRECISION min, PRECISION max,int intervals, int sample_size,
PRECISION min_out, PRECISION max_out, int bins);
static TMatrix MakeHistogramAuto(int low, int *h, int high, PRECISION min, PRECISION max, int intervals, int sample_size, int bins);
/*******************************************************************************
The following set of routines create a matrix of histograms on the fly.
*******************************************************************************/
/*
Assumes
rows > 0
cols > 0
intervals > 0
type = HISTOGRAM_FIXED or HISTOGRAM_VARIABLE
Results
Creates and returns a matrix histogram data structure. The size of the
matrix is m x n and the number of intervals is intrvls.
*/
TMatrixHistogram *CreateMatrixHistogram(int rows, int cols, int intervals, int type)
{
int i, j;
TMatrixHistogram *h;
if (!(h=(TMatrixHistogram *)swzMalloc(sizeof(TMatrixHistogram)))) dw_Error(MEM_ERR);
if (!(h->freq=(int***)swzMalloc(rows*sizeof(int**)))) dw_Error(MEM_ERR);
for (i=rows-1; i >= 0; i--)
{
if (!(h->freq[i]=(int**)swzMalloc(cols*sizeof(int*)))) dw_Error(MEM_ERR);
for (j=cols-1; j >= 0; j--)
if (!(h->freq[i][j]=(int*)swzMalloc(intervals*sizeof(int)))) dw_Error(MEM_ERR);
}
if (!(h->low=(int**)swzMalloc(rows*sizeof(int*)))) dw_Error(MEM_ERR);
for (i=rows-1; i >= 0; i--)
if (!(h->low[i]=(int*)swzMalloc(cols*sizeof(int)))) dw_Error(MEM_ERR);
if (!(h->high=(int**)swzMalloc(rows*sizeof(int*)))) dw_Error(MEM_ERR);
for (i=rows-1; i >= 0; i--)
if (!(h->high[i]=(int*)swzMalloc(cols*sizeof(int)))) dw_Error(MEM_ERR);
h->Min=CreateMatrix(rows,cols);
h->Max=CreateMatrix(rows,cols);
h->rows=rows;
h->cols=cols;
h->intervals=intervals;
h->sample_size=0;
h->type=type;
return h;
}
void SetMaxMinMatrixHistogram(TMatrix Min, TMatrix Max, TMatrixHistogram *h)
{
EquateMatrix(h->Min,Min);
EquateMatrix(h->Max,Max);
h->sample_size=0;
}
void FreeMatrixHistogram(TMatrixHistogram *h)
{
int i, j;
for (i=h->rows-1; i >= 0; i--)
{
for (j=h->cols-1; j >= 0; j--) swzFree(h->freq[i][j]);
swzFree(h->freq[i]);
}
swzFree(h->freq);
for (i=h->rows-1; i >= 0; i--) swzFree(h->low[i]);
swzFree(h->low);
for (i=h->rows-1; i >= 0; i--) swzFree(h->high[i]);
swzFree(h->high);
FreeMatrix(h->Min);
FreeMatrix(h->Max);
swzFree(h);
}
void AddMatrixObservation(TMatrix X, TMatrixHistogram *h)
{
int i, j, k;
if ((h->rows != RowM(X)) || (h->cols != ColM(X))) dw_Error(SIZE_ERR);
if (h->sample_size <= 0)
{
for (i=h->rows-1; i >= 0; i--)
for (j=h->cols-1; j >= 0; j--)
{
h->low[i][j]=h->high[i][j]=0;
for (k=h->intervals-1; k >= 0; k--) h->freq[i][j][k]=0;
}
if (h->type == HISTOGRAM_VARIABLE)
for (i=h->rows-1; i >= 0; i--)
for (j=h->cols-1; j >= 0; j--)
ElementM(h->Min,i,j)=ElementM(h->Max,i,j)=ElementM(X,i,j);
}
if (h->type == HISTOGRAM_FIXED)
for (i=h->rows-1; i >= 0; i--)
for (j=h->cols-1; j >= 0; j--)
AddObservationFixed(ElementM(X,i,j),h->low[i]+j,h->freq[i][j],h->high[i]+j,ElementM(h->Min,i,j),ElementM(h->Max,i,j),h->intervals);
else
for (i=h->rows-1; i >= 0; i--)
for (j=h->cols-1; j >= 0; j--)
AddObservationVariable(ElementM(X,i,j),h->freq[i][j],&ElementM(h->Min,i,j),&ElementM(h->Max,i,j),h->intervals);
h->sample_size++;
}
void MatrixPercentile(TMatrix X, PRECISION percentile, TMatrixHistogram *h)
{
int i, j;
if ((h->rows != RowM(X)) || (h->cols != ColM(X))) dw_Error(SIZE_ERR);
for (i=h->rows-1; i >= 0; i--)
for (j=h->cols-1; j >= 0; j--)
ElementM(X,i,j)=Percentile(percentile,h->low[i][j],h->freq[i][j],ElementM(h->Min,i,j),ElementM(h->Max,i,j),h->intervals,h->sample_size);
}
/*
Returns the probability that an observation is less than or equal to
level.
Assumes
For 0 <= i < h->rows and 0 <= j < h->cols, let
I[i][j][k]=(h->min[i][j] + k*inc[i][j], h->min[i][j] + (k+1)*inc[i][j]),
where inc[i][j]=(h->max[i][j] - h->min[i][j])/h->samples_size. The
distribution is uniform on I[i][k][j] and
P(h->min[i][j] + k*inc[i][j] < x[i][j] < h->min[i][j] + (k+1)*inc[i][j])
= h->freq[i][j][k]/h->sample_size.
Furthermore,
P(x[i][j] < h->min[i][j]) = 0 and P(x[i][j] > h->min[i][j]) = 0.
In addition, if h->type == FIXED, then
P(x[i][j] = h->min[i][j]) = h->low[i][j]/h->sample_size
and
P(x[i][j] = h->min[i][j]) = h->high[i][j]/h->sample_size.
*/
void MatrixCumulative(TMatrix P, TMatrix Level, TMatrixHistogram *h)
{
int i, j;
if ((h->rows != RowM(P)) || (h->cols != ColM(P)) ||
(h->rows != RowM(Level)) || (h->cols != ColM(Level)))
dw_Error(SIZE_ERR);
for (i=h->rows-1; i >= 0; i--)
for (j=h->cols-1; j >= 0; j--)
ElementM(P,i,j)=Cumulative(ElementM(Level,i,j),h->low[i][j],h->freq[i][j],ElementM(h->Min,i,j),ElementM(h->Max,i,j),h->intervals,h->sample_size);
}
TMatrix PlotMatrixHistogramAuto(int i, int j, int bins, TMatrixHistogram *h)
{
return MakeHistogramAuto(h->low[i][j],h->freq[i][j],h->high[i][j],ElementM(h->Min,i,j),ElementM(h->Max,i,j),h->intervals,h->sample_size,bins);
}
TMatrix PlotMatrixHistogram(int i, int j, PRECISION min, PRECISION max, int bins, TMatrixHistogram *h)
{
return MakeHistogram(h->low[i][j],h->freq[i][j],ElementM(h->Min,i,j),ElementM(h->Max,i,j),h->intervals,h->sample_size,min,max,bins);
}
/*******************************************************************************
The following set of routines create a vector of histograms on the fly.
*******************************************************************************/
TVectorHistogram *CreateVectorHistogram(int dim, int intervals, int type)
{
int i;
TVectorHistogram *h;
if (!(h=(TVectorHistogram *)swzMalloc(sizeof(TVectorHistogram))))
dw_Error(MEM_ERR);
if (!(h->freq=(int**)swzMalloc(dim*sizeof(int*)))) dw_Error(MEM_ERR);
for (i=dim-1; i >= 0; i--)
if (!(h->freq[i]=(int*)swzMalloc(intervals*sizeof(int)))) dw_Error(MEM_ERR);
if (!(h->low=(int*)swzMalloc(dim*sizeof(int)))) dw_Error(MEM_ERR);
if (!(h->high=(int*)swzMalloc(dim*sizeof(int)))) dw_Error(MEM_ERR);
h->Min=CreateVector(dim);
h->Max=CreateVector(dim);
h->dim=dim;
h->intervals=intervals;
h->sample_size=0;
h->type=type;
return h;
}
void SetMaxMinVectorHistogram(TVector Min, TVector Max, TVectorHistogram *h)
{
EquateVector(h->Min,Min);
EquateVector(h->Max,Max);
h->sample_size=0;
}
void FreeVectorHistogram(TVectorHistogram *h)
{
int i;
for (i=h->dim-1; i >= 0; i--) swzFree(h->freq[i]);
swzFree(h->freq);
swzFree(h->low);
swzFree(h->high);
FreeVector(h->Min);
FreeVector(h->Max);
swzFree(h);
}
void AddVectorObservation(TVector x, TVectorHistogram *h)
{
int i, k;
if (h->dim != DimV(x)) dw_Error(SIZE_ERR);
if (h->sample_size <= 0)
{
for (i=h->dim-1; i >= 0; i--)
{
h->low[i]=h->high[i]=0;
for (k=h->intervals-1; k >= 0; k--) h->freq[i][k]=0;
}
if (h->type == HISTOGRAM_VARIABLE)
for (i=h->dim-1; i >= 0; i--)
ElementV(h->Min,i)=ElementV(h->Max,i)=ElementV(x,i);
}
if (h->type == HISTOGRAM_FIXED)
for (i=h->dim-1; i >= 0; i--)
AddObservationFixed(ElementV(x,i),h->low+i,h->freq[i],h->high+i,ElementV(h->Min,i),ElementV(h->Max,i),h->intervals);
else
for (i=h->dim-1; i >= 0; i--)
AddObservationVariable(ElementV(x,i),h->freq[i],&ElementV(h->Min,i),&ElementV(h->Max,i),h->intervals);
h->sample_size++;
}
void VectorPercentile(TVector x, PRECISION percentile, TVectorHistogram *h)
{
int i;
if (h->dim != DimV(x)) dw_Error(SIZE_ERR);
for (i=h->dim-1; i >= 0; i--)
ElementV(x,i)=Percentile(percentile,h->low[i],h->freq[i],ElementV(h->Min,i),ElementV(h->Max,i),h->intervals,h->sample_size);
}
/*
Returns the probability that an observation is less than or equal to
level.
Assumes
For 0 <= i < h->dim, let
I[i][k]=(h->min[i] + k*inc[i], h->min[i] + (k+1)*inc[i]),
where inc[i]=(h->max[i] - h->min[i])/h->samples_size. The distribution
is uniform on I[i][k] and
P(h->min[i] + k*inc[i] < x[i] < h->min[i] + (k+1)*inc[i])
= h->freq[i][k]/h->sample_size.
Furthermore,
P(x[i] < h->min[i]) = 0 and P(x[i] > h->min[i]) = 0.
In addition, if h->type == FIXED, then
P(x[i] = h->min[i]) = h->low[i]/h->sample_size
and
P(x[i] = h->min[i]) = h->high[i]/h->sample_size.
*/
void VectorCumulative(TVector p, TVector level, TVectorHistogram *h)
{
int i;
if (h->dim != DimV(p) || (h->dim != DimV(level)))
dw_Error(SIZE_ERR);
for (i=h->dim-1; i >= 0; i--)
ElementV(p,i)=Cumulative(ElementV(level,i),h->low[i],h->freq[i],ElementV(h->Min,i),ElementV(h->Max,i),h->intervals,h->sample_size);
}
TMatrix PlotVectorHistogramAuto(int i, int bins, TVectorHistogram *h)
{
return MakeHistogramAuto(h->low[i],h->freq[i],h->high[i],ElementV(h->Min,i),ElementV(h->Max,i),h->intervals,h->sample_size,bins);
}
TMatrix PlotVectorHistogram(int i, PRECISION min, PRECISION max, int bins, TVectorHistogram *h)
{
return MakeHistogram(h->low[i],h->freq[i],ElementV(h->Min,i),ElementV(h->Max,i),h->intervals,h->sample_size,min,max,bins);
}
/*******************************************************************************
The following set of routines create a scalar histogram on the fly.
*******************************************************************************/
/*
Assumes
Results
Creates and returns a scalar histogram data structure.
*/
TScalarHistogram *CreateScalarHistogram(int intervals, int type)
{
TScalarHistogram *h;
if (!(h=(TScalarHistogram *)swzMalloc(sizeof(TScalarHistogram)))) dw_Error(MEM_ERR);
if (!(h->freq=(int*)swzMalloc(intervals*sizeof(int)))) dw_Error(MEM_ERR);
h->intervals=intervals;
h->sample_size=0;
h->type=type;
return h;
}
void SetMaxMinScalarHistogram(PRECISION Min, PRECISION Max, TScalarHistogram *h)
{
h->Min=Min;
h->Max=Max;
h->sample_size=0;
}
void FreeScalarHistogram(TScalarHistogram *h)
{
swzFree(h->freq);
swzFree(h);
}
void AddScalarObservation(PRECISION x, TScalarHistogram *h)
{
int k;
if (h->sample_size <= 0)
{
h->low=h->high=0;
for (k=h->intervals-1; k >= 0; k--) h->freq[k]=0;
if (h->type == HISTOGRAM_VARIABLE) h->Min=h->Max=x;
}
if (h->type == HISTOGRAM_FIXED)
AddObservationFixed(x,&(h->low),h->freq,&(h->high),h->Min,h->Max,h->intervals);
else
AddObservationVariable(x,h->freq,&(h->Min),&(h->Max),h->intervals);
h->sample_size++;
}
PRECISION ScalarPercentile(PRECISION percentile, TScalarHistogram *h)
{
return Percentile(percentile,h->low,h->freq,h->Min,h->Max,h->intervals,h->sample_size);
}
/*
Returns the probability that an observation is less than or equal to
level.
Assumes
Let
I[k]=(h->min + k*inc, h->min + (k+1)*inc),
where inc=(h->max - h->min)/h->samples_size. The distribution
is uniform on I[k] and
P(h->min + k*inc < x < h->min + (k+1)*inc) = h->freq[k]/h->sample_size.
Furthermore,
P(x < h->min) = 0 and P(x > h->min) = 0.
In addition, if h->type == FIXED, then
P(x = h->min) = h->low/h->sample_size
and
P(x = h->min) = h->high/h->sample_size.
*/
PRECISION ScalarCumulative(PRECISION level, TScalarHistogram *h)
{
return Cumulative(level,h->low,h->freq,h->Min,h->Max,h->intervals,h->sample_size);
}
TMatrix PlotScalarHistogramAuto(int bins, TScalarHistogram *h)
{
return MakeHistogramAuto(h->low,h->freq,h->Min,h->high,h->Max,h->intervals,h->sample_size,bins);
}
TMatrix PlotScalarHistogram(PRECISION min, PRECISION max, int bins, TScalarHistogram *h)
{
return MakeHistogram(h->low,h->freq,h->Min,h->Max,h->intervals,h->sample_size,min,max,bins);
}
/*******************************************************************************/
/***************************** Low Level Routines ******************************/
/*******************************************************************************/
/*
Resizes the histogram. After resizing, it is guaranteed that *min <= x <= *max.
The type of the histogram must be HISTOGRAM_VARIABLE.
*/
static void Resize(PRECISION x, int *h, PRECISION *min, PRECISION *max, int intervals)
{
int i, j, k, m;
if (x > *max)
if (x - *min >= (PRECISION)intervals*(*max - *min))
{
for (i=1; i < intervals; i++)
{
h[0]+=h[i];
h[i]=0;
}
*max=x;
}
else
{
m=(int)ceil((x - *min)/(*max - *min));
for (i=j=0; i < intervals; j++)
for(h[j]=h[i++], k=1; (k < m) && (i < intervals); k++)
h[j]+=h[i++];
for ( ; j < intervals; j++) h[j]=0;
*max=*min + m*(*max - *min);
if (x > *max) *max=x;
}
else
if (x < *min)
if (*max - x >= (PRECISION)intervals*(*max - *min))
{
for (j=intervals-1, i=intervals-2; i >= 0; i--)
{
h[j]+=h[i];
h[i]=0;
}
*min=x;
}
else
{
m=(int)ceil((*max - x)/(*max - *min));
for (i=j=intervals-1; i >= 0; j--)
for(h[j]=h[i--], k=1; (k < m) && (i >= 0); k++)
h[j]+=h[i--];
for ( ; j >= 0; j--) h[j]=0;
*min=*max - m*(*max - *min);
if (x < *min) *min=x;
}
}
/*
Adds a observation to the histogram. The type of the histogram must
be HISTOGRAM_VARIABLE.
*/
static void AddObservationVariable(PRECISION x, int *h, PRECISION *min, PRECISION *max, int intervals)
{
int i;
if ((x < *min) || (x > *max)) Resize(x,h,min,max,intervals);
if (*max > *min)
{
i=(int)(intervals*(x - *min)/(*max - *min));
h[(i < intervals) ? i : intervals-1]++;
}
else
h[0]++;
}
/*
Adds a observation to the histogram. The type of the histogram must
be HISTOGRAM_FIXED.
*/
static void AddObservationFixed(PRECISION x, int *low, int *h, int *high, PRECISION min, PRECISION max, int intervals)
{
PRECISION y=floor(intervals*(x - min)/(max - min));
if (y < 0)
(*low)++;
else
if (y < intervals)
h[(int)y]++;
else
(*high)++;
}
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
/*
Returns the level such that the probability of observing an observation
less than or equal to level is percentile. If there is a point mass at
x, and P(y < x) <= percentile <= P(y <= x), then x is returned.
Assumes
Both intervals and sample_size are poitive and low and h[i] are
non-negative. Also if
high = sample_size - (low + h[0] + ... + h[intervals - 1]),
then high is non-negative.
If min < max, let inc=(max - min)/intervals and define
I[k]=(min + k*inc, min + (k+1)*inc),
The distribution is uniform on I[k] and
P(min + k*inc < x < min + (k+1)*inc) = h[k]/sample_size.
Furthermore, there are point masses at min and max with probability
P(x = min) = low/sample_size
and
P(x = max) = high/sample_size.
If min = max, then there is a single point mass at this point.
*/
static PRECISION Percentile(PRECISION percentile, int low, int *h, PRECISION min, PRECISION max, int intervals, int sample_size)
{
int i;
percentile=percentile*sample_size - low;
if (percentile <= 0) return min;
for (i=0; i < intervals; i++)
if (h[i] && (percentile-=h[i]) <= 0)
return min + ((PRECISION)(i+1) + percentile/(PRECISION)h[i])*(max - min)/(PRECISION)intervals;
return max;
}
/*
Returns the probability that an observation is less than or equal to
level.
Assumes
Both intervals and sample_size are poitive and low and h[i] are
non-negative. Also, if
high = sample_size - (low + h[0] + ... + h[intervals - 1]),
then high is non-negative.
If min < max, let inc=(max - min)/intervals and define
I[k]=(min + k*inc, min + (k+1)*inc),
The distribution is uniform on I[k] and
P(min + k*inc < x < min + (k+1)*inc) = h[k]/sample_size.
Furthermore, there are point masses at min and max with probability
P(x = min) = low/sample_size
and
P(x = max) = high/sample_size.
If min = max, then there is a single point mass at this point
*/
static PRECISION Cumulative(PRECISION level, int low, int *h, PRECISION min, PRECISION max, int intervals, int sample_size)
{
PRECISION inc=(max-min)/(PRECISION)intervals;
int i, count;
if (level < min) return 0.0;
if (level >= max) return 1.0;
for (count=low, i=0; i < intervals; count+=h[i++])
if ((min+=inc) >= level)
return ((PRECISION)count + (PRECISION)h[i]*(level - min + inc)/inc)/(PRECISION)sample_size;
return 1.0;
}
/*
Returns a histogram over the interval I=[min_out,max_out]. The matrix returned
has bins rows and 2 columns. If inc=(max_out - min_out)/bins, then the first
element of the ith row is
min + (i + 0.5)*inc,
which is the mid-point of the ith interval. The second element is
P(min + i*inc < x <= min + (i + 1)*inc)/inc,
which is the average density over the ith interval.
Assumes
Both intervals and sample_size are poitive and low and h[i] are
non-negative. Also if
high = sample_size - (low + h[0] + ... + h[intervals - 1]),
then high is non-negative.
If min < max, let inc=(max - min)/intervals and define
I[k]=(min + k*inc, min + (k+1)*inc),
The distribution is uniform on I[k] and
P(min + k*inc < x < min + (k+1)*inc) = h[k]/sample_size.
Furthermore, there are point masses at min and max with probability
P(x = min) = low/sample_size
and
P(x = max) = high/sample_size.
If min = max, then there is a single point mass at this point.
*/
static TMatrix MakeHistogram(int low, int *h, PRECISION min, PRECISION max,
int intervals, int sample_size, PRECISION min_out, PRECISION max_out, int bins)
{
int i;
PRECISION inc, x, cdf_lower, cdf_upper;
TMatrix X;
inc=(max_out-min_out)/(PRECISION)bins;
if (inc > 0)
{
X=CreateMatrix(bins,2);
x=min_out+inc;
cdf_lower=Cumulative(min_out,low,h,min,max,intervals,sample_size);
for (i=0; i < bins; i++)
{
cdf_upper=Cumulative(x,low,h,min,max,intervals,sample_size);
ElementM(X,i,0)=x - 0.5*inc;
ElementM(X,i,1)=(cdf_upper-cdf_lower)/inc;
cdf_lower=cdf_upper;
x+=inc;
}
}
else
return (TMatrix)NULL;
return X;
}
/*
Automatically chooses lenth of interval over which to produce histogram and
then calls MakeHistogram().
*/
static TMatrix MakeHistogramAuto(int low, int *h, int high, PRECISION min, PRECISION max, int intervals, int sample_size, int bins)
{
PRECISION inc=(max-min)/intervals, max_out, min_out;
int lo, hi;
if ((low == sample_size) || (inc <= 0))
{
min_out=min-1.0;
max_out=min+1.0;
}
else
{
if (low > 0)
lo=-1;
else
for (lo=0; (lo < intervals) && !h[lo]; lo++);
if (lo == intervals)
{
min_out=max-1.0;
max_out=max+1.0;
}
else
{
if (high > 0)
hi=intervals;
else
for (hi=intervals-1; !h[hi]; hi--);
if (lo >= 0)
if (hi < intervals)
{
min_out=min+lo*inc;
max_out=min+(hi+1)*inc;
}
else
{
min_out=min+lo*inc;
if (bins == 1)
max_out=(1+SQRT_MACHINE_EPSILON)*max;
else
{
inc=(1-SQRT_MACHINE_EPSILON)*(max - min_out)/(PRECISION)(bins-1);
max_out=max + inc;
}
}
else
if (hi < intervals)
{
max_out=min+(hi+1)*inc;
if (bins == 1)
min_out=(1-SQRT_MACHINE_EPSILON)*min;
else
{
inc=(1-SQRT_MACHINE_EPSILON)*(max_out - min)/(PRECISION)(bins-1);
min_out=min - inc;
}
}
else
if (bins <= 2)
{
min_out=(1-SQRT_MACHINE_EPSILON)*min;
max_out=(1+SQRT_MACHINE_EPSILON)*max;
}
else
{
inc=(1-SQRT_MACHINE_EPSILON)*(max_out - min)/(PRECISION)(bins-2);
min_out=min - inc;
max_out=max +inc;
}
}
}
return MakeHistogram(low,h,min,max,intervals,sample_size,min_out,max_out,bins);
}

77
matlab/ms-sbvar/c-code/utilities/DWCcode/histogram/dw_histogram.h
View File

@ -1,77 +0,0 @@
#ifndef __HISTOGRAMS__
#define __HISTOGRAMS__
#include "swzmatrix.h"
#define HISTOGRAM_FIXED 1
#define HISTOGRAM_VARIABLE 2
/* Matrix histograms */
typedef struct
{
TMatrix Min;
TMatrix Max;
int **low;
int **high;
int ***freq;
int rows;
int cols;
int intervals;
int sample_size;
int type;
} TMatrixHistogram;
/* Vector histograms */
typedef struct
{
TVector Min;
TVector Max;
int *low;
int *high;
int **freq;
int dim;
int intervals;
int sample_size;
int type;
} TVectorHistogram;
/* Scalar histograms */
typedef struct
{
PRECISION Min;
PRECISION Max;
int low;
int high;
int *freq;
int intervals;
int sample_size;
int type;
} TScalarHistogram;
TMatrixHistogram *CreateMatrixHistogram(int rows, int cols, int intervals, int type);
void SetMaxMinMatrixHistogram(TMatrix Min, TMatrix Max, TMatrixHistogram *h);
void FreeMatrixHistogram(TMatrixHistogram *h);
void AddMatrixObservation(TMatrix X, TMatrixHistogram *h);
void MatrixPercentile(TMatrix X, PRECISION percentile, TMatrixHistogram *h);
void MatrixCumulative(TMatrix P, TMatrix Level, TMatrixHistogram *h);
TMatrix PlotMatrixHistogramAuto(int i, int j, int bins, TMatrixHistogram *h);
TMatrix PlotMatrixHistogram(int i, int j, PRECISION min, PRECISION max, int bins, TMatrixHistogram *h);
TVectorHistogram *CreateVectorHistogram(int dim, int intervals, int type);
void SetMaxMinVectorHistogram(TVector Min, TVector Max, TVectorHistogram *h);
void FreeVectorHistogram(TVectorHistogram *h);
void AddVectorObservation(TVector X, TVectorHistogram *h);
void VectorPercentile(TVector X, PRECISION percentile, TVectorHistogram *h);
void VectorCumulative(TVector p, TVector level, TVectorHistogram *h);
TMatrix PlotVectorHistogramAuto(int i, int bins, TVectorHistogram *h);
TMatrix PlotVectorHistogram(int i, PRECISION min, PRECISION max, int bins, TVectorHistogram *h);
TScalarHistogram *CreateScalarHistogram(int intervals, int type);
void SetMaxMinScalarHistogram(PRECISION Min, PRECISION Max, TScalarHistogram *h);
void FreeScalarHistogram(TScalarHistogram *h);
void AddScalarObservation(PRECISION x, TScalarHistogram *h);
PRECISION ScalarPercentile(PRECISION percentile, TScalarHistogram *h);
PRECISION ScalarCumulative(PRECISION level, TScalarHistogram *h);
TMatrix PlotScalarHistogramAuto(int bins, TScalarHistogram *h);
TMatrix PlotScalarHistogram(PRECISION min, PRECISION max, int bins, TScalarHistogram *h);
#endif

111
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/blas_lapack.h
View File

@ -1,111 +0,0 @@
#if defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
#include <dynmex.h>
#include <dynblas.h>
#include <dynlapack.h>
#else
#ifndef __BLAS_LAPACK__
#define __BLAS_LAPACK__
typedef int lapack_int;
typedef int blas_int;
#ifdef __cplusplus
extern "C"
{
#endif
/* Linux defines */
#define sscal sscal_
#define saxpy saxpy_
#define sgemm sgemm_
#define sgetrf sgetrf_
#define sgesdd sgesdd_
#define sgesvd sgesvd_
#define sgetrf sgetrf_
#define sorgqr sorgqr_
#define sgelqf sgelqf_
#define sorglq sorglq_
#define sgges sgges_
#define stgsen stgsen_
#define stgexc stgexc_
#define dscal dscal_ /* Blas scalar times vector ansi-c*/
#define daxpy daxpy_ /* Blas vector plus scalar times vector ansi-c*/
#define dgemm dgemm_ /* Blas matrix multiplication ansi-c*/
#define dgetrf dgetrf_
#define dgesdd dgesdd_ /* SVD decomposition (divide and conquer) ansi-c*/
#define dgesvd dgesvd_ /* SVD decomposition (QR) ansi-c*/
#define dgetrf dgetrf_ /* LU decomposition ansi-c*/
#define dgeqrf dgeqrf_ /* QR decomposition ansi-c*/
#define dorgqr dorgqr_ /* Forms orthogonal matrix from Housholder matrices created by dgeqrf ansi-c*/
#define dgelqf dgelqf_ /* LQ decompostion ansi-c*/
#define dorglq dorglq_ /* Forms orthogonal matrix from Housholder matrices created by dgeqrf ansi-c*/
#define dgges dgges_ /* Generalized Schur decomposition ansi-c*/
#define dtgsen dtgsen_ /* Reorders generalized Schur decomposition ansi-c*/
#define dtgexc dtgexc_ /* Reorders generalized Schur decomposition ansi-c*/
#define dsyev dsyev_
#define dgeev dgeev_
#define dpotrf dpotrf_
#define dpotri dpotri_
#define dtrtri dtrtri_
#define dgetri dgetri_
#define dgeqp3 dgeqp3_
#define dormqr dormqr_
#define dgesv dgesv_
/*******************************************************************************/
/* cblas defines *
#define cblas_daxpy daxpy
/*******************************************************************************/
/* Window defines */
void sscal(int *n, float *alpha, float *x, int *incx);
void saxpy(int *n, float *alpha, float *x, int *incx, float *y, int *incy);
void sgemm(char *transa, char *transb, int *m, int *n, int *k, float *alpha, float *a, int *lda, float *b, int *ldb, float *beta, float *c, int *ldc);
void sgetrf(int *M, int *N, float *A, int *LDA, int *IPIV, int *INFO);
void sgesdd(char *jobz, int *m, int *n, float *a, int *lda, float *s, float *u, int *ldu, float *vt, int *ldvt, float *work, int *lwork, int *iwork, int *info);
void sgesvd(char *jobu, char *jobvt, int *m, int *n, float *a, int *lda, float *s, float *u, int *ldu, float *vt, int *ldvt, float *work, int *lwork, int *info);
void sgeqrf(int *M, int *N, float *A, int *LDA, float *TAU, float *WORK, int *LWORK, int *INFO);
void sorgqr(int *M, int *N, int *K, float *A, int *LDA, float *TAU, float *WORK, int *LWORK, int *INFO);
void sgelqf(int *M, int *N, float *A, int *LDA, float *TAU, float *WORK, int *LWORK, int *INFO);
void sorglq(int *M, int *N, int *K, float *A, int *LDA, float *TAU, float *WORK, int *LWORK, int *INFO);
void sgges(char *jobvsl, char *jobvsr, char *sort, void *selctg, int *n, float *a, int *lda, float *b, int *ldb, int *sdim, float *alphar, float *alphai, float *beta, float *vsl, int *ldvsl, float *vsr, int *ldvsr, float *work, int *lwork, void *bwork, int *info);
void stgsen(int *ijob, void *wantq, void *wantz, void *select, int *n, float *a, int *lda, float *b, int *ldb, float *alphar, float *alphai, float *beta, float *q, int *ldq, float *z, int *ldz, int *m, float *pl, float *pr, float *dif, float *work, int *lwork, int *iwork, int *liwork, int *info);
void stgexc(void *wantq, void *wantz, int *n, float *a, int *lda, float *b, int *ldb, float *q, int *ldq, float *z, int *ldz, int *ifst, int *ilst, float *work, int *lwork, int *info);
void dscal(int*,double*,double*,int*);
void daxpy(int*,double*,double*,int*,double*,int*);
void dgemm(char*,char*,int*,int*,int*,double*,double*,int*,double*,int*,double*,double*,int*);
void dgetrf(int*,int*,double*,int*,int*,int*);
void dgesdd(char*,int*,int*,double*,int*,double*,double*,int*,double*,int*,double*,int*,int*,int*);
void dgesvd(char*,char*,int*,int*,double*,int*,double*,double*,int*,double*,int*,double*,int*,int*);
void dgeqrf(int*,int*,double*,int*,double*,double*,int*,int*);
void dorgqr(int*,int*,int*,double*,int*,double*,double*,int*,int*);
void dgelqf(int*,int*,double*,int*,double*,double*,int*,int*);
void dorglq(int*,int*,int*,double*,int*,double*,double*,int*,int*);
void dgges(char*,char*,char*,void*,int*,double*,int*,double*,int*,int*,double*,double*,double*,double*,int*,double*,int*,double*,int*,void*,int*);
void dtgsen(int*,void*,void*,void*,int*,double*,int*,double*,int*,double*,double*,double*,double*,int*,double*,int*,int*,double*,double*,double*,double*,int*,int*,int*,int*);
void dtgexc(void*,void*,int*,double*,int*,double*,int*,double*,int*,double*,int*,int*,int*,double*,int*,int*);
void dsyev(char*,char*,int*,double*,int*,double*,double*,int*,int*);
void dgeev(char*,char*,int*,double*,int*,double*,double*,double*,int*,double*,int*,double*,int*,int*);
void dpotrf(char*,int*,double*,int*,int*);
void dpotri(char*,int*,double*,int*,int*);
void dgeqp3(int*,int*,double*,int*,int*,double*,double*,int*,int*);
void dtrtri(char*,char*,int*,double*,int*,int*);
void dgetri(int*,double*,int*,int*,double*,int*,int*);
void dormqr(char*,char*,int*,int*,int*,double*,int*,double*,double*,int*,double*,int*,int*);
void dgesv(int*,int*,double*,int*,int*,double*,int*,int*);
/*******************************************************************************/
#ifdef __cplusplus
}
#endif
#endif
#endif

1
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/bmatrix.c
View File

@ -1 +0,0 @@
#include "bmatrix_blas_lapack.c"

67
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/bmatrix.h
View File

@ -1,67 +0,0 @@
#ifndef __BMATRIX__
#define __BMATRIX__
#include "prcsn.h"
#ifdef __cplusplus
extern "C"
{
#endif
/* Unary Operators */
int bNegative(PRECISION *x, PRECISION *y, int m);
int bAbs(PRECISION *x, PRECISION *y, int m);
int bTranspose(PRECISION *x, PRECISION *y, int m, int n, int t);
int bTransposeInPlace(PRECISION *x, int m);
/* Addition */
int bAdd(PRECISION *x, PRECISION *y, PRECISION *z, int m);
int bSubtract(PRECISION *x, PRECISION *y, PRECISION *z, int m);
int bLinearUpdateScalar(PRECISION *x, PRECISION *y, PRECISION a, int m);
int bLinearCombination(PRECISION *x, PRECISION a, PRECISION *y, PRECISION b, PRECISION *z, int m);
int bMatrixAdd(PRECISION *x, PRECISION *y, PRECISION *z, int m, int n, int xt, int yt, int zt);
int bMatrixSubtract(PRECISION *x, PRECISION *y, PRECISION *z, int m, int n, int xt, int yt, int zt);
int bMatrixLinearCombination(PRECISION *x, PRECISION a, PRECISION *y, PRECISION b,PRECISION *z, int m, int n, int xt, int yt, int zt);
/* Multiplication */
int bMultiply(PRECISION *x, PRECISION *y, PRECISION s, int m);
int bMatrixMultiply(PRECISION *x, PRECISION *y, PRECISION *z, int m, int n, int p, int xt, int yt, int zt);
/* LU Decomposition */
int bLU(int *p, PRECISION *x, int m, int n, int xt);
int bSolveTriangular(PRECISION *x, PRECISION *b, int m, int n,int u, int xt, int bt);
int bSolveUnitTriangular(PRECISION *x, PRECISION *b, int m, int n, int u, int xt, int bt);
/* QR Decompositions */
int bQR(PRECISION *Q, PRECISION *R, PRECISION *X, int m, int n, int q, int qt, int rt, int xt);
/* Singular Value Decomposition */
int bSVD(PRECISION *U, PRECISION *d, PRECISION *V, PRECISION *A, int m, int n, int ut, int vt, int at);
int bSVD_new(PRECISION *U, PRECISION *d, PRECISION *V, PRECISION *A, int m, int n, int ut, int vt, int at, int compact);
/* Generalize Schur Decomposition */
int bQZ_real(PRECISION *Q, PRECISION *Z, PRECISION *S, PRECISION *T, PRECISION *A, PRECISION *B, int n, int qt, int zt, int st, int tt, int at, int bt,
PRECISION *alpha_r, PRECISION *alpha_i, PRECISION *beta);
/* Cholesky Decompositions */
int bCholesky(PRECISION *X, int m, int u, int t);
/* Permutation Routines */
int bPermutationMultiply(int *p, PRECISION *y, int m, int n, int q, int pt, int yt);
int bPermutation(PRECISION *x, int *p, int m, int q, int t);
/* Tensor Calculus */
int bMatrixTensor(PRECISION *x, PRECISION *y, PRECISION *z, int m, int n, int r, int s, int xt, int yt, int zt);
int bVectorTensor(PRECISION *x, PRECISION *y, PRECISION *z, int m, int n);
/* //int bQRPivot_R(PRECISION *R, int *p, int m, int n); ansi-c*/
/* //int bQRPivot_QR(PRECISION *Q, PRECISION *R, int *p, int m, int n); ansi-c*/
#ifdef __cplusplus
}
#endif
#endif

2413
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/bmatrix_blas_lapack.c
View File

File diff suppressed because it is too large Load Diff

3699
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/bmatrix_native.c
View File

File diff suppressed because it is too large Load Diff

18
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/m_err.h
View File

@ -1,18 +0,0 @@
/* Matrix error constants */
#define NO_ERR 0x00000000
#define MEM_ERR 0x00000001
#define SIZE_ERR 0x00000002
#define NULL_ERR 0x00000004
#define SING_ERR 0x00000008
#define ITER_ERR 0x00000010
#define POSDEF_ERR 0x00000020
#define FLOAT_ERR 0x00000040
#define ARG_ERR 0x00000080
#define NOT_IMPLEMENTED_ERR 0x00000100
#define BLAS_LAPACK_ERR 0x00000200
#define ALL_ERRORS 0x000001FF

35
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/prcsn.h
View File

@ -1,35 +0,0 @@
/*
Defines the precision to be used
*/
#ifndef __PRECISION_H__
#define __PRECISION_H__
#include <float.h>
/********** double precision **********/
#define PRECISION double
#define MACHINE_EPSILON 1.11E-16
#define SQRT_MACHINE_EPSILON 1.06E-08
#define PRECISION_SIZE 8
#define PRECISION_SHIFT 3
#define PRECISION_WORD qword
#define MINUS_INFINITY -1.0E300
#define PLUS_INFINITY 1.0E300
/* //#define MINUS_INFINITY -DBL_MAX ansi-c*/
/* //#define PLUS_INFINITY DBL_MAX ansi-c*/
/**************************************/
/********** single precision **********
#define PRECISION float
#define MACHINE_EPSILON 5.97E-08
#define SQRT_MACHINE_EPSILON 2.45E-04
#define PRECISION_SIZE 4
#define PRECISION_SHIFT 2
#define PRECISION_WORD dword
#define MINUS_INFINITY -FLT_MAX
#define PLUS_INFINITY FLT_MAX
/**************************************/
#endif

5033
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/swzmatrix.c
View File

File diff suppressed because it is too large Load Diff

594
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/swzmatrix.h
View File

@ -1,594 +0,0 @@
/********************************************************************************
VECTORS AND MATRICES
A TVector is an array of floating points together with the dimension of the
vector. A TVector implementation can contain additional information. An
instance of TVector must be created with calls to CreateVector() and freed with
calls to FreeVector(). The following macros must be defined.
DimV(x) - x : TVector
Returns: int containing the dimension.
ElementV(x,i) - x : TVector
i : integer
Returns: L-value PRECISION containing the ith element. The
index i is zero-based.
pElementV(x) - x : TVector
Returns: pointer to 0th element of the array storing the vector.
A TMatrix is an array of floating points together with the number of rows and
columns in the matrix. If the storage type (row or column major) is variable,
then it also must be stored. A TMatrix implementation can contain additional
information. A instance of TMatrix must be created with CreateMatrix() and freed
with FreeMatrix(). The following macros must be defined.
RowM(x) - x : TMatrix
Returns: int containing the number of rows.
ColM(x) - x : TMatrix
Returns: int containing the number of columns.
ElementM(x,i,j) - x : TVector
i : int
j : int
Returns: L-value PRECISION containing the element in the ith
row and jth column. The indexes i and j are zero
based.
pElementM(x) - x : TMatrix
Returns: pointer to 0th element of the array storing the
matrix.
MajorForm(x) - x : TMatrix
Returns: 0 if data stored in row major format and 1 if data
stored in column major format. The data is in row
major format if
ElementM(x,i,j) = pElementM(x)[i*ColM(x)+j]
and is in column major format if
ElementM(x,i,j) = pElementM(x)[i+j*RowM(x)]
SetMajorForm(x,i) - Sets the MajorForm of the TMatrix x to the int i. The value
of i must be either 0 or 1. If the implementation allows
for only one type, then this can be defined to be blank.
For this reason, it is important that the user be careful in
using this macro since it may not have an effect in all
implementations. It is always permissible to assign the
value of an existing TMatrix, as in
SetMajorForm(x,MajorForm(y));
but in all other cases, it is important to check, via a call
to MajorForm(), that the MajorForm has actually been set.
The precision (float or double) is controlled by the define PRECISION
contained in the file prcsn.h.
PERMUTATION MATRICES
For 0 <= i,j <= m-1, let (i,j) denote the transposition which interchanges i
and j leaves the other elements fixed. Let P(i,j) denote the m x m matrix
obtained from the m x m identitiy matrix by interchanging the ith and jth rows,
which for the identity matrix is equivalent to interchanging the ith and jth
columns. If p is a permutation of {0,...,m-1} and is equal to the product of
transpositions
(i1,j1)*(i2,j2)*...*(iq,jq)
then the permutation matrix associated with the permutation p is
P = P(i1,j1)*P(i2,j2)*...*P(iq,jq)
Note that our convention is that
(i1,j1)*(i2,j2)(k) = (i1,j1)((i2,j2)(k))
Thus (1,2)(2,3) is the permutation that sends 1 to 2, 2 to 3, and 3 to 1. Note
that multiplication on the left by a permutation matrix P associated with the
permutation p permutes the rows by p. Multiplication on the right permutes the
columns by the inverse of p.
A TPermutation is an integer array together with the length of the array and
the number of array elements actually used. A TPermutation implementation can
contain additional information. A instance of TPermutation must be created
with CreatePermutation() and freed with FreePermutation(). The following
macros must be defined.
DimP(x) - x : TPermutation
Returns: int containing the dimension.
UseP(x) - x : TPermutation
Returns: L-value int containing the number of array elements
used. This macro can also be used to set this number.
It must be the case that 0 <= UseP(x) <= DimP(x).
ElementP(x,i) - x : TPermutation
i : int
Returns: L-value int containing the ith element. The index i
is zero-based. It must be case that
i <= ElementP(x,i) <= DimP(x).
pElementP(x) - x : TPermutation
Returns: pointer to 0th element of the array storing the
permutation.
The representation as a product of transpositions used by TPermutation
(0,ElementP(x,0))*...*(UseP(x)-1,ElementP(x,UseP(x)-1)
*******************************************************************************/
/*******************************************************************************
Some thoughts on vector and matrix implementation:
1) Because vectors are one dimensional and matrices are two dimensional,
they should have different implementations for reasons of efficiency.
2) Can one get efficiency from more general n-dimensional matrix
representations?
3) Should the types be encoded as a pointer to a structure or as a pointer
to a float or double with the dimension and other infomation hidden.
4) There must be an efficient Element() operator. If (1) is followed, there
must be efficient ElementV() and ElementM() operators. These operators
must be able to return L-values and so probably need to implemented as
macros. This has the disadvantage that ElementM() will have side effects
that must be avoided.
5) There must be an efficient Dim() operator. If (1) is followed, there
should be efficient DimV(), RowM(), ColM() operators, probably
implemented as macros.
6) Should there be a flag to represent special matrices. For instance,
diagonal, upper triangular, lower triagular, and symmetric. If the
decision is made to include such a flag, then a decision must be made
on the storage of special matrices. In particular, should special
matrices use a compressed storage, or should they use the general
storage technique. If they use the general storage technique, should
the full matrix be stored, or should the redundant elements be left
undefined. This has implications for the ElementM() operator.
7) Should a decision be made to always encode matrices as column major, or
should there be a flag to determine whether the matrix is encoded as
column major or row major. This gives added flexibility, but adds an
extra cost to all matrix functions. For complex functions which already
check size, this cost is small, but for functions such as ElementM(),
the cost may not be so small. One solution would to be to add the
operators ElementM_R() and ElementM_C(), which would retrieve the orginal
efficiency in ElementM(), but would put a burden on the user to ensure
that the right operator was called.
8) Many routines will have the form Y = fnct(X, Z1, Z2, ...), where X and Y
are pointers to the same type. The characteristics (usually size) of X
depends on the Z's. For this reason, X is allowed to be a null pointer.
This allows the routine to create and return a pointer with the proper
characteristics. On the other hand, errors occur in the routine, then
a null pointer is returned. There is a potential for memory leaks. The
following syntax must be avoided: X = fnct(X, Z1, Z2, ... ). If X is null
or no errors occur, then no harm will result, but if X is not null and an
error occurs then a memory leak will exist. This type of construct must
be avoided. Similarly, the following construct must be avoided:
X = fnct2(fnct1(...), ...)
If fnct1() returns a non-null pointer but fnct2 exists because of an
error, then a memory leak will exist. The proper construct in this case
is
fnct1(X = fnct1(...), ...)
********************************************************************************/
#ifndef __MATRIX__
#define __MATRIX__
#include "prcsn.h"
#include <stdio.h>
#ifdef __cplusplus
extern "C"
{
#endif
/******************************************************************************/
/********************************* Data Types *********************************/
/******************************************************************************/
/* //#define STANDARD_COLUMN_MAJOR ansi-c*/
/* //#define STANDARD_ROW_MAJOR ansi-c*/
/* //#define STRUCTURED_COLUMN_MAJOR ansi-c*/
/* //#define STRUCTURED_ROW_MAJOR ansi-c*/
/* //#define STRUCTURED_MAJOR_FORM ansi-c*/
/* //#define LEGACY_ROW_MAJOR ansi-c*/
#define TZ_COLUMN_MAJOR
/* //#define CHECK_MACRO_CALLS ansi-c*/
#define COLUMN_MAJOR 1
#define ROW_MAJOR 0
/*----------------------------------------------------------------------------*/
#if defined CHECK_MACRO_CALLS
typedef PRECISION *TVector;
typedef PRECISION **TMatrix;
typedef int *TPermutation;
int DimV(TVector x);
PRECISION ElementV(TVector x, int i);
PRECISION* pElementV(TVector x);
int RowM(TMatrix x);
int ColM(TMatrix x);
PRECISION ElementM(TMatrix x, int i, int j);
PRECISION* pElementM(TMatrix x);
int DimP(TPermutation x);
int UseP(TPermutation x);
int ElementP(TPermutation y, int i);
int* pElementP(TPermutation y);
#endif
/*----------------------------------------------------------------------------*/
#if (defined(STANDARD_COLUMN_MAJOR) || defined(STANDARD_ROW_MAJOR))
/* // Data types ansi-c*/
typedef struct
{
int dim;
PRECISION x[1];
} TVectorStructure;
typedef TVectorStructure *TVector;
typedef struct
{
int row;
int col;
PRECISION x[1];
} TMatrixStructure;
typedef TMatrixStructure* TMatrix;
typedef struct
{
int dim;
int use;
int x[1];
} TPermutationStructure;
typedef TPermutationStructure* TPermutation;
/* // Element access macros ansi-c*/
#define DimV(y) ((y)->dim)
#define pElementV(y) ((y)->x)
#define ElementV(y,i) ((y)->x[(i)])
#define RowM(y) ((y)->row)
#define ColM(y) ((y)->col)
#define pElementM(y) ((y)->x)
#if defined STANDARD_COLUMN_MAJOR
#define ElementM(y,i,j) ((y)->x[(i)+(j)*((y)->row)])
#else
#define ElementM(y,i,j) ((y)->x[(i)*((y)->col)+(j)])
#endif
#define UseP(y) ((y)->use)
#define DimP(y) ((y)->dim)
#define pElementP(y) ((y)->x)
#define ElementP(y,i) ((y)->x[(i)])
/* // Major form macros ansi-c*/
#define SetMajorForm(x,i)
#if defined STANDARD_COLUMN_MAJOR
#define MajorForm(x) COLUMN_MAJOR
#else
#define MajorForm(x) ROW_MAJOR
#endif
#endif
/*----------------------------------------------------------------------------*/
#if (defined(STRUCTURED_COLUMN_MAJOR) || defined(STRUCTURED_ROW_MAJOR) || defined(STRUCTURED_MAJOR_FORM))
/* // Data types ansi-c*/
typedef struct
{
int dim;
PRECISION *x;
} TVectorStructure;
typedef TVectorStructure *TVector;
typedef struct
{
int row;
int col;
#if (defined(STRUCTURED_MAJOR_FORM))
int major;
#endif
PRECISION *x;
} TMatrixStructure;
typedef TMatrixStructure* TMatrix;
typedef struct
{
int dim;
int use;
int *x;
} TPermutationStructure;
typedef TPermutationStructure* TPermutation;
/* // Element access macros ansi-c*/
#define DimV(y) ((y)->dim)
#define pElementV(y) ((y)->x)
#define ElementV(y,i) ((y)->x[(i)])
#define RowM(y) ((y)->row)
#define ColM(y) ((y)->col)
#define pElementM(y) ((y)->x)
#if defined STRUCTURED_COLUMN_MAJOR
#define ElementM(y,i,j) ((y)->x[(i)+(j)*((y)->row)])
#elif defined STRUCTURED_ROW_MAJOR
#define ElementM(y,i,j) ((y)->x[(i)*((y)->col)+(j)])
#elif defined STRUCTURED_MAJOR_FORM
#define ElementM(y,i,j) ((y)->x[(y)->major ? (i)+(j)*((y)->row) : (i)*((y)->col)+(j)])
#endif
#define UseP(y) ((y)->use)
#define DimP(y) ((y)->dim)
#define pElementP(y) ((y)->x)
#define ElementP(y,i) ((y)->x[(i)])
/* // Major form macros ansi-c*/
#if defined STRUCTURED_COLUMN_MAJOR
#define MajorForm(x) COLUMN_MAJOR
#define SetMajorForm(x,i)
#elif defined STRUCTURED_ROW_MAJOR
#define MajorForm(x) ROW_MAJOR
#define SetMajorForm(x,i)
#elif defined STRUCTURED_MAJOR_FORM
#define SetMajorForm(x,i) ((x)->major=(i))
#define MajorForm(x) ((x)->major)
#endif
#endif
/*----------------------------------------------------------------------------*/
#if defined LEGACY_ROW_MAJOR
/* // Data types ansi-c*/
typedef PRECISION *TVector;
typedef PRECISION **TMatrix;
typedef int* TPermutation;
/* // Element access macros ansi-c*/
#define DimV(y) (((int*)(y))[-1])
#define pElementV(y) (y)
#define ElementV(y,i) ((y)[(i)])
#define RowM(y) (((int*)(y))[-2])
#define ColM(y) (((int*)(y))[-1])
#define pElementM(y) ((y)[0])
#define ElementM(y,i,j) ((y)[(i)][(j)])
#define UseP(y) (((int*)(y))[-1])
#define DimP(y) (((int*)(y))[-2])
#define pElementP(y) (y)
#define ElementP(y,i) ((y)[(i)])
/* // Legacy element access ansi-c*/
#define V_DIM(x) (((int*)(x))[-1])
#define M_ROW(x) (((int*)(x))[-2])
#define M_COL(x) (((int*)(x))[-1])
#define P_USE(x) (((int*)(x))[-1])
#define P_DIM(x) (((int*)(x))[-2])
/* // Major form macros ansi-c*/
#define SetMajorForm(x,i)
#define MajorForm(x) 0
#endif
/*----------------------------------------------------------------------------*/
#if defined TZ_COLUMN_MAJOR
/* In prcsn.h, PRECISION must be defined to be double */
/* //#define PRECISION double ansi-c*/
/* // Use Tao's implimentation ansi-c*/
#include "tzmatlab.h"
/* // Use DW's implimentation - not all functionality supported ansi-c*/
/* //#include "tz2dw.h" ansi-c*/
/* // Data types ansi-c*/
typedef TSdvector* TVector;
typedef TSdmatrix* TMatrix;
typedef struct
{
int dim;
int use;
int x[1];
} TPermutationStructure;
typedef TPermutationStructure* TPermutation;
/* // Element access macros ansi-c*/
#define DimV(y) ((y)->n)
#define pElementV(y) ((y)->v)
#define ElementV(y,i) ((y)->v[(i)])
#define RowM(y) ((y)->nrows)
#define ColM(y) ((y)->ncols)
#define pElementM(y) ((y)->M)
#define ElementM(y,i,j) ((y)->M[(i)+(j)*((y)->nrows)])
#define UseP(y) ((y)->use)
#define DimP(y) ((y)->dim)
#define pElementP(y) ((y)->x)
#define ElementP(y,i) ((y)->x[(i)])
/* // Major form macros ansi-c*/
#define SetMajorForm(x,i)
#define MajorForm(x) COLUMN_MAJOR
#endif
/*----------------------------------------------------------------------------*/
/******************************************************************************/
/******************************************************************************/
/* Allocation/Deallocation Routines */
TVector CreateVector(int m);
TMatrix CreateMatrix(int m, int n);
void FreeVector(TVector x);
void FreeMatrix(TMatrix X);
/* Initialization Routines */
TVector InitializeVector(TVector x, PRECISION c);
TMatrix InitializeMatrix(TMatrix X, PRECISION c);
/* Assignment Routines */
TVector EquateVector(TVector x, TVector y);
TMatrix EquateMatrix(TMatrix X, TMatrix Y);
TMatrix Transpose(TMatrix X, TMatrix Y);
TMatrix IdentityMatrix(TMatrix X, int m);
TMatrix DiagonalMatrix(TMatrix X, TVector y);
TVector AbsV(TVector x, TVector y);
TMatrix AbsM(TMatrix X, TMatrix Y);
TVector MinusV(TVector x, TVector y);
TMatrix MinusM(TMatrix X, TMatrix Y);
TMatrix SubMatrix(TMatrix X, TMatrix Y, int brow, int bcol, int rows, int cols);
TMatrix InsertSubMatrix(TMatrix X, TMatrix Y, int brow_X, int bcol_X, int brow_Y, int bcol_Y, int rows, int cols);
TMatrix CopyColumnVector(TMatrix X, TVector y, int col);
TVector SubVector(TVector x, TVector y, int b, int d);
TVector ColumnVector(TVector x, TMatrix Y, int col);
TVector RowVector(TVector x, TMatrix Y, int row);
TMatrix ColumnMatrix(TMatrix X, TVector y);
TMatrix RowMatrix(TMatrix X, TVector y);
/* //=== Addition Routines === ansi-c*/
TVector AddVV(TVector x, TVector y, TVector z);
TMatrix AddMM(TMatrix X, TMatrix Y, TMatrix Z);
TVector SubtractVV(TVector x, TVector y, TVector z);
TMatrix SubtractMM(TMatrix X, TMatrix Y, TMatrix Z);
/* //=== Multiplication Routines === ansi-c*/
TVector ProductSV(TVector x, PRECISION s, TVector y);
#define ProductVS(x,y,s) ProductSV(x,s,y)
TMatrix ProductSM(TMatrix X, PRECISION s, TMatrix Y);
#define ProductMS(X,Y,s) ProductSM(X,s,Y)
TVector ProductVM(TVector x, TVector y, TMatrix Z);
TVector ProductMV(TVector x, TMatrix Y, TVector z);
TMatrix ProductMM(TMatrix X, TMatrix Y, TMatrix Z);
TVector ProductInverseVM(TVector x, TVector y, TMatrix Z);
TMatrix ProductInverseMM(TMatrix X, TMatrix Y, TMatrix Z);
TVector ProductInverseVU(TVector x, TVector y, TMatrix Z);
TMatrix ProductInverseMU(TMatrix X, TMatrix Y, TMatrix Z);
TVector ProductInverseVL(TVector x, TVector y, TMatrix Z);
TMatrix ProductInverseML(TMatrix X, TMatrix Y, TMatrix Z);
TVector InverseProductMV(TVector x, TMatrix Y, TVector z);
TMatrix InverseProductMM(TMatrix X, TMatrix Y, TMatrix Z);
TVector InverseProductUV(TVector x, TMatrix Y, TVector z);
TMatrix InverseProductUM(TMatrix X, TMatrix Y, TMatrix Z);
TVector InverseProductLV(TVector x, TMatrix Y, TVector z);
TMatrix InverseProductLM(TMatrix X, TMatrix Y, TMatrix Z);
TMatrix TransposeProductMM(TMatrix X, TMatrix Y, TMatrix Z);
#define TransposeProductMV(x,Y,z) ProductVM(x,z,Y)
TMatrix ProductTransposeMM(TMatrix X, TMatrix Y, TMatrix Z);
#define ProductTransposeVM(x,y,Z) ProductMV(x,Z,y)
/* //=== Linear Combination with Updating === ansi-c*/
TVector UpdateVS(TVector x, TVector y, PRECISION a);
TMatrix UpdateMS(TMatrix X, TMatrix Y, PRECISION a);
TVector LinearCombinationVV(TVector x, PRECISION a, TVector y, PRECISION b, TVector z);
TMatrix LinearCombinationMM(TMatrix x, PRECISION a, TMatrix y, PRECISION b, TMatrix z);
/* Matrix Inverse Routines */
TMatrix Inverse_LU(TMatrix X, TMatrix Y);
TMatrix Inverse_SVD(TMatrix X, TMatrix Y);
TMatrix Inverse_Cholesky(TMatrix X, TMatrix Y);
TMatrix Inverse_UT(TMatrix X, TMatrix Y);
TMatrix Inverse_LT(TMatrix X, TMatrix Y);
/* Matrix Decompositions */
int SVD(TMatrix U, TVector d, TMatrix V, TMatrix A);
int QR(TMatrix Q, TMatrix R, TMatrix X);
int LU(TPermutation P, TMatrix X, TMatrix A);
int QZ_Real(TMatrix S, TMatrix T, TMatrix Q, TMatrix Z, TMatrix A, TMatrix B, TVector alpha_r, TVector alpha_i, TVector beta);
int ReorderQZ_Real(TMatrix SS, TMatrix TT, TMatrix QQ, TMatrix ZZ, TMatrix S, TMatrix T, TMatrix Q, TMatrix Z, int *select, TVector alpha_r, TVector alpha_i, TVector beta);
TMatrix CholeskyUT(TMatrix T, TMatrix X);
TMatrix CholeskyLT(TMatrix T, TMatrix X);
TVector LU_SolveCol(TVector x, TVector y, TMatrix LU, TPermutation P);
TVector LU_SolveRow(TVector x, TVector y, TMatrix LU, TPermutation P);
/* Miscellaneous Routines */
PRECISION Norm(TVector x);
PRECISION MatrixNormEuclidean(TMatrix X);
PRECISION MatrixNorm(TMatrix X);
PRECISION DotProduct(TVector x, TVector y);
PRECISION InnerProduct(TVector x, TVector y, TMatrix S);
TMatrix OuterProduct(TMatrix X, TVector y, TVector z);
PRECISION Trace(TMatrix X);
PRECISION Determinant_LU(TMatrix X);
PRECISION LogAbsDeterminant_LU(TMatrix X);
PRECISION Determinant_QR(TMatrix X);
int Rank_SVD(TMatrix X);
TVector CrossProduct_LU(TVector x, TMatrix Y);
TVector CrossProduct_QR(TVector x, TMatrix Y);
TMatrix NullSpace(TMatrix Y);
TMatrix GeneralizedInverse(TMatrix X, TMatrix Y);
/* Kronecker Routines */
TVector Vec(TVector x, TMatrix Y);
TMatrix KroneckerProduct(TMatrix X, TMatrix Y, TMatrix Z);
/* Input - Output Routines */
int dw_PrintVector(FILE *f, TVector x, char *format);
int dw_PrintMatrix(FILE *f, TMatrix X, char *format);
int dw_ReadMatrix(FILE *f, TMatrix X);
int dw_ReadVector(FILE *f, TVector x);
int OutVectorFloat(FILE *f, TVector x);
int OutMatrixFloat(FILE *f, TMatrix X);
int OutVectorDouble(FILE *f, TVector x);
int OutMatrixDouble(FILE *f, TMatrix X);
TVector InVector(FILE *f, TVector x);
TMatrix InMatrix(FILE *f, TMatrix X);
/* Permutations */
TPermutation CreatePermutation(int m);
void FreePermutation(TPermutation X);
TPermutation InitializePermutationFromIntArray(TPermutation X, int *p, int m);
TPermutation TranspositionPermutation(TPermutation X, int i, int j, int m);
TPermutation EquatePermutation(TPermutation X, TPermutation Y);
TMatrix PermutationMatrix(TMatrix X, TPermutation Y);
TMatrix ProductPM(TMatrix X, TPermutation Y, TMatrix Z);
TMatrix ProductMP(TMatrix X, TMatrix Y, TPermutation Z);
TVector ProductPV(TVector x, TPermutation Y, TVector z);
TVector ProductVP(TVector x, TVector y, TPermutation Z);
TMatrix TransposeProductPM(TMatrix X, TPermutation Y, TMatrix Z);
#define TransposeProductPV(x,Y,z) ProductVP(x,z,Y)
TMatrix ProductTransposeMP(TMatrix X, TMatrix Y, TPermutation Z);
#define ProductTransposeVP(x,y,Z) ProductPV(x,Z,y)
void PrintPermutation(FILE *f, TPermutation);
/****** Old Style Syntax ******
//====== Error Routines ======
#define MatrixError(err) Error(err)
#define ClearMatrixError() ClearError()
#define GetMatrixError() GetError()
#define SetMatrixErrorVerbose(err) SetVerboseErrors(err)
#define SetMatrixErrorTerminate(err) SetTerminalErrors(err)
//#define Inverse(X,Y) Inverse_LU(X,Y)
//#define TransposeProduct(X,Y,Z) TransposeProductMM(X,Y,Z)
//#define ProductTranspose(X,Y,Z) ProductTransposeMM(X,Y,Z)
//#define InverseProduct(X,Y,Z) InverseProductMM(X,Y,Z)
//#define ProductInverse(X,Y,Z) ProductInverseMM(X,Y,Z)
//#define VectorProductInverse(x,y,Z) ProductInverseVM(x,y,Z)
//#define ERROR(i) MatrixError(i)
// int Cholesky_U(TMatrix T, TMatrix X) X = T'* T (T upper triangular)
// int Cholesky_L(TMatrix T, TMatrix X) X = T * T' (T lower triangular)
// int SingularValueDecomposition(TMatrix U, TVector d, TMatrix V, TMatrix A) A = U * Diagonal(d) * V'
// int* QR_RPivot(TMatrix R, TMatrix X);
// int* QR_QRPivot(TMatrix Q, TMatrix R, TMatrix X);
/**/
#ifdef __cplusplus
}
#endif
#endif

45
matlab/ms-sbvar/c-code/utilities/DWCcode/matrix/tz2dw.h
View File

@ -1,45 +0,0 @@
#ifndef __TZ2DW__
#define __TZ2DW__
#include "swzmatrix.h"
#include "modify_for_mex.h"
/* // flags and defines ansi-c*/
#define NEARINFINITY 1.0E+300
#define M_UNDEF 0 /* 0 or NULL: No attribute will be given when memory is allocated but no values are initialized. ansi-c*/
#define M_GE 0x0001 /* 1: A general matrix. ansi-c*/
#define M_SU 0x0002 /* 2: A symmetric (must be square) matrix but only the upper triangular part is referenced. ansi-c*/
#define M_SL 0x0004 /* 4: A symmetric (must be square) matrix but only the lower triangular part is referenced. ansi-c*/
#define M_UT 0x0008 /* 8: A upper triangular (trapezoidal if nrows < ncols) matrix but only the upper triangular part is referenced. ansi-c*/
#define M_LT 0x0010 /* 16: A lower triangular (trapezoidal if nrows > ncols) matrix but only the lower triangular part is referenced. ansi-c*/
#define M_CN 0x0020 /* 32: A constant (CN) matrix (All elements are the same or no (N) change from one to another). ansi-c*/
#define V_UNDEF 0 /* Zero or NULL: No values have been assigned to the double vector. ansi-c*/
#define V_DEF 1 /* True: Values have been assigned to the double vector. ansi-c*/
#define square(x) ((x)*(x))
/* // matrix and vector structures ansi-c*/
typedef struct
{
double *M;
int nrows, ncols;
int flag; /* flag: Refers to M_GE, M_SU, M_SL, M_UT, and M_LT in tzmatlab.h. ansi-c*/
} TSdmatrix;
typedef struct
{
double *v;
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TSdvector;
/* // memory management ansi-c*/
#define tzMalloc(elt_count,type) (type *)swzMalloc((elt_count)*sizeof(type))
#define tzDestroy(x) {if (x) { swzFree((x)); (x) = NULL; }}
/* // i/o ansi-c*/
#define tzFclose(x) {if (x) { fclose(x); (x)=(FILE *)NULL;}}
#endif

666
matlab/ms-sbvar/c-code/utilities/DWCcode/sort/dw_matrix_sort.c
View File

@ -1,666 +0,0 @@
#include "dw_matrix_sort.h"
#include "dw_error.h"
#include <stdlib.h>
#include <string.h>
#include "modify_for_mex.h"
static void b_qsort_array_ascending_real(PRECISION *x, int m);
static void b_qsort_array_descending_real(PRECISION *x, int m);
static void b_qsort_matrix_columns_ascending_real(PRECISION *x, int m, int n, int idx);
static void b_qsort_matrix_columns_descending_real(PRECISION *x, int m, int n, int idx);
static void b_qsort_matrix_rows_ascending_real(PRECISION *x, int m, int n, int br, int er, int idx);
static void b_qsort_matrix_rows_descending_real(PRECISION *x, int m, int n, int br, int er, int idx);
/*
Assumes
X : m x n matrix or null
Y : m x n matrix
j : column to sort
Results
The rows of X are sorted in ascending order on the ith column. The matrix
X is created if null.
Returns
Returns X upon success and null on failure. Call GetError() to
determine the cause of failure.
Notes
X and Y do not have to be distinct matrices. Uses the quick sort algorithm,
*/
TMatrix SortMatrixRowsAscending(TMatrix X, TMatrix Y, int j)
{
if (!Y)
{
dw_Error(NULL_ERR);
return (TMatrix)NULL;
}
if ((X != Y) && !(X=EquateMatrix(X,Y)))
return (TMatrix)NULL;
if (MajorForm(X) == ROW_MAJOR)
b_qsort_matrix_columns_ascending_real(pElementM(X),ColM(X),RowM(X),j);
else
b_qsort_matrix_rows_ascending_real(pElementM(X),RowM(X),ColM(X),0,RowM(X)-1,j*RowM(X));
return X;
}
/*
Assumes
X : m x n matrix or null
Y : m x n matrix
j : column to sort
Results
The rows of X are sorted in descending order on the ith column. The matrix
X is created if null.
Returns
Returns X upon success and null on failure. Call GetError() to
determine the cause of failure.
Notes
X and Y do not have to be distinct matrices. Uses the quick sort algorithm,
*/
TMatrix SortMatrixRowsDescending(TMatrix X, TMatrix Y, int j)
{
if (!Y)
{
dw_Error(NULL_ERR);
return (TMatrix)NULL;
}
if ((X != Y) && !(X=EquateMatrix(X,Y)))
return (TMatrix)NULL;
if (MajorForm(X) == ROW_MAJOR)
b_qsort_matrix_columns_descending_real(pElementM(X),ColM(X),RowM(X),j);
else
b_qsort_matrix_rows_descending_real(pElementM(X),RowM(X),ColM(X),0,RowM(X)-1,j*RowM(X));
return X;
}
/*
Assumes
X : m x n matrix or null
Y : m x n matrix
i : row to sort
Results
The columns of X are sorted in ascending order on the ith row. The matrix X
is created if null.
Returns
Returns X upon success and null on failure. Call GetError() to
determine the cause of failure.
Notes
X and Y do not have to be distinct matrices. Uses the quick sort algorithm,
*/
TMatrix SortMatrixColumnsAscending(TMatrix X, TMatrix Y, int i)
{
if (!Y)
{
dw_Error(NULL_ERR);
return (TMatrix)NULL;
}
if ((X != Y) && !(X=EquateMatrix(X,Y)))
return (TMatrix)NULL;
if (MajorForm(X) == ROW_MAJOR)
b_qsort_matrix_rows_ascending_real(pElementM(X),ColM(X),RowM(X),0,ColM(X)-1,i*RowM(X));
else
b_qsort_matrix_columns_ascending_real(pElementM(X),RowM(X),ColM(X),i);
return X;
}
/*
Assumes
X : m x n matrix or null
Y : m x n matrix
i : row to sort
Results
The columns of X are sorted in descending order on the ith row. The matrix
X is created if null.
Returns
Returns X upon success and null on failure. Call GetError() to
determine the cause of failure.
Notes
X and Y do not have to be distinct matrices. Uses the quick sort algorithm,
*/
TMatrix SortMatrixColumnsDescending(TMatrix X, TMatrix Y, int i)
{
if (!Y)
{
dw_Error(NULL_ERR);
return (TMatrix)NULL;
}
if ((X != Y) && !(X=EquateMatrix(X,Y)))
return (TMatrix)NULL;
if (MajorForm(X) == ROW_MAJOR)
b_qsort_matrix_rows_descending_real(pElementM(X),ColM(X),RowM(X),0,ColM(X)-1,i*RowM(X));
else
b_qsort_matrix_columns_descending_real(pElementM(X),RowM(X),ColM(X),i);
return X;
}
/*
Assumes
x : m vector or null
y : m vector
Results
The vector x is sorted in ascending order. The vector x is created if
null.
Returns
Returns x upon success and null on failure. Call GetError() to
determine the cause of failure.
Notes
x and x do not have to be distinct vectors. Uses the quick sort algorithm,
*/
TVector SortVectorAscending(TVector x, TVector y)
{
if (!y)
{
dw_Error(NULL_ERR);
return (TVector)NULL;
}
if ((x != x) && !(x=EquateVector(x,y)))
return (TVector)NULL;
b_qsort_array_ascending_real(pElementV(x),DimV(x));
return x;
}
/*
Assumes
x : m vector or null
y : m vector
Results
The vector x is sorted in descending order. The vector x is created if
null.
Returns
Returns x upon success and null on failure. Call GetError() to
determine the cause of failure.
Notes
x and x do not have to be distinct vectors. Uses the quick sort algorithm,
*/
TVector SortVectorDescending(TVector x, TVector y)
{
if (!y)
{
dw_Error(NULL_ERR);
return (TVector)NULL;
}
if ((x != x) && !(x=EquateVector(x,y)))
return (TVector)NULL;
b_qsort_array_descending_real(pElementV(x),DimV(x));
return x;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*
Assumes:
x - array of length m
Results:
x is sorted in ascending order
Notes:
Uses the quick sort mean algorithm. Switches to insertion sort when the
size of the list is 10 or less.
*/
static void b_qsort_array_ascending_real(PRECISION *x, int m)
{
PRECISION y, c;
int j, k;
if (m > 10)
{
/* // quick sort ansi-c*/
m--;
if (x[0] == x[m])
c=x[0];
else
{
if (x[0] > x[m])
{ y=x[m]; x[m]=x[0]; x[0]=y; }
c=0.5*(x[0] + x[m]);
}
for (j=1; (j < m) && (x[j] <= c); j++);
for (k=m-1; (k > 0) && (x[k] >= c); k--);
while (j < k)
{
y=x[j]; x[j]=x[k]; x[k]=y;
while (x[j] <= c) j++;
while (x[k] >= c) k--;
}
if (k > 0)
b_qsort_array_ascending_real(x,k+1);
if (j < m)
b_qsort_array_ascending_real(x+j,m-j+1);
}
else
{
/* // insertion sort ansi-c*/
for (j=1; j < m; j++)
{
y=x[j];
for (k=j-1; k >= 0; k--)
if (x[k] <= y)
break;
else
x[k+1]=x[k];
x[k+1]=y;
}
}
}
/*
Assumes:
x - array of length m
Results:
x is sorted in descending order
Notes:
Uses the quick sort mean algorithm. Switches to insertion sort when the
size of the list is 10 or less.
*/
static void b_qsort_array_descending_real(PRECISION *x, int m)
{
PRECISION y, c;
int j, k;
if (m > 10)
{
/* // quick sort ansi-c*/
m--;
if (x[0] == x[m])
c=x[0];
else
{
if (x[0] < x[m])
{ y=x[m]; x[m]=x[0]; x[0]=y; }
c=0.5*(x[0] + x[m]);
}
for (j=1; (j < m) && (x[j] >= c); j++);
for (k=m-1; (k > 0) && (x[k] <= c); k--);
while (j < k)
{
y=x[j]; x[j]=x[k]; x[k]=y;
while (x[j] >= c) j++;
while (x[k] <= c) k--;
}
if (k > 0)
b_qsort_array_descending_real(x,k+1);
if (j < m)
b_qsort_array_descending_real(x+j,m-j+1);
}
else
{
/* // insertion sort ansi-c*/
for (j=1; j < m; j++)
{
y=x[j];
for (k=j-1; k >= 0; k--)
if (x[k] >= y)
break;
else
x[k+1]=x[k];
x[k+1]=y;
}
}
}
/*
Assumes:
x - array of length m*n in colum major format.
m - number of rows
n - number of columns
Results:
The columns of x are sorted in ascending order on row idx.
Notes:
Uses the quick sort mean algorithm. Switches to insertion sort when the
size of the list is 10 or less. If the matrix is in row major format, then
m is the number of columns, n is the number of rows, and the rows of x are
sorted in ascending order on column idx.
*/
static void b_qsort_matrix_columns_ascending_real(PRECISION *x, int m, int n, int idx)
{
PRECISION *y, c;
int j, k, p, s;
y=(PRECISION*)swzMalloc(s=m*sizeof(PRECISION));
if (n > 10)
{
/* // quick sort ansi-c*/
p=(n-1)*m;
k=p+idx;
if (x[idx] == x[k])
c=x[idx];
else
{
if (x[idx] > x[k])
{ memcpy(y,x+p,s); memcpy(x+p,x,s); memcpy(x,y,s); }
c=0.5*(x[idx] + x[k]);
}
for (j=m+idx; (j < p) && (x[j] <= c); j+=m);
for (k-=m; (k > idx) && (x[k] >= c); k-=m);
while (j < k)
{
memcpy(y,x+j-idx,s); memcpy(x+j-idx,x+k-idx,s); memcpy(x+k-idx,y,s);
while (x[j] <= c) j+=m;
while (x[k] >= c) k-=m;
}
if (k > idx)
b_qsort_matrix_columns_ascending_real(x,m,(k-idx)/m+1,idx);
if (j < p)
b_qsort_matrix_columns_ascending_real(x+j-idx,m,n-(j-idx)/m,idx);
}
else
{
/* // insertion sort ansi-c*/
p=n*m;
for (j=m+idx; j < p; j+=m)
if (x[j-m] > x[j])
{
memcpy(y,x+j-idx,s);
memcpy(x+j-idx,x+j-m-idx,s);
for (k=j-m-m; k >= 0; k-=m)
if (x[k] <= y[idx])
break;
else
memcpy(x+k+m-idx,x+k-idx,s);
memcpy(x+k+m-idx,y,s);
}
}
swzFree(y);
}
/*
Assumes:
x - array of length m*n in colum major format.
m - number of rows
n - number of columns
Results:
The columns of x are sorted in ascending order on row idx.
Notes:
Uses the quick sort mean algorithm. Switches to insertion sort when the
size of the list is 10 or less. If the matrix is in row major format, then
m is the number of columns, n is the number of rows, and the rows of x are
sorted in ascending order on column idx.
*/
static void b_qsort_matrix_columns_descending_real(PRECISION *x, int m, int n, int idx)
{
PRECISION *y, c;
int j, k, p, s;
y=(PRECISION*)swzMalloc(s=m*sizeof(PRECISION));
if (n > 10)
{
/* // quick sort ansi-c*/
p=(n-1)*m;
k=p+idx;
if (x[idx] == x[k])
c=x[idx];
else
{
if (x[idx] < x[k])
{ memcpy(y,x+p,s); memcpy(x+p,x,s); memcpy(x,y,s); }
c=0.5*(x[idx] + x[k]);
}
for (j=m+idx; (j < p) && (x[j] >= c); j+=m);
for (k-=m; (k > idx) && (x[k] <= c); k-=m);
while (j < k)
{
memcpy(y,x+j-idx,s); memcpy(x+j-idx,x+k-idx,s); memcpy(x+k-idx,y,s);
while (x[j] >= c) j+=m;
while (x[k] <= c) k-=m;
}
if (k > idx)
b_qsort_matrix_columns_descending_real(x,m,(k-idx)/m+1,idx);
if (j < p)
b_qsort_matrix_columns_descending_real(x+j-idx,m,n-(j-idx)/m,idx);
}
else
{
/* // insertion sort ansi-c*/
p=n*m;
for (j=m+idx; j < p; j+=m)
if (x[j-m] < x[j])
{
memcpy(y,x+j-idx,s);
memcpy(x+j-idx,x+j-m-idx,s);
for (k=j-m-m; k >= 0; k-=m)
if (x[k] >= y[idx])
break;
else
memcpy(x+k+m-idx,x+k-idx,s);
memcpy(x+k+m-idx,y,s);
}
}
swzFree(y);
}
/*
Assumes:
x - array of length m*n in colum major format.
m - number of rows
n - number of columns
br - first row in block to sort
er - last row in block to sort to sort
idx - idx/m is column to sort
Results:
The rows of x are sorted in ascending order on column idx/m.
Notes:
Uses the quick sort mean algorithm. Switches to insertion sort when the
size of the list is 10 or less. If the matrix is in row major format, then
m is the number of columns, n is the number of rows, and the columns of x
are sorted in ascending order on row idx.
*/
static void b_qsort_matrix_rows_ascending_real(PRECISION *x, int m, int n, int br, int er, int idx)
{
PRECISION y, c;
int i, j, k;
if (er-br+1 > 10)
{
/* // quick sort ansi-c*/
if (x[idx+br] == x[idx+er])
c=x[idx+br];
else
{
if (x[idx+br] > x[idx+er])
for (i=(n-1)*m; i >= 0; i-=m)
{ y=x[i+br]; x[i+br]=x[i+er]; x[i+er]=y; }
c=0.5*(x[idx+br] + x[idx+er]);
}
for (j=br+1; (j < er) && (x[idx+j] <= c); j++);
for (k=er-1; (k > br) && (x[idx+k] >= c); k--);
while (j < k)
{
for (i=(n-1)*m; i >= 0; i-=m)
{ y=x[i+j]; x[i+j]=x[i+k]; x[i+k]=y; }
while (x[idx+j] <= c) j++;
while (x[idx+k] >= c) k--;
}
if (k > br)
b_qsort_matrix_rows_ascending_real(x,m,n,br,k,idx);
if (j < er)
b_qsort_matrix_rows_ascending_real(x,m,n,j,er,idx);
}
else
{
/* // insertion sort ansi-c*/
int r;
for (j=br+1; j <= er; j++)
{
for (k=j-1; k >= br; k--)
if (x[idx+k] <= x[idx+j]) break;
if (++k < j)
for (i=(n-1)*m; i >= 0; i-=m)
{
y=x[i+j];
for (r=j; r > k; r--) x[i+r]=x[i+r-1];
x[i+k]=y;
}
}
}
}
/*
Assumes:
x - array of length m*n in colum major format.
m - number of rows
n - number of columns
br - first row in block to sort
er - last row in block to sort to sort
idx - idx/m is column to sort
Results:
The rows of x are sorted in ascending order on column idx/m.
Notes:
Uses the quick sort mean algorithm. Switches to insertion sort when the
size of the list is 10 or less. If the matrix is in row major format, then
m is the number of columns, n is the number of rows, and the columns of x
are sorted in ascending order on row idx.
*/
static void b_qsort_matrix_rows_descending_real(PRECISION *x, int m, int n, int br, int er, int idx)
{
PRECISION y, c;
int i, j, k;
if (er-br+1 > 10)
{
/* // quick sort ansi-c*/
if (x[idx+br] == x[idx+er])
c=x[idx+br];
else
{
if (x[idx+br] < x[idx+er])
for (i=(n-1)*m; i >= 0; i-=m)
{ y=x[i+br]; x[i+br]=x[i+er]; x[i+er]=y; }
c=0.5*(x[idx+br] + x[idx+er]);
}
for (j=br+1; (j < er) && (x[idx+j] >= c); j++);
for (k=er-1; (k > br) && (x[idx+k] <= c); k--);
while (j < k)
{
for (i=(n-1)*m; i >= 0; i-=m)
{ y=x[i+j]; x[i+j]=x[i+k]; x[i+k]=y; }
while (x[idx+j] >= c) j++;
while (x[idx+k] <= c) k--;
}
if (k > br)
b_qsort_matrix_rows_descending_real(x,m,n,br,k,idx);
if (j < er)
b_qsort_matrix_rows_descending_real(x,m,n,j,er,idx);
}
else
{
/* // insertion sort ansi-c*/
int r;
for (j=br+1; j <= er; j++)
{
for (k=j-1; k >= br; k--)
if (x[idx+k] >= x[idx+j]) break;
if (++k < j)
for (i=(n-1)*m; i >= 0; i-=m)
{
y=x[i+j];
for (r=j; r > k; r--) x[i+r]=x[i+r-1];
x[i+k]=y;
}
}
}
}
/*
Assumes:
x - array of length m
Results:
x is sorted in ascending order
Notes:
Uses the quick sort median of three algorithm
*/
static void b_median_qsort_array_ascending(PRECISION *x, int m)
{
PRECISION y;
int j, k;
if (m > 10)
{
/* // Quick sort ansi-c*/
j=(m--)/2;
y=x[j]; x[j]=x[1]; x[1]=y;
if (x[1] > x[m])
if (x[0] > x[m])
if (x[0] > x[1])
{ y=x[0]; x[0]=x[m]; x[m]=y; }
else
{ y=x[0]; x[0]=x[m]; x[m]=x[1]; x[1]=y; }
else
{ y=x[1]; x[1]=x[m]; x[m]=y; }
else
if (x[0] > x[1])
if (x[0] > x[m])
{ y=x[0]; x[0]=x[1]; x[1]=x[m]; x[m]=y; }
else
{ y=x[0]; x[0]=x[1]; x[1]=y; };
for (j=2; (j < m) && (x[j] <= x[1]); j++);
for (k=m-1; (k > 1) && (x[k] >= x[1]); k--);
while (j < k)
{
y=x[j]; x[j]=x[k]; x[k]=y;
while (x[j] <= x[1]) j++;
while (x[k] >= x[1]) k--;
}
if (k > 1)
{
y=x[k]; x[k]=x[1]; x[1]=y;
b_median_qsort_array_ascending(x,k);
}
if (j < m)
b_median_qsort_array_ascending(x+j,m-j+1);
}
else
{
/* // Insertion sort ansi-c*/
for (j=1; j < m; j++)
{
for (k=j-1; k >= 0; k--)
if (x[j] >= x[k]) break;
if (++k < j)
{
y=x[j];
memmove(x+k+1,x+k,(j-k)*sizeof(PRECISION));
x[k]=y;
}
}
}
}

14
matlab/ms-sbvar/c-code/utilities/DWCcode/sort/dw_matrix_sort.h
View File

@ -1,14 +0,0 @@
#ifndef __SORT_MATRICES__
#define __SORT_MATRICES__
#include "swzmatrix.h"
TVector SortVectorAscending(TVector x, TVector y);
TVector SortVectorDescending(TVector x, TVector y);
TMatrix SortMatrixRowsAscending(TMatrix X, TMatrix Y, int j);
TMatrix SortMatrixRowsDescending(TMatrix X, TMatrix Y, int j);
TMatrix SortMatrixColumnsAscending(TMatrix X, TMatrix Y, int i);
TMatrix SortMatrixColumnsDescending(TMatrix X, TMatrix Y, int i);
#endif

418
matlab/ms-sbvar/c-code/utilities/DWCcode/spherical/spherical.c
View File

@ -1,418 +0,0 @@
#include "spherical.h"
#include "dw_rand.h"
#include "dw_matrix_rand.h"
#include "dw_error.h"
#include "dw_ascii.h"
#include <math.h>
#include <stdlib.h>
#include <string.h>
#include "modify_for_mex.h"
#define SPHERICAL_GAUSSIAN 1
#define SPHERICAL_UNIFORM 2
#define SPHERICAL_POWER 3
#define SPHERICAL_TRUNCATED_POWER 4
#define SPHERICAL_TABLE 5
#define SPHERICAL_TRUNCATED_GAUSSIAN 6
#define PI 3.141592653589793
static int SPHERICAL_TYPE=0;
static int SPHERICAL_DIM=0;
static PRECISION SPHERICAL_CONSTANT=0.0;
static PRECISION SPHERICAL_POWER_EXP=0.0;
static PRECISION SPHERICAL_LOWER_TRUNCATE=0.0;
static PRECISION SPHERICAL_UPPER_TRUNCATE=0.0;
static PRECISION *SPHERICAL_TABLE_VALUES=(PRECISION*)NULL;
static int SPHERICAL_TABLE_LENGTH=0;
/*
Returns ln(exp(a) + exp(b)) computed to avoid overflow. If
a = ln(c) and b = ln(d), as is usually the case, then the
routine returns ln(c + d).
*/
static PRECISION AddLogs_static(PRECISION a, PRECISION b)
{
return (a > b) ? a + log(1.0 + exp(b-a)) : b + log(exp(a-b) + 1.0);
}
char* SphericalType(void)
{
static char buffer[128];
switch (SPHERICAL_TYPE)
{
case SPHERICAL_GAUSSIAN:
return "Gaussian";
case SPHERICAL_UNIFORM:
return "Uniform";
case SPHERICAL_POWER:
sprintf(buffer,"Power(%lg)",SPHERICAL_POWER_EXP);
return buffer;
case SPHERICAL_TRUNCATED_POWER:
sprintf(buffer,"TruncatedPower(%lg,%lg)",SPHERICAL_POWER_EXP,SPHERICAL_LOWER_TRUNCATE);
return buffer;
case SPHERICAL_TABLE:
sprintf(buffer,"Table(%d)",SPHERICAL_TABLE_LENGTH);
return buffer;
case SPHERICAL_TRUNCATED_GAUSSIAN:
sprintf(buffer,"TruncatedGaussian(%lg,%lg)",SPHERICAL_LOWER_TRUNCATE,SPHERICAL_UPPER_TRUNCATE);
return buffer;
default:
return "Spherical type not set";
}
}
void SetupSpherical_Gaussian(int n)
{
SPHERICAL_TYPE=SPHERICAL_GAUSSIAN;
SPHERICAL_DIM=n;
SPHERICAL_CONSTANT=-0.5*n*log(2.0*PI);
}
void SetupSpherical_TruncatedGaussian(int n, PRECISION r1, PRECISION r2)
{
SPHERICAL_TYPE=SPHERICAL_TRUNCATED_GAUSSIAN;
SPHERICAL_DIM=n;
SPHERICAL_CONSTANT=-0.5*n*log(2.0*PI) - log(dw_chi_square_cdf(r2*r2,n) - dw_chi_square_cdf(r1*r1,n));
SPHERICAL_LOWER_TRUNCATE=r1;
SPHERICAL_UPPER_TRUNCATE=r2;
}
void SetupSpherical_Uniform(int n)
{
SPHERICAL_TYPE=SPHERICAL_UNIFORM;
SPHERICAL_DIM=n;
SPHERICAL_CONSTANT=log(0.5*n) + dw_log_gamma(0.5*n) - 0.5*n*log(PI);
}
/*
See the function PowerUnitBall() below for the description of the
distribution.
*/
void SetupSpherical_Power(int n, PRECISION k)
{
SPHERICAL_TYPE=SPHERICAL_POWER;
SPHERICAL_DIM=n;
SPHERICAL_CONSTANT=log(0.5*k) + dw_log_gamma(0.5*n) - 0.5*n*log(PI);
SPHERICAL_POWER_EXP=k;
}
void SetupSpherical_TruncatedPower(int n, PRECISION k, PRECISION a)
{
SPHERICAL_TYPE=SPHERICAL_TRUNCATED_POWER;
SPHERICAL_DIM=n;
SPHERICAL_CONSTANT=log(0.5*k/(1.0 - pow(a,k))) + dw_log_gamma(0.5*n) - 0.5*n*log(PI);
SPHERICAL_POWER_EXP=k;
SPHERICAL_LOWER_TRUNCATE=a;
}
void SetupSpherical_Table(int n, PRECISION *table, int m)
{
int i;
SPHERICAL_TYPE=SPHERICAL_TABLE;
SPHERICAL_DIM=n;
SPHERICAL_CONSTANT=log(0.5) + dw_log_gamma(0.5*n) - 0.5*n*log(PI);
if (SPHERICAL_TABLE_VALUES) swzFree(SPHERICAL_TABLE_VALUES);
SPHERICAL_TABLE_VALUES=(PRECISION*)swzMalloc((m+1)*sizeof(PRECISION));
SPHERICAL_TABLE_LENGTH=m;
memcpy(SPHERICAL_TABLE_VALUES,table,(m+1)*sizeof(PRECISION));
/* // Check ansi-c*/
if (SPHERICAL_TABLE_VALUES[0] != 0.0)
{
printf("First entry of inverse cumulative spherical table must be zero\n");
swzExit(0);
}
for (i=1; i < SPHERICAL_TABLE_LENGTH; i++)
if (SPHERICAL_TABLE_VALUES[i-1] >= SPHERICAL_TABLE_VALUES[i])
{
printf("Inverse cumulative spherical table must be strictly increasing\n");
for (i=0; i <= m; i++) printf("%lf\n",table[i]);
swzExit(0);
}
}
PRECISION DrawSpherical(TVector x)
{
PRECISION r;
switch (SPHERICAL_TYPE)
{
case SPHERICAL_GAUSSIAN:
dw_NormalVector(x);
return Norm(x);
case SPHERICAL_UNIFORM:
return UniformUnitBall(x);
case SPHERICAL_POWER:
return PowerUnitBall(x,SPHERICAL_POWER_EXP);
case SPHERICAL_TRUNCATED_POWER:
return TruncatedPowerUnitBall(x,SPHERICAL_POWER_EXP,SPHERICAL_LOWER_TRUNCATE);
case SPHERICAL_TABLE:
return SphericalTable(x,SPHERICAL_TABLE_VALUES,SPHERICAL_TABLE_LENGTH);
case SPHERICAL_TRUNCATED_GAUSSIAN:
do
{
dw_NormalVector(x);
r=Norm(x);
}
while ((r < SPHERICAL_LOWER_TRUNCATE) || (SPHERICAL_UPPER_TRUNCATE < r));
return r;
default:
swz_fprintf_err("Unknown spherical type\n");
swzExit(0);
}
}
PRECISION LogSphericalDensity(PRECISION r)
{
switch (SPHERICAL_TYPE)
{
case SPHERICAL_GAUSSIAN:
return -0.5*r*r + SPHERICAL_CONSTANT;
case SPHERICAL_UNIFORM:
return (r > 1.0) ? MINUS_INFINITY : SPHERICAL_CONSTANT;
case SPHERICAL_POWER:
return (r > 1.0) ? MINUS_INFINITY : SPHERICAL_CONSTANT + (SPHERICAL_POWER_EXP - SPHERICAL_DIM)*log(r);
case SPHERICAL_TRUNCATED_POWER:
return ((r < SPHERICAL_LOWER_TRUNCATE) || (r > 1.0)) ? MINUS_INFINITY
: SPHERICAL_CONSTANT + (SPHERICAL_POWER_EXP - SPHERICAL_DIM)*log(r);
case SPHERICAL_TABLE:
return SPHERICAL_CONSTANT - (SPHERICAL_DIM - 1)*log(r) + LogSphericalTableDensity(r,SPHERICAL_TABLE_VALUES,SPHERICAL_TABLE_LENGTH);
case SPHERICAL_TRUNCATED_GAUSSIAN:
return ((r < SPHERICAL_LOWER_TRUNCATE) || (r > SPHERICAL_UPPER_TRUNCATE)) ? MINUS_INFINITY : -0.5*r*r + SPHERICAL_CONSTANT;
default:
swz_fprintf_err("Unknown spherical type\n");
swzExit(0);
}
}
/*
The ith entry of the returned vector is the cumulative density evaluated at
(i + 1) * max / bins. The integer cum_bins controls the accuracy of the
estimation. The larger the value, the more accuate the estimate.
*/
TVector SphericalCumulativeDensity(PRECISION max, int bins, int cum_bins)
{
TVector cumulative=CreateVector(bins);
int i, j;
PRECISION r, z, inc=max/(PRECISION)bins, cum_inc=inc/(PRECISION)cum_bins;
for (i=0; i < bins; i++)
{
for (r=(PRECISION)i*inc + 0.5*cum_inc, z=MINUS_INFINITY, j=0; j < cum_bins; r+=cum_inc, j++)
z=AddLogs_static(z,LogSphericalDensity(r) + (SPHERICAL_DIM - 1)*log(r));
ElementV(cumulative,i)=exp(z - log(0.5) + 0.5*SPHERICAL_DIM*log(PI) - dw_log_gamma(0.5*SPHERICAL_DIM) + log(cum_inc));
}
for (i=1; i < bins; i++)
ElementV(cumulative,i)+=ElementV(cumulative,i-1);
return cumulative;
}
void TestSpherical(FILE *f, char *filename, PRECISION max)
{
TMatrix cumulative;
TVector x;
int i, j, bins=1000, cum_bins=20, ndraws=1000000;
PRECISION r, z, inc=max/(PRECISION)bins, cum_inc=inc/(PRECISION)cum_bins, s=1.0/(PRECISION)ndraws;
FILE *f_out;
cumulative=CreateMatrix(bins,3);
for (i=0; i < bins; i++)
{
ElementM(cumulative,i,0)=(PRECISION)(i+1)*inc;
for (r=(PRECISION)i*inc + 0.5*cum_inc, z=MINUS_INFINITY, j=0; j < cum_bins; r+=cum_inc, j++)
z=AddLogs_static(z,LogSphericalDensity(r) + (SPHERICAL_DIM - 1)*log(r));
ElementM(cumulative,i,1)=exp(z - log(0.5) + 0.5*SPHERICAL_DIM*log(PI) - dw_log_gamma(0.5*SPHERICAL_DIM) + log(cum_inc));
ElementM(cumulative,i,2)=0.0;
}
x=CreateVector(SPHERICAL_DIM);
for (i=ndraws; i > 0; i--)
{
r=DrawSpherical(x);
if ((j=(int)floor(r/inc)) < bins)
ElementM(cumulative,j,2)+=s;
}
FreeVector(x);
for (i=1; i < bins; i++)
{
ElementM(cumulative,i,1)+=ElementM(cumulative,i-1,1);
ElementM(cumulative,i,2)+=ElementM(cumulative,i-1,2);
}
f_out=!f ? dw_CreateTextFile(filename) : f;
dw_PrintMatrix(f_out,cumulative,"%lf,");
if (!f) fclose(f_out);
FreeMatrix(cumulative);
}
#undef PI
#undef SPHERICAL_GAUSSIAN
#undef SPHERICAL_UNIFORM
#undef SPHERICAL_POWER
#undef SPHERICAL_TURNCATED_POWER
#undef SPHERICAL_TRUNCATED_GAUSSIAN
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*
Assumes:
x : m-vector
Results:
The vector x is filled with a vector drawn from the uniform distribution on
the m dimensional solid unit sphere.
Returns:
Upon success, returns the norm of x, upon failure returns negative value.
Notes:
The vector is drawn by drawing a m-vector from the standard normal
distribution and a real number u from the uniform distribution on [0,1], and
normalizing the vector so its length equal to u^(1/m).
*/
PRECISION UniformUnitBall(TVector x)
{
PRECISION r, s;
if (!x)
{
dw_Error(NULL_ERR);
return -1.0;
}
do
dw_NormalVector(x);
while ((s=Norm(x)) == 0.0);
ProductSV(x,(r=pow(dw_uniform_rnd(),1.0/DimV(x)))/s,x);
return r;
}
/*
Assumes:
x : n-vector
Results:
The vector x is filled with a vector drawn from the distribution
0.5 * k * Gamma(n/2) * pi^(-n/2) * norm(x)^(k-n)
Returns:
norm(x) upon success and a negative value upon failure.
Notes:
If x is obtained by drawing y from the standard n-dimensional Gaussian
distribtuion and r from the distribution on [0,1] with density
k * r^(k-1)
Since the cumulative density of r is
r^k
a draw of r can be obtained by drawing u from the uniform on [0,1] and
defining r = u^(1/k). This assumes that k > 0.
*/
PRECISION PowerUnitBall(TVector x, PRECISION k)
{
PRECISION r, s;
if (!x)
{
dw_Error(NULL_ERR);
return -1.0;
}
do
dw_NormalVector(x);
while ((s=Norm(x)) == 0.0);
ProductSV(x,(r=pow(dw_uniform_rnd(),1.0/k))/s,x);
return r;
}
/*
Assumes:
x : n-vector
Results:
The vector x is filled with a vector drawn from the distribution
0.5 * k * Gamma(n/2) * pi^(-n/2) * norm(x)^(k-n) / (1 - a^k)
Returns:
norm(x) upon success and a negative value upon failure.
Notes:
If x is obtained by drawing y from the standard n-dimensional Gaussian
distribtuion and r from the distribution on [a,1] with density
k * r^(k-1) / (1 - a^k)
Since the cumulative density of r is
(r^k - a^k) / (1 - a^k)
a draw of r can be obtained by drawing u from the uniform on [0,1] and
defining r = (u(1-a^k) + a^k)^(1/k). This assumes that k > 0.
*/
PRECISION TruncatedPowerUnitBall(TVector x, PRECISION k, PRECISION a)
{
PRECISION r, s, t;
if (!x)
{
dw_Error(NULL_ERR);
return -1.0;
}
do
dw_NormalVector(x);
while ((s=Norm(x)) == 0.0);
t=pow(a,k);
ProductSV(x,(r=pow(dw_uniform_rnd()*(1.0 - t) + t,1.0/k))/s,x);
return r;
}
PRECISION SphericalTable(TVector x, PRECISION *table, int m)
{
PRECISION r, s;
int i, j;
if (!x)
{
dw_Error(NULL_ERR);
return -1.0;
}
do
dw_NormalVector(x);
while ((s=Norm(x)) == 0.0);
j=(int)floor(dw_uniform_rnd()*(PRECISION)m);
r=(j < m) ? table[j] + dw_uniform_rnd()*(table[j+1] - table[j]) : table[m];
ProductSV(x,r/s,x);
return r;
}
PRECISION LogSphericalTableDensity(PRECISION r, PRECISION *table, int m)
{
int min=0, max=m, mid;
if (r > table[m]) return MINUS_INFINITY;
while (max - min > 1)
if (r > table[mid=(min + max)/2])
min=mid;
else
max=mid;
return -log((PRECISION)m*(table[max] - table[min]));
}

23
matlab/ms-sbvar/c-code/utilities/DWCcode/spherical/spherical.h
View File

@ -1,23 +0,0 @@
#include "swzmatrix.h"
char* SphericalType(void);
void SetupSpherical_Gaussian(int n);
void SetupSpherical_Uniform(int n);
void SetupSpherical_Power(int n, PRECISION k);
void SetupSpherical_TruncatedPower(int n, PRECISION k, PRECISION a);
void SetupSpherical_Table(int n, PRECISION *table, int m);
void SetupSpherical_TruncatedGaussian(int n, PRECISION r1, PRECISION r2);
PRECISION DrawSpherical(TVector x);
PRECISION LogSphericalDensity(PRECISION r);
TVector SphericalCumulativeDensity(PRECISION max, int bins, int cum_bins);
void TestSpherical(FILE *f, char *filename, PRECISION max);
PRECISION UniformUnitBall(TVector x);
PRECISION PowerUnitBall(TVector x, PRECISION k);
PRECISION TruncatedPowerUnitBall(TVector x, PRECISION k, PRECISION a);
PRECISION SphericalTable(TVector x, PRECISION *table, int m);
PRECISION LogSphericalTableDensity(PRECISION r, PRECISION *table, int m);

284
matlab/ms-sbvar/c-code/utilities/DWCcode/stat/dw_matrix_rand.c
View File

@ -1,284 +0,0 @@
#include "dw_matrix_rand.h"
#include "dw_rand.h"
#include "dw_error.h"
#include <math.h>
#include "modify_for_mex.h"
/******************************************************************************/
/************************ Random Matrices and Vectors *************************/
/******************************************************************************/
/*
Assumes
x : m-vector
Results
Fills x with deviates drawn from the uniform distribution on [0,1]
*/
TVector dw_UniformVector(TVector x)
{
int i;
if (!x) { dw_Error(NULL_ERR); return (TVector)NULL; }
for (i=DimV(x)-1; i >= 0; i--) ElementV(x,i)=dw_uniform_rnd();
return x;
}
/*
Assumes
X : m x n matrix
Results
Fills X with deviates drawn from the uniform distribution on [0,1]
*/
TMatrix dw_UniformMatrix(TMatrix X)
{
int i;
PRECISION *pX;
if (!X) { dw_Error(NULL_ERR); return (TMatrix)NULL; }
for (pX=pElementM(X), i=RowM(X)*ColM(X)-1; i >= 0; i--) pX[i]=dw_uniform_rnd();
return X;
}
/*
Assumes
x : m-vector
Results
Fills x with independent standard normal deviates
*/
TVector dw_NormalVector(TVector x)
{
int i;
if (!x) { dw_Error(NULL_ERR); return (TVector)NULL; }
for (i=DimV(x)-1; i >= 0; i--) ElementV(x,i)=dw_gaussian_rnd();
return x;
}
/*
Assumes
X : m x n matrix
Results
Fills X with independent standard normal deviates
*/
TMatrix dw_NormalMatrix(TMatrix X)
{
int i;
PRECISION *pX;
if (!X) { dw_Error(NULL_ERR); return (TMatrix)NULL; }
for (pX=pElementM(X), i=RowM(X)*ColM(X)-1; i >= 0; i--) pX[i]=dw_gaussian_rnd();
return X;
}
/*
Assumes
x : m-vector
Results
Fills x with independent log normal deviates. The mean and standard
deviation of the underlying normal distribution are passed.
*/
TVector dw_LogNormalVector(TVector x, PRECISION mean, PRECISION standard_deviation)
{
int i;
if (!x) { dw_Error(NULL_ERR); return (TVector)NULL; }
for (i=DimV(x)-1; i >= 0; i--) ElementV(x,i)=dw_lognormal_rnd(mean,standard_deviation);
return x;
}
/*
Computes a matrix of gamma deviates. If x, a, and b represent X(i,j),
A(i,j), and B(i,j), then density of x is
x^(a-1) exp(-x/b)
------------------
gamma(a) b^a
*/
TMatrix dw_GammaMatrix(TMatrix X, TMatrix A, TMatrix B)
{
int i;
PRECISION *pX, *pA, *pB;
if (!A || !B)
{
dw_Error(NULL_ERR);
return (TMatrix)NULL;
}
if ((RowM(A) != RowM(B)) || (ColM(A) != ColM(B)))
{
dw_Error(SIZE_ERR);
return (TMatrix)NULL;
}
if (!X)
{
if (!(X=CreateMatrix(RowM(A),ColM(A))))
return (TMatrix)NULL;
}
else
if ((RowM(X) != RowM(A)) || (ColM(X) != ColM(A)))
{
dw_Error(SIZE_ERR);
return (TMatrix)NULL;
}
for (pX=pElementM(X), pA=pElementM(A), pB=pElementM(B), i=RowM(X)*ColM(X)-1; i >= 0; i--)
pX[i]=pB[i]*dw_gamma_rnd(pA[i]);
return X;
}
/*
Assumes
X : m x m matrix
S : m x m non-singular matrix
Results
X is drawn from the Wishart distribution with parameters sigma, nu, and m,
where sigma=Inverse(S'S). The pdf of X is proportional to
|det(X)|^(0.5*(nu - m - 1))
---------------------------- * exp(-0.5*tr(Inverse(sigma*X))
|det(sigma)|^(0.5*nu)
= |det(X)|^(0.5*(nu - m - 1)) |det(S)|^(0.5*nu) exp(-0.5*tr(S'*X*S))
*/
TMatrix dw_Wishart(TMatrix X, TMatrix S, int nu)
{
int m=RowM(S);
TMatrix Z;
if ((m != ColM(S)) || (m != RowM(X)) || (m != ColM(X))) dw_Error(SIZE_ERR);
Z=dw_NormalMatrix(CreateMatrix(m,nu));
ProductMM(Z,S,Z);
ProductTransposeMM(X,Z,Z);
FreeMatrix(Z);
return X;
}
/*
Assumes
x : n x n matrix
T : n x n upper triangular matrix
Results
x is drawn from the multivariate student-t distribution with parameters.
The pdf of x is given by
*/
TVector dw_StudentT(TVector x, TMatrix T, int nu)
{
PRECISION r=0.0, s;
int i, n=DimV(x);
if ((n != ColM(T)) || (n != RowM(T))) dw_Error(SIZE_ERR);
dw_NormalVector(x);
ProductMV(x,T,x);
for (i=nu; i > 0; i--)
{
s=dw_gaussian_rnd();
r+=s*s;
}
ProductSV(x,sqrt((PRECISION)nu/r),x);
return x;
}
TMatrix dw_UniformOrthogonal(TMatrix Q)
{
TMatrix X;
int i, j, err;
if (!Q)
{
dw_Error(NULL_ERR);
return (TMatrix)NULL;
}
if (RowM(Q) != ColM(Q))
{
dw_Error(SIZE_ERR);
return (TMatrix)NULL;
}
/* Uncomment to use IMSL implementation */
/* //imsls_d_random_orthogonal_matrix(RowM(Q),IMSLS_RETURN_USER,pElementM(Q),0); ansi-c*/
/**/
/* Uncomment to use C code implementation */
X=dw_NormalMatrix(CreateMatrix(RowM(Q),ColM(Q)));
if (!(err=QR(Q,X,X)))
for (i=RowM(X)-1; i >= 0; i--)
if (ElementM(X,i,i) < 0)
for (j=RowM(Q)-1; j >= 0; j--) ElementM(Q,j,i)=-ElementM(Q,j,i);
FreeMatrix(X);
if (err) return (TMatrix)NULL;
/**/
return Q;
}
/*
Assumes:
x : m-vector
Results:
The vector x is filled with a vector drawn from the uniform distribution on
the m-1 dimensional unit sphere.
Returns:
The vector x.
Notes:
The vector is obtained by drawing a m-vector from the standard normal
distribution and then normalizing its length to one.
*/
TVector dw_UniformUnitSphere(TVector x)
{
PRECISION r;
if (!x)
{
dw_Error(NULL_ERR);
return (TVector)NULL;
}
do
dw_NormalVector(x);
while ((r=Norm(x)) == 0.0);
return ProductSV(x,1.0/r,x);
}
/*
Assumes:
x : m-vector
Results:
The vector x is filled with a vector drawn from the uniform distribution on
the m dimensional solid unit sphere.
Returns:
Upon success, returns the norm of x, upon failure returns -1.0.
Notes:
The vector is drawn by drawing a m-vector from the standard normal
distribution and a real number u from the uniform distribution on [0,1], and
normalizing the vector so its length equal to u^(1/m).
*/
TVector dw_UniformUnitBall(TVector x)
{
PRECISION r, s;
if (!x)
{
dw_Error(NULL_ERR);
return (TVector)NULL;
}
do
dw_NormalVector(x);
while ((s=Norm(x)) == 0.0);
ProductSV(x,(r=pow(dw_uniform_rnd(),1.0/DimV(x)))/s,x);
return x;
}
/******************************************************************************/
/******************************************************************************/

20
matlab/ms-sbvar/c-code/utilities/DWCcode/stat/dw_matrix_rand.h
View File

@ -1,20 +0,0 @@
#ifndef __RANDOM_MATRIX__
#define __RANDOM_MATRIX__
#include "swzmatrix.h"
/* Random Matrices and Vectors */
TVector dw_UniformVector(TVector x);
TMatrix dw_UniformMatrix(TMatrix X);
TVector dw_NormalVector(TVector x);
TMatrix dw_NormalMatrix(TMatrix X);
TVector dw_LogNormalVector(TVector x, PRECISION mean, PRECISION standard_deviation);
TMatrix dw_GammaMatrix(TMatrix X, TMatrix A, TMatrix B);
TMatrix dw_Wishart(TMatrix X, TMatrix S, int nu);
TVector dw_StudentT(TVector x, TMatrix T, int nu);
TMatrix dw_UniformOrthogonal(TMatrix Q);
TVector dw_UniformUnitSphere(TVector x);
TVector dw_UniformUnitBall(TVector x);
#endif

657
matlab/ms-sbvar/c-code/utilities/DWCcode/stat/dw_rand.c
View File

@ -1,657 +0,0 @@
#include <math.h>
#include <time.h>
#include <stdlib.h>
#include <memory.h>
#include <limits.h>
#include "prcsn.h"
#include "dw_rand.h"
#include "dw_error.h"
#include "modify_for_mex.h"
/* //=== Static routines === ansi-c*/
static void gser(PRECISION *gamser, PRECISION a, PRECISION x, PRECISION *gln);
static void gcf(PRECISION *gammcf, PRECISION a, PRECISION x, PRECISION *gln);
static PRECISION gammp(PRECISION a, PRECISION x);
/*******************************************************************************/
/*************************** Uniform Random Numbers ****************************/
/*******************************************************************************/
/*
Flag controling which uniform random number to choose
*/
/* //#define USE_NR1_RNG ansi-c*/
#define USE_NR2_RNG
/* //#define USE_IMSL_RNG ansi-c*/
#if defined (USE_IMSL_RNG)
#include <imsls.h>
#elif defined(USE_NR1_RNG)
#define NTAB 32
static int idum=-1;
static int iy=0;
static int iv[NTAB];
#elif defined(USE_NR2_RNG)
#define NTAB 32
static int idum=-1;
static int idum2=123456789;
static int iy=0;
static int iv[NTAB];
#endif
/*
Initializes seed value for uniform random number generator. The seed value
can be any integer. A value of 0 will initialize the seed from the system
clock for the Numerical Recipies algorithms.
*/
void dw_initialize_generator(int init)
{
#ifdef USE_IMSL_RNG
imsls_random_option(7);
imsls_random_seed_set((init < 0) ? -init : init);
#else
if (init)
idum=(init > 0) ? -init : init;
else
{
idum=0;
idum=(int)(-INT_MAX*dw_uniform_rnd());
}
#endif
}
/*
Allocates memory and saves the state of the random number generator. The
calling routine is responsible for freeing the returned memory.
*/
void* dw_get_generator_state(void)
{
#if defined(USE_IMSL_RNG)
int *state=(int*)NULL;
if (state=(int*)swzMalloc(1566*sizeof(int)))
{
imsls_random_GFSR_table_get(&state,IMSLS_RETURN_USER,state,0);
state[1565]=imsls_random_seed_get();
}
return state;
#elif defined (USE_NR1_RNG)
int *state=(int*)NULL;
if (state=(int*)swzMalloc((NTAB+2)*sizeof(int)))
{
memcpy(state,iv,NTAB*sizeof(int));
state[NTAB]=iy;
state[NTAB+1]=idum;
}
return state;
#elif defined (USE_NR2_RNG)
int *state=(int*)NULL;
if (state=(int*)swzMalloc((NTAB+3)*sizeof(int)))
{
memcpy(state,iv,NTAB*sizeof(int));
state[NTAB]=iy;
state[NTAB+1]=idum;
state[NTAB+2]=idum2;
}
return state;
#endif
}
/*
Returns the size in bytes of the void pointer returned by
dw_get_generator_state().
*/
int dw_get_generator_state_size(void)
{
#if defined(USE_IMSL_RNG)
return 1566*sizeof(int);
#elif defined (USE_NR1_RNG)
return (NTAB+2)*sizeof(int);
#elif defined (USE_NR2_RNG)
return (NTAB+3)*sizeof(int);
#endif
}
/*
Sets the state of the random number generator. The void pointer must have
been obtained via a call to dw_get_generator_state().
*/
void dw_set_generator_state(void *state)
{
#if defined(USE_IMSL_RNG)
imsls_random_GFSR_table_set((int*)state);
imsls_random_seed_set(((int*)state)[1565]);
#elif defined (USE_NR1_RNG)
memcpy(iv,state,NTAB*sizeof(int));
iy=((int*)state)[NTAB];
idum=((int*)state)[NTAB+1];
#elif defined (USE_NR2_RNG)
memcpy(iv,state,NTAB*sizeof(int));
iy=((int*)state)[NTAB];
idum=((int*)state)[NTAB+1];
idum2=((int*)state)[NTAB+2];
#endif
}
void dw_print_generator_state(FILE *f)
{
if (f)
{
#if defined(USE_IMSL_RNG)
int i, *state;
if (state=dw_get_generator_state())
{
for (i=0; i < 1566; i++) fprintf(f,"%d ",state[i]);
fprintf(f,"\n");
swzFree(state);
}
#elif defined (USE_NR1_RNG)
int i, *state;
if (state=dw_get_generator_state())
{
for (i=0; i < NTAB+2; i++) fprintf(f,"%d ",state[i]);
fprintf(f,"\n");
swzFree(state);
}
#elif defined (USE_NR2_RNG)
int i, *state;
if (state=dw_get_generator_state())
{
for (i=0; i < NTAB+3; i++) fprintf(f,"%d ",state[i]);
fprintf(f,"\n");
swzFree(state);
}
#endif
}
}
void dw_read_generator_state(FILE *f)
{
if (f)
{
#if defined(USE_IMSL_RNG)
int i, *state;
if (state=(int*)swzMalloc(1566*sizeof(int)))
{
for (i=0; i < 1566; i++) fscanf(f," %d ",state+i);
dw_set_generator_state(state);
swzFree(state);
}
#elif defined (USE_NR1_RNG)
int i, *state;
if (state=(int*)swzMalloc((NTAB+2)*sizeof(int)))
{
for (i=0; i < NTAB+2; i++) fscanf(f," %d ",state+i);
dw_set_generator_state(state);
swzFree(state);
}
#elif defined (USE_NR2_RNG)
int i, *state;
if (state=(int*)swzMalloc((NTAB+3)*sizeof(int)))
{
for (i=0; i < NTAB+3; i++) fscanf(f," %d ",state+i);
dw_set_generator_state(state);
swzFree(state);
}
#endif
}
}
/*
The following code is adapted from Numerical Recipes in C. This rnd1() from
that text.
*/
#ifdef USE_NR1_RNG
#define IA 16807
#define IM 2147483647
#define AM (1.0/IM)
#define IQ 127773
#define IR 2836
#define NDIV (1+(IM-1)/NTAB)
#define RNMX (1.0-MACHINE_EPSILON)
PRECISION dw_uniform_rnd(void)
{
int j, k;
PRECISION temp;
if (idum <= 0)
{
if (idum == 0)
{
if(constant_seed==0)
idum=abs((int)time((time_t *)NULL));
else
{
srand(constant_seed);
idum=rand();
}
if (idum == 0) idum=1;
}
else
idum=-idum;
for (j=NTAB+7; j >= 0; j--)
{
k=idum/IQ;
idum=IA*(idum-k*IQ)-IR*k;
if (idum < 0) idum+=IM;
if (j < NTAB) iv[j]=idum;
}
iy=iv[0];
}
k=idum/IQ;
idum=IA*(idum-k*IQ)-IR*k;
if (idum < 0) idum+=IM;
j=iy/NDIV;
iy=iv[j];
iv[j]=idum;
return ((temp=(PRECISION)(AM*iy)) > RNMX) ? (PRECISION)RNMX : temp;
}
#undef IA
#undef IM
#undef AM
#undef IQ
#undef IR
#undef NDIV
#undef RNMX
#endif
/*
The following code is adapted from Numerical Recipes in C. This rnd2() from
that text.
*/
#ifdef USE_NR2_RNG
#define IM1 2147483563
#define IM2 2147483399
#define AM (1.0/IM1)
#define IMM1 (IM1-1)
#define IA1 40014
#define IA2 40692
#define IQ1 53668
#define IQ2 52774
#define IR1 12211
#define IR2 3791
#define NDIV (1+IMM1/NTAB)
#define RNMX (1.0-MACHINE_EPSILON)
PRECISION dw_uniform_rnd(void)
{
int j, k;
PRECISION temp;
if (idum <= 0)
{
if (idum == 0)
{
if(constant_seed==0)
idum=abs((int)time((time_t *)NULL));
else
{
srand(constant_seed);
idum=rand();
}
if (idum == 0) idum=1;
}
else
idum=-idum;
idum2=idum;
for (j=NTAB+7; j>=0; j--)
{
k=idum/IQ1;
idum=IA1*(idum-k*IQ1)-k*IR1;
if (idum < 0) idum += IM1;
if (j < NTAB) iv[j] = idum;
}
iy=iv[0];
}
k=idum/IQ1;
idum=IA1*(idum-k*IQ1)-k*IR1;
if (idum < 0) idum += IM1;
k=idum2/IQ2;
idum2=IA2*(idum2-k*IQ2)-k*IR2;
if (idum2 < 0) idum2 += IM2;
j=iy/NDIV;
iy=iv[j]-idum2;
iv[j] = idum;
if (iy < 1) iy += IMM1;
return ((temp=AM*iy) > RNMX) ? RNMX : temp;
}
#undef IM1
#undef IM2
#undef AM
#undef IMM1
#undef IA1
#undef IA2
#undef IQ1
#undef IQ2
#undef IR1
#undef IR2
#undef NDIV
#undef RNMX
#endif
#ifdef USE_IMSL_RNG
PRECISION dw_uniform_rnd(void)
{
PRECISION x;
#if PRECISION_SIZE == 8
imsls_d_random_uniform(1,IMSLS_RETURN_USER,&x,0);
#else
imsls_f_random_uniform(1,IMSLS_RETURN_USER,&x,0);
#endif
return x;
}
#endif
#if defined (USE_IMSL_RNG)
#undef USE_IMSL_RNG
#elif defined (USE_NR1_RNG)
#undef NTAB
#undef USE_NR1_RNG
#elif defined (USE_NR2_RNG)
#undef NTAB
#undef USE_NR2_RNG
#endif
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*
Returns a standard gaussian deviate. The density function for the
standard gaussian is
1
----------- exp(-0.5*x^2)
sqrt(2*Pi)
*/
PRECISION dw_gaussian_rnd(void)
{
static int iset=0;
static PRECISION gset;
PRECISION fac,r,v1,v2;
if (iset == 0)
{
do
{
v1=2.0*dw_uniform_rnd()-1.0;
v2=2.0*dw_uniform_rnd()-1.0;
r=v1*v1+v2*v2;
}
while (r >= 1.0);
fac=sqrt(-2.0*log(r)/r);
gset=v1*fac;
iset=1;
return v2*fac;
}
else
{
iset=0;
return gset;
}
}
#undef PI
/*
Returns a standard gamma deviate. The density function for a standard gamma
distribution is
x^(a-1)*exp(-x)
gamma_density(x;a) = ----------------
gamma(a)
for a > 0. The function gamma(a) is the integral with from 0 to infinity of
exp(-t)*t^(a-1).
When a = 1.0, then gamma is exponential. (Devroye, page 405).
When a < 1.0, Johnk's generator (Devroye, page 418).
When a > 1.0, a rejection method or Best's algorithm (Devroye, page 410).
A general gamma variate can be obtained as follows. Let z=b*x. Then,
z is drawn from a general gamma distribution whose density is
z^(a-1)*exp(-z/b)
gamma_density(z;a,b) = ------------------
gamma(a)*b^a
Uses algorithm translated by Iskander Karibzhanov from the Matlab function
gamrnd.m, which follows Johnk's generator in Devroye ("Non-Uniform Random
Variate Generation", Springer-Verlag, 1986, page 418).
Notes:
Does not check if a > 0.
*/
PRECISION dw_gamma_rnd(PRECISION a)
{
PRECISION b, u, v, w, x, y, z;
if (a == 1.0) return -log(dw_uniform_rnd());
if (a < 1.0)
{
u=1.0/a;
v=1.0/(1.0-a);
do
{
x=pow(dw_uniform_rnd(),u);
y=pow(dw_uniform_rnd(),v);
}
while (x+y > 1.0);
return -log(dw_uniform_rnd())*x/(x+y);
}
b=a - 1.0;
while(1)
{
u=dw_uniform_rnd();
w=u*(1.0 - u);
y=sqrt((3.0*a - 0.75)/w)*(u - 0.5);
x=b + y;
if (x > 0.0)
{
v=dw_uniform_rnd();
z=64.0*w*w*w*v*v;
if ((z <= 1.0 - 2.0*y*y/x) || (log(z) <= 2.0*(b*log(x/b) - y)))
return x;
}
}
}
/*
Returns a lognormal deviate. The mean and standard deviations of the
underlying normal distributions are passed.
*/
PRECISION dw_lognormal_rnd(PRECISION mean, PRECISION standard_deviation)
{
return exp(standard_deviation * dw_gaussian_rnd() + mean);
}
/*
Returns the integral from -infinity to x of 1/sqrt(2*PI)*exp(-y^2/2).
Routine adapted from Numerical Recipes in C.
*/
double dw_normal_cdf(double x)
{
double z=fabs(0.7071067811865*x), t=2.0/(2.0+z);
return (x > 0) ?
1.0-0.5*t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+
t*(0.09678418+t*(-0.18628806+t*(0.27886807+t*(-1.13520398+
t*(1.48851587+t*(-0.82215223+t*0.17087277)))))))))
:
0.5*t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+
t*(0.09678418+t*(-0.18628806+t*(0.27886807+t*(-1.13520398+
t*(1.48851587+t*(-0.82215223+t*0.17087277)))))))));
}
PRECISION dw_chi_square_cdf(PRECISION x, int df)
{
return gammp(0.5*df,0.5*x);
}
#define MAXITER 1000
PRECISION dw_chi_square_invcdf(PRECISION p, int df)
{
int i;
PRECISION p_lo=p-SQRT_MACHINE_EPSILON, p_hi=p+SQRT_MACHINE_EPSILON, hi, lo=0.0, mid, cdf;
if (p <= 0)
{
if (p < 0) dw_Error(ARG_ERR);
return 0.0;
}
else
if (p >= 1)
{
if (p > 1) dw_Error(ARG_ERR);
return PLUS_INFINITY;
}
if ((cdf=dw_chi_square_cdf(hi=2*df,df)) < p_lo)
{
for (lo=hi, i=MAXITER; (i > 0) && ((cdf=dw_chi_square_cdf(hi*=2,df)) < p_lo); lo=hi, i--);
if (i == 0)
{
dw_Error(ITERATION_ERR);
return PLUS_INFINITY;
}
}
if (cdf < p_hi) return hi;
for (i=MAXITER; i > 0; i--)
if ((cdf=dw_chi_square_cdf(mid=0.5*(lo+hi),df)) < p_lo)
lo=mid;
else
if (cdf > p_hi)
hi=mid;
else
return mid;
return 0.5*(lo+hi);
}
#undef MAXITER
/*
Returns the natural logrithm of the gamma function applied to x. The gamma
function of x is the integral from 0 to infinity of t^(x-1)*exp(-t)dt.
Routine adapted from the gammln routine from Numerical Recipes in C.
*/
PRECISION dw_log_gamma(PRECISION x)
{
static PRECISION cof[6]={ 76.18009172947146, -86.50532032941677,
24.01409824083091, -1.231739572450155,
0.1208650973866179e-2, -0.5395239384953e-5};
PRECISION y, z, ser;
int j;
z=x+5.5;
z-=(x+0.5)*log(z);
ser=1.000000000190015;
for (y=x, j=0; j <= 5; j++) ser+=cof[j]/++y;
return -z+log(2.5066282746310005*ser/x);
}
/******************************************************************************/
/************************** Numerical Recipies in C ***************************/
/******************************************************************************/
#define ITMAX 1000
#define EPS 3.0e-7
static void gser(PRECISION *gamser, PRECISION a, PRECISION x, PRECISION *gln)
{
int n;
PRECISION sum,del,ap;
dw_ClearError();
*gln=dw_log_gamma(a);
if (x <= 0.0)
{
if (x < 0.0)
dw_Error(ARG_ERR);
else
*gamser=0.0;
}
else
{
ap=a;
del=sum=1.0/a;
for (n=1; n <= ITMAX; n++)
{
++ap;
del *= x/ap;
sum += del;
if (fabs(del) < fabs(sum)*EPS)
{
*gamser=sum*exp(-x+a*log(x)-(*gln));
return;
}
}
dw_Error(ITERATION_ERR);
}
}
#undef ITMAX
#undef EPS
/* (C) Copr. 1986-92 Numerical Recipes Software */
#define ITMAX 100
#define EPS 3.0e-7
#define FPMIN 1.0e-30
static void gcf(PRECISION *gammcf, PRECISION a, PRECISION x, PRECISION *gln)
{
int i;
PRECISION an,b,c,d,del,h;
*gln=dw_log_gamma(a);
b=x+1.0-a;
c=1.0/FPMIN;
d=1.0/b;
h=d;
for (i=1; i <= ITMAX; i++)
{
an = -i*(i-a);
b += 2.0;
d=an*d+b;
if (fabs(d) < FPMIN) d=FPMIN;
c=b+an/c;
if (fabs(c) < FPMIN) c=FPMIN;
d=1.0/d;
del=d*c;
h *= del;
if (fabs(del-1.0) < EPS) break;
}
if (i > ITMAX)
dw_Error(ITERATION_ERR);
else
{
*gammcf=exp(-x+a*log(x)-(*gln))*h;
dw_ClearError();
}
}
#undef ITMAX
#undef EPS
#undef FPMIN
/* (C) Copr. 1986-92 Numerical Recipes Software */
static PRECISION gammp(PRECISION a, PRECISION x)
{
PRECISION gamser,gammcf,gln;
if (x < 0.0 || a <= 0.0)
{
dw_Error(ARG_ERR);
return 0.0;
}
dw_ClearError();
if (x < (a+1.0))
{
gser(&gamser,a,x,&gln);
return gamser;
}
else
{
gcf(&gammcf,a,x,&gln);
return 1.0-gammcf;
}
}
/* (C) Copr. 1986-92 Numerical Recipes Software */
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/

35
matlab/ms-sbvar/c-code/utilities/DWCcode/stat/dw_rand.h
View File

@ -1,35 +0,0 @@
#ifndef __DW_RANDOM__
#define __DW_RANDOM__
#ifdef __cplusplus
extern "C"
{
#endif
#include "prcsn.h"
#include <stdio.h>
void dw_initialize_generator(int init);
void* dw_get_generator_state(void);
int dw_get_generator_state_size(void);
void dw_set_generator_state(void *state);
void dw_print_generator_state(FILE *f);
void dw_read_generator_state(FILE *f);
PRECISION dw_uniform_rnd(void);
PRECISION dw_gaussian_rnd(void);
PRECISION dw_lognormal_rnd(PRECISION mean, PRECISION standard_deviation);
PRECISION dw_gamma_rnd(PRECISION a);
PRECISION dw_normal_cdf(PRECISION x);
PRECISION dw_chi_square_cdf(PRECISION x, int df);
PRECISION dw_chi_square_invcdf(PRECISION p, int df);
PRECISION dw_log_gamma(PRECISION x);
#ifdef __cplusplus
}
#endif
#endif

582
matlab/ms-sbvar/c-code/utilities/TZCcode/congradmin.c
View File

@ -1,582 +0,0 @@
/*************************************************************
* Conjugate Gradient Minimization Methods. See Numerical Recipes in C by Press, Flannery, Teukolsky, and Vetterling.
* (I) frprmn(): Plolak-Ribiere method with the line minimization without using the derivative information.
* (II) dlinmin(): Fletcher-Reeves method with the line minimization using the derivative information.
*
* Modified by Tao Zha, September 2003.
*************************************************************/
#include "congradmin.h"
#include "modify_for_mex.h"
static void linmin(double p[], double xi[], int n, double *fret, double tol_brent, int itmax_brent, double (*func)(double [], int));
static double brent(double ax, double bx, double cx, double (*f)(double), double tol_brent, double itmax_brent, double *xmin);
/* // ansi-c*/
static void dlinmin(double p[], double xi[], int n, double *fret, double tol_dbrent, double itmax_dbrent, double *grdh_p, double (*func)(double [], int), void (*dfunc)(double [], double [], int, double (*func)(double [], int), double *, double));
static double dbrent(double ax, double bx, double cx, double (*f)(double), double (*df)(double, double *), double *grdh_p, double tol_dbrent, double itmax_dbrent, double *xmin);
static double df1dim(double x, double *grdh_p);
/* // ansi-c*/
static void mnbrak(double *ax, double *bx, double *cx, double *fa, double *fb, double *fc, double (*func)(double));
static double f1dim(double x);
/* // ansi-c*/
static double ftd_norm2(double *vnew_p, double *vold_p, int _n);
static double ftd_innerproduct(double *x, double *y, int _n);
#define ANGLE 0.001 /* .0 implies 90.00 degress (acrcos(ANGLE)*180/pi). ansi-c*/
/* //.005 implies 89.71 degrees (acrcos(ANGLE)*180/pi). ansi-c*/
/* //.01 implies 89.43 degrees (acrcos(ANGLE)*180/pi). ansi-c*/
/* //.05 implies 87.13 degrees (acrcos(ANGLE)*180/pi). ansi-c*/
/* //.1 implies 84.26 degrees (acrcos(ANGLE)*180/pi). ansi-c*/
#define STRLEN 192
static FILE *fptr_interesults = (FILE *)NULL; /* Printing intermediate results to a file. ansi-c*/
static char filename_sp3vecs[STRLEN]; /* Three vectors. 1st row: line search direction; 2nd row: numerical gradient; 3rd row: vectorized parameters. ansi-c*/
/* //static FILE *fptr_interesults_db = (FILE *)NULL; //Printing intermediate results to a file for debugging (db). ansi-c*/
#define PRINTON /* Added by TZ, September 2003. ansi-c*/
#define EPS 1.0e-10 /* Small number to rectify special case of converging to exactly zero function value. ansi-c*/
#ifdef PRINTON /* Added by TZ, September 2003. ansi-c*/
#define FREEALL {tzDestroy(xi); tzDestroy(h); tzDestroy(g); tzDestroy(pold); tzDestroy(numgrad)}
#else
#define FREEALL {tzDestroy(xi); tzDestroy(h); tzDestroy(g);}
#endif
void frprmn(double p[], int n, int *iter, double *fret,
double (*func)(double [], int), void (*dfunc)(double [], double [], int, double (*func)(double [], int), double *, double),
double *ftol_p, int *itmax_p, double *tol_brent_p, int *itmax_brent_p, double *grdh_p) {
/* //Outputs: ansi-c*/
/* // p[0, ..., n-1]: the location of the minimum if it converges, which replaces the starting value. ansi-c*/
/* // iter: pointer to the number of iterations that were performed. ansi-c*/
/* // fret: pointer to the minimum value of the function. ansi-c*/
/* //Inputs: ansi-c*/
/* // p[0, ..., n-1]: a starting point for the minimization. ansi-c*/
/* // n: the dimension of p. ansi-c*/
/* // ftol_p: pointer to the convergence tolerance on the objective function value. Default: 1.0e-4 if NULL. ansi-c*/
/* // itmax_p: pointer to the maximum number of iterations in the main minimization program frprmn(). Default: 2000 if NULL. ansi-c*/
/* // tol_brent_p: pointer to the convergence tolerance for the line minimization in brent(). Default: 2.0e-4 if NULL. ansi-c*/
/* // itmax_brent_p: pointer to the maximum number of iterations for the line minimization in brent(). Default: 100 if NULL. ansi-c*/
/* // grdh: pointer to the user's specified step size for a numerical gradient. If NULL, dfunc() (i.e., gradcd_gen()) will select grdh automatically. ansi-c*/
/* // func(): the objective function. ansi-c*/
/* // dfunc(): the gradient function computing the numerical gradient. In the form of gradcd_gen() in cstz.c. ansi-c*/
int j, its, itmax, itmax_brent;
double gg, gam, fp, dgg, ftol, tol_brent;
double *g=NULL, *h=NULL, *xi=NULL;
#ifdef PRINTON /* Added by TZ, September 2003. ansi-c*/
time_t begtime, currentime;
double normforp, *pold = NULL, *numgrad = NULL;
int cnt_wrong_dirs = -1; /* Counts the number of times that a numerical direction in the line search has a wrong sign. ansi-c*/
#endif
/* //=== Memory allocation. ansi-c*/
g=tzMalloc(n, double);
h=tzMalloc(n, double);
xi=tzMalloc(n, double);
/* // ansi-c*/
numgrad = tzMalloc(n, double); /* Added by TZ, September 2003. ansi-c*/
#ifdef PRINTON /* Added by TZ, September 2003. ansi-c*/
pold = tzMalloc(n, double);
#endif
/* //=== Default values. ansi-c*/
if (!ftol_p) ftol = 1.0e-4; else ftol = *ftol_p;
if (!itmax_p) itmax = 200; else itmax = *itmax_p;
if (!tol_brent_p) tol_brent = 2.0e-4; else tol_brent = *tol_brent_p;
if (!itmax_brent_p) itmax_brent = 100; else itmax_brent = *itmax_brent_p;
fp=(*func)(p, n);
(*dfunc)(xi, p, n, func, grdh_p, fp);
for (j=n-1;j>=0;j--) {
g[j] = -xi[j];
xi[j]=h[j]=g[j];
}
memcpy(numgrad, xi, n*sizeof(double)); /* Added by TZ, September 2003. Save the numerical gradient to be printed out at the right place. ansi-c*/
for (its=0;its<itmax;its++) {
#ifdef PRINTON
time(&begtime); /* Added by TZ, September 2003. ansi-c*/
memcpy(pold, p, n*sizeof(double)); /* Added by TZ, September 2003. ansi-c*/
#endif
/* //====== Added by TZ, September 2003 ====== ansi-c*/
if ( !(fptr_interesults = fopen(filename_sp3vecs,"w")) ) {
printf("\n\nUnable to create the starting point data file %s in congradmin.c!\n", filename_sp3vecs);
getchar();
swzExit(EXIT_FAILURE);
}
/* // rewind(fptr_interesults); //Must put the pointer at the beginning of the file. ansi-c*/
/* //=== Prints out the line search direction. ansi-c*/
fprintf(fptr_interesults, "--------Line search direction---------\n");
for (j=0; j<n; j++) fprintf(fptr_interesults, " %0.16e ", xi[j]);
fprintf(fptr_interesults, "\n");
/* // fflush( fptr_interesults ); ansi-c*/
/* //=== Prints out the message about a wrong numerical direction in the line search for the miminziation. ansi-c*/
if ( ftd_innerproduct(xi, numgrad, n)/(ftd_norm2(xi, xi, n)*ftd_norm2(numgrad, numgrad, n)) > - ANGLE ) {
#ifdef PRINTON
printf("\n----------------\n"
"Warning: wrong numerical direction in the line search for the miminziation (a total of %d times)!\n"
"----------------\n", ++cnt_wrong_dirs);
#endif
}
*iter=its;
#if defined (CGI_OPTIMIZATION)
linmin(p,xi,n,fret, tol_brent, itmax_brent, func);
#elif defined (CGII_OPTIMIZATION)
dlinmin(p, xi, n, fret, tol_brent, itmax_brent, grdh_p, func, dfunc);
#else
fn_DisplayError("The minimization routine frprmn() requires activating CGI_OPTIMIZATION or CGII_OPTIMIZATION in tzmatlab.h");
#endif
#ifdef PRINTON
normforp = ftd_norm2(p, pold, n);
/* //=== Prints out intermediate results. ansi-c*/
printf("\n========================================\n");
printf("Intermediate results for the conjugate gradient algorithm.");
printf("\n (1) Number of iterations so far (maximum number): %d (%d)\n (2) New value of objective function (old value, improvement): %0.9f (%0.9f, %0.9f)\n"
" (3) Norm-2 of dx: %0.9f\n",
its, itmax, *fret, fp, fp-(*fret), normforp);
fflush(stdout); /* Flush the buffer to get out this message without delay. ansi-c*/
#endif
/* //====== The following statements print out intermediate results. Added by TZ, September 2003 ====== ansi-c*/
/* //=== Prints out the gradient. ansi-c*/
fprintf(fptr_interesults, "--------Numerical graident---------\n");
for (j=0; j<n; j++) fprintf(fptr_interesults, " %0.16e ", numgrad[j]);
fprintf(fptr_interesults, "\n");
/* // ansi-c*/
fprintf(fptr_interesults, "--------Restarting point---------\n");
for (j=0; j<n; j++) fprintf(fptr_interesults, " %0.16e ", p[j]);
fprintf(fptr_interesults, "\n\n");
/* // fflush( fptr_interesults ); ansi-c*/
tzFclose(fptr_interesults);
if (2.0*fabs(*fret-fp) <= ftol*(fabs(*fret)+fabs(fp)+EPS)) {
/* //This is a normal convergence. ansi-c*/
printf("\n----- Normal convergence by the criterion of the objective function evaluation -----------\n");
FREEALL
return;
}
fp=(*func)(p, n);
(*dfunc)(xi, p, n, func, grdh_p, fp);
memcpy(numgrad, xi, n*sizeof(double)); /* Added by TZ, September 2003. Save the numerical gradient to be printed out at the right place. ansi-c*/
/* // if (filename_sp3vecs) { ansi-c*/
/* // //=== Prints out the gradient. ansi-c*/
/* // fprintf(fptr_interesults, "--------Numerical graident---------\n"); ansi-c*/
/* // for (j=0; j<n; j++) fprintf(fptr_interesults, " %0.16e ", xi[j]); ansi-c*/
/* // fprintf(fptr_interesults, "\n\n"); ansi-c*/
/* //// fflush( fptr_interesults ); ansi-c*/
/* // tzFclose(fptr_interesults); ansi-c*/
/* // } ansi-c*/
dgg=gg=0.0;
for (j=n-1;j>=0;j--) {
gg += g[j]*g[j];
dgg += (xi[j]+g[j])*xi[j];
}
if (gg == 0.0) {
FREEALL
return;
}
gam=dgg/gg;
for (j=n-1;j>=0;j--) {
g[j] = -xi[j];
xi[j]=h[j]=g[j]+gam*h[j];
}
#ifdef PRINTON
time(&currentime);
/* //=== Times the iterative progress. ansi-c*/
printf(" (4) Seconds to complete one iteration: %0.4f\n (5) Current time of day: %s\n", difftime(currentime, begtime), ctime(&currentime));
fflush(stdout); /* Flush the buffer to get out this message without delay. ansi-c*/
#endif
}
fn_DisplayError("The maximum number of iterations in frprmn() is reached before convergence");
}
#undef PRINTON
#undef EPS
#undef FREEALL
#if defined (CGI_OPTIMIZATION)
static int ncom;
static double *pcom=NULL, *xicom=NULL, (*nrfunc)(double [], int); /* nrfunc(), pcom, ncom, and xicom will be used by f1dim(). ansi-c*/
static void linmin(double p[], double xi[], int n, double *fret, double tol_brent, int itmax_brent, double (*func)(double [], int)) {
/* //Outputs: ansi-c*/
/* // p[0, ..., n-1]: a returned and reset value. ansi-c*/
/* // xi[0, ..., n-1]: a value repaced by the actual vector displacement that p was moved. ansi-c*/
/* // fret: the value of func at the returned location p. ansi-c*/
/* //Inputs: ansi-c*/
/* // p[0, ..., n-1]: a given point. ansi-c*/
/* // xi[0, ..., n-1]: a given multidimensional direction. ansi-c*/
/* // n: the dimension of p and xi. ansi-c*/
/* // func(): the objective function. ansi-c*/
int j;
double xx,xmin,fx,fb,fa,bx,ax;
ncom=n;
pcom = tzMalloc(n, double);
xicom = tzMalloc(n, double);
nrfunc=func;
for (j=n-1;j>=0;j--) {
pcom[j]=p[j];
xicom[j]=xi[j];
}
ax=0.0;
xx=1.0;
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim);
*fret=brent(ax,xx,bx,f1dim, tol_brent, itmax_brent, &xmin);
for (j=n-1;j>=0;j--) {
xi[j] *= xmin;
p[j] += xi[j];
}
tzDestroy(xicom);
tzDestroy(pcom);
}
/* //=== Used by linmin() only; ansi-c*/
#define CGOLD 0.3819660
#define ZEPS 1.0e-10
#define SHFT(a,b,c,d) {(a)=(b);(b)=(c);(c)=(d);}
#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
static double brent(double ax, double bx, double cx, double (*f)(double), double tol_brent, double itmax_brent, double *xmin) {
int iter;
double a,b,d,etemp,fu,fv,fw,fx,p,q,r,tol1,tol2,u,v,w,x,xm;
double e=0.0;
a=(ax < cx ? ax : cx);
b=(ax > cx ? ax : cx);
x=w=v=bx;
fw=fv=fx=(*f)(x);
for (iter=0;iter<itmax_brent;iter++) {
xm=0.5*(a+b);
tol2=2.0*(tol1=tol_brent*fabs(x)+ZEPS);
if (fabs(x-xm) <= (tol2-0.5*(b-a))) {
*xmin=x;
return fx;
}
if (fabs(e) > tol1) {
r=(x-w)*(fx-fv);
q=(x-v)*(fx-fw);
p=(x-v)*q-(x-w)*r;
q=2.0*(q-r);
if (q > 0.0) p = -p;
q=fabs(q);
etemp=e;
e=d;
if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x))
d=CGOLD*(e=(x >= xm ? a-x : b-x));
else {
d=p/q;
u=x+d;
if (u-a < tol2 || b-u < tol2)
d=SIGN(tol1,xm-x);
}
} else {
d=CGOLD*(e=(x >= xm ? a-x : b-x));
}
u=(fabs(d) >= tol1 ? x+d : x+SIGN(tol1,d));
fu=(*f)(u);
if (fu <= fx) {
if (u >= x) a=x; else b=x;
SHFT(v,w,x,u)
SHFT(fv,fw,fx,fu)
} else {
if (u < x) a=u; else b=u;
if (fu <= fw || w == x) {
v=w;
w=u;
fv=fw;
fw=fu;
} else if (fu <= fv || v == x || v == w) {
v=u;
fv=fu;
}
}
}
fn_DisplayError("The maximum number of iterations in brent() is reached before convergence");
*xmin=x;
return fx;
}
#undef CGOLD
#undef ZEPS
#undef SHFT
#undef SIGN
#else /* Default to CGII_OPTIMIZATION ansi-c*/
static int ncom;
static double *pcom=NULL, *xicom=NULL, (*nrfunc)(double [], int); /* nrfunc(), pcom, ncom, and xicom will be used by f1dim() and df1dim(). ansi-c*/
static void (*nrdfun)(double [], double [], int, double (*func)(double [], int), double *, double);
static void dlinmin(double p[], double xi[], int n, double *fret, double tol_dbrent, double itmax_dbrent, double *grdh_p, double (*func)(double [], int), void (*dfunc)(double [], double [], int, double (*func)(double [], int), double *, double)) {
/* //Outputs: ansi-c*/
/* // p[0, ..., n-1]: a returned and reset value. ansi-c*/
/* // xi[0, ..., n-1]: a value repaced by the actual vector displacement that p was moved. ansi-c*/
/* // fret: the value of func at the returned location p. ansi-c*/
/* //Inputs: ansi-c*/
/* // p[0, ..., n-1]: a given point. ansi-c*/
/* // xi[0, ..., n-1]: a given multidimensional direction. ansi-c*/
/* // n: the dimension of p and xi. ansi-c*/
/* // func(): the objective function. ansi-c*/
/* // dfunc(): the gradient function computing the numerical gradient. In the form of gradcd_gen() in cstz.c. ansi-c*/
int j;
double xx,xmin,fx,fb,fa,bx,ax;
ncom=n;
pcom = tzMalloc(n, double);
xicom = tzMalloc(n, double);
nrfunc=func;
nrdfun=dfunc;
for (j=n-1;j>=0;j--) {
pcom[j]=p[j];
xicom[j]=xi[j];
}
ax=0.0;
xx=1.0;
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim);
*fret=dbrent(ax,xx,bx,f1dim, df1dim, grdh_p, tol_dbrent, itmax_dbrent, &xmin);
for (j=n-1;j>=0;j--) {
xi[j] *= xmin;
p[j] += xi[j];
}
tzDestroy(xicom);
tzDestroy(pcom);
}
/* //=== Used by dlinmin() only; ansi-c*/
#define ZEPS 1.0e-10
#define MOV3(a,b,c, d,e,f) {(a)=(d);(b)=(e);(c)=(f);}
#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
static double dbrent(double ax, double bx, double cx, double (*f)(double), double (*df)(double, double *), double *grdh_p, double tol_dbrent, double itmax_dbrent, double *xmin) {
int iter,ok1,ok2;
double a,b,d,d1,d2,du,dv,dw,dx,e=0.0;
double fu,fv,fw,fx,olde,tol1,tol2,u,u1,u2,v,w,x,xm;
a=(ax < cx ? ax : cx);
b=(ax > cx ? ax : cx);
x=w=v=bx;
fw=fv=fx=(*f)(x);
dw=dv=dx=(*df)(x, grdh_p);
for (iter=1;iter<=itmax_dbrent;iter++) {
xm=0.5*(a+b);
tol1=tol_dbrent*fabs(x)+ZEPS;
tol2=2.0*tol1;
if (fabs(x-xm) <= (tol2-0.5*(b-a))) {
*xmin=x;
return fx;
}
if (fabs(e) > tol1) {
d1=2.0*(b-a);
d2=d1;
if (dw != dx) d1=(w-x)*dx/(dx-dw);
if (dv != dx) d2=(v-x)*dx/(dx-dv);
u1=x+d1;
u2=x+d2;
ok1 = (a-u1)*(u1-b) > 0.0 && dx*d1 <= 0.0;
ok2 = (a-u2)*(u2-b) > 0.0 && dx*d2 <= 0.0;
olde=e;
e=d;
if (ok1 || ok2) {
if (ok1 && ok2)
d=(fabs(d1) < fabs(d2) ? d1 : d2);
else if (ok1)
d=d1;
else
d=d2;
if (fabs(d) <= fabs(0.5*olde)) {
u=x+d;
if (u-a < tol2 || b-u < tol2)
d=SIGN(tol1,xm-x);
} else {
d=0.5*(e=(dx >= 0.0 ? a-x : b-x));
}
} else {
d=0.5*(e=(dx >= 0.0 ? a-x : b-x));
}
} else {
d=0.5*(e=(dx >= 0.0 ? a-x : b-x));
}
if (fabs(d) >= tol1) {
u=x+d;
fu=(*f)(u);
} else {
u=x+SIGN(tol1,d);
fu=(*f)(u);
if (fu > fx) {
*xmin=x;
return fx;
}
}
du=(*df)(u, grdh_p);
if (fu <= fx) {
if (u >= x) a=x; else b=x;
MOV3(v,fv,dv, w,fw,dw)
MOV3(w,fw,dw, x,fx,dx)
MOV3(x,fx,dx, u,fu,du)
} else {
if (u < x) a=u; else b=u;
if (fu <= fw || w == x) {
MOV3(v,fv,dv, w,fw,dw)
MOV3(w,fw,dw, u,fu,du)
} else if (fu < fv || v == x || v == w) {
MOV3(v,fv,dv, u,fu,du)
}
}
}
fn_DisplayError("The maximum number of iterations in dbrent() is reached before convergence");
return 0.0;
}
#undef ZEPS
#undef MOV3
#undef SIGN
/* //=== Used by dlinmin() and dbrent() only; ansi-c*/
static double df1dim(double x, double *grdh_p) {
int j;
double df1=0.0;
double *xt,*df;
xt = tzMalloc(ncom, double);
df = tzMalloc(ncom, double);
for (j=ncom-1;j>=0;j--) xt[j]=pcom[j]+x*xicom[j];
(*nrdfun)(df, xt, ncom, nrfunc, grdh_p, nrfunc(xt, ncom));
/* //=================== WARNING ====================== ansi-c*/
/* //We use 0.0 because the current gradient function gradcd_gen() in cstz.c do not use this function value. A more ansi-c*/
/* // sophisticated central gradient method would require this function value, and therefore we must pass ansi-c*/
/* // nrfunc(xt, ncom) instead of 0.0. TZ, September 2003. ansi-c*/
/* //=================== WARNING ====================== ansi-c*/
for (j=ncom-1;j>=0;j--) df1 += df[j]*xicom[j];
tzDestroy(df);
tzDestroy(xt);
return df1;
}
#endif
static double f1dim(double x) {
/* //Collapsing to one dimension line search, used by limin() or dlimin(). ansi-c*/
int j;
double f,*xt=NULL;
xt = tzMalloc(ncom, double);
for (j=ncom-1;j>=0;j--) xt[j]=pcom[j]+x*xicom[j];
f=(*nrfunc)(xt, ncom);
tzDestroy(xt);
return f;
}
#define GOLD 1.618034
#define GLIMIT 100.0
#define TINY 1.0e-20
#define SHFT(a,b,c,d) {(a)=(b);(b)=(c);(c)=(d);}
#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
static void mnbrak(double *ax, double *bx, double *cx, double *fa, double *fb, double *fc, double (*func)(double)) {
double ulim,u,r,q,fu,dum, tmpd;
*fa=(*func)(*ax);
*fb=(*func)(*bx);
if (*fb > *fa) {
SHFT(dum,*ax,*bx,dum)
SHFT(dum,*fb,*fa,dum)
}
*cx=(*bx)+GOLD*(*bx-*ax);
*fc=(*func)(*cx);
while (*fb > *fc) {
r=(*bx-*ax)*(*fb-*fc);
q=(*bx-*cx)*(*fb-*fa);
u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/
(2.0*SIGN((tmpd=fabs(q-r))>TINY ? tmpd : TINY,q-r)); /* Original: (2.0*SIGN(FMAX(fabs(q-r),TINY),q-r)); ansi-c*/
ulim=(*bx)+GLIMIT*(*cx-*bx);
if ((*bx-u)*(u-*cx) > 0.0) {
fu=(*func)(u);
if (fu < *fc) {
*ax=(*bx);
*bx=u;
*fa=(*fb);
*fb=fu;
return;
} else if (fu > *fb) {
*cx=u;
*fc=fu;
return;
}
u=(*cx)+GOLD*(*cx-*bx);
fu=(*func)(u);
} else if ((*cx-u)*(u-ulim) > 0.0) {
fu=(*func)(u);
if (fu < *fc) {
SHFT(*bx,*cx,u,*cx+GOLD*(*cx-*bx))
SHFT(*fb,*fc,fu,(*func)(u))
}
} else if ((u-ulim)*(ulim-*cx) >= 0.0) {
u=ulim;
fu=(*func)(u);
} else {
u=(*cx)+GOLD*(*cx-*bx);
fu=(*func)(u);
}
SHFT(*ax,*bx,*cx,u)
SHFT(*fa,*fb,*fc,fu)
}
}
#undef GOLD
#undef GLIMIT
#undef TINY
#undef SHFT
#undef SIGN
/* //------------------- ansi-c*/
/* // My own functions. ansi-c*/
/* //------------------- ansi-c*/
/* //=== Computing Norm2 of dv. ansi-c*/
static double ftd_norm2(double *vnew_p, double *vold_p, int _n) {
int _i;
double dtheta=0.0, /* Cumulative. ansi-c*/
tmpd;
for (_i=_n-1; _i>=0; _i--) {
tmpd = vnew_p[_i] - vold_p[_i];
dtheta += square(tmpd);
}
return ( sqrt(dtheta) );
}
/* //=== Computing the inner product of x and y. ansi-c*/
static double ftd_innerproduct(double *x, double *y, int _n) {
int _i;
double a = 0.0; /* Cumulative. ansi-c*/
for (_i=_n-1; _i>=0; _i--) a += x[_i] * y[_i]; /* a += (*x++) * (*y++); Be aware that this alternative maybe too fancy. ansi-c*/
return (a);
}
/* //=== Extern function to be accessed by other C files. ansi-c*/
void congradmin_SetPrintFile(char *filename) {
if (!filename) sprintf(filename_sp3vecs, "outdata5congradmin.prn"); /* Default filename. ansi-c*/
else {
strcpy(filename_sp3vecs, filename);
/* //filename_sp3vecs[STRLEN-1] = '\0'; //The end of the string is set to NUL to prevent it from be a non-string. ansi-c*/
}
}
/* //void congradmin_SetPrintFile(FILE *fptr_sp) { ansi-c*/
/* // fptr_interesults = fptr_sp; ansi-c*/
/* //} ansi-c*/
/* //void congradmin_SetPrintFile_db(FILE *fptr_sp) { ansi-c*/
/* // fptr_interesults_db = fptr_sp; ansi-c*/
/* //} ansi-c*/
#undef STRLEN

33
matlab/ms-sbvar/c-code/utilities/TZCcode/congradmin.h
View File

@ -1,33 +0,0 @@
#ifndef __CONGRADMIN_H__
#define __CONGRADMIN_H__
#include "tzmatlab.h"
#include <string.h>
void frprmn(double p[], int n, int *iter, double *fret,
double (*func)(double [], int), void (*dfunc)(double [], double [], int, double (*func)(double [], int), double *, double),
double *ftol_p, int *itmax_p, double *tol_brent_p, int *itmax_brent_p, double *grdh_p);
/* //Outputs: ansi-c*/
/* // p[0, ..., n-1]: the location of the minimum if it converges, which replaces the starting value. ansi-c*/
/* // iter: pointer to the number of iterations that were performed. ansi-c*/
/* // fret: pointer to the minimum value of the function. ansi-c*/
/* //Inputs: ansi-c*/
/* // p[0, ..., n-1]: a starting point for the minimization. ansi-c*/
/* // n: the dimension of p. ansi-c*/
/* // ftol_p: pointer to the convergence tolerance on the objective function value. Default: 1.0e-4 if NULL. ansi-c*/
/* // itmax_p: pointer to the maximum number of iterations in the main minimization program frprmn(). Default: 2000 if NULL. ansi-c*/
/* // tol_brent_p: pointer to the convergence tolerance for the line minimization in brent(). Default: 2.0e-4 if NULL. ansi-c*/
/* // itmax_brent_p: pointer to the maximum number of iterations for the line minimization in brent(). Default: 100 if NULL. ansi-c*/
/* // grdh: pointer to the user's specified step size for a numerical gradient. If NULL, dfunc() (i.e., gradcd_gen()) will select grdh automatically. ansi-c*/
/* // func(): the objective function. ansi-c*/
/* // dfunc(): the gradient function computing the numerical gradient. In the form of gradcd_gen() in cstz.c. ansi-c*/
void congradmin_SetPrintFile(char *filename);
/* //If filename=NULL, no intermediate results will be printed out to a file. ansi-c*/
/* // void congradmin_SetPrintFile(FILE *fptr_sp); ansi-c*/
/* //If fptr_sp=NULL, no intermediate results will be printed out to a file. ansi-c*/
/* // void congradmin_SetPrintFile_db(FILE *fptr_sp); ansi-c*/
#endif

855
matlab/ms-sbvar/c-code/utilities/TZCcode/csminwel.c
View File

@ -1,855 +0,0 @@
/* //======= Revisions by T. Zha. ansi-c*/
/* //======= Fixing bugs: convering all if-else loop. 02/24/05 ansi-c*/
/*=========================================================
* csminwel.c
*
* Unconstrained minimization. Uses a quasi-Newton method with BFGS update of
* the estimated inverse hessian. It is robust against certain pathologies
* common on likelihood functions. It attempts to be robust against "cliffs",
* i.e. hyperplane discontinuities, though it is not really clear whether what
* it does in such cases succeeds reliably.
*
* function [fhat,xhat,ghat,Hhat,itct,fcount,retcodehat] = csminwelmex(fcn,x0,H0,grad,crit,nit,varargin)
* fcn: string naming the objective function to be minimized
* x0: initial value of the parameter vector
* H0: initial value for the inverse Hessian. Must be positive definite.
* grad: Either a string naming a function that calculates the gradient, or the null matrix.
* If it's null, the program calculates a numerical gradient. In this case fcn must
* be written so that it can take a matrix argument and produce a row vector of values.
* crit: Convergence criterion. Iteration will cease when it proves impossible to improve the
* function value by more than crit.
* nit: Maximum number of iterations.
* varargin: A list of optional length of additional parameters that get handed off to fcn each
* time it is called.
* Note that if the program ends abnormally, it is possible to retrieve the current x,
* f, and H from the files g1.mat and H.mat that are written at each iteration and at each
* hessian update, respectively. (When the routine hits certain kinds of difficulty, it
* write g2.mat and g3.mat as well. If all were written at about the same time, any of them
* may be a decent starting point. One can also start from the one with best function value.)
*
* retcodes: 0, normal step (converged). 1, zero gradient (converged).
* 4,2, back and forth adjustment of stepsize didn't finish.
* 3, smallest stepsize still improves too slow. 5, largest step still improves too fast.
* 6, no improvement found.
*---------------------
* Fixed 7/17/93 to use inverse-hessian instead of hessian itself in bfgs update.
* Fixed 7/19/93 to flip eigenvalues of H to get better performance when it's not psd.
*
* Note: to set the level of display output, change preprocessor definitions at the beginning of this file.
* to display all output, uncomment both VERBOSE_WARNINGS and VERBOSE_DETOUTPUT
* to display only warnings without output, uncomment VERBOSE_WARNINGS
* to display no ouput, comment both VERBOSE_DETOUTPUT and VERBOSE_WARNINGS
*
* MATLAB algorithm by Christopher Sims
* C implementation by Iskander Karibzhanov
* Modified by Dan Waggoner and Tao Zha
*
* Copyright(c) 1996 Christopher Sims
* Copyright(c) 2003 Karibzhanov, Waggoner, and Zha
*=======================================================
* Revision history by T. Zha:
*
* 10/3/2002 - 1. corrected problem with memory corruption in C-MEX-file (csminwelmex.c)
* (needed to switch fcnRhs[0] back to x[0] before destroying it.
* If we don't do this, we will later clear previously destroyed array
* (one of x[1], x[2] or x[3]) which causes memory fault.
* The reason why fcnRhs[0] pointed to array other than x[0] is
* because we use mxSetPr in feval and gfeval.
* This was not a problem in C-file (csminwel.c).
*
* 10/11/2002 - 1. changed csminit function to avoid using fPeak without first initializing it
* 2. added two switches in csminit function to assign retcode to 7 for lambda>=4
* 3. added one more verbose level to display only warnings or all output *
*
* 07/13/2005 - Change #define GRADSTPS_CSMINWEL to double GRADSTPS_CSMINWEL in the .h file so the user can change the value.
*
* 03/10/2006 - Iskander's use of randmax=1/RAND_MAX is incorrect. Changed to randmax=1.0/RAND_MAX. Note rand() is in stdlib.h and time() is in time.h.
* - Fatal BUG by Iskander to have eye(n) instead of eye(nn). Corrected by TZ.
*
========================================================*/
/* //#include "csminwel.h" ansi-c*/
#include "optpackage.h"
#include "modify_for_mex.h"
#define VERBOSE_WARNINGS /* Display warnings. ansi-c*/
#define VERBOSE_DETOUTPUT /* Display detailed output. ansi-c*/
#define STRLEN 192
/* //#define INDXNUMGRAD_CSMINWEL 2 //Index for choosing the numerical gradient. 1, forward difference; 2, central difference. ansi-c*/
double GRADSTPS_CSMINWEL = 1.0e-04; /* Default value. Will be overwritten by the data in the input file if it exists. ansi-c*/
/* //1.0e-04 (for monthly TBVAR) ansi-c*/
/* //Step size for numerical gradient only when the value of x is less than 1.0 in absolute value. ansi-c*/
/* //If abs(x)>1.0, the step size is GRADSTPS_CSMINWEL*x. ansi-c*/
static int RANDOMSEED_CSMINWEL = 0; /* Default value: no fixed seed. Will be initialized somewhere else through csminwel_randomseedChanged(). ansi-c*/
static double GLB_sclForHess;
static int numgrad(double *g, double *x, int n,
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims);
static void csminit(double *fhat, double *xhat, int *fcount, int *retcode,
double *x0, double f0, double *g, int badg, double *H0, int n,
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims);
static void bfgsi(double *H, double *dg, double *dx, int n, int nn);
static int peakwall(double *g, int retcode, double *x, int n,
int (*gfcn)(double *x, int n, double *g, double **args, int *dims),
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims);
static double times(double *x, double *y, int n);
static double *mtimes(double *x, double *y, int n, int nn);
static double *mminus(double *x, double *y, int n);
static FILE *fptr_interesults = (FILE *)NULL; /* Printing intermediate results to a file. ansi-c*/
static char filename_sp2vecs[STRLEN]; /* Two vectors. 1st row: numerical gradient; 2nd row: vectorized parameters. ansi-c*/
#define MAX_NUM_BADCASES 3
#define EPS (1.0e-10) /* Small number to rectify special case of converging to exactly zero function value. ansi-c*/
#define TERMINATEVALUE (1.0e+300) /* If the value of the objective function at the intial value is greater than this, terminates the program. ansi-c*/
void csminwel(double (*fcn)(double *x, int n, double **args, int *dims),
double *xh, int n, double *H, double *gh,
int (*gfcn)(double *x, int n, double *g, double **args, int *dims),
double *fh, double crit, int *itct, int nit,
int *fcount, int *retcodeh, double **args, int *dims)
{
/* //If gfcn is passed as NULL, numerical gradient is automatically computed. ansi-c*/
/* //unsigned int randomseed = (unsigned int)time((time_t)RANDOMSEED_CSMINWEL); //793; ansi-c*/
unsigned int randomseed;
static int first_time = TZ_TRUE; /* Added by T.Zha; 03/10/2006. ansi-c*/
int done=0, badg[4], badgh, nogh=1, stuck=0;
double *x[4], *g[4], f[4], *dg, *dx;
int retcode[3], fc=0, ih, nn, i;
int cnt_n_badcases = 0; /* Must set to 0. Counts the number of bad cases before restarting with the initial diagonal (inverse of) Hessian. Added by TZ. ansi-c*/
TSdmatrix *H_dm = tzMalloc(1, TSdmatrix); /* H_dm wil point to the same location as H. ansi-c*/
#ifdef VERBOSE_DETOUTPUT
time_t begtime, currentime;
#endif
/* //=== Seed for random number generator in stdlib.h. Added by T.Zha; 03/10/2006. ansi-c*/
if (!RANDOMSEED_CSMINWEL)
{
if(constant_seed==0)
randomseed = (unsigned int)time((time_t *)NULL);
/* //Note that (unsigned int)time(0) uses the time of day for random seed. ansi-c*/
/* //Added by T.Zha; 03/10/2006. time() is in time.h. ansi-c*/
else
randomseed = constant_seed;
}
else
randomseed = (unsigned int)RANDOMSEED_CSMINWEL;
if ( first_time )
{
first_time = TZ_FALSE;
srand( randomseed );
}
GLB_sclForHess = H[0]; /* The scale factor for the initial (inverse of) Hessian, which was supposed to be **diagonal**. Added by TZ. ansi-c*/
nn = n*n; /* n: dimension size of x or xh */
*itct = -1; /* itct: number of actual iterations */
*fcount = -1; /* fcount: number of evaluations of the function */
for (i=0; i<4; i++)
x[i] = tzMalloc(n, double); /* x[i] = swzCalloc(n, sizeof(double)); Commented out by TZ. ansi-c*/
memcpy(x[0],xh,n*sizeof(double));
for (i=0; i<4; i++)
g[i] = tzMalloc(n, double); /* swzCalloc(n, sizeof(double)); Commented out by TZ. ansi-c*/
f[0] = fcn(x[0],n,args,dims);
if (f[0] > TERMINATEVALUE) {
printf("Bad initial parameter. Minimization is terminated without any returned value!\n");
return;
}
if (gfcn)
/* if grad is a string, compute it */
badg[0] = gfcn(x[0],n,g[0],args,dims);
else
/* if grad is not string, compute it */
badg[0] = numgrad(g[0],x[0],n,fcn,args,dims);
retcode[2] = 101;
/* iterate until done is false */
while (!done) {
#ifdef VERBOSE_DETOUTPUT
time(&begtime);
#endif
for (i=0; i<n; i++)
g[1][i] = g[2][i] = g[3][i] = 0;
/* // #ifdef VERBOSE_DETOUTPUT ansi-c*/
/* // printf("-----------------\n-----------------\n"); ansi-c*/
/* // printf("f at the beginning of new iteration, %.10f\nx = ",f[0]); ansi-c*/
/* // for (i=0; i<n; i++) { ansi-c*/
/* // printf("%15.8g ",x[0][i]); ansi-c*/
/* // if (i%4==3) printf("\n"); ansi-c*/
/* // } ansi-c*/
/* // if (i%4>0) printf("\n"); ansi-c*/
/* // #endif ansi-c*/
(*itct)++;
csminit(&f[1],x[1],&fc,&retcode[0],x[0],f[0],g[0],badg[0],H,n,fcn,args,dims);
*fcount += fc;
/* if retcode1=1 gradient is zero and you are at the peak */
if (retcode[0]!=1) {
badg[1] = peakwall(g[1],retcode[0],x[1],n,gfcn,fcn,args,dims);
/* Bad gradient or back and forth on step length.
Possibly at cliff edge. Try perturbing search direction. */
if (badg[1]) {
double *Hcliff = tzMalloc(nn, double); /* swzCalloc(nn,sizeof(double)); Commented out by TZ. ansi-c*/
double randmax=1.0/(double)RAND_MAX; /* 03/10/2006, changed from 1/ to 1.0/ to make randmax a legal double. ansi-c*/
/* if stuck, give it another try by perturbing Hessian */
memcpy(Hcliff,H,nn*sizeof(double));
for (i=0; i<nn; i+=n+1)
Hcliff[i] *= 1+rand()*randmax; /* DDDDebugging. Hcliff[i] *= 1+0.5; ansi-c*/
#ifdef VERBOSE_WARNINGS
printf("======= Random search takes place now. =======\n");
printf("Cliff. Perturbing search direction.\n");
#endif
csminit(&f[2],x[2],&fc,&retcode[1],x[0],f[0],g[0],badg[0],Hcliff,n,fcn,args,dims);
*fcount += fc;
if (f[2] < f[0]) {
badg[2] = peakwall(g[2],retcode[1],x[2],n,gfcn,fcn,args,dims);
if (badg[2]) {
double *xx = tzMalloc(n, double), nx; /* swzCalloc(n,sizeof(double)), nx; Commented out by TZ. ansi-c*/
#ifdef VERBOSE_WARNINGS
printf("Cliff again. Try traversing.\n");
#endif
for (i=0; i<n; i++)
xx[i] = x[2][i]-x[1][i];
nx = times(xx,xx,n);
if (sqrt(nx) < 1e-13) {
f[3] = f[0];
memcpy(x[3],x[0],n*sizeof(double));
badg[3] = 1;
retcode[2] = 101;
} else {
double *gcliff = tzMalloc(n, double), /* swzCalloc(n,sizeof(double)), Commented out by TZ. ansi-c*/
*eye = tzMalloc(nn, double); /* swzCalloc(n,sizeof(double)); Bugs of Iskander. Changed from n to nn. 03/10/06. ansi-c*/
double dfnx = (f[2]-f[1])/nx;
for (i=0; i<n; i++) {
gcliff[i] = dfnx*xx[i];
eye[i*(n+1)] = 1;
}
csminit(&f[3],x[3],&fc,&retcode[2],x[0],f[0],gcliff,0,eye,n,fcn,args,dims);
*fcount += fc;
badg[3] = peakwall(g[3],retcode[2],x[3],n,gfcn,fcn,args,dims);
tzDestroy(eye);
tzDestroy(gcliff);
}
tzDestroy(xx);
} else {
f[3] = f[0];
memcpy(x[3],x[0],n*sizeof(double));
badg[3] = 1;
retcode[2] = 101;
}
} else {
f[3] = f[0];
memcpy(x[3],x[0],n*sizeof(double));
badg[3] = 1;
retcode[2] = 101;
}
tzDestroy(Hcliff);
} else {
/* normal iteration, no walls, or else we're finished here. */
f[2] = f[0];
f[3] = f[0];
badg[2] = 1;
badg[3] = 1;
retcode[1] = 101;
retcode[2] = 101;
}
}
else /*Bugs fixed by T. Zha -- 02/24/05.*/
{
f[1] = f[0];
f[2] = f[0];
f[3] = f[0];
retcode[1] = retcode[0];
retcode[2] = retcode[0];
}
/* // % normal iteration, no walls, or else we're finished here. ansi-c*/
/* // f2=f; f3=f; badg2=1; badg3=1; retcode2=101; retcode3=101; ansi-c*/
/* // f1=f; f2=f; f3=f; retcode2=retcode1; retcode3=retcode1; ansi-c*/
/* how to pick gh and xh */
if (f[3]<f[0] && badg[3]==0) {
/* if 3 (transversing) was needed, it improved and gradient is good, take that */
ih = 3;
*fh = f[3];
memcpy(xh,x[3],n*sizeof(double));
memcpy(gh,g[3],n*sizeof(double));
badgh = badg[3];
*retcodeh = retcode[2];
}
else if (f[2]<f[0] && badg[2]==0) {
/* if 2 (perturbig) was needed, it improved and gradient is good, take that */
ih = 2;
*fh = f[2];
memcpy(xh,x[2],n*sizeof(double));
memcpy(gh,g[2],n*sizeof(double));
badgh = badg[2];
*retcodeh = retcode[1];
}
else if (f[1]<f[0] && badg[1]==0) {
/* if first try went fine, take that */
ih = 1;
*fh = f[1];
memcpy(xh,x[1],n*sizeof(double));
memcpy(gh,g[1],n*sizeof(double));
badgh = badg[1];
*retcodeh = retcode[0];
}
else {
/* if nothing worked, just take the min of your attempts and compute the gradient */
if (f[1] <= f[2])
if (f[1] <= f[3]) ih = 1;
else ih = 3;
else
if (f[2] <= f[3]) ih = 2;
else ih = 3;
*fh = f[ih];
memcpy(xh,x[ih],n*sizeof(double));
*retcodeh = retcode[ih-1];
if (nogh) {
nogh = 0;
if (gfcn)
badgh = gfcn(xh,n,gh,args,dims);
else
badgh = numgrad(gh,xh,n,fcn,args,dims);
}
badgh = 1;
}
/* end of picking */
stuck = fabs(*fh-f[0]) < crit; /* Used if fh>0. TZ, 9/03. ansi-c*/
/* //stuck = (2.0*fabs(*fh-f[0]) <= crit*(fabs(*fh)+fabs(f[0])+EPS)); //Used if fh<0. Added by TZ, 9/03. ansi-c*/
/* if nothing REALLY worked, too bad, you're stuck */
if (!badg[0] && !badgh && !stuck) {
/* if you are not stuck, update H0 matrix */
dg = mminus(gh,g[0],n);
dx = mminus(xh,x[0],n);
bfgsi(H,dg,dx,n,nn);
tzDestroy(dx);
tzDestroy(dg);
}
#ifdef VERBOSE_DETOUTPUT
/* //=== Prints out intermediate results. ansi-c*/
printf("========================================\n");
printf(" (1) New value of the obj. func. on iteration %d: %.9f\n (2) Old value: %.9f\n (3) Downhill improvement: %.9f\n",
(int)*itct, *fh, f[0], f[0]-(*fh));
time(&currentime);
/* //=== Times the iterative progress. ansi-c*/
printf(" (4) Seconds to complete one iteration: %0.4f\n (5) Current time of day: %s\n\n", difftime(currentime, begtime), ctime(&currentime));
fflush(stdout); /* Flush the buffer to get out this message without delay. ansi-c*/
#endif
/* //--------- Prints outputs to a file. --------- ansi-c*/
if ( !(fptr_interesults = fopen(filename_sp2vecs,"w")) ) {
printf("\n\nUnable to create the starting point data file %s in csminwel.c!\n", filename_sp2vecs);
getchar();
swzExit(EXIT_FAILURE);
}
fprintf(fptr_interesults, "========= Only one block at a time if more-than-one blocks are used. ========== \n");
fprintf(fptr_interesults, "--------Numerical gradient---------\n");
for (i=0; i<n; i++) fprintf(fptr_interesults, " %0.16e ", gh[i]);
fprintf(fptr_interesults, "\n");
fprintf(fptr_interesults, "--------Restarting point---------\n");
for (i=0; i<n; i++) fprintf(fptr_interesults, " %0.16e ", xh[i]);
fprintf(fptr_interesults, "\n\n");
fflush(fptr_interesults);
tzFclose(fptr_interesults);
if ((int)*itct > nit) {
#ifdef VERBOSE_WARNINGS
printf("\nWarning: termination as the maximum number of iterations is reached.\n");
#endif
done = 1;
}
else if (stuck) {
#ifdef VERBOSE_DETOUTPUT
printf("\nConvergence (improvement < crit %.4e) with return code %d.\n", crit, *retcodeh);
#endif
done = 1;
}
#ifdef VERBOSE_WARNINGS
switch (*retcodeh) {
case 1:
printf("\nCoverged: Zero gradient.\n"); break;
case 2:
printf("\nWarning: Back adjustment of stepsize didn't finish.\n"); break;
case 3:
printf("\nWarning: Smallest stepsize still improving too slow.\n"); break;
case 4:
printf("\nWarning: Forth adjustment of stepsize didn't finish.\n"); break;
case 6:
printf("\nWarning: Smallest step still improving too slow, reversed gradient.\n"); break;
case 5:
printf("\nWarning: Largest stepsize still improving too fast.\n"); break;
case 7:
printf("\nWarning: Possible inaccuracy in Hessian matrix.\n"); break;
}
#endif
/* //=== Restarts from the initial (inverse of) Hessian when stuck for a while in bad cases. Added by TZ. ansi-c*/
if (*retcodeh && *retcodeh != 1)
if (++cnt_n_badcases >= MAX_NUM_BADCASES) {
H_dm->M = H;
H_dm->nrows = H_dm->ncols = n;
InitializeDiagonalMatrix_lf(H_dm, GLB_sclForHess);
/* //H_dm->flag = M_GE | M_SU | M_SL; //Hessian is symmetric. ansi-c*/
cnt_n_badcases = 0; /* Reset after we restart wtih the initial Hessian. ansi-c*/
#ifdef VERBOSE_WARNINGS
printf("Hessian is reset to the initial value because the maximum number of bad cases, %d, is reached!\n", MAX_NUM_BADCASES);
#endif
}
f[0] = *fh;
memcpy(x[0],xh,n*sizeof(double));
memcpy(g[0],gh,n*sizeof(double));
badg[0] = badgh;
}
/* //--------- Prints outputs to a file. --------- ansi-c*/
if ( !(fptr_interesults = fopen(filename_sp2vecs,"w")) ) {
printf("\n\nUnable to create the starting point data file %s in csminwel.c!\n", filename_sp2vecs);
getchar();
swzExit(EXIT_FAILURE);
}
fprintf(fptr_interesults, "========= Only a block at a time if more-than-one blocks are used. ========== \n");
fprintf(fptr_interesults, "--------Numerical gradient---------\n");
for (i=0; i<n; i++) fprintf(fptr_interesults, " %0.16e ", g[0][i]);
fprintf(fptr_interesults, "\n");
fprintf(fptr_interesults, "--------Restarting point---------\n");
for (i=0; i<n; i++) fprintf(fptr_interesults, " %0.16e ", x[0][i]);
fprintf(fptr_interesults, "\n\n");
fflush(fptr_interesults);
tzFclose(fptr_interesults);
/* //=== Frees memory. ansi-c*/
for (i=0; i<4; i++) {
tzDestroy(g[i]);
tzDestroy(x[i]);
}
tzDestroy(H_dm);
}
#undef MAX_NUM_BADCASES
#undef EPS
#undef TERMINATEVALUE
#if INDXNUMGRAD_CSMINWEL == 1
#define SCALE 1.0
static int numgrad(double *g, double *x, int n,
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims) {
/* //Forward difference gradient method. ansi-c*/
double delta, deltai;
double f0, g0, ff, tmp, *xp;
int i;
int badg;
f0 = fcn(x,n,args,dims);
badg = 0;
for (i=0, xp=x; i<n; i++, xp++, g++) {
delta=SCALE*GRADSTPS_CSMINWEL, deltai=1.0/delta; /* e+5/SCALE; ansi-c*/
tmp = *xp;
*xp += delta;
delta = *xp - tmp; /* This increases the precision slightly. Added by TZ. ansi-c*/
if ( (ff=fcn(x,n,args,dims)) < NEARINFINITY ) g0 = (ff-f0)*deltai; /* Not over the boundary. ansi-c*/
else {
/* //Switches to the other side of the boundary. ansi-c*/
*xp = tmp - delta;
g0 = (f0-fcn(x,n,args,dims))*deltai;
}
*xp = tmp; /* Puts back to the original place. TZ, 9/03. ansi-c*/
if (fabs(g0)<1.0e+15)
*g = g0;
else {
#ifdef VERBOSE_WARNINGS
printf("Bad gradient.\n");
#endif
*g = 0;
badg = 1;
}
}
return badg;
}
/* //#elif INDXNUMGRAD_CSMINWEL == 2 ansi-c*/
#else
/* //#define STPS 1.0e-04 // 6.0554544523933391e-6 step size = pow(DBL_EPSILON,1.0/3) ansi-c*/
static int numgrad(double *g, double *x, int n,
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims) {
/* //Central difference gradient method. Added by TZ. ansi-c*/
double dh;
double f0, fp, fm, tmp, *xp;
int i;
int badg;
badg = 0;
for (i=0, xp=x; i<n; i++, xp++, g++) {
dh = fabs(*xp)<=1 ? GRADSTPS_CSMINWEL : GRADSTPS_CSMINWEL*(*xp);
tmp = *xp;
*xp += dh;
dh = *xp - tmp; /* This increases the precision slightly. ansi-c*/
fp = fcn(x,n,args,dims);
*xp = tmp - dh;
fm = fcn(x,n,args,dims);
/* //=== Checking the boundary condition for the minimization problem. ansi-c*/
if (fp >= NEARINFINITY) {
*xp = tmp; /* Puts back to the original place. TZ, 9/03. ansi-c*/
f0 = fcn(x,n,args,dims);
*g = (f0-fm)/dh;
}
else if (fm >= NEARINFINITY) {
/* //Switches to the other side of the boundary. ansi-c*/
*xp = tmp; /* Puts back to the original place. TZ, 9/03. ansi-c*/
f0 = fcn(x,n,args,dims);
*g = (fp-f0)/dh;
}
else {
*g = (fp-fm)/(2.0*dh);
*xp = tmp; /* Puts back to the original place. TZ, 9/03. ansi-c*/
}
if (fabs(*g)>1.0e+15) {
#ifdef VERBOSE_WARNINGS
printf("Bad gradient.\n");
#endif
*g = 0.0;
badg = 1;
}
}
return badg;
}
#endif
/* ////#undef INDXNUMGRAD_CSMINWEL ansi-c*/
/* ////#undef GRADSTPS_CSMINWEL ansi-c*/
#define ANGLE 0.01 /* When output of this variable becomes negative, we have a wrong analytical graident. ansi-c*/
/* //.005 works for identified VARs and OLS. ansi-c*/
/* //.005 implies 89.71 degrees (acrcos(ANGLE)*180/pi). ansi-c*/
/* //.01 implies 89.43 degrees (acrcos(ANGLE)*180/pi). ansi-c*/
/* //.05 implies 87.13 degrees (acrcos(ANGLE)*180/pi). ansi-c*/
/* //.1 implies 84.26 degrees (acrcos(ANGLE)*180/pi). ansi-c*/
#define THETA .4 /* (0<THETA<.5) THETA near .5 makes long line searches, possibly fewer iterations. ansi-c*/
/* //.1 works for OLS or other nonlinear functions. ansi-c*/
/* //.3 works for identified VARs. ansi-c*/
#define FCHANGE 1000
#define MINLAMB 1e-9
#define MINDFAC .01
static void csminit(double *fhat, double *xhat, int *fcount, int *retcode,
double *x0, double f0, double *g, int badg, double *H0, int n,
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims) {
double lambda=1, gnorm=0, dxnorm=0, factor=3, lambdaPeak=0;
double f, dfhat, a, tmp, fPeak=f0, lambdaMax=DBL_MAX;
double *dx, *dxtest;
int done=0, shrink=1, shrinkSignal, growSignal;
int i;
memcpy(xhat, x0, n*sizeof(double)); /* Iskander's original code does not have this line, which is a major bug. Corrected by TZ. ansi-c*/
*fhat = f0;
*fcount = 0;
*retcode = 0;
gnorm = sqrt(times(g,g,n));
if ((gnorm < 1.e-12) && !badg)
*retcode = 1; /* gradient convergence */
else {
/* with badg 1, we don't try to match rate of improvement to directional
derivative. We're satisfied just to get some improvement in f. */
dx = tzMalloc(n, double); /* dx = swzCalloc(n, sizeof(double)); Commented out by TZ. ansi-c*/
/* //if (!dx) printf("Dynamic memory allocation error.\n"); Commnted out by TZ. ansi-c*/
for (i=0; i<n; i++)
dx[i] = -times(&H0[i*n],g,n);
dxnorm = sqrt(times(dx,dx,n));
if (dxnorm > 1e12) {
#ifdef VERBOSE_WARNINGS
printf("Near-singular H problem.\n");
#endif
for (i=0; i<n; i++)
dx[i] *= FCHANGE/dxnorm;
}
dfhat = times(dx,g,n);
if (!badg) {
/* If the gradient is good, test for alignment of dx with gradient and fix if necessary */
if ((a=-dfhat/(gnorm*dxnorm))<ANGLE) {
tmp = (ANGLE*dxnorm+dfhat/gnorm)/gnorm;
for (i=0; i<n; i++)
dx[i] -= tmp*g[i];
dfhat = times(dx,g,n);
dxnorm = sqrt(times(dx,dx,n));
#ifdef VERBOSE_DETOUTPUT
printf("Correct for low angle: %g\n",a);
#endif
}
}
#ifdef VERBOSE_DETOUTPUT
printf("Predicted improvement: %18.9f, Norm of gradient: %18.9f\n", -dfhat*0.5, gnorm);
#endif
dxtest = tzMalloc(n, double); /* swzCalloc(n, sizeof(double)); Commented out by TZ. ansi-c*/
while (!done) {
for (i=0; i<n; i++)
dxtest[i] = x0[i]+dx[i]*lambda;
f = fcn(dxtest,n,args,dims);
#ifdef VERBOSE_DETOUTPUT
printf("lambda = %10.5g; f = %20.7e\n",lambda,f);
#endif
if (f<*fhat) {
*fhat = f;
memcpy(xhat,dxtest,n*sizeof(double));
}
(*fcount)++;
tmp = -THETA*dfhat*lambda;
/* the optimal lambda should be such that f0-f > -THETA*dfhat*lambda (see Berndt et al.)
If that's not the case and grad is good, OR
if grad is bad and f is not going down, shrinkSignal = 1 */
shrinkSignal = ( !badg && (f0-f <= (tmp>0?tmp:0)) ) ||
( badg && (f0-f < 0 ) );
/* the optimal lambda should also be such that f0-f<-(1-THETA)*dfhat*lambda
If that's not the case with lambda>0, AND grad is good, growthSignal = 1 */
growSignal = !badg && ( (lambda > 0) && (f0-f >= -(1-THETA)*dfhat*lambda) );
/* If shrinkSignal=1 AND ( lambda>lambdaPeak or lambda negative )
(note when lambdaPeak=0 the second part only excludes lambda=0)
try shrinking lambda */
if ( shrinkSignal && ( (lambda>lambdaPeak) || (lambda<0) ) ) {
/* if shrink=0 OR lambda/factor is already smaller than lambdaPeak, increase factor */
if ( (lambda>0) && ((!shrink) || (lambda/factor <= lambdaPeak)) ) {
shrink = 1;
factor = pow(factor,.6);
while (lambda/factor <= lambdaPeak)
factor = pow(factor,.6);
if (fabs(factor-1)<MINDFAC) {
if (fabs(lambda) < 4)
*retcode = 2;
else
*retcode = 7;
done = 1;
}
}
if ((lambda<lambdaMax) && (lambda>lambdaPeak))
lambdaMax=lambda;
/* shrink lambda */
lambda /= factor;
/* if lambda has already been shrunk as much as possible */
if (fabs(lambda) < MINLAMB)
/* if lambda is positive AND you have not made any improvement
try going against gradient, which may be inaccurate */
if ((lambda > 0) && (f0 <= *fhat))
lambda = -lambda*pow(factor,6);
else {
/* if lambda is negative: let it be known and quit trying */
if (lambda < 0)
*retcode = 6;
/* if you have not made any imporvement:
let it be known and quit trying */
else
*retcode = 3;
done = 1;
}
}
/* If growSignal=1 and lambda positive OR ( lambda>lambdaPeak or lambda negative )
(note when lambdaPeak=0 the second part only excludes lambda=0)
try increase lambda */
else
if ( (growSignal && (lambda > 0) ) ||
( shrinkSignal && (lambda <= lambdaPeak) && (lambda > 0) ) ) {
if (shrink) {
shrink = 0;
factor = pow(factor,.6);
if (fabs(factor-1) < MINDFAC) {
if (fabs(lambda) < 4)
*retcode = 4;
else
*retcode = 7;
done = 1;
}
}
if ( (f<fPeak) && (lambda>0) ) {
fPeak = f;
lambdaPeak = lambda;
if (lambdaMax <= lambdaPeak)
lambdaMax = lambdaPeak*factor*factor;
}
/* increase lambda (up to 1e20) */
lambda *= factor;
/* if lambda has been increased up to the limit and
you have not made any imporvement:
let it be known and quit trying */
if (fabs(lambda) > 1e20) {
*retcode = 5;
done = 1;
}
}
/* If growthSignal=shrinkSignal=0 you found a good lambda, you are done */
else {
done = 1;
*retcode = factor<1.2 ? 7 : 0;
}
}
tzDestroy(dxtest);
tzDestroy(dx);
}
#ifdef VERBOSE_DETOUTPUT
printf("Norm of dx %10.5g\n", dxnorm);
#endif
}
#undef ANGLE
#undef THETA
#undef FCHANGE
#undef MINLAMB
#undef MINDFAC
static double times(double *x, double *y, int n) {
double z = 0;
int i;
for (i=0; i<n; i++, x++, y++)
z += (*x)*(*y);
return z;
}
static int peakwall(double *g, int retcode, double *x, int n,
int (*gfcn)(double *x, int n, double *g, double **args, int *dims),
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims) {
/* if retcode=2 or 4 you have shrunk or increased lambda as much as you could:
exhausted search possibilities the csminit step has failed */
if (retcode==2 || retcode==4)
return 1;
else
/* if you are not at the peak but the csminit has improved,
compute the gradient again to update H0 */
if (gfcn)
return gfcn(x,n,g,args,dims);
else
return numgrad(g,x,n,fcn,args,dims);
}
static void bfgsi(double *H, double *dg, double *dx, int n, int nn) {
double *Hdg, *dxdx, *dxHdg, *Hdgdx;
double dgdx, m;
int i;
TSdmatrix *H_dm = NULL;
Hdg = tzMalloc(n, double); /* swzCalloc(n, sizeof(double)); Commented out by TZ. ansi-c*/
/* //if (!Hdg) printf("Dynamic memory allocation error.\n"); Commented out by TZ. ansi-c*/
/* Hdg = H0*dg; */
for (i=0; i<n; i++)
Hdg[i] = times(&H[i*n],dg,n);
/* dgdx = dg'*dx; */
dgdx = 1/times(dg,dx,n);
if (fabs(dgdx)<1e12) {
dxdx = mtimes(dx,dx,n,nn);
dxHdg = mtimes(dx,Hdg,n,nn);
Hdgdx = mtimes(Hdg,dx,n,nn);
m = 1+times(dg,Hdg,n)*dgdx;
for (i=0; i<nn; i++, H++, dxdx++, dxHdg++, Hdgdx++)
*H += (m*(*dxdx)-(*dxHdg)-(*Hdgdx))*dgdx;
swzFree(Hdgdx-nn);
Hdgdx=NULL; /* DDDDDebugging. ansi-c*/
swzFree(dxHdg-nn);
dxHdg = NULL;
swzFree(dxdx-nn);
dxdx = NULL;
}
else {
/* //=== Restarting the inverse of Hessian at its initial value. Added by TZ. ansi-c*/
H_dm = tzMalloc(1, TSdmatrix); /* H_dm wil point to the same location as H. ansi-c*/
H_dm->M = H;
H_dm->nrows = H_dm->ncols = n;
InitializeDiagonalMatrix_lf(H_dm, GLB_sclForHess);
/* //H_dm->flag = M_GE | M_SU | M_SL; //Hessian is symmetric. ansi-c*/
tzDestroy(H_dm);
#ifdef VERBOSE_WARNINGS
printf("BFGS update failed.\n");
printf("|dg| = %f |dx| = %f\n",sqrt(times(dg,dg,n)),sqrt(times(dx,dx,n)));
printf("dg\'*dx = %f\n",dgdx);
printf("|H*dg| = %f\n",sqrt(times(Hdg,Hdg,n)));
#endif
}
tzDestroy(Hdg);
}
static double *mtimes(double *x, double *y, int n, int nn) {
double *x0;
double *z;
int i, j;
z = tzMalloc(nn, double); /* swzCalloc(nn, sizeof(double)); Commented out by TZ. ansi-c*/
for (i=0, x0=x; i<n; i++, y++)
for (j=0, x=x0; j<n; j++, x++, z++)
*z = (*x)*(*y);
return z-nn;
}
static double *mminus(double *x, double *y, int n) {
double *z;
int i;
z = tzMalloc(n, double); /* swzCalloc(n, sizeof(double)); Commented out by TZ. ansi-c*/
for (i=0; i<n; i++, x++, y++, z++)
*z = (*x)-(*y);
return z-n;
}
/* //=== The following two extern functions to be accessed by other C files. ansi-c*/
void csminwel_SetPrintFile(char *filename) {
if (!filename) sprintf(filename_sp2vecs, "outdata5csminwel.prn"); /* Default filename. ansi-c*/
else if (STRLEN-1 < strlen(filename)) fn_DisplayError(".../csminwel.c: the allocated length STRLEN for filename_sp2vecs is too short. Must increase the string length");
else strcpy(filename_sp2vecs, filename);
}
int csminwel_randomseedChanged(int seednumber)
{
int oldseednumber = RANDOMSEED_CSMINWEL;
RANDOMSEED_CSMINWEL = seednumber;
return (oldseednumber);
}
#undef STRLEN

23
matlab/ms-sbvar/c-code/utilities/TZCcode/csminwel.h
View File

@ -1,23 +0,0 @@
#ifndef __CSMINWEL_H__
#define __CSMINWEL_H__
#include "tzmatlab.h"
#include <string.h>
#include <float.h>
/* //--- This extern variable allows an input by the user from an input data file. ansi-c*/
extern double GRADSTPS_CSMINWEL;
void csminwel(double (*fcn)(double *x, int n, double **args, int *dims),
double *x, int n, double *H, double *gh,
int (*grad)(double *x, int n, double *g, double **args, int *dims),
double *fh, double crit, int *itct, int nit,
int *fcount, int *retcodeh, double **args, int *dims);
/* // Alternative but less clear way: ... (double (*fcn)(double *, int, double **, int *), ... ansi-c*/
void csminwel_SetPrintFile(char *filename);
int csminwel_randomseedChanged(int seednumber);
#endif

2792
matlab/ms-sbvar/c-code/utilities/TZCcode/cstz.c
View File

File diff suppressed because it is too large Load Diff

199
matlab/ms-sbvar/c-code/utilities/TZCcode/cstz.h
View File

@ -1,199 +0,0 @@
#ifndef __CSTZ_H__
#define __CSTZ_H__
#include "tzmatlab.h"
#include "switch_opt.h" /* DW's Markov-switching routines, only used by gradcd_timet() and ComputeCovarianceFromOuterProduct(). ansi-c*/
typedef struct {
double bound; /* Real bounds to avoid extreme values that may make the P2 algorithm fail. ansi-c*/
double *p; /* 5-by-1 probabilities as {0.0, p/2, p, (1+p)/2, 1.0}. ansi-c*/
double *q; /* 5-by-1 quantiles. Only q[2] is used as an estimate of p[2]-quantile or p-quantile. ansi-c*/
int *m; /* 5-by-1 markers. ansi-c*/
int cnt;
int ndeg; /* Number of exceptions such as degenerate numbers like inf. ansi-c*/
} TSdp2m5;
typedef struct {
TSdp2m5 **v;
int n;
} TSdvectorp2m5;
typedef struct {
TSdp2m5 **M;
int nrows;
int ncols;
} TSdmatrixp2m5;
typedef struct {
TSdmatrixp2m5 **C;
int ncells;
} TSdcellp2m5;
typedef struct {
TSdcellp2m5 **F;
int ndims;
} TSdfourthp2m5;
TSdp2m5 *CreateP2m5(const double p, const double bound);
TSdp2m5 *DestroyP2m5(TSdp2m5 *x_dp2m5);
TSdvectorp2m5 *CreateVectorP2m5(const int n, const double p, const double bound);
TSdvectorp2m5 *DestroyVectorP2m5(TSdvectorp2m5 *x_dvp2m5);
TSdmatrixp2m5 *CreateMatrixP2m5(const int nrows, const int ncols, const double p, const double bound);
TSdmatrixp2m5 *DestroyMatrixP2m5(TSdmatrixp2m5 *X_dmp2m5);
TSdcellp2m5 *CreateCellP2m5(const TSivector *rows_iv, const TSivector *cols_iv, const double p, const double bound);
TSdcellp2m5 *DestroyCellP2m5(TSdcellp2m5 *X_dcp2m5);
TSdfourthp2m5 *CreateFourthP2m5(const int ndims, const TSivector *rows_iv, const TSivector *cols_iv, const double p, const double bound);
TSdfourthp2m5 *DestroyFourthP2m5(TSdfourthp2m5 *X_d4p2m5);
/* // ansi-c*/
int P2m5Update(TSdp2m5 *x_dp2m5, const double newval);
void P2m5VectorUpdate(TSdvectorp2m5 *x_dvp2m5, const TSdvector *newval_dv);
void P2m5MatrixUpdate(TSdmatrixp2m5 *X_dmp2m5, const TSdmatrix *newval_dm);
void P2m5CellUpdate(TSdcellp2m5 *X_dcp2m5, const TSdcell *newval_dc);
void P2m5FourthUpdate(TSdfourthp2m5 *X_d4p2m5, const TSdfourth *newval_d4);
#if defined ( CSMINWEL_OPTIMIZATION )
void fn_gradcd(double *g, double *x, int n, double grdh,
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims);
void fn_hesscd(double *H, double *x, int n, double grdh,
double (*fcn)(double *x, int n, double **args, int *dims),
double **args, int *dims);
#elif defined ( IMSL_OPTIMIZATION )
void fn_gradcd(double *g, double *x, int n, double grdh,
double fcn(int n, double *x));
void fn_hesscd(double *H, double *x, int n, double grdh,
double fcn(int n, double *x));
#endif
/* //=== For the conjugate gradient method I or II ansi-c*/
void gradcd_gen(double *g, double *x, int n, double (*fcn)(double *x, int n), double *grdh, double f0);
void gradfd_gen(double *g, double *x, int n, double (*fcn)(double *x, int n), double *grdh, double f0);
/* //=== For computing inverse Hessian. ansi-c*/
void gradcd_timet(TSdvector *g_dv, TSdvector *x_dv, int t, struct TStateModel_tag *smodel_ps, double (*fcn)(double *x, int t, struct TStateModel_tag *smodel_ps), double grdh, double f0);
TSdmatrix *ComputeHessianFromOuterProduct(TSdmatrix *Hessian_dm, struct TStateModel_tag *smodel_ps, TSdvector *xhat_dv);
TSdmatrix *ComputeCovarianceFromOuterProduct(TSdmatrix *Omega_dm, struct TStateModel_tag *smodel_ps, TSdvector *xhat_dv);
int next_permutation(int *first, int *last);
/* //void fn_ergodp(double **aop, int *aod, mxArray *cp); ansi-c*/
void fn_cumsum(double **aos_v, int *aods_v, double *v, int d_v);
int fn_cumsum_int(int *x_v, const int d_x_v);
double fn_cumsum_lf(double *x_v, const int d_x_v);
double fn_mean(const double *a_v, const int _n);
/* //=== For sorting according to x_dv. ansi-c*/
void tz_sort(TSdvector *x_dv, char ad);
void tz_sortindex_lf(TSivector *x_iv, TSdvector *base_dv, char ad);
void tz_sortindex(TSivector *x_iv, TSvoidvector *base_voidv, char ad); /* ??????Not fully tested yet. ansi-c*/
/* //+ ansi-c*/
void tz_sort_matrix(TSdmatrix *X_dm, char ad, char rc);
TSdvector *tz_prctile_matrix(TSdvector *z_dv, const double prc, TSdmatrix *Z_dm, const char rc);
TSdvector *tz_mean_matrix(TSdvector *z_dv, TSdmatrix *Z_dm, const char rc);
/* //--- The following 3 functions should be hided (static) but are made visible to accomodate the old code that uses these functions. ansi-c*/
void fn_SetBaseArrayForComp(TSdvector *x_dv);
int fn_compare(const void *i1, const void *i2);
int fn_compare2(const void *i1, const void *i2);
/* //=== Normalization for VARs. ansi-c*/
void fn_wznormalization(TSdvector *wznmlz_dv, TSdmatrix *A0draw_dm, TSdmatrix *A0peak_dm);
/* //=== Handling under or over flows with log values. ansi-c*/
typedef struct TSveclogsum_tag {
/* //For a recurisve algorithm to compute the log of sum (and therefore log of mean). See p.81a and p.105 in TVBAR Notes. ansi-c*/
int n; /* Number of sums, which is the dimension for N_iv, Ysum_dv, and ymax_dv. ansi-c*/
TSivector *N_iv; /* (N_1, ..., N_n). ansi-c*/
TSdvector *logsum_dv, /* (logofsum_1, ..., logofsum_n). ansi-c*/
*logmax_dv; /* (logmax_1, ..., logmax_n). ansi-c*/
} TSveclogsum;
struct TSveclogsum_tag *CreateVeclogsum(int n);
struct TSveclogsum_tag *DestroyVeclogsum(struct TSveclogsum_tag *);
/* // ansi-c*/
void UpdateSumFor1st2ndMoments(TSdvector *x1stsum_dv, TSdmatrix *X2ndsum_dm, const TSdvector *xdraw_dv);
int tz_update_logofsum(double *Y_N_dp, double *y_Nmax_dp, double ynew, int N);
int fn_update_logofsum(int N, double ynew, double *Y_N_dp, double *y_Nmax_dp);
double fn_replace_logofsumsbt(double *yold, double _a, double ynew, double _b);
/* //---------------------------- Special functions and densities. --------------------- ansi-c*/
double fn_normalcdf(double x);
double fn_normalinv(double p); /* Inverse of normal cdf. ansi-c*/
double fn_chi2inv(double p, double df);
/* //p = int_{0}^{\infty} chi2pdf(t, df) dt ansi-c*/
double fn_betainv(double p, double _alpha, double _beta);
/* //p = int_{0}^{\infty} betapdf(t, _alpha, _beta) dt where betapdf(t,_alpha,_beta) \propt t^{_alpha-1}*(1-t)^(_beta-1}. ansi-c*/
double fn_gammalog(double x);
/* //log gamma (x) where gamma(n+1) = n! and gamma(x) = int_0^{\infty} e^{-t} t^{x-1} dt. ansi-c*/
double fn_betalog(double x, double y);
/* //log beta(x, y) where beta(x, y) = gamma(x)*gamm(y)/gamma(x+y). ansi-c*/
/* //+ Density functions ansi-c*/
double tz_lognormalpdf(double _x, double _m, double _s);
double tz_logbetapdf(double _x, double _a, double _b);
double tz_loggammapdf(double _x, double _a, double _b);
double tz_loginversegammapdf(double _x, double _a, double _b);
/* //---------------------------- Some high-level VAR functions --------------------- ansi-c*/
void fn_lev2growthanual(TSdmatrix *levgro_dm, const TSdmatrix *levgrominus1_dm, const TSivector *indxlogper_iv);
void fn_ctfals_givenshocks_sm(TSdmatrix *ctfalstran_dm, TSdvector *xprimeminus1_dv, const int bloc, const int eloc, const TSdmatrix *strshockstran_dm,
const TSivector *S_Tdraw_iv, const TSdcell *Bsdraw_dc, const TSdcell *A0sdrawinv_dc, const TSivector *noshocks_iv);
void fn_ctfals_sm(TSdmatrix *ctfalstran_dm, TSdvector *xprimeminus1_dv, const int bloc, const int eloc, const TSdmatrix *strshockstran_dm, const TSivector *Snfores_iv, const TSdcell *Bsdraw_dc, const TSdcell *A0sdrawinv_dc);
void fn_ctfals_policyonly(TSdmatrix *ctfalstran_dm, TSdvector *xprimeminus1_dv, const int bloc, const int eloc, const TSdmatrix *strshockstran_dm, const TSivector *S_Tdraw_iv, const int statecon, const int selej, const TSdcell *A0sdraw_dc, const TSdcell *Apsdraw_dc);
void fn_impulse(TSdmatrix *imftran_dm, const TSdmatrix *Bh_dm, const TSdmatrix *swishtran_dm, const int nlags, const int imsteps);
TSdmatrix *tz_impulse2levels(TSdmatrix *imflev_dm, TSdmatrix *imf_dm, TSivector *vlist2levels_iv);
/* // ansi-c*/
void DynamicResponsesAR(TSdvector *resps_dv, const double c0, const TSdvector *a1_dv);
void DynamicResponsesForStructuralEquation(TSdmatrix *Resps_dm, const int loclv, const int nlags, const TSdvector *a0p_dv);
/* //---------------------------- Some regular vector or matrix operations --------------------- ansi-c*/
double MinVector_lf(TSdvector *x_dv);
TSdvector *ConvertVector2exp(TSdvector *y_dv, TSdvector *x_dv); /* y=exp(x): output; x: input. ansi-c*/
TSdvector *ConvertVector2log(TSdvector *y_dv, TSdvector *x_dv); /* y=log(x): output; x: input. ansi-c*/
double tz_normofvector(TSdvector *x_dv, double p);
/* //---------------------------- Old Interface --------------------- ansi-c*/
double gammalog(double x);
/* //log gamma (x) where gamma(n+1) = n! and gamma(x) = int_0^{\infty} e^{-t} t^{x-1} dt. ansi-c*/
/* //----------- Must keep the following forever. ------------- ansi-c*/
/**
typedef struct {
double *p; //5-by-1 probabilities as {0.0, p/2, p, (1+p)/2, 1.0}.
double *q; //5-by-1 quantiles. Only q[2] is used as an estimate of p[2]-quantile or p-quantile.
int *m; //5-by-1 markers.
int cnt;
int ndeg; //Number of exceptions such as degenerate numbers like inf.
} TSdp2m5;
typedef struct {
TSdp2m5 **v;
int n;
} TSdvectorp2m5;
typedef struct {
TSdp2m5 **M;
int nrows;
int ncols;
} TSdmatrixp2m5;
typedef struct {
TSdmatrixp2m5 **C;
int ncells;
} TSdcellp2m5;
TSdp2m5 *CreateP2m5(const double p);
TSdp2m5 *DestroyP2m5(TSdp2m5 *x_dp2m5);
TSdvectorp2m5 *CreateVectorP2m5(const int n, const double p);
TSdvectorp2m5 *DestroyVectorP2m5(TSdvectorp2m5 *x_dvp2m5);
TSdmatrixp2m5 *CreateMatrixP2m5(const int nrows, const int ncols, const double p);
TSdmatrixp2m5 *DestroyMatrixP2m5(TSdmatrixp2m5 *X_dmp2m5);
TSdcellp2m5 *CreateCellP2m5(const TSivector *rows_iv, const TSivector *cols_iv, const double p);
TSdcellp2m5 *DestroyCellP2m5(TSdcellp2m5 *X_dcp2m5);
/**/
#endif

2792
matlab/ms-sbvar/c-code/utilities/TZCcode/cstz_dw.c
View File

File diff suppressed because it is too large Load Diff

850
matlab/ms-sbvar/c-code/utilities/TZCcode/fn_filesetup.c
View File

@ -1,850 +0,0 @@
/***********
* Reads the input file name and output file names specified by the user from the command line with automatic default to
* both input an output files.
***********/
#include "fn_filesetup.h"
#include "modify_for_mex.h"
/* //----------------- ansi-c*/
/* // For command line. ansi-c*/
/* // Finds /ch in the command line. If found, returns the args location ansi-c*/
/* // indexed by int and zero otherwise. ansi-c*/
/* //----------------- ansi-c*/
int fn_ParseCommandLine(int n_arg, char **args, char ch) {
int i;
for (i=1; i<n_arg; i++)
if ((args[i][0] == '/') && (args[i][1] == ch)) return i;
return 0;
}
/* //----------------- ansi-c*/
/* // For command line. ansi-c*/
/* // Finds /ch in the command line. If found returns a pointer ansi-c*/
/* // to the string trailing /ch. If /ch is not found or there is ansi-c*/
/* // no trailing string or the trailing string is another argument, ansi-c*/
/* // then default_return is returned. No memory is allocated and ansi-c*/
/* // the calling routine should not free the returned pointer. ansi-c*/
/* //----------------- ansi-c*/
char *fn_ParseCommandLine_String(int n_arg, char **args, char ch, char *default_return) {
int i=fn_ParseCommandLine(n_arg,args,ch);
if (i > 0)
if (strlen(args[i]) > 2) return args[i]+2;
/* // In case the user forgot typing a space between /ch and string following it, still returns a pointer to the string folloing /ch. ansi-c*/
else if ((i+1 < n_arg) && (args[i+1][0] != '/')) return args[i+1];
/* // Returns a pointer to the string that does NOT begin with / and there is a whitespace between /ch and the string. ansi-c*/
return default_return;
}
/* //----------------- ansi-c*/
/* // For command line. ansi-c*/
/* // Finds /ch in the command line. If found returns the integer ansi-c*/
/* // value of the string trailing /ch (e.g, the integer value is ansi-c*/
/* // sample size or normalization index. If /ch is not found or there ansi-c*/
/* // is no trailing string or the trailing string is another argument, ansi-c*/
/* // then the default_return value is returned. ansi-c*/
/* //----------------- ansi-c*/
int fn_ParseCommandLine_Integer(int n_arg, char **args, char ch, int default_return) {
char *str=fn_ParseCommandLine_String(n_arg,args,ch,(char*)NULL);
return str ? atoi(str) : default_return;
}
/* //----------------- ansi-c*/
/* // Finds proper location in the input data file. ansi-c*/
/* // Returns 1 if the NUL-terminated string id is found ansi-c*/
/* // in the file and 0 otherwise. The file pointer is set ansi-c*/
/* // to the line immediately after the line containing id. ansi-c*/
/* // If the string id has a length (including the new line ansi-c*/
/* // character \n) more than 1023, it will be cut off at 1023. ansi-c*/
/* //----------------- ansi-c*/
int fn_SetFilePosition(FILE *f, const char *id) {
/* // As an output, the file pointer f will be reset to the beginning of the line next to the line headed by the string id. ansi-c*/
char buffer[1024];
size_t n=strlen(id);
int ch;
if ( !f ) fn_DisplayError(".../fn_filesetup.c/fn_SetFilePosition(): the file, *f, must be created (opened)");
if (n>1023) n=1023;
rewind(f); /* Reset a file poiniter to the beginning of the file. There may be more efficient ways but this is good enough as long as the file is not too long. ansi-c*/
while (fgets(buffer,1024,f)) { /* Reads a line at a time in the file f (including \n and a NUL byte) until it matches id. fgets returns the pointer to the buffer and is often only used to check for EOF. ansi-c*/
if (buffer[strlen(buffer)-1] != '\n') /* -1 because the first element of the buffer is indexed by buffer[0]. ansi-c*/
/* // If the end of the buffer (excluding the NUL byte) encounters no new line, f points to the next character after ansi-c*/
/* // the end of the buffer on the SAME line (i.e., f does not point to the begining of the new line at this point). ansi-c*/
/* // The following do loop will take f to point to the beginning of the new line. ansi-c*/
do ch=fgetc(f); /* Gets one character at a time until it reachs the end of the current '\n' or the end of the file EOF. ansi-c*/
while ( (ch != '\n') && (ch != EOF) );
if (!memcmp(buffer,id,n)) return 1; /* The match is found. ansi-c*/
}
return 0; /* No match is found. ansi-c*/
}
/* //----------------- ansi-c*/
/* // Reads a string from the input data file with the NULL-terminated ansi-c*/
/* // character but without the new line character. ansi-c*/
/* // Returns 1 if the vector of characters is all read without ansi-c*/
/* // errors and 0 otherwise. The file pointer is then moved ansi-c*/
/* // to point to the next non-whitespace character after these ansi-c*/
/* // characters. ansi-c*/
/* //----------------- ansi-c*/
int ReadNullTerminatedString(FILE *fptr, TScvector *x_cv)
{
/* //x_cv will have a string without the new line character and with the NULL character. ansi-c*/
/* //It is the user's responsiblity to ensure the string x_cv has an enough length to use fgets(). ansi-c*/
/* // If not, it stops after x_cv->n-1 characters have been stored in x_cv->v and a NULL byte is appended to make it a string. ansi-c*/
/* // If yet, reading stops after a newline character is read and stored in x_cv->v and a NULL byte is then appended. ansi-c*/
int _n;
char *cv;
if (!fptr || !x_cv) fn_DisplayError(".../fn_filesetup.c/ReadNullTerminatedString(): File or input string must be created (memory-allocated)");
_n = x_cv->n;
cv = x_cv->v;
if ( !fgets(cv, _n, fptr) ) return 0;
cv[strlen(cv)-1] = '\0'; /* Removes the new line character and replaces it with the NULL character. ansi-c*/
/* //The string length (size_t type) strlen(cv) does NOT count the NULL byte at the end, but it counts the new line character. ansi-c*/
return 1;
}
/* //----------------- ansi-c*/
/* // Reads a vector of integers from the input data file. ansi-c*/
/* // Returns 1 if the vector of integers is all read without ansi-c*/
/* // errors and 0 otherwise. The file pointer is then moved ansi-c*/
/* // to point to the next non-whitespace character after these ansi-c*/
/* // integers. ansi-c*/
/* //----------------- ansi-c*/
int fn_ReadVector_int(FILE *fptr, int *x_v, const int d_x_v) {
int ki;
for (ki=0; ki<d_x_v; ki++)
if ( fscanf(fptr, " %d ", &x_v[ki]) !=1 ) return 0;
return 1;
}
int ReadVector_int(FILE *fptr, TSivector *x_iv) {
int ki, _n,
*v;
if (!fptr || !x_iv) fn_DisplayError(".../fn_filesetup.c/ReadVector_int(): File or input matrix must be created (memory-allocated)");
_n = x_iv->n;
v = x_iv->v;
for (ki=0; ki<_n; ki++)
if ( fscanf(fptr, " %d ", &v[ki]) != 1 ) return 0;
return 1;
}
/* //----------------- ansi-c*/
/* // Reads a vector of doubles from the input data file. ansi-c*/
/* // Returns 1 if the vector of doubles is all read without ansi-c*/
/* // errors and 0 otherwise. The file pointer is then moved ansi-c*/
/* // to point to the next non-whitespace character after these ansi-c*/
/* // doubles. ansi-c*/
/* //----------------- ansi-c*/
int fn_ReadVector_lf(FILE *fptr, double *x_v, const int d_x_v) {
int ki;
for (ki=0; ki<d_x_v; ki++)
if ( fscanf(fptr, " %lf ", &x_v[ki]) !=1 ) return 0;
return 1;
}
int ReadVector_lf(FILE *fptr, TSdvector *x_dv) {
int ki, _n;
double *v;
if (!fptr || !x_dv) fn_DisplayError(".../fn_filesetup.c/ReadVector_lf(): File or input matrix must be created (memory-allocated)");
_n = x_dv->n;
v = x_dv->v;
for (ki=0; ki<_n; ki++)
if ( fscanf(fptr, " %lf ", &v[ki]) != 1 ) return 0;
x_dv->flag = V_DEF;
return 1;
}
/* //----------------- ansi-c*/
/* // Reads a column-major matrix of integers from the input data file. ansi-c*/
/* // Returns 1 if the matrix of integers is all read without ansi-c*/
/* // errors and 0 otherwise. The file pointer is then moved ansi-c*/
/* // to point to the next non-whitespace character after these ansi-c*/
/* // integers. ansi-c*/
/* //----------------- ansi-c*/
int fn_ReadMatrix_int(FILE *fptr, int *x_m, const int r_x_m, const int c_x_m) {
int ki, kj;
for (ki=0; ki<r_x_m; ki++)
for (kj=0; kj<c_x_m; kj++)
if ( fscanf(fptr, " %d ", &x_m[kj*r_x_m+ki]) !=1 ) return 0;
return 1;
}
int ReadMatrix_int(FILE *fptr, TSimatrix *X_im)
{
int ki, kj;
int nrows, ncols;
if (!fptr || !X_im) fn_DisplayError(".../fn_filesetup.c/ReadMatrix_int(): File or input matrix must be created (memory-allocated)");
nrows = X_im->nrows;
ncols = X_im->ncols;
for (ki=0; ki<nrows; ki++)
for (kj=0; kj<ncols; kj++)
if ( fscanf(fptr, " %d ", (X_im->M+mos(ki,kj,nrows))) !=1 ) return 0;
return 1;
}
/* //----------------- ansi-c*/
/* // Reads a column-major matrix of doubles from the input data file. ansi-c*/
/* // Returns 1 if the matrix of doubles is all read without ansi-c*/
/* // errors and 0 otherwise. The file pointer is then moved ansi-c*/
/* // to point to the next non-whitespace character after these ansi-c*/
/* // doubles. ansi-c*/
/* //----------------- ansi-c*/
int fn_ReadMatrix_lf(FILE *fptr, double *x_m, const int r_x_m, const int c_x_m) {
int ki, kj;
for (ki=0; ki<r_x_m; ki++)
for (kj=0; kj<c_x_m; kj++)
if ( fscanf(fptr, " %lf ", &x_m[kj*r_x_m+ki]) !=1 ) return 0;
return 1;
}
int ReadMatrix_lf(FILE *fptr, TSdmatrix *x_dm) {
/* //Outputs: ansi-c*/
/* // x_dm (whose memory is already allocated): To be filled with the numbers from the file fptr. ansi-c*/
int ki, kj, nrows, ncols;
double *M;
if (!fptr || !x_dm) fn_DisplayError(".../fn_filesetup.c/ReadMatrix_lf(): File or input matrix must be created (memory-allocated)");
nrows = x_dm->nrows;
ncols = x_dm->ncols;
M = x_dm->M;
for (ki=0; ki<nrows; ki++)
for (kj=0; kj<ncols; kj++)
if ( fscanf(fptr, " %lf ", &M[mos(ki,kj,nrows)]) !=1 ) return 0;
x_dm->flag = M_GE;
return 1;
}
/* //----------------- ansi-c*/
/* // Reads a column-major cell of double vectors from the input data file. ansi-c*/
/* // Returns 1 if all data are read without errors and 0 otherwise. ansi-c*/
/* // The file pointer is then moved to point to the next non-whitespace character ansi-c*/
/* // after these doubles. ansi-c*/
/* //----------------- ansi-c*/
int ReadCellvec_lf(FILE *fptr, TSdcellvec *x_dcv) {
/* //Outputs: ansi-c*/
/* // x_dcv (whose memory is already allocated): To be filled with the numbers from the file fptr. ansi-c*/
int ci, kj, _n, ncells;
double *v;
if (!fptr || !x_dcv) fn_DisplayError(".../fn_filesetup.c/ReadCellvec_lf(): File or input cell must be created (memory-allocated)");
ncells = x_dcv->ncells;
for (ci=0; ci<ncells; ci++) {
_n = x_dcv->C[ci]->n;
v = x_dcv->C[ci]->v;
for (kj=0; kj<_n; kj++)
if ( fscanf(fptr, " %lf ", &v[kj]) != 1 ) return 0;
}
return 1;
}
/* //----------------- ansi-c*/
/* // Reads a column-major cell of double matrices from the input data file. ansi-c*/
/* // Returns 1 if all data are read without errors and 0 otherwise. ansi-c*/
/* // The file pointer is then moved to point to the next non-whitespace character ansi-c*/
/* // after these doubles. ansi-c*/
/* //----------------- ansi-c*/
int ReadCell_lf(FILE *fptr, TSdcell *x_dc) {
/* //Outputs: ansi-c*/
/* // x_dc (whose memory is already allocated): To be filled with the numbers from the file fptr. ansi-c*/
int ci, ki, kj, nrows, ncols, ncells;
double *M;
if (!fptr || !x_dc) fn_DisplayError(".../fn_filesetup.c/ReadCell_lf(): File or input cell must be created (memory-allocated)");
ncells = x_dc->ncells;
for (ci=0; ci<ncells; ci++) {
nrows = x_dc->C[ci]->nrows;
ncols = x_dc->C[ci]->ncols;
M = x_dc->C[ci]->M;
for (ki=0; ki<nrows; ki++)
for (kj=0; kj<ncols; kj++)
if ( fscanf(fptr, " %lf ", &M[mos(ki,kj,nrows)]) != 1 ) return 0;
}
return 1;
}
/* //----------------- ansi-c*/
/* // Write a column-major matrix of floats to the output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void fn_WriteMatrix_f(FILE *fptr_debug, const double *x_m, const int r_x_m, const int c_x_m) {
int _i, _j;
for (_i=0; _i<r_x_m; _i++) {
for (_j=0; _j<c_x_m; _j++) {
fprintf(fptr_debug, " %f ", x_m[_j*r_x_m + _i]);
if (_j==c_x_m-1) fprintf(fptr_debug, "\n");
}
if (_i==r_x_m-1) fprintf(fptr_debug, "\n\n");
}
}
void WriteMatrix_f(FILE *fptr_debug, const TSdmatrix *x_dm) {
int _i, _j;
if (!fptr_debug || !x_dm) fn_DisplayError(".../fn_filesetup.c/WriteMatrix_f(): File or input matrix cannot be NULL (must be created)");
for (_i=0; _i<x_dm->nrows; _i++) {
for (_j=0; _j<x_dm->ncols; _j++) {
fprintf(fptr_debug, " %10.5f ", x_dm->M[_j*x_dm->nrows + _i]);
if (_j==x_dm->ncols-1) fprintf(fptr_debug, "\n");
}
if (_i==x_dm->nrows-1) fprintf(fptr_debug, "\n\n");
}
}
/* //----------------- ansi-c*/
/* // Write a column-major matrix of doubles to the output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void fn_WriteMatrix_lf(FILE *fptr_debug, const double *x_m, const int r_x_m, const int c_x_m) {
int _i, _j;
for (_i=0; _i<r_x_m; _i++) {
for (_j=0; _j<c_x_m; _j++) {
fprintf(fptr_debug, " %.16e ", x_m[_j*r_x_m + _i]);
if (_j==c_x_m-1) fprintf(fptr_debug, "\n");
}
if (_i==r_x_m-1) fprintf(fptr_debug, "\n\n");
}
}
void WriteMatrix_lf(FILE *fptr_debug, const TSdmatrix *x_dm) {
int _i, _j;
if (!fptr_debug || !x_dm) fn_DisplayError(".../fn_filesetup.c/WriteMatrix_lf(): File or input matrix cannot be NULL (must be created)");
for (_i=0; _i<x_dm->nrows; _i++) {
for (_j=0; _j<x_dm->ncols; _j++) {
fprintf(fptr_debug, " %.16e ", x_dm->M[_j*x_dm->nrows + _i]);
if (_j==x_dm->ncols-1) fprintf(fptr_debug, "\n");
}
if (_i==x_dm->nrows-1) fprintf(fptr_debug, "\n\n");
}
}
void WriteMatrix(FILE *fptr_debug, const TSdmatrix *x_dm, const char *format) {
int _i, _j, nrows, ncols;
double *M;
if (!fptr_debug || !x_dm) fn_DisplayError(".../fn_filesetup.c/WriteMatrix(): File or input matrix cannot be NULL (must be created)");
nrows = x_dm->nrows;
ncols = x_dm->ncols;
M = x_dm->M;
if (!format) format=" %10.5f "; /* Default format. ansi-c*/
for (_i=0; _i<nrows; _i++)
for (_j=0; _j<ncols; _j++) {
fprintf(fptr_debug, format, M[_j*x_dm->nrows + _i]);
if (_j==ncols-1) fprintf(fptr_debug, "\n");
}
/* //fprintf(fptr_debug, "\n"); ansi-c*/
}
/* //+ ansi-c*/
void WriteMatrixTranspose(FILE *fptr_debug, const TSdmatrix *x_dm, const char *format)
{
int _i, _j, nrows, ncols;
double *M;
/* //=== ansi-c*/
TSdmatrix *Xtran_dm = NULL;
if (!fptr_debug || !x_dm) fn_DisplayError(".../fn_filesetup.c/WriteMatrixTranspose(): File or input matrix cannot be NULL (must be created)");
Xtran_dm = tz_TransposeRegular((TSdmatrix *)NULL, x_dm);
nrows = Xtran_dm->nrows;
ncols = Xtran_dm->ncols;
M = Xtran_dm->M;
if (!format) format=" %10.5f "; /* Default format. ansi-c*/
for (_i=0; _i<nrows; _i++)
for (_j=0; _j<ncols; _j++) {
fprintf(fptr_debug, format, M[_j*Xtran_dm->nrows + _i]);
if (_j==ncols-1) fprintf(fptr_debug, "\n");
}
/* //fprintf(fptr_debug, "\n"); ansi-c*/
/* //=== ansi-c*/
DestroyMatrix_lf(Xtran_dm);
}
/* //----------------- ansi-c*/
/* // Write cells of column-major double matrices to the output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void WriteCell_lf(FILE *fptr_debug, const TSdcell *x_dc) {
int _i, _n;
if (!fptr_debug || !x_dc) fn_DisplayError(".../fn_filesetup.c/WriteCell_lf(): File or input cell cannot be NULL (must be created)");
_n = x_dc->ncells;
for (_i=0; _i<_n; _i++) {
fprintf(fptr_debug, "Cell %d\n", _i);
WriteMatrix_lf(fptr_debug, x_dc->C[_i]);
}
}
void WriteCell_f(FILE *fptr_debug, const TSdcell *x_dc) {
int _i, _n;
if (!fptr_debug || !x_dc) fn_DisplayError(".../fn_filesetup.c/WriteCell_f(): File or input cell cannot be NULL (must be created)");
_n = x_dc->ncells;
for (_i=0; _i<_n; _i++) {
fprintf(fptr_debug, "Cell %d\n", _i);
WriteMatrix_f(fptr_debug, x_dc->C[_i]);
}
}
void WriteCell(FILE *fptr_debug, const TSdcell *x_dc, const char *format) {
int _i, _n;
if (!fptr_debug || !x_dc) fn_DisplayError(".../fn_filesetup.c/WriteCell(): File or input cell cannot be NULL (must be created)");
_n = x_dc->ncells;
for (_i=0; _i<_n; _i++)
{
WriteMatrix(fptr_debug, x_dc->C[_i], format);
fprintf(fptr_debug, "\n");
}
}
/* //+ ansi-c*/
void WriteCellTranspose(FILE *fptr_debug, const TSdcell *x_dc, const char *format)
{
int _i, _n;
if (!fptr_debug || !x_dc) fn_DisplayError(".../fn_filesetup.c/WriteCell(): File or input cell cannot be NULL (must be created)");
_n = x_dc->ncells;
for (_i=0; _i<_n; _i++)
{
WriteMatrixTranspose(fptr_debug, x_dc->C[_i], format);
fprintf(fptr_debug, "\n");
}
}
/* //----------------- ansi-c*/
/* // Write cells of vectors to the output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void WriteCellvec_lf(FILE *fptr_debug, const TSdcellvec *x_dcv) {
int _i;
if (!fptr_debug || !x_dcv) fn_DisplayError(".../fn_filesetup.c/WriteCellvec_lf(): File or input cell cannot be NULL (must be created)");
for (_i=0; _i<x_dcv->ncells; _i++) {
fprintf(fptr_debug, "Cell %d\n", _i);
WriteVector_lf(fptr_debug, x_dcv->C[_i]);
}
}
void WriteCellvec_f(FILE *fptr_debug, const TSdcellvec *x_dcv) {
int _i;
if (!fptr_debug || !x_dcv) fn_DisplayError(".../fn_filesetup.c/WriteCellvec_lf(): File or input cell cannot be NULL (must be created)");
for (_i=0; _i<x_dcv->ncells; _i++) {
fprintf(fptr_debug, "Cell %d\n", _i);
WriteVector_f(fptr_debug, x_dcv->C[_i]);
}
}
void WriteCellvec(FILE *fptr_debug, const TSdcellvec *x_dcv, const char *format) {
int _i, _n;
if (!fptr_debug || !x_dcv) fn_DisplayError(".../fn_filesetup.c/WriteCellvec(): File or input cell cannot be NULL (must be created)");
_n = x_dcv->ncells;
for (_i=0; _i<_n; _i++) WriteVector(fptr_debug, x_dcv->C[_i], format);
}
void WriteCellvec_int(FILE *fptr_debug, const TSicellvec *x_icv)
{
int _i, _n;
if (!fptr_debug || !x_icv) fn_DisplayError(".../fn_filesetup.c/WriteCellvec_int(): File or input cell cannot be NULL (must be created)");
_n = x_icv->ncells;
for (_i=0; _i<_n; _i++) WriteVector_int(fptr_debug, x_icv->C[_i]);
}
/* //----------------- ansi-c*/
/* // Write fourths of column-major double matrices to an output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void WriteFourth_f(FILE *fptr_debug, const TSdfourth *x_d4) {
int _j, _i, _m, _n;
if (!fptr_debug || !x_d4) fn_DisplayError(".../fn_filesetup.c/WriteFourth_f(): File or input fourth cannot be NULL (must be created)");
_m = x_d4->ndims;
for (_j=0; _j<_m; _j++) {
_n = x_d4->F[_j]->ncells;
fprintf(fptr_debug, "Fourth %d\n", _j);
for (_i=0; _i<_n; _i++) {
fprintf(fptr_debug, "Cell %d\n", _i);
WriteMatrix_f(fptr_debug, x_d4->F[_j]->C[_i]);
}
}
}
void WriteFourth(FILE *fptr_debug, const TSdfourth *x_d4, const char *format) {
int _j, _i, _m, _n;
if (!fptr_debug || !x_d4) fn_DisplayError(".../fn_filesetup.c/WriteFourth_f(): File or input fourth cannot be NULL (must be created)");
_m = x_d4->ndims;
for (_j=0; _j<_m; _j++) {
_n = x_d4->F[_j]->ncells;
for (_i=0; _i<_n; _i++) {
WriteMatrix(fptr_debug, x_d4->F[_j]->C[_i], format);
}
}
}
/* //----------------- ansi-c*/
/* // Write a column-major matrix of ints to the output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void fn_WriteMatrix_int(FILE *fptr_debug, const int *x_m, const int r_x_m, const int c_x_m) {
int _i, _j;
for (_i=0; _i<r_x_m; _i++) {
for (_j=0; _j<c_x_m; _j++) {
fprintf(fptr_debug, " %d ", x_m[_j*r_x_m + _i]);
if (_j==c_x_m-1) fprintf(fptr_debug, "\n");
}
if (_i==r_x_m-1) fprintf(fptr_debug, "\n\n");
}
}
void WriteMatrix_int(FILE *fptr_debug, const TSimatrix *x_im) {
int _i, _j;
if (!fptr_debug || !x_im) fn_DisplayError(".../fn_filesetup.c/WriteMatrix_int(): File or input matrix cannot be NULL (must be created)");
for (_i=0; _i<x_im->nrows; _i++) {
for (_j=0; _j<x_im->ncols; _j++) {
fprintf(fptr_debug, " %d ", x_im->M[_j*x_im->nrows + _i]);
if (_j==x_im->ncols-1) fprintf(fptr_debug, "\n");
}
if (_i==x_im->nrows-1) fprintf(fptr_debug, "\n\n");
}
}
/* //----------------- ansi-c*/
/* // Write a vector of doubles to the output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void fn_WriteVector_lf(FILE *fptr_debug, const double *x_v, const int d_x_v) {
int _i;
for (_i=0; _i<d_x_v; _i++) {
fprintf(fptr_debug, " %20.16f ", x_v[_i]);
if (_i==d_x_v-1) fprintf(fptr_debug, "\n\n");
}
}
void WriteVector_lf(FILE *fptr_debug, const TSdvector *x_dv) {
int _i;
for (_i=0; _i<x_dv->n; _i++) {
fprintf(fptr_debug, " %20.16f ", x_dv->v[_i]);
if (_i==x_dv->n-1) fprintf(fptr_debug, "\n\n");
}
}
void WriteVector(FILE *fptr_debug, const TSdvector *x_dv, const char *format) {
int _i, _n;
double *v;
if ( !fptr_debug || !x_dv ) fn_DisplayError(".../fn_filesetup.c/WriteVector(): File or input vector cannot be NULL (must be created)");
_n = x_dv->n;
v = x_dv->v;
if (!format) format=" %10.5f "; /* Default format. ansi-c*/
for (_i=0; _i<_n; _i++) fprintf(fptr_debug, format, v[_i]);
fprintf(fptr_debug, "\n");
}
void WriteVector_column(FILE *fptr_debug, const TSdvector *x_dv, const char *format)
{
int _i, _n;
double *v;
if ( !fptr_debug || !x_dv ) fn_DisplayError(".../fn_filesetup.c/WriteVector_column(): File or input vector cannot be NULL (must be created)");
_n = x_dv->n;
v = x_dv->v;
if (!format) format=" %10.5f "; /* Default format. ansi-c*/
for (_i=0; _i<_n; _i++)
{
fprintf(fptr_debug, format, v[_i]);
fprintf(fptr_debug, "\n");
}
}
/* //----------------- ansi-c*/
/* // Write a vector of floats to the output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void fn_WriteVector_f(FILE *fptr_debug, const double *x_v, const int d_x_v) {
int _i;
for (_i=0; _i<d_x_v; _i++) fprintf(fptr_debug, " %f ", x_v[_i]);
fprintf(fptr_debug, "\n");
}
void WriteVector_f(FILE *fptr_debug, const TSdvector *x_dv) {
int _i;
if (!fptr_debug || !x_dv) fn_DisplayError(".../fn_filesetup.c/WriteVector_f(): File or input vector cannot be NULL (must be created)");
for (_i=0; _i<x_dv->n; _i++) fprintf(fptr_debug, " %10.5f ", x_dv->v[_i]);
fprintf(fptr_debug, "\n");
}
/* //----------------- ansi-c*/
/* // Write a vector of integers to the output file. ansi-c*/
/* // The file pointer is then moved to point to the next ansi-c*/
/* // non-whitespace character after these doubles. ansi-c*/
/* //----------------- ansi-c*/
void WriteVector_int(FILE *fptr_debug, const TSivector *x_iv)
{
int _i;
if (!fptr_debug || !x_iv) fn_DisplayError(".../fn_filesetup.c/WriteVector_int(): File or input vector cannot be NULL (must be created)");
for (_i=0; _i<x_iv->n; _i++) {
fprintf(fptr_debug, " %d ", x_iv->v[_i]);
if (_i==x_iv->n-1) fprintf(fptr_debug, "\n\n");
}
}
void PrintVector_int(const TSivector *x_iv)
{
int _i, _n;
if (!x_iv) fn_DisplayError(".../fn_filesetup.c/PrintVector_int(): Input vector must be created (memory-allocated)");
_n = x_iv->n;
/* // printf("\nVector:\n"); ansi-c*/
for (_i=0; _i<_n; _i++) {
printf("v[%d]=%d\n", _i, x_iv->v[_i]);
}
}
/* //----------------- ansi-c*/
/* // Print a vector of doubles to the screen. ansi-c*/
/* //----------------- ansi-c*/
void PrintVector(const TSdvector *x_dv, const char *format)
{
int _i, _n;
if (!x_dv) fn_DisplayError(".../fn_filesetup.c/PrintVector(): Input vector must be created (memory-allocated)");
_n = x_dv->n;
/* // printf("\n\nVector:\n"); ansi-c*/
for (_i=0; _i<_n; _i++) {
printf(format, x_dv->v[_i]);
}
}
/* //+ ansi-c*/
void PrintVector_f(const TSdvector *x_dv)
{
int _i, _n;
if (!x_dv) fn_DisplayError(".../fn_filesetup.c/PrintVector_f(): Input vector must be created (memory-allocated)");
_n = x_dv->n;
/* // printf("\n\nVector:\n"); ansi-c*/
for (_i=0; _i<_n; _i++) {
printf("v[%d]=%6.4f\n", _i, x_dv->v[_i]);
}
}
void PrintVector_dz(const TSdzvector *x_dzv)
{
int _i;
if (!x_dzv) fn_DisplayError(".../fn_filesetup.c/PrintVector_dz(): Input complex vector must be created (memory-allocated)");
printf("\n\nComplex vector:\n");
for (_i=0; _i<x_dzv->real->n; _i++) {
printf("vreal[%d]=%6.4f; vimag[%d]=%6.4f\n", _i, x_dzv->real->v[_i], _i, x_dzv->imag->v[_i]);
}
}
void PrintMatrix_int(const TSimatrix *X_im)
{
int _i, _j, nrows, ncols;
int *M=X_im->M;
if (!X_im) fn_DisplayError(".../fn_filesetup.c/PrintMatrix_int(): Input matrix must be created (memory-allocated)");
else {
nrows = X_im->nrows;
ncols = X_im->ncols;
M = X_im->M;
}
printf("\n\nMatrix:\n");
for (_i=0; _i<nrows; _i++) {
for (_j=0; _j<ncols; _j++) {
printf(" %d ", M[_j*nrows + _i]);
if (_j==ncols-1) printf("\n");
}
if (_i==nrows-1) printf("\n");
}
}
void PrintMatrix_f(const TSdmatrix *x_dm)
{
int _i, _j, nrows, ncols;
double *M=x_dm->M;
if (!x_dm) fn_DisplayError(".../fn_filesetup.c/PrintMatrix_f(): Input matrix must be created (memory-allocated)");
else {
nrows = x_dm->nrows;
ncols = x_dm->ncols;
M = x_dm->M;
}
printf("\n\nMatrix:\n");
for (_i=0; _i<nrows; _i++) {
for (_j=0; _j<ncols; _j++) {
printf(" %6.4f ", M[_j*nrows + _i]);
if (_j==ncols-1) printf("\n");
}
if (_i==nrows-1) printf("\n");
}
}
void PrintMatrix(const TSdmatrix *x_dm, const char *format)
{
int _i, _j, nrows, ncols;
double *M=x_dm->M;
if (!x_dm) fn_DisplayError(".../fn_filesetup.c/PrintMatrix_f(): Input matrix must be created (memory-allocated)");
else {
nrows = x_dm->nrows;
ncols = x_dm->ncols;
M = x_dm->M;
}
printf("\n\nMatrix:\n");
if (!format) format=" %10.5f "; /* Default format. ansi-c*/
for (_i=0; _i<nrows; _i++) {
for (_j=0; _j<ncols; _j++) {
printf(format, M[_j*nrows + _i]);
if (_j==ncols-1) printf("\n");
}
if (_i==nrows-1) printf("\n");
}
}
void PrintMatrix_dz(const TSdzmatrix *x_dzm) {
int _i, _j, nrows, ncols;
double *Mr=NULL,
*Mi=NULL;
if (!x_dzm) fn_DisplayError(".../fn_filesetup.c/PrintMatrix_dz(): Input complex matrix must be created (memory-allocated)");
else {
nrows = x_dzm->real->nrows;
ncols = x_dzm->real->ncols;
Mr = x_dzm->real->M,
Mi = x_dzm->imag->M;
}
printf("\n\nReal part of the matrix:\n");
for (_i=0; _i<nrows; _i++) {
for (_j=0; _j<ncols; _j++) {
printf(" %6.4f ", Mr[_j*nrows + _i]);
if (_j==ncols-1) printf("\n");
}
if (_i==nrows-1) printf("\n");
}
printf("\n\nImaginary part of the matrix:\n");
for (_i=0; _i<nrows; _i++) {
for (_j=0; _j<ncols; _j++) {
printf(" %6.4f ", Mi[_j*nrows + _i]);
if (_j==ncols-1) printf("\n");
}
if (_i==nrows-1) printf("\n");
}
}
void PrintCellvec_f(const TSdcellvec *x_dcv) {
int _i, ci, _n;
double *v;
if (!x_dcv) fn_DisplayError(".../fn_filesetup.c/PrintCellvec_f(): Input cell must be created (memory-allocated)");
for (ci=0; ci<x_dcv->ncells; ci++ ) {
_n = x_dcv->C[ci]->n;
v = x_dcv->C[ci]->v;
printf("\nCellvec %d:\n", ci);
for (_i=0; _i<_n; _i++) {
printf("v[%d]=%6.4f\n", _i, v[_i]);
}
}
}
void PrintCell_f(const TSdcell *x_dc) {
int _i, _j, ci, nrows, ncols;
double *M;
if (!x_dc) fn_DisplayError(".../fn_filesetup.c/PrintCell_f(): Input cell must be created (memory-allocated)");
for (ci=0; ci<x_dc->ncells; ci++ ) {
nrows = x_dc->C[ci]->nrows;
ncols = x_dc->C[ci]->ncols;
M = x_dc->C[ci]->M;
printf("\nCell %d:\n", ci);
for (_i=0; _i<nrows; _i++) {
for (_j=0; _j<ncols; _j++) {
printf(" %6.4f ", M[_j*nrows + _i]);
if (_j==ncols-1) printf("\n");
}
if (_i==nrows-1) printf("\n");
}
}
}
void PrintCell(const TSdcell *x_dc, const char *format)
{
int _i, _j, ci, nrows, ncols;
double *M;
if (!x_dc) fn_DisplayError(".../fn_filesetup.c/PrintCell_f(): Input cell must be created (memory-allocated)");
for (ci=0; ci<x_dc->ncells; ci++ ) {
nrows = x_dc->C[ci]->nrows;
ncols = x_dc->C[ci]->ncols;
M = x_dc->C[ci]->M;
printf("\nCell %d:\n", ci);
if (!format) format=" %10.5f "; /* Default format. ansi-c*/
for (_i=0; _i<nrows; _i++) {
for (_j=0; _j<ncols; _j++) {
printf(format, M[_j*nrows + _i]);
if (_j==ncols-1) printf("\n");
}
if (_i==nrows-1) printf("\n");
}
}
}
void PrintFourthvec_f(TSdfourthvec *x_d4v) {
int _j, _i, _k, _m, _n, _o;
if (!x_d4v) fn_DisplayError(".../fn_filesetup.c/PrintFourthvec_f(): Input fourthvec cannot be NULL (must be created)");
_m = x_d4v->ndims;
for (_j=0; _j<_m; _j++) {
_n = x_d4v->F[_j]->ncells;
for (_i=0; _i<_n; _i++) {
printf("\nFourthvec %d and Cell %d:\n", _j, _i);
_o = x_d4v->F[_j]->C[_i]->n;
for (_k=0; _k<_o; _k++) {
printf("v[%d]=%6.4f\n", _k, x_d4v->F[_j]->C[_i]->v[_k]);
}
}
}
}
/* //------------------- ansi-c*/
/* // Prints entire input data (fptr_in) to the output file (fptr_out) ansi-c*/
/* // for the user to know what has produced the output. ansi-c*/
/* // The maximum number of characters in each line of the input file ansi-c*/
/* // is 4095 (excluding the NUL byte), but the rest of the line will ansi-c*/
/* // continue to be printed in new lines in the output file. ansi-c*/
/* //------------------- ansi-c*/
#define BUFFERLEN 4096
void ReprintInputData(FILE *fptr_in, FILE *fptr_out)
{
char *inpbuffer;
inpbuffer = tzMalloc(BUFFERLEN, char); /* @ Allocate memory to the string (including the NUL byte). ansi-c*/
rewind(fptr_in);
while (fgets(inpbuffer,BUFFERLEN,fptr_in))
fprintf(fptr_out, "%s", inpbuffer);
fprintf(fptr_out, "\n\n\n\n\n//------------------------------- Output Data Begin Here -------------------------------\n");
swzFree(inpbuffer);
}
#undef BUFFERLEN

69
matlab/ms-sbvar/c-code/utilities/TZCcode/fn_filesetup.h
View File

@ -1,69 +0,0 @@
#ifndef __FN_FILESETUP_H__
#define __FN_FILESETUP_H__
#include <string.h>
/* //#include <malloc.h> // For malloc, calloc, etc. ansi-c*/
#include "tzmatlab.h"
#include "mathlib.h" /* Used for tz_TransposeRegular(). ansi-c*/
int fn_ParseCommandLine(int n_arg, char **args, char ch);
char *fn_ParseCommandLine_String(int n_arg, char **args, char ch, char *default_return);
int fn_ParseCommandLine_Integer(int n_arg, char **args, char ch, int default_return);
int fn_SetFilePosition(FILE *f, const char *id);
int fn_ReadVector_int(FILE *fptr, int *x_v, const int d_x_v);
int fn_ReadVector_lf(FILE *fptr, double *x_v, const int d_x_v);
int fn_ReadMatrix_int(FILE *fptr, int *x_m, const int r_x_m, const int c_x_m);
int fn_ReadMatrix_lf(FILE *fptr, double *x_m, const int r_x_m, const int c_x_m);
int ReadNullTerminatedString(FILE *fptr, TScvector *x_cv);
int ReadVector_int(FILE *fptr, TSivector *x_iv);
int ReadVector_lf(FILE *fptr, TSdvector *x_dv);
int ReadMatrix_int(FILE *fptr, TSimatrix *X_im);
int ReadMatrix_lf(FILE *fptr, TSdmatrix *x_dm);
int ReadCell_lf(FILE *fptr, TSdcell *x_dc);
int ReadCellvec_lf(FILE *fptr, TSdcellvec *x_dcv);
void fn_WriteMatrix_f(FILE *fprt_debug, const double *x_m, const int r_x_m, const int c_x_m);
void fn_WriteMatrix_lf(FILE *fprt_debug, const double *x_m, const int r_x_m, const int c_x_m);
void fn_WriteMatrix_int(FILE *fprt_debug, const int *x_m, const int r_x_m, const int c_x_m);
void fn_WriteVector_f(FILE *fprt_debug, const double *x_v, const int d_x_v);
void WriteMatrix_f(FILE *fprt_debug, const TSdmatrix *x_dm);
void WriteMatrix_lf(FILE *fprt_debug, const TSdmatrix *x_dm);
void WriteMatrix(FILE *fprt_debug, const TSdmatrix *x_dm, const char *format);
void WriteMatrixTranspose(FILE *fptr_debug, const TSdmatrix *x_dm, const char *format);
void WriteCell_lf(FILE *fprt_debug, const TSdcell *x_dc);
void WriteCell_f(FILE *fprt_debug, const TSdcell *x_dc);
void WriteCell(FILE *fprt_debug, const TSdcell *x_dc, const char *format);
void WriteCellTranspose(FILE *fptr_debug, const TSdcell *x_dc, const char *format);
void WriteCellvec_lf(FILE *fprt_debug, const TSdcellvec *x_dcv);
void WriteCellvec_f(FILE *fprt_debug, const TSdcellvec *x_dcv);
void WriteCellvec(FILE *fptr_debug, const TSdcellvec *x_dcv, const char *format);
void WriteFourth_f(FILE *fptr_debug, const TSdfourth *x_d4);
void WriteFourth(FILE *fptr_debug, const TSdfourth *x_d4, const char *format);
void WriteVector_f(FILE *fprt_debug, const TSdvector *x_dv);
void WriteVector_lf(FILE *fprt_debug, const TSdvector *x_dv);
void WriteVector(FILE *fprt_debug, const TSdvector *x_dv, const char *format);
void WriteVector_column(FILE *fptr_debug, const TSdvector *x_dv, const char *format);
void WriteCellvec_int(FILE *fptr_debug, const TSicellvec *x_icv);
void WriteMatrix_int(FILE *fprt_debug, const TSimatrix *x_im);
void WriteVector_int(FILE *fprt_debug, const TSivector *x_iv);
void PrintVector_int(const TSivector *x_iv);
void PrintVector(const TSdvector *x_dv, const char *format);
void PrintVector_f(const TSdvector *x_dv);
void PrintVector_dz(const TSdzvector *x_dzv);
void PrintMatrix_int(const TSimatrix *X_im);
void PrintMatrix_f(const TSdmatrix *x_dm);
void PrintMatrix(const TSdmatrix *x_dm, const char *format);
void PrintMatrix_dz(const TSdzmatrix *x_dzm);
void PrintCellvec_f(const TSdcellvec *x_dcv);
void PrintCell_f(const TSdcell *x_dc);
void PrintCell(const TSdcell *x_dc, const char *format);
void PrintFourthvec_f(TSdfourthvec *x_d4v);
void ReprintInputData(FILE *fptr_in, FILE *fptr_out);
#endif

1273
matlab/ms-sbvar/c-code/utilities/TZCcode/gensys.c
View File

File diff suppressed because it is too large Load Diff

67
matlab/ms-sbvar/c-code/utilities/TZCcode/gensys.h
View File

@ -1,67 +0,0 @@
/*******************************************************************
* [G1,C,impact,fmat,fwt,ywt,gev,eu]=gensys(g0,g1,c,psi,pi,div)
*
* System given as
* g0*y(t)=g1*y(t-1)+c+psi*z(t)+pi*eta(t),
* with z an exogenous variable process and eta being endogenously determined
* one-step-ahead expectational errors. Returned system is
* y(t)=G1*y(t-1)+C+impact*z(t)+ywt*inv(I-fmat*inv(L))*fwt*z(t+1) .
* If z(t) is i.i.d., the last term drops out.
* If div or stake is omitted from argument list, a div>1 or stake>1 is calculated.
* eu(1)=1 for existence, eu(2)=1 for uniqueness. eu(1)=-1 for
* existence only with not-serially correlated z(t); eu=[-2,-2] for coincident zeros.
*
* g0, g1: n-by-n matrices.
* c: n-by-1 constant terms.
* z(t): m-by-1 vector of exogenous residuals where m < n.
* psi: n-by-m matrix.
* eta(t): h-by-1 vector of expectational (endogenous) errors.
* pi: n-by-h matrix.
* div: a real number dividing stable and unstable roots.. If < 1.0, a div>1.0 is calculated mechanically.
*-------
* G1 or Theta_dm: n-by-n matrices.
* C: n-by-1 vector of constant terms.
* impact: n-by-m matrix.
* gev: n-by-2 z vector of stacked generalized eigenvalues where gev(;,2) ./ gev(:,1) = eig(g0, g1).
* ywt: n-by-nunstab z matrix of possible complex numbers. Initialized to NULL and dynamically allocated.
* fmat: nunstab-by-nunstab z matrix where nunstab is the number of non-stable roots.
* fwt: nunstab-by-m z matrix.
********************************************************************/
#ifndef __GENSYS_H__
#define __GENSYS_H__
#include "tzmatlab.h"
/* //#include "fn_filesetup.h" //For DDDDebugging purpose. ansi-c*/
#define REALSMALL 1e-7
/* //#define PRINTWARNINGofSUNSPOT ansi-c*/
typedef struct TSgensys_tag {
/* //=== Output arguments. ansi-c*/
TSdmatrix *Theta_dm; /* n-by-n. ansi-c*/
TSdvector *c_dv; /* n-by-1. ansi-c*/
TSdmatrix *Impact_dm; /* n-by-m. ansi-c*/
TSdzmatrix *Fmat_dzm; /* nunstab-by-nunstab z matrix. Initialized to NULL and will be dynamically allocated whenever gensys() is called. ansi-c*/
TSdzmatrix *Fwt_dzm; /* nunstab-by-m z matrix of possible complex numbers. Initialized to NULL and dynamically allocated. ansi-c*/
TSdzmatrix *Ywt_dzm; /* n-by-nunstab z matrix of possible complex numbers. Initialized to NULL and dynamically allocated. ansi-c*/
TSdzmatrix *Gev_dzm; /* n-by-2 z matrix of possible complex numbers. ansi-c*/
TSivector *eu_iv; /* 2-by-1. ansi-c*/
/* //=== Function itself. ansi-c*/
int (*gensys)(struct TSgensys_tag *, void *);
/* //=== Input arguments, which are all intialized to 0.0 and whose flags are set to M_GE. ansi-c*/
TSdmatrix *G0_dm; /* n-by-n. ansi-c*/
TSdmatrix *G1_dm; /* n-by-n. ansi-c*/
TSdvector *c0_dv; /* n-by-1. ansi-c*/
TSdmatrix *Psi_dm; /* n-by-m. ansi-c*/
TSdmatrix *Pi_dm; /* n-by-k whtere k is the number of expectational errors. ansi-c*/
double div; /* Real number dividing stable and unstable roots.. If < 1.0, a div>1.0 is calculated mechanically. ansi-c*/
} TSgensys;
/* // ansi-c*/
typedef int TFlinratexp(struct TSgensys_tag *, void *); /* For linear rational expectations models. ansi-c*/
struct TSgensys_tag *CreateTSgensys(TFlinratexp *func, const int _n, const int _m, const int _k, const double div);
struct TSgensys_tag *DestroyTSgensys(struct TSgensys_tag *gensys_ps);
int gensys_sims(struct TSgensys_tag *gensys_ps, void *dummy_ps);
#endif

2752
matlab/ms-sbvar/c-code/utilities/TZCcode/kalman.c
View File

File diff suppressed because it is too large Load Diff

300
matlab/ms-sbvar/c-code/utilities/TZCcode/kalman.h
View File

@ -1,300 +0,0 @@
#ifndef __KALMAN_H__
#define __KALMAN_H__
#include "tzmatlab.h"
#include "mathlib.h"
#include "switch.h"
#include "fn_filesetup.h" /* Used to call WriteMatrix(FPTR_DEBUG,....). ansi-c*/
typedef struct TSkalcvfurw_tag {
/* //urw: univariate random walk kalman filter. Desigend specially for the 2006 AER SWZ paper. ansi-c*/
/* //=== Input arguments. ansi-c*/
int indx_tvsigmasq; /* 0: constant siqmasq in Kalman updating (default); ansi-c*/
/* //1: Keyensian (project-specific) type of time-varying sigmasq in Kalman updating; See pp.37 and 37a in SWZ Learning NOTES; ansi-c*/
/* //2: project-specific type; ansi-c*/
/* //3: another project-specific type. ansi-c*/
double sigmasq; /* Variance for the residual eps(t) of the measurement equation. ansi-c*/
int fss; /* T: effective sample size (excluding lags). ansi-c*/
int kx; /* dimension for x(t). ansi-c*/
TSdmatrix *V_dm; /* kx-by-kx. Covariance (symmetric and positive definite) matrix for the residual eta(t) of the transition equation. ansi-c*/
TSdvector *ylhtran_dv; /* 1-by-T of y(t). The term lh means lelf hand side and tran means transpose. ansi-c*/
TSdmatrix *Xrhtran_dm; /* kx-by-T of x(t). The term rh means right hand side and tran means transpose. ansi-c*/
TSdvector *z10_dv; /* kx-by-1. Initial condition for prediction: z_{1|0}. ansi-c*/
TSdmatrix *P10_dm; /* kx-by-kx symmetric matrix. Initial condition for the variance of the prediction: P_{1|0}. ansi-c*/
/* //=== Output arguments. ansi-c*/
TSdvector *zupdate_dv; /* kx-by-1. z_{T+1|T}. ansi-c*/
TSdmatrix *Zpredtran_dm; /* kx-by-T matrix of one-step predicted values of z(t). [z_{2|1}, ..., z_{t+1|t}, ..., z_{T+1|T}]. ansi-c*/
/* //Set to NULL (no output) if storeZ = 0; ansi-c*/
TSdcell *Ppred_dc; /* T cells and kx-by-kx symmetric and positive definite matrix for each cell. Mean square errors of predicted state variables. ansi-c*/
/* //{P_{2|1}, ..., P{t+1|t}, ..., P{T+1|T}. Set to NULL (no output if storeV = 0). ansi-c*/
TSdvector *ylhtranpred_dv; /* 1-by-T one-step prediction of y(t) or ylhtran_dv. Added 03/17/05. ansi-c*/
/* //=== Function itself. ansi-c*/
void (*learning_fnc)(struct TSkalcvfurw_tag *, void *);
} TSkalcvfurw; /* urw: univariate random walk. ansi-c*/
/* // ansi-c*/
typedef void TFlearninguni(struct TSkalcvfurw_tag *, void *); /* For linear rational expectations models. ansi-c*/
/* //=== Better version is TSkalfilmsinputs_1stapp_tag. Kalman filter for constant or known-time-varying DSGE models. ansi-c*/
typedef struct TSkalfiltv_tag
{
/* //General (known-time-varying) Kalman filter for DSGE models. ansi-c*/
/* // It computes a sequence of one-step predictions and their covariance matrices, and the log likelihood. ansi-c*/
/* // The function uses a forward recursion algorithm. See also the Matlab function fn_kalfil_tv.m ansi-c*/
/* // ansi-c*/
/* // State space model is defined as follows: ansi-c*/
/* // y(t) = a(t) + H(t)*z(t) + eps(t) (observation or measurement equation) ansi-c*/
/* // z(t) = b(t) + F(t)*z(t) + eta(t) (state or transition equation) ansi-c*/
/* // where a(t), H(t), b(t), and F(t) depend on s_t that follows a Markov-chain process and are taken as given. ansi-c*/
/* // ansi-c*/
/* // Inputs are as follows: ansi-c*/
/* // Y_T is a n_y-by-T matrix containing data [y(1), ... , y(T)]. ansi-c*/
/* // a is an n_y-by-T matrix of time-varying input vectors in the measurement equation. ansi-c*/
/* // H is an n_y-by-n_z-by-T 3-D of time-varying matrices in the measurement equation. ansi-c*/
/* // R is an n_y-by-n_y-by-T 3-D of time-varying covariance matrices for the error in the measurement equation. ansi-c*/
/* // G is an n_z-by-n_y-by-T 3-D of time-varying E(eta_t * eps_t'). ansi-c*/
/* // ------ ansi-c*/
/* // b is an n_z-by-T matrix of time-varying input vectors in the state equation with b(:,1) as an initial condition. ansi-c*/
/* // F is an n_z-by-n_z-by-T 3-D of time-varying transition matrices in the state equation with F(:,:,1) as an initial condition. ansi-c*/
/* // V is an n_z-by-n_z-by-T 3-D of time-varying covariance matrices for the error in the state equation with V(:,:,1) as an initial condition. ansi-c*/
/* // ------ ansi-c*/
/* // indxIni: 1: using the initial condition with zt_tm1(:,1)=z0 and Pt_tm1(:,:,1)=P0; ansi-c*/
/* // 0: using the unconditional mean for any given regime at time 0. ansi-c*/
/* // z0 is an n_z-by-1 vector of initial condition when indxIni=1. (Not used if indxIni=0.) ansi-c*/
/* // P0 is an n_z-by-n_z matrix of initial condition when indxIni=1. (Not used if indxIni=0.) ansi-c*/
/* // ansi-c*/
/* // Outputs are as follows: ansi-c*/
/* // loglh is a value of the log likelihood function of the state-space model ansi-c*/
/* // under the assumption that errors are multivariate Gaussian. ansi-c*/
/* // zt_tm1 is an n_z-by-T matrices of one-step predicted state vectors with z0_0m1 as a initial condition ansi-c*/
/* // and with z_{t+1|t} as the last element. Thus, we can use it as a base-1 vector. ansi-c*/
/* // Pt_tm1 is an n_z-by-n_z-by-T 3-D of covariance matrices of zt_tm1 with P0_0m1 as a initial condition ansi-c*/
/* // and with P_{t+1|t} as the last element. Thus, we can use it as a base-1 cell. ansi-c*/
/* // ansi-c*/
/* // The initial state vector and its covariance matrix are computed under the bounded (stationary) condition: ansi-c*/
/* // z0_0m1 = (I-F(:,:,1))\b(:,1) ansi-c*/
/* // vec(P0_0m1) = (I-kron(F(:,:,1),F(:,:,1)))\vec(V(:,:,1)) ansi-c*/
/* // Note that all eigenvalues of the matrix F(:,:,1) are inside the unit circle when the state-space model is bounded (stationary). ansi-c*/
/* // ansi-c*/
/* // March 2007, written by Tao Zha ansi-c*/
/* // See Hamilton's book ([13.2.13] -- [13.2.22]), Harvey (pp.100-106), and LiuWZ Model I NOTES pp.001-003. ansi-c*/
/* //=== Input arguments. ansi-c*/
int ny; /* number of observables. ansi-c*/
int nz; /* number of state variables. ansi-c*/
int T; /* sample size. ansi-c*/
int indxIni; /* 1: using the initial condition with zt_tm1(:,1)=z0 and Pt_tm1(:,:,1)=P0; ansi-c*/
/* //0: using the unconditional mean for any given regime at time 0. (Default value) ansi-c*/
TSdmatrix *yt_dm; /* ny-by-T. ansi-c*/
TSdmatrix *at_dm; /* ny-by-T. ansi-c*/
TSdcell *Ht_dc; /* ny-by-nz-by-T. ansi-c*/
TSdcell *Rt_dc; /* ny-by-ny-by-T. Covariance matrix for the measurement equation. ansi-c*/
TSdcell *Gt_dc; /* nz-by-ny-by-T. Cross-covariance. ansi-c*/
/* // ansi-c*/
TSdmatrix *bt_dm; /* nz-by-T. ansi-c*/
TSdcell *Ft_dc; /* nz-by-nz-by-T. ansi-c*/
TSdcell *Vt_dc; /* nz-by-nz-by-T. Covariance matrix for the state equation. ansi-c*/
/* // ansi-c*/
TSdvector *z0_dv; /* nz-by-1; ansi-c*/
TSdmatrix *P0_dm; /* nz-by-nz. ansi-c*/
/* //=== Output arguments. ansi-c*/
double loglh; /* log likelihood. ansi-c*/
TSdmatrix *zt_tm1_dm; /* nz-by-T. ansi-c*/
TSdcell *Pt_tm1_dc; /* nz-by-nz-T. ansi-c*/
} TSkalfiltv;
/* //=== Inputs for filter for Markov-switching DSGE models at any time t. ansi-c*/
typedef struct TSkalfilmsinputs_1stapp_tag
{
/* //Inputs Markov-switching Kalman filter for DSGE models (conditional on all the regimes at time t). ansi-c*/
/* // It computes a sequence of one-step predictions and their covariance matrices, and the log likelihood. ansi-c*/
/* // The function uses a forward recursion algorithm. See also the Matlab function fn_kalfil_tv.m ansi-c*/
/* // ansi-c*/
/* // State space model is defined as follows: ansi-c*/
/* // y(t) = a(t) + H(t)*z(t) + eps(t) (observation or measurement equation) ansi-c*/
/* // z(t) = b(t) + F(t)*z(t) + eta(t) (state or transition equation) ansi-c*/
/* // where a(t), H(t), b(t), and F(t) depend on the grand regime s_t that follows a Markov-chain process ansi-c*/
/* // and is taken as given. ansi-c*/
/* // ansi-c*/
/* // Inputs at time t are as follows where nst is number of grand regimes (including lagged regime ansi-c*/
/* // and coefficients and shock variances): ansi-c*/
/* // Y_T is a n_y-by-T matrix containing data [y(1), ... , y(T)]. ansi-c*/
/* // a is an n_y-by-nst matrix of Markov-switching input vectors in the measurement equation. ansi-c*/
/* // H is an n_y-by-n_z-by-nst 3-D of Markov-switching matrices in the measurement equation. ansi-c*/
/* // R is an n_y-by-n_y-by-nst 3-D of Markov-switching covariance matrices for the error in the measurement equation. ansi-c*/
/* // G is an n_z-by-n_y-by-nst 3-D of Markov-switching E(eta_t * eps_t'). ansi-c*/
/* // ------ ansi-c*/
/* // b is an n_z-by-nst matrix of Markov-switching input vectors in the state equation with b(:,st) as an initial condition. ansi-c*/
/* // (alternatively, with the ergodic weighted b(:,st) as an initial condition). ansi-c*/
/* // F is an n_z-by-n_z-by-nst 3-D of Markov-switching transition matrices in the state equation with F(:,:,st) ansi-c*/
/* // as an initial condition (alternatively, with the ergodic weighted F(:,:,st) as an initial condition). ansi-c*/
/* // V is an n_z-by-n_z-by-nRv 3-D of Markov-switching covariance matrices for the error in the state equation ansi-c*/
/* // with V(:,:,st) as an initial condition (alternatively, with the ergodic weighted V(:,:,st) as an initial condition). ansi-c*/
/* // ------ ansi-c*/
/* // indxIni: 1: using the initial condition with zt_tm1(:,1)=z0 and Pt_tm1(:,:,1)=P0; ansi-c*/
/* // 0: using the unconditional mean for any given regime at time 0. ansi-c*/
/* // z0 is an n_z-by-nst matrix of initial condition (Not used if indxIni=0). ansi-c*/
/* // P0 is an n_z-by-n_z-by-nst 3-D of initial condition (Not used if indxIni=0). ansi-c*/
/* // ansi-c*/
/* // The initial state vector and its covariance matrix are computed under the bounded (stationary) condition: ansi-c*/
/* // z0_0m1 = (I-F(:,:,st))\b(:,st) ansi-c*/
/* // vec(P0_0m1) = (I-kron(F(:,:,st),F(:,:,st)))\vec(V(:,:,st)) ansi-c*/
/* // Note that all eigenvalues of the matrix F(:,:,st) are inside the unit circle when the state-space model is bounded (stationary). ansi-c*/
/* // ansi-c*/
/* // November 2007, written by Tao Zha. Revised, April 2008. ansi-c*/
/* // See Hamilton's book ([13.2.13] -- [13.2.22]), Harvey (pp.100-106), and LiuWZ Model I NOTES pp.001-003. ansi-c*/
/* //=== Input arguments. ansi-c*/
int ny; /* number of observables. ansi-c*/
int nz; /* number of state variables. ansi-c*/
int nst; /* number of grand composite regimes (current and past regimes, coefficient and volatility regimes). ansi-c*/
int T; /* sample size. ansi-c*/
int indxIni; /* 1: using the initial condition with zt_tm1(:,1)=z0 and Pt_tm1(:,:,1)=P0, ansi-c*/
/* //0: using the unconditional momnets for any given regime at time 0 (default when indxDiffuse = 0). ansi-c*/
int indxDiffuse; /* 1: using the diffuse condition for z_{1|0} and P_{1|0} (default option), according to Koopman and Durbin, "Filtering and Smoothing of State Vector for Diffuse State-Space Models," J. of Time Series Analysis, Vol 24(1), pp.85-99. ansi-c*/
/* //0: using the unconditional moments. ansi-c*/
double DiffuseScale; /* A large (infinity) number when indxDiffuse = 1. ansi-c*/
int ztm1_track; /* t-1 = -1: no initial conditions z_{1|0} and P_{1|0} has been computed yet, but will be using InitializeKalman_z10_P10(), ansi-c*/
/* //t-1 >= 0:T-1: z_{t|t-1} and P_{t|t-1} are updated up to t-1. ansi-c*/
int dtm1_track; /* t-1 = -1: no etdata_dc->C[0] or Dtdata_d4->F[0] has been computed yet. ansi-c*/
/* //t-1 >= 0:T-1: etdata_dc->C[t-1] and Dtdata_d4->F[t-1] are updated up to t-1. ansi-c*/
TSdmatrix *yt_dm; /* ny-by-T. ansi-c*/
TSdmatrix *at_dm; /* ny-by-nst. ansi-c*/
TSdcell *Ht_dc; /* ny-by-nz-by-nst. ansi-c*/
TSdcell *Rt_dc; /* ny-by-ny-by-nst. Covariance matrix for the measurement equation. ansi-c*/
TSdcell *Gt_dc; /* nz-by-ny-by-nst. Cross-covariance. ansi-c*/
/* // ansi-c*/
TSdmatrix *bt_dm; /* nz-by-nst. ansi-c*/
TSdcell *Ft_dc; /* nz-by-nz-by-nst. ansi-c*/
TSdcell *Vt_dc; /* nz-by-nz-by-nst. Covariance matrix for the state equation. ansi-c*/
/* // ansi-c*/
TSdmatrix *z0_0_dm; /* nz-by-nst. z_{0|0}. ansi-c*/
TSdmatrix *z0_dm; /* nz-by-nst. z_{1|0}. ansi-c*/
TSdcell *P0_dc; /* nz-by-nz-by-nst. P_{1|0} ansi-c*/
/* //=== Output arguments only used for 1st order approximation to zt and Pt depending on infinite past regimes. ansi-c*/
TSdcell *zt_tm1_dc; /* nz-by-nst-by-(T+1), where z_{1|0} is an initial condition (1st element with t-1=0 or t=1 for base-1) and ansi-c*/
/* // the terminal condition z_{T+1|T} using Updatekalfilms_1stapp(T, ...) is not computed ansi-c*/
/* // when the likelihood logTimetCondLH_kalfilms_1stapp() is computed. Thus, z_{T+1|T} ansi-c*/
/* // has not legal value computed in most applications unless in out-of-sample forecasting problems. ansi-c*/
TSdfourth *Pt_tm1_d4; /* nz-by-nz-by-nst-by-(T+1), where P_{1|0} is an initial condition (1st element with t-1=0) and ansi-c*/
/* // the terminal condition P_{T+1|T} using Updatekalfilms_1stapp(T, ...) is not computed ansi-c*/
/* // when the likelihood logTimetCondLH_kalfilms_1stapp() is computed. Thus, P_{T+1|T} ansi-c*/
/* // has not legal value computed in most applications unless in out-of-sample forecasting problems. ansi-c*/
/* //+ Will be save for updating likelihood and Kalman filter Updatekalfilms_1stapp(), so save time to recompute these objects again. ansi-c*/
TSdfourth *PHtran_tdata_d4; /* nz-by-ny-by-nst-T, P_{t|t-1}*H_t'. Saved only for updating Kalman filter Updatekalfilms_1stapp(). ansi-c*/
TSdcell *etdata_dc; /* ny-by-nst-by-T (with base-0 T), forecast errors e_t in the likelihood. ansi-c*/
TSdcell *yt_tm1_dc; /* ny-by-nst-by-T, one-step forecast y_{t|t-1} for t=0 to T-1 (base-0). Used to back out structural shocks. ansi-c*/
TSdfourth *Dtdata_d4; /* ny-by-ny-nst-by-T, forecast covariance D_t in the likelihood. Saved for updating Kalman filter Updatekalfilms_1stapp(). ansi-c*/
} TSkalfilmsinputs_1stapp;
/* //=== OLD Code: Inputs for filter for Markov-switching DSGE models at any time t. ansi-c*/
typedef struct TSkalfilmsinputs_tag
{
/* //Inputs Markov-switching Kalman filter for DSGE models (conditional on all the regimes at time t). ansi-c*/
/* // It computes a sequence of one-step predictions and their covariance matrices, and the log likelihood. ansi-c*/
/* // The function uses a forward recursion algorithm. See also the Matlab function fn_kalfil_tv.m ansi-c*/
/* // ansi-c*/
/* // State space model is defined as follows: ansi-c*/
/* // y(t) = a(t) + H(t)*z(t) + eps(t) (observation or measurement equation) ansi-c*/
/* // z(t) = b(t) + F(t)*z(t) + eta(t) (state or transition equation) ansi-c*/
/* // where a(t), H(t), b(t), and F(t) depend on s_t that follows a Markov-chain process and are taken as given. ansi-c*/
/* // ansi-c*/
/* // Inputs at time t are as follows where nRc is number of regimes for coefficients ansi-c*/
/* // nRv is number of regimes for volatility (shock variances): ansi-c*/
/* // Y_T is a n_y-by-T matrix containing data [y(1), ... , y(T)]. ansi-c*/
/* // a is an n_y-by-nRc matrix of Markov-switching input vectors in the measurement equation. ansi-c*/
/* // H is an n_y-by-n_z-by-nRc 3-D of Markov-switching matrices in the measurement equation. ansi-c*/
/* // R is an n_y-by-n_y-by-nRv 3-D of Markov-switching covariance matrices for the error in the measurement equation. ansi-c*/
/* // G is an n_z-by-n_y-by-nRv 3-D of Markov-switching E(eta_t * eps_t'). ansi-c*/
/* // ------ ansi-c*/
/* // b is an n_z-by-nRc matrix of Markov-switching input vectors in the state equation with b(:,1) as an initial condition. ansi-c*/
/* // F is an n_z-by-n_z-by-nRc 3-D of Markov-switching transition matrices in the state equation with F(:,:,1) as an initial condition. ansi-c*/
/* // V is an n_z-by-n_z-by-nRv 3-D of Markov-switching covariance matrices for the error in the state equation with V(:,:,1) as an initial condition. ansi-c*/
/* // ------ ansi-c*/
/* // indxIndRegimes: 1: coefficient regime and volatility regime are independent; 0: these two regimes are synchronized completely. ansi-c*/
/* // indxIni: 1: using the initial condition with zt_tm1(:,1)=z0 and Pt_tm1(:,:,1)=P0; ansi-c*/
/* // 0: using the unconditional mean for any given regime at time 0. ansi-c*/
/* // z0 is an n_z-by-nRc*nRv matrix of initial condition when indxIni=1 and indxIndRegimes=1. (Not used if indxIni=0.) ansi-c*/
/* // z0 is an n_z-by-nRv matrix of initial condition when indxIni=1 and indxIndRegimes=0. (Not used if indxIni=0.) ansi-c*/
/* // P0 is an n_z-by-n_z-by-nRc*nRv 3-D of initial condition when indxIni=1 and indxIndRegimes=1. (Not used if indxIni=0.) ansi-c*/
/* // P0 is an n_z-by-n_z-by-nRv 3-D of initial condition when indxIni=1 and indxIndRegimes=0. (Not used if indxIni=0.) ansi-c*/
/* // ansi-c*/
/* // The initial state vector and its covariance matrix are computed under the bounded (stationary) condition: ansi-c*/
/* // z0_0m1 = (I-F(:,:,1))\b(:,1) ansi-c*/
/* // vec(P0_0m1) = (I-kron(F(:,:,1),F(:,:,1)))\vec(V(:,:,1)) ansi-c*/
/* // Note that all eigenvalues of the matrix F(:,:,1) are inside the unit circle when the state-space model is bounded (stationary). ansi-c*/
/* // ansi-c*/
/* // November 2007, written by Tao Zha ansi-c*/
/* // See Hamilton's book ([13.2.13] -- [13.2.22]), Harvey (pp.100-106), and LiuWZ Model I NOTES pp.001-003. ansi-c*/
/* //=== Input arguments. ansi-c*/
int ny; /* number of observables. ansi-c*/
int nz; /* number of state variables. ansi-c*/
int nRc; /* number of composite regimes (current and past regimes) for coefficients. ansi-c*/
int nRstc; /* number of coefficient regimes at time t. ansi-c*/
int nRv; /* number of regimes for volatility (shock variances). ansi-c*/
int indxIndRegimes; /* 1: coefficient regime and volatility regime are independent; 0: these two regimes are synchronized completely. ansi-c*/
int T; /* sample size. ansi-c*/
int indxIni; /* 1: using the initial condition with zt_tm1(:,1)=z0 and Pt_tm1(:,:,1)=P0; ansi-c*/
/* //0: using the unconditional mean for any given regime at time 0. (Default value) ansi-c*/
TSdmatrix *yt_dm; /* ny-by-T. ansi-c*/
TSdmatrix *at_dm; /* ny-by-nRc. ansi-c*/
TSdcell *Ht_dc; /* ny-by-nz-by-nRc. ansi-c*/
TSdcell *Rt_dc; /* ny-by-ny-by-nRv. Covariance matrix for the measurement equation. ansi-c*/
TSdcell *Gt_dc; /* nz-by-ny-by-nRv. Cross-covariance. ansi-c*/
/* // ansi-c*/
TSdmatrix *bt_dm; /* nz-by-nRc. ansi-c*/
TSdcell *Ft_dc; /* nz-by-nz-by-nRc. ansi-c*/
TSdcell *Vt_dc; /* nz-by-nz-by-nRv. Covariance matrix for the state equation. ansi-c*/
/* // ansi-c*/
TSdmatrix *z0_dm; /* nz-by-nRc*nRv if indxIndRegimes == 1 or nz-by-nRv if indxIndRegimes == 0. ansi-c*/
TSdcell *P0_dc; /* nz-by-nz-by-nRc*nRv if indxIndRegimes == 1 or nz-by-nz-by-nRv if indxIndRegimes == 0. ansi-c*/
/* //=== Output arguments only used for 1st order approximation to zt and Pt depending on infinite past regimes. ansi-c*/
TSdcell *zt_tm1_dc; /* nz-by-nRc*nRv-by-T if indxIndRegimes==1, nz-by-nRv-by-T if indxIndRegimes==0 where nRc=nRv. ansi-c*/
TSdfourth *Pt_tm1_d4; /* nz-by-nz-by-nRc*nRv-T if indxIndRegimes==1, nz-by-nz-by-nRv-by-T if indxIndRegimes==0 where nRc=nRv. ansi-c*/
} TSkalfilmsinputs;
/* //--- Functions for univariate random walk kalman filter. ansi-c*/
TSkalcvfurw *CreateTSkalcvfurw(TFlearninguni *func, int T, int k, int tv); /* , int storeZ, int storeV); ansi-c*/
TSkalcvfurw *DestroyTSkalcvfurw(TSkalcvfurw *kalcvfurw_ps);
void kalcvf_urw(TSkalcvfurw *kalcvfurw_ps, void *dummy_ps);
/* //--- New Code: Functions for Markov-switching Kalman filter. ansi-c*/
struct TSkalfilmsinputs_1stapp_tag *CreateTSkalfilmsinputs_1stapp(int ny, int nz, int nst, int T);
struct TSkalfilmsinputs_1stapp_tag *DestroyTSkalfilmsinputs_1stapp(struct TSkalfilmsinputs_1stapp_tag *kalfilmsinputs_1stapp_ps);
int InitializeKalman_z10_P10(struct TSkalfilmsinputs_1stapp_tag *kalfilmsinputs_1stapp_ps, TSdmatrix *z10_dm, TSdcell *P10_dc);
double logTimetCondLH_kalfilms_1stapp(int st, int inpt, struct TSkalfilmsinputs_1stapp_tag *kalfilmsinputs_1stapp_ps, struct TStateModel_tag *smodel_ps);
/* //--- OLD Code: Functions for general constant Kalman filter. ansi-c*/
struct TSkalfiltv_tag *CreateTSkalfiltv(int ny, int nz, int T);
struct TSkalfiltv_tag *DestroyTSkalfiltv(struct TSkalfiltv_tag *kalfiltv_ps);
/* //Used to test tz_logTimetCondLH_kalfiltv(). (Done April 08). double tz_kalfiltv(struct TSkalfiltv_tag *kalfiltv_ps); ansi-c*/
double tz_logTimetCondLH_kalfiltv(int st, int inpt, struct TSkalfiltv_tag *kalfiltv_ps);
/* //--- OLD Code: Functions for Markov-switching Kalman filter. ansi-c*/
struct TSkalfilmsinputs_tag *CreateTSkalfilmsinputs(int ny, int nz, int nRc, int nRstc, int nRv, int indxIndRegimes, int T);
struct TSkalfilmsinputs_tag *DestroyTSkalfilmsinputs(struct TSkalfilmsinputs_tag *kalfilmsinputs_ps);
double tz_logTimetCondLH_kalfilms_1st_approx(int st, int inpt, struct TSkalfilmsinputs_tag *kalfilmsinputs_ps, struct TStateModel_tag *smodel_ps);
/* //IMPORTANT NOTE: in the Markov-switching input file datainp_markov*.prn, it MUST be that ansi-c*/
/* // the coefficient regime is the 1st state variable, and ansi-c*/
/* // the volatility regime is the 2nd state variable. ansi-c*/
#endif

24
matlab/ms-sbvar/c-code/utilities/TZCcode/lapack_compat.h
View File

@ -1,24 +0,0 @@
/* // Created: August 4,2009 ansi-c*/
#ifndef __LAPACKCOMPAT__
#define __LAPACKCOMPAT__
#define USE_LAPACK
#if defined(USE_LAPACK)
#include "blas_lapack.h"
#endif
#define dgetrf dgetrf_
#define dgesv dgesv_
#define dpotrf dpotrf_
#define dsyev dsyev_
#define dgeev dgeev_
#define dpotri dpotri_
#define vdDiv vdDiv_
#define vdInv vdInv_
#define vdSqrt vdSqrt_
#define vdLn vdLn_
#define vdExp vdExp_
#endif

5635
matlab/ms-sbvar/c-code/utilities/TZCcode/mathlib.c
View File

File diff suppressed because it is too large Load Diff

395
matlab/ms-sbvar/c-code/utilities/TZCcode/mathlib.h
View File

@ -1,395 +0,0 @@
#ifndef __MATHLIB_H__
#define __MATHLIB_H__
#include "tzmatlab.h"
#include "fn_filesetup.h" /* Used to call WriteMatrix(FPTR_DEBUG,....). ansi-c*/
/* //------------------------------------------------------ ansi-c*/
/* // LAPACK routines -- all based on Intel MKL (or IMSL C Math library). ansi-c*/
/* //------------------------------------------------------ ansi-c*/
int lurgen(TSdmatrix *lu_dm, TSivector *pivot_dv, TSdmatrix *x_dm);
int eigrsym(TSdvector *eval_dv, TSdmatrix *eVec_dm, const TSdmatrix *S_dm);
int invrtri(TSdmatrix *X_dm, TSdmatrix *A_dm, const char un);
/* //The fastest way is to let X=A and A (and X) will be replaced by inv(A). ansi-c*/
int invspd(TSdmatrix *X_dm, TSdmatrix *A_dm, const char ul);
/* //Inverse of a symmetric positive matrix A. ansi-c*/
/* //Fastest way: let X=A. Then, A (and X) will be replaced by inv(A). ansi-c*/
int invrgen(TSdmatrix *X_dm, TSdmatrix *A_dm);
/* //Inverse of a general real matrix A. ansi-c*/
/* //If X=A, A (and X) will be replaced by inv(A). ansi-c*/
int eigrgen(TSdzvector *vals_dzv, TSdzmatrix *rights_dzm, TSdzmatrix *lefts_dzm, const TSdmatrix *x_dm);
int chol(TSdmatrix *D_dm, TSdmatrix *S_dm, const char ul);
/* // The fastest way for chol() is to let D = S, but D will be replaced by the Choleski factor. ansi-c*/
int BdivA_rrect(TSdmatrix *X_dm, const TSdmatrix *B_dm, const char lr, const TSdmatrix *A_dm);
int BdivA_rgens(TSdmatrix *X_dm, const TSdmatrix *B_dm, const char lr, const TSdmatrix *A_dm);
int bdivA_rgens(TSdvector *x_dv, const TSdvector *b_dv, const char lr, const TSdmatrix *A_dm);
/* //If x_dv->v = b_dv->v. Then, x_dv->v will be replaced by new values. ansi-c*/
/* // x = A\b or b/A if lr='\\' or lr='/' where A is a real general square matrix. ansi-c*/
void Aldivb_spd(TSdvector *x_dv, TSdmatrix *A_dm, TSdvector *b_dv, char an);
/* // Fastest way is to let x_dv->v = b_dv->v. Then, x_dv->v will be replaced by new values. ansi-c*/
double detspd(TSdmatrix *S_dm);
/* //Determinant of symmetric positive definite (SPD) matrix must be positive. ansi-c*/
/* //We set the return value to be -1 if this matrix is NOT SPD. ansi-c*/
double logdetspd(TSdmatrix *S_dm);
/* //Determinant of symmetric positive definite (SPD) matrix must be positive. ansi-c*/
/* //We set the return value to be log(-1.0) (becomeing NaN) if this matrix is NOT SPD. ansi-c*/
double logdeterminant(TSdmatrix *A_dm);
/* // ansi-c*/
/* //void eig_rgen_all(double *eval_v, double *evec_m, const double *x_m, const int _n); ansi-c*/
int chol_decomp(double *D, const double *x_m, const int _n, const char ul);
int eigrgen_decomp(double *evalr_v, double *evali_v, double *revecr_m, double *reveci_m, double *levecr_m, double *leveci_m, const double *x_m, const int _n);
int eigrsym_decomp(double *eval_v, double *evec_m, const double *s_m, const int _n, const char ul);
int inv_spd(double *D, const double *s_m, const int _n, const char ul);
/* //------------------------------------------------------ ansi-c*/
/* // BLAS routines -- all based on Intel MKL (or IMSL C Math library). ansi-c*/
/* //------------------------------------------------------ ansi-c*/
double VectorDotVector(TSdvector *x1_dv, TSdvector *x2_dv);
/* //Output: Return sum(x1[i] * x2[i]) over i=1, ..., n. ansi-c*/
/* // Allows the case x1_dv = x2_dv. ansi-c*/
void ScalarTimesVectorUpdate(TSdvector *x2_dv, const double _alpha, TSdvector *x1_dv);
/* //Output: x2 = alpha * x1 + x2; ansi-c*/
/* //Inputs: ansi-c*/
/* // alpha: a double scalar; ansi-c*/
/* // x1: n-by-1 double vector. ansi-c*/
void ScalarTimesVector(TSdvector *x_dv, const double _alpha, TSdvector *a_dv, const double _beta);
/* //Output: x_dv = alpha*a_dv + beta*x_dv where x_dv is n-by-1. ansi-c*/
/* // When beta=0.0 and x_dv->v = a_dv->v, x_dv->v will be replaced by new values. ansi-c*/
/* //Inputs: ansi-c*/
/* // a_dv: n-by-1. ansi-c*/
/* // _alpha: a double scalar. ansi-c*/
/* // _beta: a double scalar. ansi-c*/
void VectorPlusMinusVectorUpdate(TSdvector *x_dv, const TSdvector *b_dv, double _alpha);
/* //Output: x_dv = _alpha * b_dv + x_dv where x_dv is _n-by-1. ansi-c*/
/* //Inputs: ansi-c*/
/* // b_dv: _n-by-1 double vector. ansi-c*/
/* // _alpha: double scalar. ansi-c*/
void VectorPlusMinusVector(TSdvector *x_dv, const TSdvector *a_dv, const TSdvector *b_dv, double _alpha);
/* //???????? Use tz_VectorPlusMinusVector() or VectorPlusVector() or VectorMinusVector(). ansi-c*/
/* //???????? NOT finished yet. ansi-c*/
/* //????????Must add _beta for x_dv = alpha*a_dv + beta*b_dv. ansi-c*/
/* //??????????? NOT fully tested yet. ansi-c*/
/* //Output: x_dv = a_dv + _alpha * b_dv where x_dv is _n-by-1. ansi-c*/
/* //Inputs: ansi-c*/
/* // a_dv: _n-by-1 double vector. ansi-c*/
/* // b_dv: _n-by-1 double vector. ansi-c*/
/* // _alpha: double scalar. ansi-c*/
void VectorTimesSelf(TSdmatrix *C_dm, const TSdvector *a_dv, const double _alpha, const double _beta, const char ul);
/* //Using MKL with a default to my own C code. ansi-c*/
/* //Output is the matrix C and all other arguments are inputs. ansi-c*/
/* //Computes C = alpah*a*a' + beta*C where ansi-c*/
/* // a is m-by-1, ansi-c*/
/* // C is m-by-m symmetric matrix, ansi-c*/
/* // alpha: a double scalar, ansi-c*/
/* // beta: a double scalar. ansi-c*/
/* // ul: if=='u' or 'U', only the upper triangular part of C is to be referenced; otherwise, only the lower triangular part of C is to be referenced; ansi-c*/
void VectorTimesVector(TSdmatrix *C_dm, const TSdvector *a_dv, const TSdvector *b_dv, const double _alpha, const double _beta);
/* //?????? NOT tested for _beta != 1.0. ansi-c*/
/* //Output is the matrix C and all other arguments are inputs. ansi-c*/
/* //If beta != 0, always converting C (if symmetric or trianuglar) to a general matrix before the operation. ansi-c*/
/* //The fastest way is to let _beta = 1.0. ansi-c*/
/* //Computes C = alpah*a*b' + beta*C where ansi-c*/
/* // a is m-by-1, ansi-c*/
/* // b is n-by-1, ansi-c*/
/* // C is m-by-n general matrix, ansi-c*/
/* // alpha: a double scalar, ansi-c*/
/* // beta: a double scalar. ansi-c*/
void MatrixPlusMinusMatrixUpdate(TSdmatrix *X_dm, TSdmatrix *A_dm, double _alpha);
/* //$$$$$ If A_dm or X_dm is only upper or lower symmetric, it will be always converted to a general (and symmetric) matrix. $$$$$$ ansi-c*/
/* //Output: X =_alpha * A + X where X_dm is an m-by-n general (and possibly symmetric) matrix. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm: m-by-n general or symmetric matrix. ansi-c*/
/* // _alpha: double scalar. ansi-c*/
void MatrixTimesVector(TSdvector *x_dv, TSdmatrix *A_dm, const TSdvector *b_dv, const double _alpha, const double _beta, const char tn);
/* //????? This is NOT checked yet: If x_dv = b_dv, x_dv or b_dv will be relaced by alpha*A*x + beta*x. ansi-c*/
/* //Output: x_dv->v = _alpha*A_dm'*b_dv + _beta*x_dv for tn=='T'; x_dv = _alpha*A_dm*b_dv + _beta*x_dv for tn=='N' ansi-c*/
/* // where x_dv->v is ncols-by-1 or nrows-by-1 and needs not be initialized if _beta is set to 0.0. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm->M: nrows-by-ncols; ansi-c*/
/* // b_dv->v: nrows-by-1 or ncols-by-1; ansi-c*/
/* // _alpha: double scalar; ansi-c*/
/* // _beta: double scalar; ansi-c*/
/* // tn: if =='t' or 'T', transpose of A_dm is used; otherwise, A_dm itself (no transpose) is used. ansi-c*/
void TrimatrixTimesVector(TSdvector *x_dv, TSdmatrix *A_dm, TSdvector *b_dv, const char tn, const char un);
/* //Output: x_dv = A_dm'*b_dv for tn=='T'; x_dv = A_dm*b_dv for tn=='N' where x_dv->v is _n-by-1. ansi-c*/
/* // If x_dv = b_dv (which gives the fastest return, so try to use this option), x_dv will be relaced by A*b or A'*b. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm->M: _n-by-_n triangular matrix. ansi-c*/
/* // b_dv->v: _n-by-1 vector. ansi-c*/
/* // tn: if =='T' or 't', transpose of A_dm is used; otherwise, A_dm itself (no transpose) is used. ansi-c*/
/* // un: if =='U' or 'u', A_dm is unit triangular; otherwise, A_dm is non-unit triangular (i.e., a regular triangular matrix). ansi-c*/
void SymmatrixTimesVector(TSdvector *x_dv, TSdmatrix *A_dm, TSdvector *b_dv, const double _alpha, const double _beta);
/* //????? This is NOT checked yet: If x_dv = b_dv, x_dv or b_dv will be relaced by alpha*A*x + beta*x. ansi-c*/
/* //Output: ansi-c*/
/* // x_dv = alpha*A_dm*b_dv + beta*x_dv where x_dv->v is _n-by-1. ansi-c*/
/* // When beta=0, there is no need to initialize the value of x_dv. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm->M: _n-by-_n triangular matrix. ansi-c*/
/* // b_dv->v: _n-by-1 vector. ansi-c*/
/* // _alpha: double scalar; ansi-c*/
/* // _beta: double scalar; ansi-c*/
void VectorTimesMatrix(TSdvector *x_dv, const TSdvector *b_dv, TSdmatrix *A_dm, const double _alpha, const double _beta, const char tn);
/* //Output: x_dv->v = _alpha*b_dv*A_dm + _beta*x_dv for tn=='N'; x_dv = _alpha*b_dv*A_dm' + _beta*x_dv for tn=='T' ansi-c*/
/* // where x_dv->v is 1-by-ncols or 1-by-nrows and needs not be initialized if _beta is set to 0.0. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm->M: nrows-by-ncols; ansi-c*/
/* // b_dv->v: 1-by-nrows or 1-by-ncols; ansi-c*/
/* // _alpha: double scalar; ansi-c*/
/* // _beta: double scalar; ansi-c*/
/* // tn: if =='T' or 't', transpose of A_dm is used; otherwise (=='N' or 'n'), A_dm itself (no transpose) is used. ansi-c*/
void ScalarTimesMatrix(TSdmatrix *x_dm, const double _alpha, TSdmatrix *a_dm, const double _beta);
/* //$$$$$ If a_dm or x_dm (when _beta!=0) is only upper or lower symmetric, it will be always converted to a general (and symmetric) matrix. $$$$$$ ansi-c*/
/* //Output: x_dm = alpha*a_dm + beta*x_dm where x_dm is m-by-n. ansi-c*/
/* // Fastest way is to let beta=0.0 and x_dm->M = a_dm->M. Then x_dm->M will be replaced by new values. ansi-c*/
/* // However, with beta=0.0, x_dm and a_dm can be different. ansi-c*/
/* //Inputs: ansi-c*/
/* // a_dm: m-by-n. ansi-c*/
/* // _alpha: a double scalar. ansi-c*/
/* // _beta: a double scalar. ansi-c*/
void ScalarTimesMatrixSquare(TSdmatrix *B_dm, const double _alpha, TSdmatrix *A_dm, const char tn, const double _beta);
/* //Outputs: ansi-c*/
/* // B = alpha*o(A) + beta*B, where o(A) = A' if tn=='T' or 't' or A if tn=='N' or 'n'. ansi-c*/
/* // If A=B, then A is replaced by alpha*o(A) + beta*A. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm: n-by-n square matrix. ansi-c*/
/* // B_dm: n-by-n square matrix. ansi-c*/
/* // tn: 'T' (transpose of A) or 'N' (no transpose). ansi-c*/
/* // alpha, beta: double scalars. ansi-c*/
void MatrixTimesSelf(TSdmatrix *C_dm, const char ul, TSdmatrix *A_dm, const char tn, const double _alpha, const double _beta);
/* //If tn=='N' or 'n', C = alpha*A*A' + beta*C. ansi-c*/
/* //If tn=='T' or 't', C = alpha*A'*A + beta*C. ansi-c*/
/* //If ul=='U' or 'u', C_dm->flag = M_SU; ansi-c*/
/* //If ul=='L' or 'l', C_dm->flag = M_SL; ansi-c*/
/* // C must be different from A. ansi-c*/
/* // C is n-by-n; ansi-c*/
/* // A is n-by-k if tn=='N'; ansi-c*/
/* // k-by-n if tn=='T'; ansi-c*/
/* // alpha is a double scalar, ansi-c*/
/* // beta is a double scalar. ansi-c*/
void MatrixTimesMatrix(TSdmatrix *C_dm, TSdmatrix *A_dm, TSdmatrix *B_dm, const double _alpha, const double _beta, const char tn1, const char tn2);
/* //Output is C and all other arguments are inputs. ansi-c*/
/* //Computes C = alpah*op(A)*op(B) + beta*C where op() is either transpose or not, depending on 't' or 'n', ansi-c*/
/* // op(A) is m-by-k, ansi-c*/
/* // op(B) is k-by-n, ansi-c*/
/* // C is m-by-n, ansi-c*/
/* // C must be different from A and from B. ansi-c*/
/* // A and B can be the same, however. ansi-c*/
/* // alpha is a double scalar, ansi-c*/
/* // beta is a double scalar. ansi-c*/
/* // tn1: if == 'T' or 't', the transpose of A is used; otherwise (== 'N' or 'n"), A itself (no transpose) is used. ansi-c*/
/* // tn2: if == 'T' or 't', the transpose of B is used; otherwise (== 'N' or 'n"), B itself (no transpose) is used. ansi-c*/
void SolveTriSysVector(TSdvector *x_dv, const TSdmatrix *T_dm, TSdvector *b_dv, const char tn, const char un);
/* //Output --- computes x_dv = inv(T_dm)*b_dv by solving a triangular system of equation T_dm * x_dv = b_dv. ansi-c*/
/* // x_dv(_n-by-1) = inv(T_dm)*b_v if tn=='N'; = inv(T_dm')*b_v if tn=='T'. ansi-c*/
/* // Fastest way is to let x_dv->v = b_dv->v. Then, x_dv->v will be replaced by new values. ansi-c*/
/* // #define ScalarTimesVector(x_v, a, b_v, _n) cblas_daxpy(_n, a, b_v, 1, x_v, 1) ansi-c*/
/* // //Output: x_v = a * b_v + x_v where double *x_v (_n-by-1) must be initialized. ansi-c*/
/* // //Inputs: a -- double scalar; b_v -- pointer (_n-by-1) to double. ansi-c*/
/* // #define VectorDotVector(a_v, b_v, _n) cblas_ddot(_n, a_v, 1, b_v, 1) ansi-c*/
/* // //Output: x=a_v'*b_v: double scalar. ansi-c*/
/* // //Inputs: a_v, b_v: pointer (_n-by-1) to double. ansi-c*/
void SymmetricMatrixTimesVector(double *x_v, const double a, const double *A_m, const double *a_v, const double b, const int _n, const char ul);
/* //Output: x_v = a*A_m*a_v + b*X_m where x_v (_n-by-1) must be allocated (but needs not be initialized). ansi-c*/
/* //Inputs: ansi-c*/
/* // A_m: _n-by-_n symmetric matrix; ansi-c*/
/* // a_v: _n-by-1; ansi-c*/
/* // a, b: scalars; ansi-c*/
/* // ul: if =='u' or 'U', upper triangular elements in A_m are filled; if =='l' or 'L', lower triangular elements in A_m are filled. ansi-c*/
void SolveTriangularSystemVector(double *x_v, const double *A_m, const double *b_v, const int _n, const char ul, const char tn, const char un);
/* //Outputs: ansi-c*/
/* // x_v(_n-by-1) = inv(A_m)*b_v. If x_v=b_v, b_v will be overwritten by x_v. ansi-c*/
/* //------- ansi-c*/
/* //Inputs: ansi-c*/
/* // A_m: _n-by-_n upper or lower triangular matrix; ansi-c*/
/* // b_v: _n-by-1 vector. ansi-c*/
/* // ul: if =='u' or 'U', A_m is upper triangular; if =='l' or 'L', A_m is lower triangular. ansi-c*/
/* // tn: if =='t' or 'T', A_m' (transpose), instead of A_m, will be used; if =='n', A_m itself (no transpose) will be used. ansi-c*/
/* // un: if =='u' or 'U', A_m is a unit upper triangular (i.e., the diagonal being 1); ansi-c*/
/* // if =='n' or 'N', A_m is a non-unit upper triangular. ansi-c*/
/* // ansi-c*/
/* // Computes x_v = inv(A_m)*b_v by solving a triangular system of equation A_m * x_v = b_v. ansi-c*/
/* // Note I: Intel MLK cblas_dtrsv() does not test for singularity or near-singulariy of the system. ansi-c*/
/* // Such tests must be performed before calling this BLAS routine. ansi-c*/
/* // Note II: if x_v=b_v, b_v will be overwritten by x_v. ansi-c*/
/* //------------------------------------------------------ ansi-c*/
/* // MKL Vector Mathematical Library with default using my own routines. ansi-c*/
/* //------------------------------------------------------ ansi-c*/
void VectorDotDivByVector(TSdvector *x_dv, const TSdvector *a_dv, const TSdvector *b_dv);
/* //????????? NOT tested yet. 06/13/03. ansi-c*/
/* //--- The faster way is to use MKL VML with x_dv != a_dv and x_dv != b_dv; x = a./b; ansi-c*/
void ElementwiseVectorDivideVector(TSdvector *x_dv, const TSdvector *a_dv, const TSdvector *b_dv);
/* //--- The faster way is to use MKL VML with y_dv != x_dv; ansi-c*/
void ElementwiseInverseofVector(TSdvector *y_dv, TSdvector *x_dv);
void ElementwiseSqrtofVector(TSdvector *y_dv, TSdvector *x_dv);
void ElementwiseLogtofVector(TSdvector *y_dv, TSdvector *x_dv);
/* //--- The faster way is to use MKL VML with Y_dm != X_dm; ansi-c*/
void ElementwiseInverseofMatrix(TSdmatrix *Y_dm, TSdmatrix *X_dm);
/* //------------------------------------------------------ ansi-c*/
/* // Matrix routines (my own). ansi-c*/
/* //------------------------------------------------------ ansi-c*/
void tz_VectorPlusMinusVector(TSdvector *x_dv, const TSdvector *a_dv, const double _alpha, const TSdvector *b_dv, const double _beta);
/* //Output: x_dv = alpha*a_dv + beta*b_dv where x_dv is _n-by-1. ansi-c*/
/* //Inputs: ansi-c*/
/* // a_dv: _n-by-1 double vector. ansi-c*/
/* // _alpha: double constant. ansi-c*/
/* // b_dv: _n-by-1 double vector. ansi-c*/
/* // _beta: double constant. ansi-c*/
void VectorPlusVector(TSdvector *x_dv, const TSdvector *a_dv, const TSdvector *b_dv);
/* //Output: x_dv = a_dv + b_dv where x_dv is _n-by-1. ansi-c*/
/* // If x_dv = a_dv, a_dv will be replaced by x_dv. ansi-c*/
/* // If x_dv = b_dv, b_dv will be replaced by x_dv, ansi-c*/
/* //Inputs: ansi-c*/
/* // a_dv: _n-by-1 double vector. ansi-c*/
/* // b_dv: _n-by-1 double vector. ansi-c*/
void VectorMinusVector(TSdvector *x_dv, const TSdvector *a_dv, const TSdvector *b_dv);
/* //Output: x_dv = a_dv - b_dv where x_dv is _n-by-1. ansi-c*/
/* // If x_dv = a_dv, x_dv will be replaced by x_dv - b_dv. ansi-c*/
/* // If x_dv = b_dv, x_dv will be replaced by a_dv - x_dv. ansi-c*/
/* //Inputs: ansi-c*/
/* // a_dv: _n-by-1 double vector. ansi-c*/
/* // b_dv: _n-by-1 double vector. ansi-c*/
void VectorPlusVectorUpdate(TSdvector *x_dv, const TSdvector *b_dv);
/* //Output: x_dv = b_dv + x_dv where x_dv is _n-by-1. ansi-c*/
/* //Inputs: ansi-c*/
/* // b_dv: _n-by-1 double vector. ansi-c*/
void VectorDotTimesVector(TSdvector *x_dv, const TSdvector *a_dv, TSdvector *b_dv, const double _alpha, const double _beta);
/* //Output: ansi-c*/
/* // x_dv is _n-by-1. ansi-c*/
/* // x_dv = _alpha * a_dv .* b_dv + _beta * x_dv if x_dv != b_dv. ansi-c*/
/* // x_dv = _alpha * a_dv .* x_dv + _beta * x_dv if x_dv = b_dv. ansi-c*/
/* //Inputs: ansi-c*/
/* // a_dv: _n-by-1 double vector. ansi-c*/
/* // b_dv: _n-by-1 double vector. ansi-c*/
/* // _alpha: double scalar. ansi-c*/
/* // _beta: a double scalar. ansi-c*/
void SwapColsofMatrix(TSdmatrix *X_dm, int j1, int j2);
/* //??????? NOT tested yet. ansi-c*/
void SwapColsofMatrices(TSdmatrix *X1_dm, int j1, TSdmatrix *X2_dm, int j2);
void SwapPositionsofMatrix(TSdmatrix *X_dm, int j1, int j2);
void SwapMatricesofCell(TSdcell *A_dc, int c1, int c2);
void SwapVectorsofCellvec(TSdcellvec *x_dcv, int c1, int c2);
void SwapVectorsofCellvec_int(TSicellvec *x_icv, int c1, int c2);
void PermuteColsofMatrix(TSdmatrix *A_dm, const TSivector *indx_iv);
void PermuteRowsofMatrix(TSdmatrix *A_dm, const TSivector *indx_iv);
void PermuteMatrix(TSdmatrix *A_dm, const TSivector *indx_iv);
void PermuteMatricesofCell(TSdcell *A_dc, const TSivector *indx_iv);
void ScalarTimesColofMatrix(TSdvector *y_dv, double _alpha, TSdmatrix *x_dm, int _j);
/* //????????? Default option, in the #else, has NOT been tested yet! ansi-c*/
void ScalarTimesColofMatrix2ColofMatrix(TSdmatrix *y_dm, int jy, double _alpha, TSdmatrix *x_dm, int jx);
void ScalarTimesColofMatrixPlusVector2ColofMatrix(TSdmatrix *Y_dm, int jy, double _alpha, TSdmatrix *X_dm, int jx, double _beta, TSdvector *x_dv);
/* // void ColofMatrixDotTimesVector(TSdvector *y_dv, TSdmatrix *X_dm, int jx, TSdvector *x_dv, double _alpha, double _beta); ansi-c*/
void MatrixDotDivideVector_row(TSdmatrix *Y_dm, TSdmatrix *X_dm, TSdvector *x_dv, double _alpha, double _beta);
void RowofMatrixDotDivideVector(TSdvector *y_dv, TSdmatrix *X_dm, int ix, TSdvector *x_dv, double _alpha, double _beta);
/* //??????? NOT tested yet, 01/02/04. ansi-c*/
void ColofMatrixDotTimesVector(TSdvector *y_dv, TSdmatrix *X_dm, int jx, TSdvector *x_dv, double _alpha, double _beta);
void ColofMatrixDotTimesColofMatrix(TSdvector *y_dv, TSdmatrix *X1_dm, int jx1, TSdmatrix *X2_dm, int jx2, double _alpha, double _beta);
void ColofMatrixDotTimesColofMatrix2ColofMatrix(TSdmatrix *Y_dm, int jy, TSdmatrix *X1_dm, int jx1, TSdmatrix *X2_dm, int jx2, double _alpha, double _beta);
void MatrixPlusMatrixUpdate(TSdmatrix *X_dm, TSdmatrix *A_dm);
/* //Output: X = X + A where X_dm is an m-by-n general matrix. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm: m-by-n general matrix. ansi-c*/
void MatrixPlusMatrix(TSdmatrix *X_dm, TSdmatrix *A_dm, TSdmatrix *B_dm);
/* //Output: X = A + B where X_dm is an m-by-n general matrix. ansi-c*/
/* // If X=A, A will be replaced by X; if X=B, B will be replaced by X. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm: m-by-n general matrix. ansi-c*/
/* // B_dm: m-by-n general matrix. ansi-c*/
void MatrixMinusMatrix(TSdmatrix *X_dm, TSdmatrix *A_dm, TSdmatrix *B_dm);
/* //Output: X = A - B where X_dm is an m-by-n general matrix. ansi-c*/
/* // If X=A, A will be replaced by X; if X=B, B will be replaced by X. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm: m-by-n general matrix. ansi-c*/
/* // B_dm: m-by-n general matrix. ansi-c*/
void Matrix2PlusMinusMatrix(TSdmatrix *X_dm, TSdmatrix *A_dm, TSdmatrix *B_dm, TSdmatrix *C_dm, const double _alpha, const double _beta, const double _gamma);
/* //????? Not yet exhaust all possibilities of alpha, beta, and gamma to get most efficiency. Add more as required. 10 February 2003. ansi-c*/
/* //Output: X = alpha*A + beta*B + gamma*C where X_dm is an m-by-n general matrix. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm: m-by-n general matrix. ansi-c*/
/* // B_dm: m-by-n general matrix. ansi-c*/
/* // C_dm: m-by-n general matrix. ansi-c*/
/* // _alpha: a double scalar for A_dm. ansi-c*/
/* // _beta: a double scalar for B_dm. ansi-c*/
/* // _gamma: a double scalar for C_dm. ansi-c*/
void MatrixPlusConstantDiagUpdate(TSdmatrix *X_dm, const double _alpha);
/* //Output: X = X + diag([_alpha, ..., _alpha]) where X is an n-by-n square real matrix. ansi-c*/
void MatrixDotTimesMatrix(TSdmatrix *X_dm, TSdmatrix *A_dm, TSdmatrix *B_dm, const double _alpha, const double _beta);
/* //$$$$$ If A_dm or B_dm or X_dm (when _beta!=0) is only upper or lower symmetric, it will be always converted to a general (and symmetric) matrix. $$$$$$ ansi-c*/
/* //Output: ansi-c*/
/* // X_dm is m-by-n. ansi-c*/
/* // X_dm = _alpha * A_dm .* B_dm + _beta * X_dm if X_dm != B_dm. ansi-c*/
/* // X_dm = _alpha * A_dm .* X_dm + _beta * X_dm if X_dm = B_dm. ansi-c*/
void CopyVector0(TSdvector *x1_dv, const TSdvector *x2_dv);
void CopyMatrix0(TSdmatrix *x1_dm, TSdmatrix *x2_dm);
void CopyCellvec0(TSdcellvec *x1_dcv, TSdcellvec *x2_dcv);
void CopyCell0(TSdcell *x1_dc, TSdcell *x2_dc);
void CopySubmatrix0(TSdmatrix *x1_dm, TSdmatrix *x2_dm, const int br, const int bc, const int nrs, const int ncs);
void CopySubmatrix(TSdmatrix *x1_dm, const int br1, const int bc1, TSdmatrix *x2_dm, const int br2, const int bc2, const int nrs, const int ncs);
void CopySubrowmatrix(TSdmatrix *x1_dm, const int br1, const int bc1, TSdmatrix *x2_dm, const int br2, const int bc2, const int nrs, const int ncs);
/* //??????? NOT tested yet. ansi-c*/
void CopySubmatrix2rowmatrix(TSdmatrix *x1_dm, const int br1, const int bc1, TSdmatrix *x2_dm, const int br2, const int bc2, const int nrs, const int ncs);
void CopySubrowmatrix2matrix(TSdmatrix *x1_dm, const int br1, const int bc1, TSdmatrix *x2_dm, const int br2, const int bc2, const int nrs, const int ncs);
/* //??????? NOT tested yet. ansi-c*/
void CopySubvector(TSdvector *x1_dv, const int ptrloc1, const TSdvector *x2_dv, const int ptrloc2, const int nels);
void CopySubvector_int(TSivector *x1_iv, const int ptrloc1, const TSivector *x2_iv, const int ptrloc2, const int nels);
void CopySubmatrix2vector(TSdvector *x1_dv, const int ptrloc1, TSdmatrix *x2_dm, const int br, const int bc, const int nels);
void CopySubmatrix2vector_sub(TSdvector *x1_dv, const int ptrloc1, TSdmatrix *x2_dm, const int br, const int bc, const int nrs, const int ncs);
void CopySubmatrix2vector_int(TSivector *x1_iv, const int ptrloc1, TSimatrix *x2_im, const int br, const int bc, const int nels);
void CopySubmatrix2vector_row(TSdvector *x1_dv, const int ptrloc1, TSdmatrix *x2_dm, const int br, const int bc, const int nels);
void CopySubvector2matrix(TSdmatrix *x1_dm, const int br, const int bc, const TSdvector *x2_dv, const int ptrloc2, const int nels);
void CopySubvector2rowmatrix(TSdmatrix *x1_dm, const int br, const int bc, const TSdvector *x2_dv, const int ptrloc2, const int nels);
void CopySubvector2matrix_sub(TSdmatrix *x1_dm, const int br, const int bc, const int nrs, const int ncs, TSdvector *x2_dv, const int ptrloc2);
void CopySubvector2matrix_unr(TSdmatrix *x1_dm, const int br, const int bc, const TSdvector *x2_dv, const int ptrloc2, const int nels);
void TransposeSquare(TSdmatrix *B_dm, TSdmatrix *A_dm);
/* //???????? Some options are NOT test yet. 2/27/03. ??????????? ansi-c*/
void TransposeRegular(TSdmatrix *B_dm, const TSdmatrix *A_dm);
TSdmatrix *tz_TransposeRegular(TSdmatrix *B_dm, const TSdmatrix *A_dm);
void SUtoGE(TSdmatrix *x_dm);
/* //Output: x_dm (nrows<=ncols) becomes a general matrix in addition to being upper symmetric. ansi-c*/
/* //Input: x_dm (nrows<=ncols) is upper symmetric. ansi-c*/
void SLtoGE(TSdmatrix *x_dm);
/* //Output: x_dm (nrows>=ncols) becomes a general matrix in addition to being lower symmetric. ansi-c*/
/* //Input: x_dm (nrows>=ncols) is lower symmetric. ansi-c*/
double SumVector(TSdvector *x_dv);
double MaxVector(TSdvector *x_dv);
double MinVector(TSdvector *x_dv);
int MaxVector_int(TSivector *x_iv);
void SumMatrix(TSdvector *x_dv, const TSdmatrix *X_dm, const char rc);
/* //+ ansi-c*/
void diagdv(TSdvector *x_dv, TSdmatrix *x_dm);
TSdmatrix *tz_DiagMatrix(TSdmatrix *X_dm, TSdvector *x_dv);
double tracefabs(TSdmatrix *x_dm);
double tracelogfabs(TSdmatrix *x_dm);
double tracelog(TSdmatrix *x_dm);
double sumoflogvector(TSdvector *x_dv);
/* // ansi-c*/
TSdmatrix *tz_kron(TSdmatrix *C_dm, TSdmatrix *A_dm, TSdmatrix *B_dm);
/* //C = kron(A, B), compatible with Matlab notation. ansi-c*/
/* //Inputs: ansi-c*/
/* // A_dm and B_dm: two real general matrices. ansi-c*/
/* //Outputs: ansi-c*/
/* // If C_dm == NULL, C_dm is created (memory allocated) and returned (thus, the memory must be destroyed outside this function). ansi-c*/
/* // If C_dm != NULL, C_dm's memory has already been allocated outside this function and the same C_dm will be returned. ansi-c*/
/* //=== Self-written routines. ansi-c*/
void ergodicp(TSdvector *p_dv, TSdmatrix *P_dm);
/* //double *fn_ergodp2(const double *cp_m, const int _n); ansi-c*/
double *alloc_ergodp2(const double *cp_m, const int _n);
#endif

1110
matlab/ms-sbvar/c-code/utilities/TZCcode/optpackage.c
View File

File diff suppressed because it is too large Load Diff

496
matlab/ms-sbvar/c-code/utilities/TZCcode/optpackage.h
View File

@ -1,496 +0,0 @@
/************ 3 steps to find minimization solution. *****************
* See details at the bottom of this file.
* or lwz_est.c in D:\ZhaData\WorkDisk\LiuWZ\Project2_empirical\EstimationOct07
* or ExamplesForC.prn in D:\ZhaData\CommonFiles\C_Examples_DebugTips
*
*
* 1. minpack_csminwel_ps = CreateTSminpack();
* 2. InitializeForMinproblem(minpack_csminwel_ps, ..., indxRanIniForMin);
* //This is a local, project-specific function that initializes minpack_csminwel_ps->x_dv (note, NOT xtemp_dv)
* // according to indxStartValuesForMin.
* 3. minfinder(minpack_csminwel_ps);
/*********************************************************************/
#ifndef __OPTPACKAGE_H__
#define __OPTPACKAGE_H__
#include "tzmatlab.h"
#include "csminwel.h"
#include "congradmin.h"
#include "fn_filesetup.h" /* fn_SetFilePosition(), etc. ansi-c*/
#include "mathlib.h" /* CopyVector0(), etc. ansi-c*/
#include "switch_opt.h" /* DW's optimization routines for Markov-switching models. ansi-c*/
#include "cstz.h" /* Used for gradcd_gen() only in the IMSL linear constrainted problem. ansi-c*/
/* //-------------- Attributes for selecting optimization packages. -------------- ansi-c*/
#define MIN_DEFAULT 0 /* 0 or NULL: default or no minimization package. ansi-c*/
#define MIN_CSMINWEL 0x0001 /* 1: csminwel unconstrained minimization package. ansi-c*/
#define MIN_IMSL 0x0002 /* 2: IMSL unconstrained minimization package. ansi-c*/
#define MIN_IMSL_LNCONS 0x0004 /* 4: IMSL linearly constrained minimization package. ansi-c*/
#define MIN_IMSL_NLNCONS 0x0008 /* 8: IMSL nonlinearly constrained minimization package. ansi-c*/
#define MIN_CONGRADI 0x0010 /* 16: unconstrained conjugate gradient minimization method 1. Polak-Ribiere conjugate gradient method without using derivative information in performing the line minimization. ansi-c*/
#define MIN_CONGRADII 0x0020 /* 2*16=32: unconstrained conjugate gradient minimization method 2. NOT available yet! Pletcher-Reeves conjugate gradient method using derivative information in performing the line minimization. ansi-c*/
/* //#define MIN_CONGRADII 0x0040 //4*16=2^6: unconstrained conjugate gradient minimization method 2. ansi-c*/
/* //#define MIN_CONGRADII 0x0080 //8*16=2^7: unconstrained conjugate gradient minimization method 2. ansi-c*/
/* //#define MIN_CONGRADII 0x0100 //16^2=2^8: unconstrained conjugate gradient minimization method 2. ansi-c*/
/* //-------------- Minimization package: unconstrained BFGS csminwel. -------------- ansi-c*/
/* //--- The following three macros will be void if the input data file specifies the values of these macros. ansi-c*/
/* //--- The following three are used for the constant-parameter model only. ansi-c*/
#define CRIT_CSMINWEL 1.0e-09 /* 1.5e-08 (for monthly TVBVAR) ansi-c*/
#define ITMAX_CSMINWEL 100000 /* Maximum number of iterations. ansi-c*/
#define INI_H_CSMINWEL 1.0e-005 /* Initial value for the diagonal of inverse Hessian in the quasi-Newton search. ansi-c*/
/* //1.0e-05 (sometimes used for SargentWZ USinflation project I) ansi-c*/
/* //5.0e-04 (for monthly TVBAR) ansi-c*/
/* //--- The following macros are used in csminwel.c. Have not got time to make them void by input values. ansi-c*/
#define INDXNUMGRAD_CSMINWEL 2 /* Index for choosing the numerical gradient. 1, forward difference; 2, central difference. ansi-c*/
/* //central difference method is twice as slower as forward difference. ansi-c*/
/* //-------------- Minimization package: linearly-nconstrained IMSL. -------------- ansi-c*/
#define CRIT_IMSLCONLIN 1.0e-09 /* Overall convergence criterion on the first-order conditions. ansi-c*/
#define ITMAX_IMSLCONLIN 100000 /* Maximum number of iterations. ansi-c*/
/* //-------------- Minimization package: conjugate gradient method I. -------------- ansi-c*/
#define CRIT_CONGRAD1 1.0e-09 /* Overall convergence criterion on the first-order conditions. ansi-c*/
#define ITMAX_CONGRAD1 100000 /* Maximum number of iterations. ansi-c*/
/* //struct TSminpack_tag; ansi-c*/
/* // extern struct TSminpack_tag *MINPACK_PS; ansi-c*/
/* //typedef void TFminfinder(struct TSminpack_tag *, const int ipackage); //If ipackage = MIN_CWMINWEL, uses csminwel; etc. ansi-c*/
/* //int n, double *x_ptr, double g_ptr); //, void *mingrad_etc_ptr); ansi-c*/
/* //typedef void TFmingrad_imsl(struct TSminpack_tag *); //NOT used yet. ansi-c*/
/* //typedef void TFmingrad(void); //int n, double *x_ptr, double g_ptr); //, void *mingrad_etc_ptr); ansi-c*/
/* //====================================================== ansi-c*/
/* // Old way of using cwminwel. No longer used in my new code. 11/01/05. ansi-c*/
/* //====================================================== ansi-c*/
/* //------- For unconstrained BFGS csminwel only. ------- ansi-c*/
typedef struct TSetc_csminwel_tag {
/* //=== Optional input arguments (originally set up by Iskander), often or no longer NOT used, so we set to NULL at this point. ansi-c*/
double **args; /* k-by-q. ansi-c*/
int *dims; /* k-by-1; ansi-c*/
int _k;
/* //=== Mandatory input arguments. ansi-c*/
TSdmatrix *Hx_dm; /* n-by-n inverse Hessian. Output as well, when csminwel is done. ansi-c*/
double crit; /* Overall convergence criterion for the function value. ansi-c*/
int itmax; /* Maximum number of iterations. ansi-c*/
/* //=== Some reported input arguments. ansi-c*/
double ini_h_csminwel;
int indxnumgrad_csminwel;
double gradstps_csminwel; /* Step size for the numerical gradient if no analytical gradient is available. ansi-c*/
/* //=== Output arguments. ansi-c*/
int badg; /* If (badg==0), analytical gradient is used; otherwise, numerical gradient will be produced. ansi-c*/
int niter; /* Number of iterations taken by csminwel. ansi-c*/
int fcount; /* Number of function evaluations used by csminwel. ansi-c*/
int retcode; /* Return code for the terminating condition. ansi-c*/
/* // 0, normal step (converged). 1, zero gradient (converged). ansi-c*/
/* // 4,2, back and forth adjustment of stepsize didn't finish. ansi-c*/
/* // 3, smallest stepsize still improves too slow. 5, largest step still improves too fast. ansi-c*/
/* // 6, no improvement found. ansi-c*/
} TSetc_csminwel;
/* //============================================================= ansi-c*/
/* // New ways of making optimization packages. ansi-c*/
/* //============================================================= ansi-c*/
typedef struct TSminpack_tag {
/* //=== Input arguments. ansi-c*/
int package; /* Minimization package or routine. ansi-c*/
TSdvector *x_dv; /* n-by-1 of estimated parameters. ansi-c*/
TSdvector *g_dv; /* n-by-1 of gradient. When no analytical gradient is provided, it returns the numerical one. ansi-c*/
/* //$$$$ The x_dv and g_dv are only used minfinder(). In the wrapper function like minobj_csminwelwrap(), we must ansi-c*/
/* //$$$$ use xtemp_dv and gtemp_dv to be repointed to the temporary array created in csminwel() itself. See below. ansi-c*/
TSdvector *xtemp_dv; /* $$$$Used within the minimization problem. ansi-c*/
TSdvector *gtemp_dv; /* $$$$Used within the minimization problem. ansi-c*/
/* //$$$$WARNING: Note the vector xtemp_dv->v or gtemp_dv-v itself is not allocated memory, but only the POINTER. ansi-c*/
/* //$$$$ Within the minimization routine like csminwel(), the temporary array x enters as the argument in ansi-c*/
/* //$$$$ the objective function to compare with other values. If we use minpack_ps->x_dv->v = x ansi-c*/
/* //$$$$ in a wrapper function like minobj_csminwelwrap() where x is a temporay array in csminwel(), ansi-c*/
/* //$$$$ this tempoary array (e.g., x[0] in csminwel()) within the csminwel minimization routine ansi-c*/
/* //$$$$ will be freed after the csminwel minimization is done. Consequently, minpack_ps->x_dv-v, which ansi-c*/
/* //$$$$ which was re-pointed to this tempoary array, will freed as well. Thus, no minimization results ansi-c*/
/* //$$$$ would be stored and trying to access to minpack_ps->x_dv would cause memory leak. ansi-c*/
/* //$$$$ We don't need, however, to create another temporary pointer within the objective function itself, ansi-c*/
/* //$$$$ but we must use minpack_ps->xtemp_dv for a *wrapper* function instead and at the end of ansi-c*/
/* //$$$$ minimization, minpack_ps->x_dv will have the value of minpack_ps->xtemp_dv, which is automatically ansi-c*/
/* //$$$$ taken care of by csminwel with the lines such as ansi-c*/
/* //$$$$ memcpy(xh,x[3],n*sizeof(double)); ansi-c*/
/* //$$$$ where xh and minpack_ps->x_dv->v point to the same memory space. ansi-c*/
TSdvector *x0_dv; /* n-by-1 of initial or starting values of the estimated parameters. ansi-c*/
/* //--- Created here. Contains csminwel arguments iter, retcodeh, etc. or those that are essential to minimization package. ansi-c*/
void *etc_package_ps;
/* //--- Created outside of this structure. Including, say, csminwel input arguments such as convergence criteria ansi-c*/
/* //--- or block-wise csminwel input arguments. ansi-c*/
void *etc_project_ps;
void *(*DestroyTSetc_project)(void *);
/* //--- Optional. ansi-c*/
char *filename_printout;
/* //--- Minimization function for objective function. ansi-c*/
/* //--- May *NOT* be needed for swithcing model because DW's switch_opt.c takes care of things. ansi-c*/
double (*minobj)(struct TSminpack_tag *); /* ansi-c*/
/*** This function is used only for the constant-parameter case, NOT for DW's Markov-swtiching case. ***/
/* //--- Optional: Minimization function for analytical gradient. Often NOT available. ansi-c*/
void (*mingrad)(struct TSminpack_tag *); /* From the input argument of CreateTSminpack(). ansi-c*/
/* //=== Output arguments. ansi-c*/
double fret; /* Returned value of the objective function. ansi-c*/
double fret0; /* Returned value of the objective function at the initial or starting values x0. ansi-c*/
} TSminpack;
typedef double TFminobj(struct TSminpack_tag *); /* int n, double *x_ptr); ansi-c*/
typedef void TFmingrad(struct TSminpack_tag *);
typedef void *TFmindestroy_etcproject(void *);
typedef void TFSetPrintFile(char *);
/* //======= Function prototypes. =======// ansi-c*/
TSminpack *CreateTSminpack(TFminobj *minobj_func, void **etc_project_pps, TFmindestroy_etcproject *etcproject_func, TFmingrad *mingrad_func, char *filename_printout, const int n, const int package);
TSminpack *DestroyTSminpack(TSminpack *);
/* //=== Used for the constant-parameter model. ansi-c*/
/* //--- 28/Oct/07: The function InitializeForMinproblem_const() has not been used even for the constant-parameter model. ansi-c*/
/* //--- For examples, see lwz_est.c in D:\ZhaData\WorkDisk\LiuWZ\Project2_empirical\EstimationOct07 ansi-c*/
/* //--- or ExamplesForC.prn under D:\ZhaData\CommonFiles\C_Examples_DebugTips. ansi-c*/
/* //NOT used: void InitializeForMinproblem_const(struct TSminpack_tag *minpack_ps, char *filename_sp, TSdvector *gphi_dv, int indxStartValuesForMin); ansi-c*/
/* //--- ansi-c*/
void minfinder(TSminpack *minpack_ps);
/* //------------------------------------------------------------------------------// ansi-c*/
/* //---------- New ways of making optimization packages. 03/10/06. -------// ansi-c*/
/* //------------------------------------------------------------------------------// ansi-c*/
/* //================ For the csminwel minimization problem. ================// ansi-c*/
/* //=== Step 1. ansi-c*/
typedef struct TSargs_blockcsminwel_tag
{
/* //Arguments for blockwise minimization. ansi-c*/
/* //=== Within the block: sequence of convergence criteria. ansi-c*/
double criterion_start; /* Default: 1.0e-3; ansi-c*/
double criterion_end; /* Default: 1.0e-6; ansi-c*/
double criterion_increment; /* Default: 0.1; ansi-c*/
int max_iterations_start; /* Default: 50; Max # of iterations for csminwel. The starting value is small because criterion_start ansi-c*/
/* // is coarse at the start. As the convergence criterion is getting tighter, the max # of ansi-c*/
/* // iteration increases as it is multiplied by max_iterations_increment. ansi-c*/
double max_iterations_increment; /* Default: 2.0; Used to multiply the max # of iterations in csminwel as the convergence ansi-c*/
/* // criterion tightens. ansi-c*/
double ini_h_scale; /* Default: 5.0e-4; 1.0e-05 (sometimes used for SargentWZ USinflation project I) ansi-c*/
/* // 5.0e-04 (for monthly TVBAR) ansi-c*/
/* //=== Outside the blocks. ansi-c*/
int max_block_iterations; /* Default: 100; ansi-c*/
/* //------------------------------------------------------------ ansi-c*/
/* //Step size for numerical gradient only when the value of x is less than 1.0 in absolute value. ansi-c*/
/* //If abs(x)>1.0, the step size is GRADSTPS_CSMINWEL*x. ansi-c*/
/* // ansi-c*/
/* //For the time-varying-parameter model, GRADSTPS_CSMINWEL takes the values of gradstps_csminwel_dv: ansi-c*/
/* // 1st element: gradient step for the model parameters (tends to be large; the default value is 1.0e-02). ansi-c*/
/* // 2nd element: gradient step for the transition probability matrix (tends to be smaller; the default value is 1.0e-03) ansi-c*/
/* // 3rd element: gradient step for all the parameters (tends to be smaller; the default value is 1.0e-03 or 1.0e-04). ansi-c*/
/* //For the constant-parameter model: ansi-c*/
/* // GRADSTPS_CSMINWEL takes the value of gradstps_csminwel_const. The default value is 1.0e-04 (for monthly TBVAR) ansi-c*/
/* //------------------------------------------------------------ ansi-c*/
TSdvector *gradstps_csminwel_dv; /* 3-by-1. For the time-varying-parameter model only. ansi-c*/
double gradstps_csminwel_const; /* For the constant-parameter model. ansi-c*/
/* //--- pointer to the input data file that contains all the data on convergence, max iterations, etc. ansi-c*/
FILE *fptr_input1;
} TSargs_blockcsminwel;
struct TSargs_blockcsminwel_tag *CreateTSargs_blockcsminwel(FILE *fptr_input1);
/* //If fptr_input1==NULL or no no values supplied when fptr_input1 != NULL, default values are taken. ansi-c*/
struct TSargs_blockcsminwel_tag *DestroyTSargs_blockcsminwel(struct TSargs_blockcsminwel_tag *args_blockcsminwel_ps);
/* //+ ansi-c*/
typedef struct TStateModel_tag *TFDestroyTStateModel(struct TStateModel_tag *);
typedef struct TSetc_minproj_tag
{
/* //For optimization of the posterior or likelihood function. ansi-c*/
struct TStateModel_tag *smodel_ps;
struct TStateModel_tag *(*DestroyTStateModel)(struct TStateModel_tag *);
/* // ansi-c*/
struct TSargs_blockcsminwel_tag *args_blockcsminwel_ps;
struct TSargs_blockcsminwel_tag *(*DestroyTSargs_blockcsminwel)(struct TSargs_blockcsminwel_tag *);
} TSetc_minproj;
/* // ansi-c*/
struct TSetc_minproj_tag *CreateTSetc_minproj(struct TStateModel_tag **smodel_pps, TFDestroyTStateModel *DestroyTStateModel_func,
struct TSargs_blockcsminwel_tag **args_blockcsminwel_pps, struct TSargs_blockcsminwel_tag *(*DestroyTSargs_blockcsminwel)(struct TSargs_blockcsminwel_tag *));
struct TSetc_minproj_tag *DestroyTSetc_minproj(struct TSetc_minproj_tag *);
/* //And creates the following user's function. ansi-c*/
/* //static double minneglogpost(struct TSminpack_tag *minpack_ps); //For the constant-parameter only. ansi-c*/
/* //=== Step 2. Belongs to the user's responsibility because this function must be able to deal with ansi-c*/
/* // (1) constant-parameter case without using DW's functions; ansi-c*/
/* // (2) allowing us to generate parameters randomly, which depends on the specific model. ansi-c*/
/* // See lwz_est.c in D:\ZhaData\WorkDisk\LiuWZ\Project2_empirical\EstimationOct07 ansi-c*/
/* // or ExamplesForC.prn in D:\ZhaData\CommonFiles\C_Examples_DebugTips. ansi-c*/
/* //--- ansi-c*/
/* //void InitializeForMinproblem(struct TSminpack_tag *minpack_ps, char *filename_sp, TSdvector *gphi_dv, int indxStartValuesForMin); ansi-c*/
/* //=== Step 3. ansi-c*/
void minfinder_blockcsminwel(struct TSminpack_tag *minpack_ps, int indx_findMLE); /* Blockwise minimization. ansi-c*/
/* //indx_findMLE: 1: find MLE without a prior, 0: find posterior (with a prior). ansi-c*/
/* //================ For IMSL multivariate linearly-constrained minimizaiton package only. ================// ansi-c*/
typedef struct TSpackage_imslconlin_tag
{
/* //=== Non-simple constraints. ansi-c*/
int npars_tot; /* Total number of free parameters for the optimaization. ansi-c*/
/* //For example, model free parameters + free transition matrix parameters in the regime-switching case. ansi-c*/
int neqs; /* Number of equality constraints, excluding simple bound constraints. Must be no greater than ncons. ansi-c*/
/* //IMSL dictates that equality constraints come always BEFORE inequality constrains. ansi-c*/
int ncons; /* Total number of constrains, including equality and inequality constraints, but excluding simple bounds. ansi-c*/
TSdvector *lh_coefs_dv; /* ncons*npars_tot-by-1. ALWAYS initialized to be 0.0. ansi-c*/
/* //Left-hand coefficients in the linear constrains (excluding simple bounds). ansi-c*/
/* //IMSL rule: lh_coefs_dv stacks the neqs rows of equality constraints first, followed by the inequality constraints. ansi-c*/
/* //Set to NULL if ncons=0; ansi-c*/
TSdvector *rh_constraints_dv; /* ncons-by-1. Set to NULL if ncons=0. ansi-c*/
/* //Right-hand constraints in the equality and non-equality constrains (excluding simple bounds). ansi-c*/
/* //=== Simple bounds. ansi-c*/
TSdvector *lowbounds_dv; /* npars_tot-by-1. ALWAYS initialized to -BIGREALNUMBER for thes simple lower bounds. ansi-c*/
/* //If a component is unbounded, choose a very negative large value (e.g., -BIGREALNUMBER). ansi-c*/
TSdvector *upperbounds_dv; /* npars_tot-by-1. ALWAYS initialized to +BIGREALNUMBER for thes simple lower bounds. ansi-c*/
/* //If a component is unbounded, choose a very positive large value (e.g., BIGREALNUMBER). ansi-c*/
/* //=== Other output. ansi-c*/
TSdvector *xsaved_dv; /* npars_tot-by-1. Saved the parameters that give the minimal value of the objective function. ansi-c*/
/* //=== Other inputs. ansi-c*/
double crit; /* Overall convergence criterion on the first-order conditions. ansi-c*/
int itmax; /* Maximum number of iterations. ansi-c*/
} TSpackage_imslconlin;
/* //+ ansi-c*/
struct TSpackage_imslconlin_tag *CreateTSpackagae_imslconlin(const int npars_tot, const int neqs, const int ncons);
struct TSpackage_imslconlin_tag *DestroyTSpackagae_imslconlin(struct TSpackage_imslconlin_tag *package_imslconlin_ps);
void minfinder_noblockimslconlin(struct TSpackage_imslconlin_tag *package_imslconlin_ps, struct TSminpack_tag *minpack_ps, char *filename_printout, int ntheta);
/* //================ For conjugate gradient method I only. ================// ansi-c*/
typedef struct TSpackage_congrad1_tag
{
/* //=== Input arguments. ansi-c*/
double crit; /* Overall convergence criterion on the function value. ansi-c*/
int itmax; /* Maximum number of iterations. ansi-c*/
/* //=== Output arguments. ansi-c*/
int niters; /* Number of iterations. ansi-c*/
} TSpackage_congrad1;
/* //+ ansi-c*/
struct TSpackage_congrad1_tag *CreateTSpackage_congrad1(void);
struct TSpackage_congrad1_tag *DestroyTSpackage_congrad1(struct TSpackage_congrad1_tag *package_congrad1_ps);
/**
//------- For unconstrained BFGS csminwel only. -------
typedef struct TSminpack_csminwel_tag {
//=== Optional input arguments, often NOT used, so we set to NULL at this point.
double **args; //k-by-q.
int *dims; //k-by-1;
int _k;
//=== Mandatory input arguments.
TSdmatrix *Hx_dm; //n-by-n inverse Hessian. Output as well, when csminwel is done.
double crit; //Overall convergence criterion for the function value.
int itmax; //Maximum number of iterations.
// double grdh; //Step size for the numerical gradient if no analytical gradient is available.
//=== Initial input arguments.
double ini_h_csminwel;
int indxnumgrad_csminwel;
double gradstps_csminwel;
//=== Output arguments.
int badg; //If (badg==0), analytical gradient is used; otherwise, numerical gradient will be produced.
int niter; //Number of iterations taken by csminwel.
int fcount; //Number of function evaluations used by csminwel.
int retcode; //Return code for the terminating condition.
// 0, normal step (converged). 1, zero gradient (converged).
// 4,2, back and forth adjustment of stepsize didn't finish.
// 3, smallest stepsize still improves too slow. 5, largest step still improves too fast.
// 6, no improvement found.
} TSminpack_csminwel;
/**/
#endif
/*************** 3 steps to find minimization solution. *****************
//---------------------------------
//-- For concrete examples, see
//-- lwz_est.c in D:\ZhaData\WorkDisk\LiuWZ\Project2_empirical\EstimationOct07
//-- ExamplesForC.prn in D:\ZhaData\CommonFiles\C_Examples_DebugTips
//---------------------------------
//------ For the csminwel minimization problem. -------
//--- Step 1. Creats a number of csminwel structures for both Markov-switching and constant-parameter models.
static double minobj(struct TSminpack_tag *minpack_ps); //This function is for the constant-parameter model only.
//--- Step 2.
static void InitializeForMinproblem(struct TSminpack_tag *minpack_ps, char *filename_sp);
//--- Step 3.
//For the constant-parameter model, run minfinder(minpack_ps); //Constant-parameter case.
//For the regime-switching model, run minfinder_blockcsminwel(minpack_ps); //Time-varying case.
*
*
*
//=== main.c
int indxInitializeTransitionMatrix;
//--- My model structure.
struct TSlwzmodel_tag *lwzmodel_ps = NULL;
//--- Waggoner's Markov switching package.
struct TMarkovStateVariable_tag *sv_ps = NULL;
ThetaRoutines *sroutines_ps = NULL;
struct TStateModel_tag *smodel_ps = NULL;
//--- General (csminwel) minimization for constant-parameter.
struct TSetc_minproj_tag *etc_minproj_ps = NULL;
struct TSminpack_tag *minpack_ps = NULL;
//--- Blockwise (csminwel) minimization for regime-switching model.
struct TSargs_blockcsminwel_tag *args_blockcsminwel_ps = NULL;
//-----------------
// Reads from the command line the user-specified input file and the most-often-used integer arguments such as sample size.
//-----------------
cl_modeltag = fn_ParseCommandLine_String(n_arg,args_cl,'t',(char *)NULL); // Tag for different models.
if (!cl_modeltag) fn_DisplayError(".../main(): No model tag is specified yet");
//--- Type of the model: (0) const, (1) varionly, (2) trendinf, (3) policyonly, and (4) firmspolicy.
if (!strncmp("const", cl_modeltag, 5)) indx_tvmodel = 0;
else if (!strncmp("varionly", cl_modeltag, 5)) indx_tvmodel = 1;
else if (!strncmp("trendinf", cl_modeltag, 5)) indx_tvmodel = 2;
else if (!strncmp("policyonly", cl_modeltag, 5)) indx_tvmodel = 3;
else if (!strncmp("firmspolicy", cl_modeltag, 5)) indx_tvmodel = 4;
else fn_DisplayError("main(): the model tag is NOT properly selected");
indxStartValuesForMin = fn_ParseCommandLine_Integer(n_arg,args_cl,'c',1);
sprintf(filename_sp_vec_minproj, "outdatasp_min_%s.prn", cl_modeltag);
//+
sprintf(filenamebuffer, "dataraw.prn");
cl_filename_rawdata = fn_ParseCommandLine_String(n_arg,args_cl,'r',filenamebuffer); //Raw data input file.
fptr_rawdata = tzFopen(cl_filename_rawdata,"r");
//+
sprintf(filenamebuffer, "datainp_common.prn");
cl_filename_input1 = fn_ParseCommandLine_String(n_arg,args_cl,'i',filenamebuffer); //Common setup input data file.
fptr_input1 = tzFopen(cl_filename_input1,"r");
//+
sprintf(filenamebuffer, "datainp_%s.prn", cl_modeltag);
cl_filename_input2 = fn_ParseCommandLine_String(n_arg,args_cl,'s',filenamebuffer); //Model-specific setupt input data file.
fptr_input2 = tzFopen(cl_filename_input2,"r");
//+
sprintf(filenamebuffer, "datainp_markov_%s.prn", cl_modeltag);
cl_filename_markov = fn_ParseCommandLine_String(n_arg,args_cl,'m',filenamebuffer); //Markov-switching setup input data file.
fptr_markov = tzFopen(cl_filename_markov,"r");
//--- Output data files.
sprintf(filenamebuffer, "outdata_debug_%s.prn", cl_modeltag);
FPTR_DEBUG = tzFopen(filenamebuffer,"w"); //Debug output file.
//+
sprintf(filenamebuffer, "outdataout_%s.prn", cl_modeltag);
fptr_output = tzFopen(filenamebuffer,"w"); //Final output file.
//+
sprintf(filenamebuffer, "outdatainp_matlab_%s.prn", cl_modeltag);
fptr_matlab = tzFopen(filenamebuffer, "w");
//+
sprintf(filenamebuffer, "outdatainp_matlab1_%s.prn", cl_modeltag);
fptr_matlab1 = tzFopen(filenamebuffer, "w");
//+
sprintf(filenamebuffer, "outdatainp_matlab2_%s.prn", cl_modeltag);
fptr_matlab2 = tzFopen(filenamebuffer, "w");
//+
sprintf(filenamebuffer, "outdatainp_matlab3_%s.prn", cl_modeltag);
fptr_matlab3 = tzFopen(filenamebuffer, "w");
//----------------------------------------------
//--- Memory allocation and structure creation.
//--- The order matters!
//----------------------------------------------
//--- Model structure. ---
lwzmodel_ps = CreateTSlwzmodel(fptr_rawdata, fptr_input1, fptr_input2, fptr_markov, indx_tvmodel, indxStartValuesForMin);
sprintf(lwzmodel_ps->tag_modeltype_cv->v, cl_modeltag);
lwzmodel_ps->tag_modeltype_cv->flag = V_DEF;
//====== Waggoner's Markov switching variables. ======
sv_ps = CreateMarkovStateVariable_File(fptr_markov, (char *)NULL, lwzmodel_ps->fss);
//In this case, fptr_markov points to datainp_markov_const.prn, which can be found in D:\ZhaData\CommonFiles\C_Examples_DebugTips\DW_MarkovInputFiles.
sroutines_ps = CreateThetaRoutines_empty();
sroutines_ps->pLogConditionalLikelihood = logTimetCondLH; //User's: logTimetCondLH
sroutines_ps->pLogPrior = logpriordensity_usingDW; //User's: pLogPrior
sroutines_ps->pNumberFreeParametersTheta = NumberOfFreeModelSpecificParameters; //User's: NumberOfFreeModelSpecificParameters,
sroutines_ps->pConvertFreeParametersToTheta = ConvertFreeParameters2ModelSpecificParameters; //User's: ConvertFreeParameters2ModelSpecificParameters,
sroutines_ps->pConvertThetaToFreeParameters = ConvertModelSpecificParameters2FreeParameters; //User's: ConvertModelSpecificParameters2FreeParameters,
sroutines_ps->pThetaChanged = tz_thetaChanged; //User's: Notification routine (need to refresh everything given new parameters?)
sroutines_ps->pTransitionMatrixChanged = tz_TransitionMatrixChanged; //User's: Notification routine (need to refresh everything given new parameters?)
smodel_ps = CreateStateModel_new(sv_ps, sroutines_ps, (void *)lwzmodel_ps);
//--- Optional.
if (!indx_tvmodel && fn_SetFilePosition(fptr_markov, "//== indxInitializeTransitionMatrix ==//"))
if ((fscanf(fptr_markov, " %d ", &indxInitializeTransitionMatrix) == 1) && indxInitializeTransitionMatrix)
ReadTransitionMatrices(fptr_markov, (char*)NULL, "Initial: ", smodel_ps); //Waggoner's function.
//--- Minimization problem: Step 1. ---
args_blockcsminwel_ps = CreateTSargs_blockcsminwel(fptr_input1);
//Blockwise (csminwel) minimization arguments, reading convergence criteria or using default values if fptr_input1 is set to NULL.
//fptr_input1 contains parameters for both constant-parameter and Markov-switching models.
etc_minproj_ps = CreateTSetc_minproj(&smodel_ps, (TFDestroyTStateModel *)NULL, &args_blockcsminwel_ps, DestroyTSargs_blockcsminwel);
//Taking convergence criteria and my model structure smodel_ps into minpack_ps.
minpack_ps = CreateTSminpack((TFminobj *)minobj, (void **)&etc_minproj_ps, (TFmindestroy_etcproject *)NULL, (TFmingrad *)NULL,
filename_sp_vec_minproj,
lwzmodel_ps->xphi_dv->n+NumberFreeParametersQ(smodel_ps),
MIN_CSMINWEL);
//minobj is for the constant-parameter model only in which case, NumberFreeParametersQ(smodel_ps) will be 0.
//-----------------
// Main matter.
//-----------------
time(&lwzmodel_ps->prog_begtime); //Beginning time of the whole program.
InitializeGlobleSeed(lwzmodel_ps->randomseed = 0); //2764 If seednumber==0, a value is computed using the system clock.
csminwel_randomseedChanged(lwzmodel_ps->randomseed); //Using the same (or different) seednumber to reset csminwel seednumber for random perturbation.
//=== Finding the peak value of the logLH or logPosterior
if (lwzmodel_ps->indxEstFinder)
{
//Minimization problem: Steps 2 and 3.
InitializeForMinproblem(minpack_ps, filename_sp_vec_minproj); //Initialization for minimization.
//======= 1st round of minimization. =======
//--------------------------
//-- csminwel minimization where
//-- minpack_ps->x_dv contains the minimizing vector of parameters.
//-- minpack_ps->fret contains the minimized value.
//--------------------------
if (!lwzmodel_ps->indx_tvmodel) minfinder(minpack_ps); //Constant-parameter case.
else minfinder_blockcsminwel(minpack_ps); //Time-varying case.
}
else InitializeForMinproblem(minpack_ps, filename_sp_vec_minproj);
time(&lwzmodel_ps->prog_endtime); //Ending time of the whole program.
/*************************************************************************/

835
matlab/ms-sbvar/c-code/utilities/TZCcode/tzmatlab.c
View File

@ -1,835 +0,0 @@
/** Example:
#if defined (USE_DEBUG_FILE)
fprintf(FPTR_DEBUG, "\nWARNING: .../mathlib.c/TransposeSquare(): the matrix is already both SU and SL, so there is no need to transpose.\n");
fflush(FPTR_DEBUG);
#else
printf("\nWARNING: .../mathlib.c/TransposeSquare(): the matrix is already both SU and SL, so there is no need to transpose.\n");
fflush(stdout);
#endif
/**/
#include "tzmatlab.h"
#include "modify_for_mex.h"
FILE *FPTR_DEBUG = (FILE *)NULL; /* Debug output file, to be opened by main.c. ansi-c*/
FILE *FPTR_OPT = (FILE *)NULL; /* Optimization output file, to be opened by main.c. ansi-c*/
/* //----------------- ansi-c*/
/* // Some high-level functions. ansi-c*/
/* //----------------- ansi-c*/
int fn_locofyearqm(int q_m, int yrstart, int qmstart, int yrend, int qmend)
{
/* //Returns the (base 0) location of a specified year and month (quarter) for the time series. ansi-c*/
/* //All the other inputs take the usual (base-1) numbers, I guess 01/17/05. For example, yrstart = 1960 means the year 1960. ansi-c*/
int tmpi, loc;
if ( q_m != 12 )
if ( q_m != 4 ) fn_DisplayError(".../tzmatlab.c/fn_locofyearqm(): This function only works for monthly or quarterly data");
if ( (tmpi=yrend - yrstart) < 0 )
fn_DisplayError(".../cstz.c/fn_locofyearqm(): the end year must be greater than or equal to the start year");
else if ( (loc = (tmpi==0) ? qmend-qmstart : tmpi*q_m+qmend-qmstart) < 0 )
fn_DisplayError(".../tzmatlab.c/fn_locofyearqm(): the end month or quarter must be greater than or equal to the start month or quarter for the given year");
return (loc);
}
/* //----------------- ansi-c*/
/* // Function to display errors. ansi-c*/
/* //----------------- ansi-c*/
void fn_DisplayError(char *msg_s)
{
#if defined (USE_DEBUG_FILE)
fprintf(FPTR_DEBUG, "\nFatal Error:\n"
" %s!\n", msg_s);
fflush(FPTR_DEBUG);
#else
printf("\nFatal Error:\n"
"\t %s!\n", msg_s);
fflush(stdout);
#endif
#ifdef WIN_MATLABAPI
/* Work around to remove mexErrMsgTxt */
/* mexErrMsgTxt(".");*/
mexPrintf(".");
swzExit(1);
#else
/* //getchar(); ansi-c*/
swzExit( EXIT_FAILURE ); /* This exits the entire C program. ansi-c*/
#endif
}
/* //----------------- ansi-c*/
/* // Error-checking memory allocators ansi-c*/
/* //----------------- ansi-c*/
void *m_alloc(size_t size) {
void *new_mem;
if ( (new_mem = swzMalloc(size)) == NULL ) fn_DisplayError("Out of Memory!");
return(new_mem);
}
/* //+ ansi-c*/
void *c_alloc(size_t elt_count, size_t elt_size) {
void *new_mem;
if ( (new_mem = swzCalloc(elt_count, elt_size)) == NULL ) fn_DisplayError("Out of Memory!");
return(new_mem);
}
/* //----------------- ansi-c*/
/* // Creat and destroy vectors, matrices, and cells. ansi-c*/
/* //----------------- ansi-c*/
/**
TSvoidvector *CreateVector_void(int _n)
{
TSvoidvector *x_voidv = tzMalloc(1, TSvoidvector);
x_voidv->flag = V_UNDEF;
x_voidv->n = _n;
x_voidv->v = tzMalloc(_n, void);
return(x_voidv);
}
TSvoidvector *DestroyVector_void(TSvoidvector *x_voidv)
{
if (x_voidv) {
swzFree(x_voidv->v);
swzFree(x_voidv);
return ((TSvoidvector *)NULL);
}
else return (x_voidv);
}
/**/
TScvector *CreateVector_c(int _n)
{
TScvector *x_cv = tzMalloc(1, TScvector);
x_cv->flag = V_UNDEF;
x_cv->n = _n;
if (_n<1) fn_DisplayError(".../tzmatlab.c/CreateVector_c(): dimension input _n must be a positive integer");
x_cv->v = tzMalloc(_n, char);
return( x_cv );
}
TScvector *DestroyVector_c(TScvector *x_cv)
{
if (x_cv) {
swzFree(x_cv->v);
swzFree(x_cv);
return ((TScvector *)NULL);
}
else return (x_cv);
}
TSivector *CreateVector_int(int _n)
{
TSivector *x_iv=tzMalloc(1, TSivector);
x_iv->flag = V_UNDEF;
x_iv->n = _n;
if (_n<1) fn_DisplayError(".../tzmatlab.c/CreateVector_int(): dimension input _n must be a positive integer");
x_iv->v = tzMalloc(_n, int);
return(x_iv);
}
TSivector *DestroyVector_int(TSivector *x_iv)
{
if (x_iv) {
swzFree(x_iv->v);
swzFree(x_iv);
return ((TSivector *)NULL);
}
else return (x_iv);
}
TSimatrix *CreateMatrix_int(int nrows, int ncols)
{
TSimatrix *x_im=tzMalloc(1, TSimatrix);
x_im->nrows = nrows;
x_im->ncols = ncols;
if (nrows<1 || ncols<1) fn_DisplayError(".../tzmatlab.c/CreateMatrix_int(): dimension inputs nrows and ncols must both be positive integers");
x_im->M = tzMalloc(nrows*ncols, int);
return (x_im);
}
TSimatrix *DestroyMatrix_int(TSimatrix *x_im)
{
if (x_im) {
swzFree(x_im->M);
swzFree(x_im);
return ((TSimatrix *)NULL);
}
else return (x_im);
}
TSicellvec *CreateCellvec_int(TSivector *n_iv)
{
int _i,
ncells;
TSicellvec *x_icv = tzMalloc(1, TSicellvec);
if (!n_iv || !n_iv->flag) fn_DisplayError(".../CreateCellvec_int( ): Dimension vector n_iv must (1) created and (2) assigned legal values");
x_icv->ncells = ncells = n_iv->n;
x_icv->C = tzMalloc(ncells, TSivector *);
for (_i=ncells-1; _i>-0; _i--) *(x_icv->C + _i) = CreateVector_int(n_iv->v[_i]);
return(x_icv);
}
TSicellvec *DestroyCellvec_int(TSicellvec *x_icv)
{
int _i;
if (x_icv) {
for (_i=0; _i<x_icv->ncells; _i++) DestroyVector_int(x_icv->C[_i]);
swzFree(x_icv->C);
swzFree(x_icv);
return ((TSicellvec *)NULL);
}
else return (x_icv);
}
TSicell *CreateCell_int(TSivector *row_iv, TSivector *col_iv)
{
int _i,
ncells;
TSicell *x_ic=NULL;
if (!row_iv || !col_iv || !row_iv->flag || !col_iv->flag) fn_DisplayError(".../CreateCell_int( ): Dimension vectors row_iv and col_iv must (1) created and (2) assigned legal values");
if ((ncells = row_iv->n) != col_iv->n) fn_DisplayError(".../CreateCell_int( ): the lengths of row_iv and col_iv (i.e., numbers of cells) must be the same");
x_ic = tzMalloc(1, TSicell);
x_ic->ncells = ncells;
x_ic->C = tzMalloc(ncells, TSimatrix *);
for (_i=ncells-1; _i>=0; _i--) {
*(x_ic->C + _i) = CreateMatrix_int(row_iv->v[_i], col_iv->v[_i]);
}
return(x_ic);
}
TSicell *DestroyCell_int(TSicell *x_ic)
{
int _i;
if (x_ic) {
for (_i=x_ic->ncells-1; _i>=0; _i--) x_ic->C[_i] = DestroyMatrix_int(x_ic->C[_i]);
tzDestroy(x_ic->C);
swzFree(x_ic);
return ((TSicell *)NULL);
}
else return (x_ic);
}
TSdvector *CreateVector_lf(int _n)
{
TSdvector *x_dv=tzMalloc(1, TSdvector);
x_dv->flag = V_UNDEF;
x_dv->n = _n;
if (_n<1) fn_DisplayError(".../tzmatlab.c/CreateVector_lf(): dimension input _n must be a positive integers");
x_dv->v = tzMalloc(_n, double);
return(x_dv);
}
TSdvector *DestroyVector_lf(TSdvector *x_dv)
{
if (x_dv) {
swzFree(x_dv->v);
swzFree(x_dv);
return ((TSdvector *)NULL);
}
else return (x_dv);
}
TSdmatrix *CreateMatrix_lf(int nrows, int ncols)
{
TSdmatrix *x_dm=tzMalloc(1, TSdmatrix);
x_dm->flag = M_UNDEF;
x_dm->nrows = nrows;
x_dm->ncols = ncols;
if (nrows<1 || ncols<1) fn_DisplayError(".../tzmatlab.c/CreateMatrix_lf(): dimension inputs nrows and ncols must both be positive integers");
x_dm->M = tzMalloc(nrows*ncols, double);
return(x_dm);
}
TSdmatrix *DestroyMatrix_lf(TSdmatrix *x_dm)
{
if (x_dm) {
swzFree(x_dm->M);
swzFree(x_dm);
return ((TSdmatrix *)NULL);
}
else return (x_dm);
}
TSdcell *CreateCell_lf(TSivector *row_iv, TSivector *col_iv)
{
int _i,
ncells;
TSdcell *x_dc=NULL;
/* //-------------- The following line must be enacted when we produce new code in the future. --------------------- ansi-c*/
/* //-------------- In old code I forgot to set the flags for row_iv and col_iv but change them in all places are too time-consuming at this point. --------------------- ansi-c*/
/* //if (!row_iv || !col_iv || !row_iv->flag || !col_iv->flag) fn_DisplayError(".../CreateCell_lf( ): Dimension vectors row_iv and col_iv must (1) created and (2) assigned legal values"); ansi-c*/
if ((ncells = row_iv->n) != col_iv->n) fn_DisplayError(".../CreateCell_lf( ): the lengths of row_iv and col_iv (i.e., numbers of cells) must be the same");
x_dc = tzMalloc(1, TSdcell);
x_dc->ncells = ncells;
x_dc->C = tzMalloc(ncells, TSdmatrix *);
for (_i=ncells-1; _i>=0; _i--) {
*(x_dc->C + _i) = CreateMatrix_lf(row_iv->v[_i], col_iv->v[_i]);
}
return(x_dc);
}
TSdcell *DestroyCell_lf(TSdcell *x_dc)
{
int _i;
if (x_dc) {
for (_i=x_dc->ncells-1; _i>=0; _i--) x_dc->C[_i] = DestroyMatrix_lf(x_dc->C[_i]);
tzDestroy(x_dc->C);
swzFree(x_dc);
return ((TSdcell *)NULL);
}
else return (x_dc);
}
TSdcellvec *CreateCellvec_lf(TSivector *n_iv) {
TSdcellvec *x_dcv = tzMalloc(1, TSdcellvec);
int _i,
ncells;
/* //-------------- The following line must be enacted when we produce new code in the future. --------------------- ansi-c*/
/* //-------------- In old code I forgot to set the flag for n_iv but change it in all places are too time-consuming at this point. --------------------- ansi-c*/
/* //if (!n_iv || !n_iv->flag) fn_DisplayError(".../CreateCellvec_lf( ): Dimension vector n_iv must (1) created and (2) assigned legal values"); ansi-c*/
x_dcv->ncells = ncells = n_iv->n;
x_dcv->C = tzMalloc(ncells, TSdvector *);
for (_i=0; _i<ncells; _i++) *(x_dcv->C + _i) = CreateVector_lf(n_iv->v[_i]);
return(x_dcv);
}
TSdcellvec *DestroyCellvec_lf(TSdcellvec *x_dcv) {
int _i;
if (x_dcv) {
for (_i=x_dcv->ncells-1; _i>=0; _i--) DestroyVector_lf(x_dcv->C[_i]);
swzFree(x_dcv->C);
swzFree(x_dcv);
return ((TSdcellvec *)NULL);
}
else return (x_dcv);
}
TSdfourth *CreateFourth_lf(int ndims, TSivector *row_iv, TSivector *col_iv) {
int _i;
TSdfourth *x_d4 = NULL;
/* //if (row_iv->n != col_iv->n) fn_DisplayError(".../CreateFourth_lf( ): the lengths of row_iv and col_iv (i.e., sizes of dimensions) must be the same"); ansi-c*/
x_d4 = tzMalloc(1, TSdfourth);
x_d4->ndims = ndims;
x_d4->F = tzMalloc(ndims, TSdcell *);
for (_i=ndims-1; _i>=0; _i--) {
*(x_d4->F + _i) = CreateCell_lf(row_iv, col_iv);
}
return(x_d4);
}
TSdfourth *DestroyFourth_lf(TSdfourth *x_d4) {
int _i;
if (x_d4) {
for (_i=x_d4->ndims-1; _i>=0; _i--) DestroyCell_lf(x_d4->F[_i]);
swzFree(x_d4->F);
swzFree(x_d4);
return ((TSdfourth *)NULL);
}
else return (x_d4);
}
TSdfourthvec *CreateFourthvec_lf(int ndims, TSivector *n_iv)
{
int _i;
TSdfourthvec *x_d4v = NULL;
/* //if (n_iv->n != col_iv->n) fn_DisplayError(".../CreateFourth_lf( ): the lengths of n_iv and col_iv (i.e., sizes of dimensions) must be the same"); ansi-c*/
x_d4v = tzMalloc(1, TSdfourthvec);
x_d4v->ndims = ndims;
x_d4v->F = tzMalloc(ndims, TSdcellvec *);
for (_i=ndims-1; _i>=0; _i--) {
*(x_d4v->F + _i) = CreateCellvec_lf(n_iv);
}
return(x_d4v);
}
TSdfourthvec *DestroyFourthvec_lf(TSdfourthvec *x_d4v)
{
int _i;
if (x_d4v) {
for (_i=x_d4v->ndims-1; _i>=0; _i--) DestroyCellvec_lf(x_d4v->F[_i]);
swzFree(x_d4v->F);
swzFree(x_d4v);
return ((TSdfourthvec *)NULL);
}
else return (x_d4v);
}
TSdzvector *CreateVector_dz(int _n)
{
TSdzvector *x_dzv=tzMalloc(1, TSdzvector);
x_dzv->real = CreateVector_lf(_n);
x_dzv->imag = CreateVector_lf(_n);
return( x_dzv );
}
TSdzvector *DestroyVector_dz(TSdzvector *x_dzv)
{
if (x_dzv) {
DestroyVector_lf(x_dzv->real);
DestroyVector_lf(x_dzv->imag);
swzFree(x_dzv);
return ((TSdzvector *)NULL);
}
else return (x_dzv);
}
TSdzmatrix *CreateMatrix_dz(int nrows, int ncols) {
TSdzmatrix *x_dzm=tzMalloc(1, TSdzmatrix);
x_dzm->real = CreateMatrix_lf(nrows, ncols);
x_dzm->imag = CreateMatrix_lf(nrows, ncols);
return( x_dzm );
}
TSdzmatrix *DestroyMatrix_dz(TSdzmatrix *x_dzm)
{
if (x_dzm) {
DestroyMatrix_lf(x_dzm->real);
DestroyMatrix_lf(x_dzm->imag);
swzFree(x_dzm);
return ((TSdzmatrix *)NULL);
}
else return (x_dzm);
}
/* //----------------- ansi-c*/
/* // Creates special vectors, matrices, and cells but uses the same destroy utilities as above. ansi-c*/
/* //----------------- ansi-c*/
/* //=== Creates two special matrices: zeros and identity. Use DestroyMatrix_lf to free the memory allocated to these functions. ansi-c*/
TSdmatrix *CreateZeroMatrix_lf(const int nrows, const int ncols) {
int _i;
TSdmatrix *x_dm=CreateMatrix_lf(nrows, ncols);
/* //x_dm->flag = M_GE | M_SU | M_SL | M_UT | M_LT; ansi-c*/
x_dm->flag = M_GE;
for (_i=nrows*ncols-1; _i>=0; _i--)
x_dm->M[_i] = 0.0;
return(x_dm);
}
TSdmatrix *CreateIdentityMatrix_lf(const int nrows, const int ncols) {
int _i;
TSdmatrix *x_dm=CreateZeroMatrix_lf(nrows, ncols);
if (nrows==ncols) {
/* //x_dm->flag = M_GE | M_SU | M_SL | M_UT | M_LT; ansi-c*/
/* //x_dm->flag = M_GE; ansi-c*/
for (_i=square(nrows)-1; _i>=0; _i -= nrows+1) x_dm->M[_i] = 1.0;
x_dm->flag = M_GE | M_SU | M_SL | M_UT | M_LT;
}
else if (nrows<ncols) {
/* //x_dm->flag = M_GE | M_SU | M_UT; ansi-c*/
/* //x_dm->flag = M_GE; ansi-c*/
for (_i=square(nrows)-1; _i>=0; _i -= nrows+1) x_dm->M[_i] = 1.0;
x_dm->flag = M_GE | M_UT | M_LT;
}
else {
/* //x_dm->flag = M_GE | M_SL | M_LT; ansi-c*/
/* //x_dm->flag = M_GE; ansi-c*/
for (_i=(ncols-1)*(nrows+1); _i>=0; _i -= nrows+1) x_dm->M[_i] = 1.0;
x_dm->flag = M_GE | M_UT | M_LT;
}
return(x_dm);
}
/* //=== Other speicial matrices. ansi-c*/
TSivector *CreateConstantVector_int(const int _n, const int _k) {
/* //Inputs: ansi-c*/
/* // _k: Integer constant; ansi-c*/
/* // _n: Dimension of the vector. ansi-c*/
int _i;
TSivector *x_iv=CreateVector_int(_n);
for (_i=_n-1; _i>=0; _i--)
x_iv->v[_i] = _k;
x_iv->flag = V_DEF;
return(x_iv);
}
TSimatrix *CreateConstantMatrix_int(const int nrows, const int ncols, const int _n)
{
int _i;
TSimatrix *x_im=CreateMatrix_int(nrows, ncols);
for (_i=nrows*ncols-1; _i>=0; _i--) x_im->M[_i] = _n;
if ( nrows==ncols ) x_im->flag = M_GE | M_SU | M_SL | M_CN;
else x_im->flag = M_GE | M_CN;
return(x_im);
}
TSicellvec *CreateConstantCellvec_int(TSivector *n_iv, const int _n)
{
int _i,
ncells;
TSicellvec *x_icv = tzMalloc(1, TSicellvec);
if (!n_iv || !n_iv->flag) fn_DisplayError(".../CreateCellvec_int( ): Dimension vector n_iv must (1) created and (2) assigned legal values");
x_icv->ncells = ncells = n_iv->n;
x_icv->C = tzMalloc(ncells, TSivector *);
for (_i=ncells-1; _i>=0; _i--) *(x_icv->C + _i) = CreateConstantVector_int(n_iv->v[_i], _n);
return(x_icv);
}
TSicell *CreateConstantCell_int(TSivector *row_iv, TSivector *col_iv, const int _n)
{
int _i,
ncells;
TSicell *x_ic=NULL;
if (!row_iv || !col_iv || !row_iv->flag || !col_iv->flag) fn_DisplayError(".../CreateConstantCell_int( ): Dimension vectors row_iv and col_iv must (1) created and (2) assigned legal values");
if ((ncells = row_iv->n) != col_iv->n) fn_DisplayError(".../CreateCell_int( ): the lengths of row_iv and col_iv (i.e., numbers of cells) must be the same");
x_ic = tzMalloc(1, TSicell);
x_ic->ncells = ncells;
x_ic->C = tzMalloc(ncells, TSimatrix *);
for (_i=ncells-1; _i>=0; _i--) *(x_ic->C + _i) = CreateConstantMatrix_int(row_iv->v[_i], col_iv->v[_i], _n);
return(x_ic);
}
TSdvector *CreateConstantVector_lf(const int _n, const double _alpha) {
int _i;
TSdvector *x_dv=CreateVector_lf(_n);
for (_i=_n-1; _i>=0; _i--) x_dv->v[_i] = _alpha;
x_dv->flag = V_DEF;
return(x_dv);
}
TSdmatrix *CreateConstantMatrix_lf(const int nrows, const int ncols, const double _alpha) {
/* //Inputs: ansi-c*/
/* // _alpha: Double constant; ansi-c*/
/* // nrows and ncols: Dimensions of the matrix. ansi-c*/
int _i;
TSdmatrix *x_dm=CreateMatrix_lf(nrows, ncols);
for (_i=nrows*ncols-1; _i>=0; _i--) x_dm->M[_i] = _alpha;
if ( nrows==ncols ) x_dm->flag = M_GE | M_SU | M_SL | M_CN;
else x_dm->flag = M_GE | M_CN;
return(x_dm);
}
TSdcellvec *CreateConstantCellvec_lf(TSivector *n_iv, const double _alpha) {
/* //Inputs: ansi-c*/
/* // _alpha: Double constant; ansi-c*/
/* // _n: Length (dimension) of the vector. ansi-c*/
int _i,
ncells;
TSdcellvec *x_dcv = tzMalloc(1, TSdcellvec);
/* //-------------- The following line must be enacted when we produce new code in the future. --------------------- ansi-c*/
/* //-------------- In old code I forgot to set the flag for n_iv but change it in all places are too time-consuming at this point. --------------------- ansi-c*/
/* //if (!n_iv || !n_iv->flag) fn_DisplayError(".../CreateConstantCellvec_lf( ): Dimension vector n_iv must (1) created and (2) assigned legal values"); ansi-c*/
x_dcv->ncells = ncells = n_iv->n;
x_dcv->C = tzMalloc(ncells, TSdvector *);
for (_i=ncells-1; _i>=0; _i--) *(x_dcv->C + _i) = CreateConstantVector_lf(n_iv->v[_i], _alpha);
return(x_dcv);
}
TSdcell *CreateConstantCell_lf(TSivector *row_iv, TSivector *col_iv, const double _alpha) {
/* //Inputs: ansi-c*/
/* // _alpha: Double constant; ansi-c*/
/* // nrows: Number of rows; ansi-c*/
/* // ncols: Number of columns. ansi-c*/
int _i,
ncells;
TSdcell *x_dc=NULL;
/* //-------------- The following line must be enacted when we produce new code in the future. --------------------- ansi-c*/
/* //-------------- In old code I forgot to set the flags for row_iv and col_iv but change them in all places are too time-consuming at this point. --------------------- ansi-c*/
/* //if (!row_iv || !col_iv || !row_iv->flag || !col_iv->flag) fn_DisplayError(".../CreateConstantCell_lf( ): Dimension vectors row_iv and col_iv must (1) created and (2) assigned legal values"); ansi-c*/
if ((ncells = row_iv->n) != col_iv->n) fn_DisplayError(".../CreateCell_lf( ): the lengths of row_iv and col_iv (i.e., numbers of cells) must be the same");
x_dc = tzMalloc(1, TSdcell);
x_dc->ncells = ncells;
x_dc->C = tzMalloc(ncells, TSdmatrix *);
for (_i=ncells-1; _i>=0; _i--) *(x_dc->C + _i) = CreateConstantMatrix_lf(row_iv->v[_i], col_iv->v[_i], _alpha);
return(x_dc);
}
TSdvector *CreateDatesVector_lf(int nq_m, int yrstart, int qmstart, int yrend, int qmend)
{
/* //If nq_m==4, quarterly data; nq_m==12, monthly data. ansi-c*/
/* //All the other inputs take the usual (base-1) numbers, I guess 01/17/05. For example, yrstart = 1960 means the year 1960. ansi-c*/
int _t;
int samplesize = 1+fn_locofyearqm(nq_m, yrstart, qmstart, yrend, qmend); /* 1+ because fn_locofyearqm() returns a 0-based integer. ansi-c*/
/* // ansi-c*/
TSdvector *dates_dv = tzMalloc(1, TSdvector);
dates_dv->n = samplesize;
dates_dv->v = tzMalloc(samplesize, double);
if (nq_m==4 || nq_m==12) {
for (_t=samplesize-1; _t>=0; _t--) dates_dv->v[_t] = (double)yrstart + (double)(qmstart+_t-1)/(double)nq_m;
dates_dv->flag = V_DEF;
}
else fn_DisplayError(".../tzmatlab.c/CreateDatesVector_lf(): Dates have to be either monthly or quarterly");
return (dates_dv);
}
/* //----------------- ansi-c*/
/* // Initializes already-created special vectors, matrices, and cells. ansi-c*/
/* //----------------- ansi-c*/
void InitializeConstantVector_lf(TSdvector *x_dv, const double _alpha)
{
/* //Ouputs: ansi-c*/
/* // x_dv: Initialized to a constant value _alpha for all elements. ansi-c*/
/* //Inputs: ansi-c*/
/* // x_dv: Memory allocated already. ansi-c*/
/* // _alpha: Double constant; ansi-c*/
int _i, _n;
if (!x_dv) fn_DisplayError(".../tzmatlab.c/InitializeConstantVector_lf(): Input vector must be created (memory-allocated)");
else {
_n=x_dv->n;
}
for (_i=_n-1; _i>=0; _i--) x_dv->v[_i] = _alpha;
x_dv->flag = V_DEF;
}
void InitializeConstantVector_int(TSivector *x_iv, const int _k)
{
/* //Ouputs: ansi-c*/
/* // x_iv: Initialized to a constant value _alpha for all elements. ansi-c*/
/* //Inputs: ansi-c*/
/* // x_iv: Memory allocated already. ansi-c*/
/* // _alpha: Integer constant; ansi-c*/
int _i, _n;
if (!x_iv) fn_DisplayError(".../tzmatlab.c/InitializeConstantVector_int(): Input vector must be created (memory-allocated)");
else {
_n=x_iv->n;
}
for (_i=_n-1; _i>=0; _i--) x_iv->v[_i] = _k;
x_iv->flag = V_DEF;
}
void InitializeConstantMatrix_lf(TSdmatrix *x_dm, const double _alpha)
{
/* //Ouputs: ansi-c*/
/* // x_dm: Initialized to a constant value _alpha for all elements. ansi-c*/
/* //Inputs: ansi-c*/
/* // x_dm: Memory allocated already. ansi-c*/
/* // _alpha: Double constant; ansi-c*/
/* //See Kenneth Reek, pp.202-212. ansi-c*/
/* // int _i; ansi-c*/
/* // for (_i=x_dm->nrows*x_dm->ncols-1; _i>=0; _i--) ansi-c*/
/* // x_dm->M[_i] = _alpha; ansi-c*/
/* // int nrows, ncols; ansi-c*/
double *ptrcnt, *lastptr;
if ( !x_dm) fn_DisplayError(".../tzmathlab.c/InitializeConstantMatrix_int(): Input matrix must be created (memory-allocated)");
else {
/* // nrows = x_dm->nrows; ansi-c*/
/* // ncols = x_dm->ncols; ansi-c*/
lastptr = (ptrcnt = x_dm->M) + x_dm->nrows * x_dm->ncols;
}
/* // if (nrows==ncols) x_dm->flag = M_GE | M_SU | M_SL; ansi-c*/
/* // else if (nrows<ncols) x_dm->flag = M_GE | M_SU; ansi-c*/
/* // else x_dm->flag = M_GE | M_SL; ansi-c*/
x_dm->flag = M_GE | M_CN;
for ( ; ptrcnt<lastptr; ptrcnt++ ) *ptrcnt = _alpha;
}
void InitializeDiagonalMatrix_lf(TSdmatrix *x_dm, const double _alpha) {
int _i, n2, nrows, ncols;
double *M;
if ( !x_dm ) fn_DisplayError(".../tzmathlab.c/InitializeIdentiyMatrix_lf(): (1) Input matrix must be created (memory-allocated)");
else {
nrows = x_dm->nrows;
ncols = x_dm->ncols;
M = x_dm->M;
}
if (nrows==ncols) {
for (_i=(n2=square(nrows))-1; _i>=0; _i--) M[_i] = 0.0;
for (_i=n2-1; _i>=0; _i -= nrows+1) M[_i] = _alpha;
x_dm->flag = M_GE | M_SU | M_SL | M_UT | M_LT;
}
else if (nrows<ncols) {
for (_i=nrows*ncols-1; _i>=0; _i--) M[_i] = 0.0;
for (_i=square(nrows)-1; _i>=0; _i -= nrows+1) M[_i] = _alpha;
x_dm->flag = M_GE | M_UT | M_LT;
}
else {
for (_i=nrows*ncols-1; _i>=0; _i--) M[_i] = 0.0;
for (_i=(ncols-1)*(nrows+1); _i>=0; _i -= nrows+1) M[_i] = _alpha;
x_dm->flag = M_GE | M_UT | M_LT;
}
}
void InitializeConstantMatrix_int(TSimatrix *x_im, const int _alpha) {
/* //Ouputs: ansi-c*/
/* // x_im: Initialized to a constant value _alpha for all elements. ansi-c*/
/* //Inputs: ansi-c*/
/* // x_im: Memory allocated already. ansi-c*/
/* // _alpha: Integer constant; ansi-c*/
/* // ansi-c*/
/* //See Kenneth Reek, pp.202-212. ansi-c*/
/* // int _i; ansi-c*/
/* // for (_i=x_im->nrows*x_im->ncols-1; _i>=0; _i--) ansi-c*/
/* // x_im->M[_i] = _alpha; ansi-c*/
int *ptrcnt, *lastptr;
if ( !x_im) fn_DisplayError(".../tzmathlab.c/InitializeConstantMatrix_int(): Input matrix must be created (memory-allocated)");
else lastptr = (ptrcnt = x_im->M) + x_im->nrows * x_im->ncols;
for ( ; ptrcnt<lastptr; ptrcnt++ ) *ptrcnt = _alpha;
}
void InitializeConstantCellvec_lf(TSdcellvec *x_dcv, const double _alpha) {
/* //Ouputs: ansi-c*/
/* // x_dcv: Initialized to a constant value _alpha for all elements. ansi-c*/
/* //Inputs: ansi-c*/
/* // x_dcv: Memory allocated already. ansi-c*/
/* // _alpha: Double constant; ansi-c*/
int _i, _k, _n;
double *v;
if ( !x_dcv ) fn_DisplayError(".../tzmatlab.c/InitializeConstantCellvec_lf(): Input cell vector must be created (memory-allocated)");
for (_i=x_dcv->ncells-1; _i>=0; _i--) {
v = x_dcv->C[_i]->v;
_n = x_dcv->C[_i]->n;
for (_k=_n-1; _k>=0; _k--) v[_k] = _alpha;
x_dcv->C[_i]->flag = V_DEF;
}
}
void InitializeConstantCell_lf(TSdcell *x_dc, const double _alpha)
{
/* //Ouputs: ansi-c*/
/* // x_dc: Initialized to a constant value _alpha for all elements. ansi-c*/
/* //Inputs: ansi-c*/
/* // x_dc: Memory allocated already. ansi-c*/
/* // _alpha: Double constant; ansi-c*/
int _i, _k, nrows, ncols;
double *M;
if ( !x_dc ) fn_DisplayError(".../tzmatlab.c/InitializeConstantCell_lf(): Input cell must be created (memory-allocated)");
for (_i=x_dc->ncells-1; _i>=0; _i--) {
M = x_dc->C[_i]->M;
nrows = x_dc->C[_i]->nrows;
ncols = x_dc->C[_i]->ncols;
/* // if (nrows==ncols) x_dc->C[_i]->flag = M_GE | M_SU | M_SL; ansi-c*/
/* // else if (nrows<ncols) x_dc->C[_i]->flag = M_GE | M_SU; ansi-c*/
/* // else x_dc->C[_i]->flag = M_GE | M_SL; ansi-c*/
for (_k=nrows*ncols-1; _k>=0; _k--) M[_k] = _alpha;
x_dc->C[_i]->flag = M_GE | M_CN;
}
}
void InitializeConstantFourthvec_lf(TSdfourthvec *x_d4v, const double _alpha) {
/* //Ouputs: ansi-c*/
/* // x_d4v: Initialized to a constant value _alpha for all elements. ansi-c*/
/* //Inputs: ansi-c*/
/* // x_d4v: Memory allocated already. ansi-c*/
/* // _alpha: Double constant; ansi-c*/
int _j, _i, _k;
double *v;
if ( !x_d4v ) fn_DisplayError(".../tzmatlab.c/InitializeConstantFourthvec_lf(): Input fourth must be created (memory-allocated)");
for (_j=x_d4v->ndims-1; _j>=0; _j--) {
for (_i=x_d4v->F[_j]->ncells-1; _i>=0; _i--) {
v = x_d4v->F[_j]->C[_i]->v;
for (_k=x_d4v->F[_j]->C[_i]->n-1; _k>=0; _k--) v[_k] = _alpha;
x_d4v->F[_j]->C[_i]->flag = V_DEF;
}
}
}
void InitializeConstantFourth_lf(TSdfourth *x_d4, const double _alpha) {
/* //Ouputs: ansi-c*/
/* // x_d4: Initialized to a constant value _alpha for all elements. ansi-c*/
/* //Inputs: ansi-c*/
/* // x_d4: Memory allocated already. ansi-c*/
/* // _alpha: Double constant; ansi-c*/
int _j, _i, _k, nrows, ncols;
double *M;
if ( !x_d4 ) fn_DisplayError(".../tzmatlab.c/InitializeConstantFourth_lf(): Input fourth must be created (memory-allocated)");
for (_j=x_d4->ndims-1; _j>=0; _j--) {
for (_i=x_d4->F[_j]->ncells-1; _i>=0; _i--) {
M = x_d4->F[_j]->C[_i]->M;
nrows = x_d4->F[_j]->C[_i]->nrows;
ncols = x_d4->F[_j]->C[_i]->ncols;
for (_k=nrows*ncols-1; _k>=0; _k--) M[_k] = _alpha;
x_d4->F[_j]->C[_i]->flag = M_GE | M_CN;
}
}
}
void NegateColofMatrix_lf(TSdvector *y_dv, TSdmatrix *X_dm, int jx) {
/* //Ouputs: ansi-c*/
/* // If y_dv!=NULL, y_dv is the negative of the jx_th column of X_dm (i.e., multiplied by -1.0). ansi-c*/
/* // If !y_dv, the jx_th column of X_dm is replaced by its negated value (i.e., multiplied by -1.0). ansi-c*/
/* //Inputs: ansi-c*/
/* // X_dm: Memory allocated and legal values given already. ansi-c*/
/* // jx: The jx_th column of X_dm. ansi-c*/
int _i, nrows_x;
double *M, *v;
if ( !X_dm || !X_dm->flag ) fn_DisplayError(".../tzmathlab.c/NegateColumnofMatrix_lf(): (1) input matrix must be created (memory-allocated); (2) legal values must be given");
if (jx >= X_dm->ncols) fn_DisplayError(".../tzmathlab.c/NegateColumnofMatrix_lf(): The jx_th column specified exceeds the column dimension of the input matrix");
M = X_dm->M + (jx+1)*(nrows_x=X_dm->nrows) - 1; /* Points to the end of the jx_th column. ansi-c*/
if ( !y_dv )
for (_i=nrows_x-1; _i>=0; _i--, M--) *M = -(*M);
else {
for (_i=nrows_x-1, v=y_dv->v+_i; _i>=0; _i--, M--, v--) *v = -(*M);
y_dv->flag = V_DEF;
}
}
void InitializeConstantColofMatrix_lf(TSdmatrix *X_dm, int jx, double _alpha) {
/* //Ouputs: ansi-c*/
/* // The jx_th column of X_dm is replaced by its original value multiplied by _alpha. ansi-c*/
/* //Inputs: ansi-c*/
/* // X_dm: Memory allocated and legal values given already. ansi-c*/
/* // jx: The jx_th column of X_dm. ansi-c*/
/* // _alpha: A double constant. ansi-c*/
int _i, nrows_x;
double *M;
if ( !X_dm || !X_dm->flag ) fn_DisplayError(".../tzmathlab.c/NegateColumnofMatrix_lf(): (1) input matrix must be created (memory-allocated); (2) legal values must be given");
if (jx >= X_dm->ncols) fn_DisplayError(".../tzmathlab.c/NegateColumnofMatrix_lf(): The jx_th column specified exceeds the column dimension of the input matrix");
M = X_dm->M + (jx+1)*(nrows_x=X_dm->nrows) - 1; /* Points to the end of the jx_th column. ansi-c*/
for (_i=nrows_x-1; _i>=0; _i--, M--) *M = _alpha;
}
/* //----------------- ansi-c*/
/* // Open files. ansi-c*/
/* //----------------- ansi-c*/
FILE *tzFopen(char *filename, char *mode) {
FILE *fptr_dummy;
if (filename)
{
if ( !(fptr_dummy = fopen(filename,mode)) ) {
printf("\n\n...tzmatlab.c/tzFopen(): Fatal Error -- unable to write, read, or append the file %s!\n", filename);
/* //getchar(); ansi-c*/
swzExit(EXIT_FAILURE);
}
}
else fn_DisplayError(".../tzmatlab.c/tzFopen(): the input filename must exit");
return (fptr_dummy);
}

7
matlab/ms-sbvar/c-code/utilities/TZCcode/tzmatlab.h
View File

@ -1,7 +0,0 @@
/* // Use this for tao's orginal code ansi-c*/
/* //#include "tzmatlab_tao.h" ansi-c*/
/* // Use this for dan's version of the code ansi-c*/
#include "tzmatlab_dw.h"

364
matlab/ms-sbvar/c-code/utilities/TZCcode/tzmatlab_dw.h
View File

@ -1,364 +0,0 @@
/*********
* _cv: Pointer to TScvector (character vector).
* _iv: Pointer to TSivector (integer vector).
* _im: Pointer to TSimatrix (integer matrix).
* _dv: Pointer to TSdvector (double vector).
* _dm: Pointer to TSdmatrix (double matrix).
* _dc: Pointer to TSdcell (double cell -- pointer to pointer to a matrix).
* _dcv: Pointer to TSdcellvec (double cell -- pointer to pointer to a vector).
* _d4: Pointer to TSdfourth (double fourth dimension -- pointer to pointer to pointer to a matrix).
* _dzv: Pointer to TSdzvector (double complex vector).
* _dzm: Pointer to TSdzmatrix (double complex matrix).
*
* _s: structure variable.
* _ps: pointer to a structure.
* _sv: an array of structures.
*
* _sdv: structure (NOT pointer to structure) that contains TSdvector.
* _sdm: structure (NOT pointer to structure) that contains TSdmatrix.
*
* ???????? OLD NOTATIONS ??????????
* _v: C row or column vector pointer.
* _vint: C row or column vector pointer to integer.
* _m: C matrix pointer.
* _mint: C matrix pointer to integer.
* _m3: C 3-D matrix pointer.
* _ppm: C pointer to pointer to a matrix.
* d_???_ppm: the number of pointers that are pointed to by _ppm.
* rv_???_ppm: a vector (with dimension d_???_ppm) pointer of numbers of rows, each of the numbers coresponding to a pointed matrix.
* cv_???_ppm: a vector (with dimension d_???_ppm) pointer of numbers of columns, each of the numbers coresponding to a pointed matrix.
* d_???_v: dimension size.
* r_???_m: numbers of rows.
* c_???_m: number of columns.
* r_???_m3: number of rows.
* c_???_m3: number of columns.
* t_???_m3: number of a third dimension.
*********/
#ifndef __TZMATLAB__
#define __TZMATLAB__
#define _ISOC99_SOURCE /* Using C99 features for gcc or icc on Linux. Must be placed as the first line above all #include lines. ansi-c*/
#include <stdio.h>
#include <stdlib.h> /* For rand(), size_t, exit, malloc, free, qsort, EXIT_FAILURE. ansi-c*/
#include <memory.h> /* For memcpy, etc. Alternative: string.h ansi-c*/
#include <math.h> /* For isfinite. ansi-c*/
#include <float.h> /* For DBL_MIN, etc. ansi-c*/
#include <time.h> /* For time(), etc. ansi-c*/
#include "modify_for_mex.h"
#define USE_DEBUG_FILE /* When defined, one must use tzFopen to give the file name in the main .c file. ansi-c*/
extern FILE *FPTR_DEBUG; /* For debugging. Applied to all functions and all .c files that call tzmatlab.h. ansi-c*/
/* //Initiated to NULL in tzmatlab.c. ansi-c*/
/* //Must use tzFopen to give the file name in the main .c file. ansi-c*/
extern FILE *FPTR_OPT; /* For recording the optimization intermediate results. ansi-c*/
/* //Applied to minfinder_blockcsminwel() in optpackage.c. ansi-c*/
/* //Initiated to NULL in tzmatlab.c. ansi-c*/
/* //Must use tzFopen to give the file name in the main .c file. ansi-c*/
/*******************************************************************************/
/* Added by DW 9/1/08 */
/*******************************************************************************/
/* //#define USE_IMSL_MATH_LIBRARY ansi-c*/
/* //#define USE_IMSL_STAT_LIBRARY ansi-c*/
#define USE_GSL_LIBRARY
/* //#define USE_MKL_LIBRARY ansi-c*/
/*******************************************************************************/
/* // #define NEWVERSIONofDW_SWITCH //If defined, using DW's new switch program (implemented in 2008), ansi-c*/
/* // which may be incompatible with previous programs, such as ...\SargentWZ2\EstProbModel\EstimationJuly07USED ansi-c*/
/* //If undef, using the old, working switch program for, say, ...\SargentWZ2\EstProbModel\EstimationJuly07USED. ansi-c*/
/* //Files that are affected are: cstz.c, kalman.c, optpackage.c, ansi-c*/
#define SWITCHTOIMSLCMATH /* define: use IMSL special functions like gammlog; undef: use my own default code if it exists. ansi-c*/
/* //-------Only one of the following for math library.-------- ansi-c*/
/* // #define INTELCMATHLIBRARY // define: use Intel MKL LAPACK library; undef: use others. ansi-c*/
/* //#define IMSLCMATHLIBRARY // define: use IMSL C Math library; undef: use others. ansi-c*/
/* //#define MATLABCMATHLIBRARY // define: use Matlab C math library; undef: use others. ansi-c*/
/* //-------Only one of the following for math library.-------- ansi-c*/
#define SWITCHTOINTELCMATH /* define: use Intel MKL LAPACK library; undef: use others. ansi-c*/
/* //#define SWITCHTOTZCMATH // define: use my own C math library; undef: use others. ansi-c*/
/* //-------Only one of the following for optimization routines except that CG?_ and CSMINWEL_ can be chosen together.-------- ansi-c*/
/* //#define IMSL_OPTIMIZATION // IMSL optimization routines. ansi-c*/
#define CSMINWEL_OPTIMIZATION /* Sims's optimization routine. ansi-c*/
#define CGI_OPTIMIZATION /* Polak-Ribiere conjugate gradient method without using derivative information in performing the line minimization. ansi-c*/
/* //NOT available yet! #define CGII_OPTIMIZATION //NOT available yet! Pletcher-Reeves conjugate gradient method using derivative information in performing the line minimization. ansi-c*/
/* //-------Only one of the following for random number generating routines.-------- ansi-c*/
#define IMSL_RANDOMNUMBERGENERATOR /* IMSL random number generator. ansi-c*/
/* //#define CASE2_RANDOMNUMBERGENERATOR //Imported from the C recipe book -- case 2 and my own (Iskander) code for generating a gamma distribution. ansi-c*/
/* //-------Only one of the following statistical packages.-------- ansi-c*/
#define IMSL_STATISTICSTOOLBOX /* IMSL statistical package. ansi-c*/
/*******************************************************************************/
/* Added by DW 9/1/08 */
/*******************************************************************************/
#if defined(USE_MKL_LIBRARY)
#include "mkl.h"
#else
#if defined (USE_GSL_LIBRARY)
#include <gsl/gsl_cblas.h>
#endif
#include "blas_lapack.h"
#undef SWITCHTOINTELCMATH
/* // #undef INTELCMATHLIBRARY ansi-c*/
#endif
#if defined(USE_GSL_LIBRARY)
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_cdf.h>
#endif
#if defined(USE_IMSL_MATH_LIBRARY)
#include <imsl.h> /* IMSL math package. ansi-c*/
#include <imsls.h> /* IMSL statistical package. ansi-c*/
#else
#undef IMSL_OPTIMIZATION
#undef SWITCHTOIMSLCMATH
#undef IMSL_OPTIMIZATION
#undef IMSL_RANDOMNUMBERGENERATOR
#endif
#if defined(USE_IMSL_STAT_LIBRARY)
#include <imsls.h> /* IMSL statistical package. ansi-c*/
#else
#undef IMSL_STATISTICSTOOLBOX
#endif
/*******************************************************************************/
/* //-------If define: use matlab API interface; otherwise (undef), use C console. ansi-c*/
#undef WIN_MATLABAPI /* define: use matlab API interface; undef: use C dos console. ansi-c*/
/* //--------------- ansi-c*/
#ifdef MATLABCMATHLIBRARY
#include "matlab.h" /* For all mlf???? functions. ansi-c*/
#include "matrix.h" /* For mxGetM, mxCreatDoubleMatrix, etc. ansi-c*/
#endif
#ifdef WIN_MATLABAPI /* define: use matlab API interface; undef: use C dos console. ansi-c*/
#include "mex.h" /* For all mex??? calls. Matlab API (application program interface or external interface). ansi-c*/
#define printf mexPrintf
#define malloc mxMalloc
#define calloc mxCalloc
#define free mxFree
#endif
/* //-------------- Attributes for the real double matrix type TSdmatrix. -------------- ansi-c*/
/* //-------------- Whenever a matrix is initialized, the default is M_GE, but nothing else. -------------- ansi-c*/
#define M_UNDEF 0 /* 0 or NULL: No attribute will be given when memory is allocated but no values are initialized. ansi-c*/
#define M_GE 0x0001 /* 1: A general matrix. ansi-c*/
#define M_SU 0x0002 /* 2: A symmetric (must be square) matrix but only the upper triangular part is referenced. ansi-c*/
#define M_SL 0x0004 /* 4: A symmetric (must be square) matrix but only the lower triangular part is referenced. ansi-c*/
#define M_UT 0x0008 /* 8: A upper triangular (trapezoidal if nrows < ncols) matrix but only the upper triangular part is referenced. ansi-c*/
#define M_LT 0x0010 /* 16: A lower triangular (trapezoidal if nrows > ncols) matrix but only the lower triangular part is referenced. ansi-c*/
#define M_CN 0x0020 /* 32: A constant (CN) matrix (All elements are the same or no (N) change from one to another). ansi-c*/
/* // #define M_UTU 0x0040 //2^6: An unit upper triangular matrix. ansi-c*/
/* // #define M_LTU 0x0080 //2^7: An unit lower triangular matrix. ansi-c*/
/* //-------------- Attributes for the real double vector type TSdvector or the character vector type TScvector. -------------- ansi-c*/
#define V_UNDEF 0 /* Zero or NULL: No values have been assigned to the double vector. ansi-c*/
#define V_DEF 1 /* True: Values have been assigned to the double vector. ansi-c*/
/* //-------------- Other macro definitions. -------------- ansi-c*/
#define BLOCKSIZE_FOR_INTEL_MKL 128 /* A machine-dependent value (typically, 16 to 64) required for optimum performance of the blocked algorithm in Intel MKL. ansi-c*/
#define NEARINFINITY 1.0E+300
#define BIGREALNUMBER 1.0E+30
#define MACHINEZERO DBL_MIN
#define EPSILON DBL_EPSILON /* 1.0E-015. In Standard C, DBL_EPSILON = 2.2204460492503131 ansi-c*/
#define SQRTEPSILON 1.490116119384766E-008 /* 1.0E-15. In Standard C, DBL_EPSILON = 2.2204460492503131E-016 ansi-c*/
#define SQRTMACHINEZERO 1.490116119384766E-008
/* //This is really not correct, because this number is sqrt(epsion), where DBL_MIN is around 1.0e-300. ansi-c*/
#define MACHINEINFINITY DBL_MAX
#define MACHINE_EXP_INFINITY DBL_MAX_EXP
#define EXP_NEARINFINITY 1000
/* //=== ansi-c*/
#define TZ_TRUE 1
#define TZ_FALSE 0
/* //--------------- ansi-c*/
#define tzMalloc(elt_count, type) (type *)m_alloc((elt_count)*sizeof(type))
#define tzCalloc(elt_count, type) (type *)c_alloc((elt_count), sizeof(type))
#define tzDestroy(x) {if ((x)) { \
swzFree((x)); \
(x) = NULL; \
}}
#define tzFclose(x) {if ((x)) { \
fclose((x)); \
(x) = (FILE *)NULL; \
}}
#define mos(i, j, nrows) ((j)*(nrows)+(i)) /* i: ith row; j: jth column; nrows: number of rows for the matrix. ansi-c*/
/* //Offset(os) for a matrix(m) in column major order and with base 0. See Reek pp.241-242. ansi-c*/
#define square(x) ((x) * (x)) /* Must be careful to avoid using, say, square(tmpd=2) or square(++x). ansi-c*/
#define _max(a, b) ((a)>(b) ? (a) : (b)) /* Macro max or __max is already defined in stdlib.h in MS visual C++, but mex.h may overwrite the max macro so we use _max. ansi-c*/
#define _min(a, b) ((a)>(b) ? (b) : (a))
#define swap(a, b, stemp) {(stemp)=(a); (a)=(b); (b)=(stemp);}
/* // ansi-c*/
#ifndef isfinite
#define isfinite(x) _finite(x) /* _finite is for Microsoft C++ compiler only (in float.h, which strangely is not ANSI compible), ansi-c*/
/* // All these Microsoft functions are not yet C99 compatible. ansi-c*/
#endif
/* //--- The following does not work. ansi-c*/
/* // #ifndef FP_NAN ansi-c*/
/* // #define FP_NAN _FPCLASS_SNAN //_FPCLASS_SNAN is for Microsoft C++ compiler only (in float.h, which strangely is not ANSI compible), ansi-c*/
/* // // All these Microsoft functions are not yet C99 compatible. ansi-c*/
/* // #endif ansi-c*/
#define isdiagonalmatrix(x) (((x)->flag & (M_UT | M_LT)) == (M_UT | M_LT)) /* x is the tz type of matrix. ansi-c*/
/* // ansi-c*/
#define DestroyDatesVector_lf(x) DestroyVector_lf(x)
/* //--------------- ansi-c*/
typedef struct TScvector_tag
{
char *v; /* v: vector. ansi-c*/
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TScvector;
typedef struct TSvoidvector_tag
{
void *v; /* v: vector. ansi-c*/
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TSvoidvector;
typedef struct {
int *v; /* v: vector. ansi-c*/
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TSivector;
typedef struct {
int *M; /* M: matrix. ansi-c*/
int nrows, ncols;
int flag; /* flag: Refers to M_GE, M_SU, M_SL, M_UT, and M_LT in tzmatlab.h. ansi-c*/
} TSimatrix;
typedef struct {
TSivector **C; /* ncells-by-1 cells (C) and a ponter to vector in each cell. ansi-c*/
int ncells; /* Number of pointers (cells) to pointer. ansi-c*/
} TSicellvec;
typedef struct {
TSimatrix **C; /* ncells-by-1 cells (C) and a ponter to vector in each cell. ansi-c*/
int ncells; /* Number of pointers (cells) to pointer. ansi-c*/
} TSicell;
/* //=== Real types. ansi-c*/
typedef struct {
double *v; /* v: vector. ansi-c*/
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TSdvector;
typedef struct {
double *M; /* M: matrix. ansi-c*/
int nrows, ncols;
int flag; /* flag: Refers to M_GE, M_SU, M_SL, M_UT, and M_LT in tzmatlab.h. ansi-c*/
} TSdmatrix;
typedef struct {
TSdmatrix **C; /* ncells-by-1 cells (C) and a pointer to matrix in each cell. ansi-c*/
int ncells; /* Number of pointers (cells) to pointer. ansi-c*/
} TSdcell;
typedef struct {
TSdvector **C; /* ncells-by-1 cells (C) and a ponter to vector in each cell. ansi-c*/
int ncells; /* Number of pointers (cells) to pointer. ansi-c*/
} TSdcellvec;
typedef struct {
TSdcell **F; /* ndims-by-1 fourths (F) and a pointer to cell in each fourth. ansi-c*/
int ndims; /* Number of pointers (fourth dimensions) to pointer. ansi-c*/
} TSdfourth;
typedef struct {
TSdcellvec **F; /* ndims-by-1 fourths (F) and a pointer to cellvec in each fourth. ansi-c*/
int ndims; /* Number of pointers (fourth dimensions) to pointer. ansi-c*/
} TSdfourthvec;
/* //=== Complex types. ansi-c*/
typedef struct {
TSdvector *real; /* Real part. ansi-c*/
TSdvector *imag; /* Imaginary part. ansi-c*/
} TSdzvector;
typedef struct {
TSdmatrix *real; /* Real part. ansi-c*/
TSdmatrix *imag; /* Imaginary part. ansi-c*/
} TSdzmatrix;
/* //----------------- Some high-level functions. ----------------- ansi-c*/
int fn_locofyearqm(int q_m, int yrstart, int qmstart, int yrend, int qmend);
/* //--------------- ansi-c*/
void fn_DisplayError(char *msg_s);
void *m_alloc(size_t size);
void *c_alloc(size_t elt_count, size_t elt_size);
/**
TSvoidvector *CreateVector_void(int _n);
TSvoidvector *DestroyVector_void(TSvoidvector *x_voidv);
/**/
TScvector *CreateVector_c(int _n);
TScvector *DestroyVector_c(TScvector *x_s);
TSivector *CreateVector_int(int _n);
TSivector *DestroyVector_int(TSivector *x_iv);
TSimatrix *CreateMatrix_int(int nrows, int ncols);
TSimatrix *DestroyMatrix_int(TSimatrix *x_im);
TSicellvec *CreateCellvec_int(TSivector *n_iv);
TSicellvec *DestroyCellvec_int(TSicellvec *x_icv);
TSicell *CreateCell_int(TSivector *row_iv, TSivector *col_iv);
TSicell *DestroyCell_int(TSicell *x_ic);
TSdvector *CreateVector_lf(int _n);
TSdvector *DestroyVector_lf(TSdvector *x_iv);
TSdmatrix *CreateMatrix_lf(int nrows, int ncols);
TSdmatrix *DestroyMatrix_lf(TSdmatrix *x_im);
TSdcell *CreateCell_lf(TSivector *row_iv, TSivector *col_iv);
TSdcell *DestroyCell_lf(TSdcell *x_dc);
TSdcellvec *CreateCellvec_lf(TSivector *n_iv);
TSdcellvec *DestroyCellvec_lf(TSdcellvec *x_dcv);
TSdfourth *CreateFourth_lf(int ndims, TSivector *row_iv, TSivector *col_iv);
TSdfourth *DestroyFourth_lf(TSdfourth *x_d4);
TSdfourthvec *CreateFourthvec_lf(int ndims, TSivector *n_iv);
TSdfourthvec *DestroyFourthvec_lf(TSdfourthvec *x_d4v);
TSdzvector *CreateVector_dz(int _n);
TSdzvector *DestroyVector_dz(TSdzvector *x_dzv);
TSdzmatrix *CreateMatrix_dz(int nrows, int ncols);
TSdzmatrix *DestroyMatrix_dz(TSdzmatrix *x_dzm);
/* //+ ansi-c*/
TSdmatrix *CreateZeroMatrix_lf(const int nrows, const int ncols);
TSdmatrix *CreateIdentityMatrix_lf(const int nrows, const int ncols);
/* //TSdvector *CreateZerosVector_lf(int _n); ansi-c*/
TSivector *CreateConstantVector_int( const int _n, const int _k);
TSimatrix *CreateConstantMatrix_int(const int nrows, const int ncols, const int _n);
TSicellvec *CreateConstantCellvec_int(TSivector *n_iv, const int _n);
TSicell *CreateConstantCell_int(TSivector *row_iv, TSivector *col_iv, const int _n);
TSdvector *CreateConstantVector_lf(const int _n, const double _alpha);
TSdmatrix *CreateConstantMatrix_lf(const int nrows, const int ncols, const double _alpha);
TSdcellvec *CreateConstantCellvec_lf(TSivector *n_iv, const double _alpha);
TSdcell *CreateConstantCell_lf(TSivector *row_iv, TSivector *col_iv, const double _alpha);
TSdvector *CreateDatesVector_lf(int nq_m, int yrstart, int qmstart, int yrend, int qmend);
/* //+ ansi-c*/
void InitializeConstantVector_lf(TSdvector *x_dv, const double _alpha);
void InitializeConstantVector_int(TSivector *x_iv, const int _k);
void InitializeConstantMatrix_lf(TSdmatrix *x_dm, const double _alpha);
void InitializeDiagonalMatrix_lf(TSdmatrix *x_dm, const double _alpha);
void InitializeConstantMatrix_int(TSimatrix *x_dm, const int _alpha);
void InitializeConstantCellvec_lf(TSdcellvec *x_dcv, const double _alpha);
void InitializeConstantCell_lf(TSdcell *x_dc, const double _alpha);
void InitializeConstantFourthvec_lf(TSdfourthvec *x_d4v, const double _alpha);
void InitializeConstantFourth_lf(TSdfourth *x_d4, const double _alpha);
void NegateColofMatrix_lf(TSdvector *y_dv, TSdmatrix *x_dm, int _j);
void InitializeConstantColofMatrix_lf(TSdmatrix *X_dm, int jx, double _alpha);
FILE *tzFopen(char *filename, char *mode);
#endif

360
matlab/ms-sbvar/c-code/utilities/TZCcode/tzmatlab_tao.h
View File

@ -1,360 +0,0 @@
/*********
* _cv: Pointer to TScvector (character vector).
* _iv: Pointer to TSivector (integer vector).
* _im: Pointer to TSimatrix (integer matrix).
* _dv: Pointer to TSdvector (double vector).
* _dm: Pointer to TSdmatrix (double matrix).
* _dc: Pointer to TSdcell (double cell -- pointer to pointer to a matrix).
* _dcv: Pointer to TSdcellvec (double cell -- pointer to pointer to a vector).
* _d4: Pointer to TSdfourth (double fourth dimension -- pointer to pointer to pointer to a matrix).
* _dzv: Pointer to TSdzvector (double complex vector).
* _dzm: Pointer to TSdzmatrix (double complex matrix).
*
* _s: structure variable.
* _ps: pointer to a structure.
* _sv: an array of structures.
*
* _sdv: structure (NOT pointer to structure) that contains TSdvector.
* _sdm: structure (NOT pointer to structure) that contains TSdmatrix.
*
* ???????? OLD NOTATIONS ??????????
* _v: C row or column vector pointer.
* _vint: C row or column vector pointer to integer.
* _m: C matrix pointer.
* _mint: C matrix pointer to integer.
* _m3: C 3-D matrix pointer.
* _ppm: C pointer to pointer to a matrix.
* d_???_ppm: the number of pointers that are pointed to by _ppm.
* rv_???_ppm: a vector (with dimension d_???_ppm) pointer of numbers of rows, each of the numbers coresponding to a pointed matrix.
* cv_???_ppm: a vector (with dimension d_???_ppm) pointer of numbers of columns, each of the numbers coresponding to a pointed matrix.
* d_???_v: dimension size.
* r_???_m: numbers of rows.
* c_???_m: number of columns.
* r_???_m3: number of rows.
* c_???_m3: number of columns.
* t_???_m3: number of a third dimension.
*********/
#ifndef __TZMATLAB__
#define __TZMATLAB__
#define _ISOC99_SOURCE /* Using C99 features for gcc or icc on Linux. Must be placed as the first line above all #include lines. ansi-c*/
#include <stdio.h>
#include <stdlib.h> /* For rand(), size_t, exit, malloc, free, qsort, EXIT_FAILURE. ansi-c*/
#include <memory.h> /* For memcpy, etc. Alternative: string.h ansi-c*/
#include <math.h> /* For isfinite. ansi-c*/
#include <float.h> /* For DBL_MIN, etc. ansi-c*/
#include <time.h> /* For time(), etc. ansi-c*/
#include "modify_for_mex.h"
#define USE_DEBUG_FILE /* When defined, one must use tzFopen to give the file name in the main .c file. ansi-c*/
extern FILE *FPTR_DEBUG; /* For debugging. Applied to all functions and all .c files that call tzmatlab.h. ansi-c*/
/* //Initiated to NULL in tzmatlab.c. ansi-c*/
/* //Must use tzFopen to give the file name in the main .c file. ansi-c*/
extern FILE *FPTR_OPT; /* For recording the optimization intermediate results. ansi-c*/
/* //Applied to minfinder_blockcsminwel() in optpackage.c. ansi-c*/
/* //Initiated to NULL in tzmatlab.c. ansi-c*/
/* //Must use tzFopen to give the file name in the main .c file. ansi-c*/
/*******************************************************************************/
/* Added by DW 9/1/08 */
/*******************************************************************************/
/* //#define USE_IMSL_MATH_LIBRARY ansi-c*/
/* //#define USE_IMSL_STAT_LIBRARY ansi-c*/
#define USE_GSL_LIBRARY
#define USE_MKL_LIBRARY
/*******************************************************************************/
#define NEWVERSIONofDW_SWITCH /* If defined, using DW's new switch program (implemented in 2008), ansi-c*/
/* // which may be incompatible with previous programs, such as ...\SargentWZ2\EstProbModel\EstimationJuly07USED ansi-c*/
/* //If undef, using the old, working switch program for, say, ...\SargentWZ2\EstProbModel\EstimationJuly07USED. ansi-c*/
/* //Files that are affected are: cstz.c, kalman.c, optpackage.c, ansi-c*/
#define SWITCHTOIMSLCMATH /* define: use IMSL special functions like gammlog; undef: use my own default code if it exists. ansi-c*/
/* //-------Only one of the following for math library.-------- ansi-c*/
#define INTELCMATHLIBRARY /* define: use Intel MKL LAPACK library; undef: use others. ansi-c*/
/* //#define IMSLCMATHLIBRARY // define: use IMSL C Math library; undef: use others. ansi-c*/
/* //#define MATLABCMATHLIBRARY // define: use Matlab C math library; undef: use others. ansi-c*/
/* //-------Only one of the following for math library.-------- ansi-c*/
#define SWITCHTOINTELCMATH /* define: use Intel MKL LAPACK library; undef: use others. ansi-c*/
/* //#define SWITCHTOTZCMATH // define: use my own C math library; undef: use others. ansi-c*/
/* //-------Only one of the following for optimization routines except that CG?_ and CSMINWEL_ can be chosen together.-------- ansi-c*/
/* //#define IMSL_OPTIMIZATION // IMSL optimization routines. ansi-c*/
#define CSMINWEL_OPTIMIZATION /* Sims's optimization routine. ansi-c*/
#define CGI_OPTIMIZATION /* Polak-Ribiere conjugate gradient method without using derivative information in performing the line minimization. ansi-c*/
/* //NOT available yet! #define CGII_OPTIMIZATION //NOT available yet! Pletcher-Reeves conjugate gradient method using derivative information in performing the line minimization. ansi-c*/
/* //-------Only one of the following for random number generating routines.-------- ansi-c*/
#define IMSL_RANDOMNUMBERGENERATOR /* IMSL random number generator. ansi-c*/
/* //#define CASE2_RANDOMNUMBERGENERATOR //Imported from the C recipe book -- case 2 and my own (Iskander) code for generating a gamma distribution. ansi-c*/
/* //-------Only one of the following statistical packages.-------- ansi-c*/
#define IMSL_STATISTICSTOOLBOX /* IMSL statistical package. ansi-c*/
/*******************************************************************************/
/* Added by DW 9/1/08 */
/*******************************************************************************/
#if defined(USE_MKL_LIBRARY)
#include "mkl.h"
#else
#include "blas_lapack.h"
#undef SWITCHTOINTELCMATH
#endif
#if defined(USE_GSL_LIBRARY)
#include "gsl_sf_gamma.h"
#include "gsl_cdf.h"
#endif
#if defined(USE_IMSL_MATH_LIBRARY)
#include <imsl.h> /* IMSL math package. ansi-c*/
#include <imsls.h> /* IMSL statistical package. ansi-c*/
#else
#undef IMSL_OPTIMIZATION
#undef SWITCHTOIMSLCMATH
#undef IMSL_OPTIMIZATION
#undef IMSL_RANDOMNUMBERGENERATOR
#endif
#if defined(USE_IMSL_STAT_LIBRARY)
#include <imsls.h> /* IMSL statistical package. ansi-c*/
#else
#undef IMSL_STATISTICSTOOLBOX
#endif
/*******************************************************************************/
/* //-------If define: use matlab API interface; otherwise (undef), use C console. ansi-c*/
#undef WIN_MATLABAPI /* define: use matlab API interface; undef: use C dos console. ansi-c*/
/* //--------------- ansi-c*/
#ifdef MATLABCMATHLIBRARY
#include "matlab.h" /* For all mlf???? functions. ansi-c*/
#include "matrix.h" /* For mxGetM, mxCreatDoubleMatrix, etc. ansi-c*/
#endif
#ifdef WIN_MATLABAPI /* define: use matlab API interface; undef: use C dos console. ansi-c*/
#include "mex.h" /* For all mex??? calls. Matlab API (application program interface or external interface). ansi-c*/
#define printf mexPrintf
#define malloc mxMalloc
#define calloc mxCalloc
#define free mxFree
#endif
/* //-------------- Attributes for the real double matrix type TSdmatrix. -------------- ansi-c*/
/* //-------------- Whenever a matrix is initialized, the default is M_GE, but nothing else. -------------- ansi-c*/
#define M_UNDEF 0 /* 0 or NULL: No attribute will be given when memory is allocated but no values are initialized. ansi-c*/
#define M_GE 0x0001 /* 1: A general matrix. ansi-c*/
#define M_SU 0x0002 /* 2: A symmetric (must be square) matrix but only the upper triangular part is referenced. ansi-c*/
#define M_SL 0x0004 /* 4: A symmetric (must be square) matrix but only the lower triangular part is referenced. ansi-c*/
#define M_UT 0x0008 /* 8: A upper triangular (trapezoidal if nrows < ncols) matrix but only the upper triangular part is referenced. ansi-c*/
#define M_LT 0x0010 /* 16: A lower triangular (trapezoidal if nrows > ncols) matrix but only the lower triangular part is referenced. ansi-c*/
#define M_CN 0x0020 /* 32: A constant (CN) matrix (All elements are the same or no (N) change from one to another). ansi-c*/
/* // #define M_UTU 0x0040 //2^6: An unit upper triangular matrix. ansi-c*/
/* // #define M_LTU 0x0080 //2^7: An unit lower triangular matrix. ansi-c*/
/* //-------------- Attributes for the real double vector type TSdvector or the character vector type TScvector. -------------- ansi-c*/
#define V_UNDEF 0 /* Zero or NULL: No values have been assigned to the double vector. ansi-c*/
#define V_DEF 1 /* True: Values have been assigned to the double vector. ansi-c*/
/* //-------------- Other macro definitions. -------------- ansi-c*/
#define BLOCKSIZE_FOR_INTEL_MKL 128 /* A machine-dependent value (typically, 16 to 64) required for optimum performance of the blocked algorithm in Intel MKL. ansi-c*/
#define NEARINFINITY 1.0E+300
#define BIGREALNUMBER 1.0E+30
#define MACHINEZERO DBL_MIN
#define EPSILON DBL_EPSILON /* 1.0E-015. In Standard C, DBL_EPSILON = 2.2204460492503131 ansi-c*/
#define SQRTEPSILON 1.490116119384766E-008 /* 1.0E-15. In Standard C, DBL_EPSILON = 2.2204460492503131E-016 ansi-c*/
#define SQRTMACHINEZERO 1.490116119384766E-008
/* //This is really not correct, because this number is sqrt(epsion), where DBL_MIN is around 1.0e-300. ansi-c*/
#define MACHINEINFINITY DBL_MAX
#define MACHINE_EXP_INFINITY DBL_MAX_EXP
#define EXP_NEARINFINITY 1000
/* //=== ansi-c*/
#define TZ_TRUE 1
#define TZ_FALSE 0
/* //--------------- ansi-c*/
#define tzMalloc(elt_count, type) (type *)m_alloc((elt_count)*sizeof(type))
#define tzCalloc(elt_count, type) (type *)c_alloc((elt_count), sizeof(type))
#define tzDestroy(x) {if ((x)) { \
swzFree((x)); \
(x) = NULL; \
}}
#define tzFclose(x) {if ((x)) { \
fclose((x)); \
(x) = (FILE *)NULL; \
}}
#define mos(i, j, nrows) ((j)*(nrows)+(i)) /* i: ith row; j: jth column; nrows: number of rows for the matrix. ansi-c*/
/* //Offset(os) for a matrix(m) in column major order and with base 0. See Reek pp.241-242. ansi-c*/
#define square(x) ((x) * (x)) /* Must be careful to avoid using, say, square(tmpd=2) or square(++x). ansi-c*/
#define _max(a, b) ((a)>(b) ? (a) : (b)) /* Macro max or __max is already defined in stdlib.h in MS visual C++, but mex.h may overwrite the max macro so we use _max. ansi-c*/
#define _min(a, b) ((a)>(b) ? (b) : (a))
#define swap(a, b, stemp) {(stemp)=(a); (a)=(b); (b)=(stemp);}
/* // ansi-c*/
#ifndef isfinite
#define isfinite(x) _finite(x) /* _finite is for Microsoft C++ compiler only (in float.h, which strangely is not ANSI compible), ansi-c*/
/* // All these Microsoft functions are not yet C99 compatible. ansi-c*/
#endif
/* //--- The following does not work. ansi-c*/
/* // #ifndef FP_NAN ansi-c*/
/* // #define FP_NAN _FPCLASS_SNAN //_FPCLASS_SNAN is for Microsoft C++ compiler only (in float.h, which strangely is not ANSI compible), ansi-c*/
/* // // All these Microsoft functions are not yet C99 compatible. ansi-c*/
/* // #endif ansi-c*/
#define isdiagonalmatrix(x) (((x)->flag & (M_UT | M_LT)) == (M_UT | M_LT)) /* x is the tz type of matrix. ansi-c*/
/* // ansi-c*/
#define DestroyDatesVector_lf(x) DestroyVector_lf(x)
/* //--------------- ansi-c*/
typedef struct TScvector_tag
{
char *v; /* v: vector. ansi-c*/
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TScvector;
typedef struct TSvoidvector_tag
{
void *v; /* v: vector. ansi-c*/
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TSvoidvector;
typedef struct {
int *v; /* v: vector. ansi-c*/
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TSivector;
typedef struct {
int *M; /* M: matrix. ansi-c*/
int nrows, ncols;
int flag; /* flag: Refers to M_GE, M_SU, M_SL, M_UT, and M_LT in tzmatlab.h. ansi-c*/
} TSimatrix;
typedef struct {
TSivector **C; /* ncells-by-1 cells (C) and a ponter to vector in each cell. ansi-c*/
int ncells; /* Number of pointers (cells) to pointer. ansi-c*/
} TSicellvec;
typedef struct {
TSimatrix **C; /* ncells-by-1 cells (C) and a ponter to vector in each cell. ansi-c*/
int ncells; /* Number of pointers (cells) to pointer. ansi-c*/
} TSicell;
/* //=== Real types. ansi-c*/
typedef struct {
double *v; /* v: vector. ansi-c*/
int n;
int flag; /* flag: no legal values are assigned if 0 and legal values are assigned if 1. ansi-c*/
} TSdvector;
typedef struct {
double *M; /* M: matrix. ansi-c*/
int nrows, ncols;
int flag; /* flag: Refers to M_GE, M_SU, M_SL, M_UT, and M_LT in tzmatlab.h. ansi-c*/
} TSdmatrix;
typedef struct {
TSdmatrix **C; /* ncells-by-1 cells (C) and a pointer to matrix in each cell. ansi-c*/
int ncells; /* Number of pointers (cells) to pointer. ansi-c*/
} TSdcell;
typedef struct {
TSdvector **C; /* ncells-by-1 cells (C) and a ponter to vector in each cell. ansi-c*/
int ncells; /* Number of pointers (cells) to pointer. ansi-c*/
} TSdcellvec;
typedef struct {
TSdcell **F; /* ndims-by-1 fourths (F) and a pointer to cell in each fourth. ansi-c*/
int ndims; /* Number of pointers (fourth dimensions) to pointer. ansi-c*/
} TSdfourth;
typedef struct {
TSdcellvec **F; /* ndims-by-1 fourths (F) and a pointer to cellvec in each fourth. ansi-c*/
int ndims; /* Number of pointers (fourth dimensions) to pointer. ansi-c*/
} TSdfourthvec;
/* //=== Complex types. ansi-c*/
typedef struct {
TSdvector *real; /* Real part. ansi-c*/
TSdvector *imag; /* Imaginary part. ansi-c*/
} TSdzvector;
typedef struct {
TSdmatrix *real; /* Real part. ansi-c*/
TSdmatrix *imag; /* Imaginary part. ansi-c*/
} TSdzmatrix;
/* //----------------- Some high-level functions. ----------------- ansi-c*/
int fn_locofyearqm(int q_m, int yrstart, int qmstart, int yrend, int qmend);
/* //--------------- ansi-c*/
void fn_DisplayError(char *msg_s);
void *m_alloc(size_t size);
void *c_alloc(size_t elt_count, size_t elt_size);
/**
TSvoidvector *CreateVector_void(int _n);
TSvoidvector *DestroyVector_void(TSvoidvector *x_voidv);
/**/
TScvector *CreateVector_c(int _n);
TScvector *DestroyVector_c(TScvector *x_s);
TSivector *CreateVector_int(int _n);
TSivector *DestroyVector_int(TSivector *x_iv);
TSimatrix *CreateMatrix_int(int nrows, int ncols);
TSimatrix *DestroyMatrix_int(TSimatrix *x_im);
TSicellvec *CreateCellvec_int(TSivector *n_iv);
TSicellvec *DestroyCellvec_int(TSicellvec *x_icv);
TSicell *CreateCell_int(TSivector *row_iv, TSivector *col_iv);
TSicell *DestroyCell_int(TSicell *x_ic);
TSdvector *CreateVector_lf(int _n);
TSdvector *DestroyVector_lf(TSdvector *x_iv);
TSdmatrix *CreateMatrix_lf(int nrows, int ncols);
TSdmatrix *DestroyMatrix_lf(TSdmatrix *x_im);
TSdcell *CreateCell_lf(TSivector *row_iv, TSivector *col_iv);
TSdcell *DestroyCell_lf(TSdcell *x_dc);
TSdcellvec *CreateCellvec_lf(TSivector *n_iv);
TSdcellvec *DestroyCellvec_lf(TSdcellvec *x_dcv);
TSdfourth *CreateFourth_lf(int ndims, TSivector *row_iv, TSivector *col_iv);
TSdfourth *DestroyFourth_lf(TSdfourth *x_d4);
TSdfourthvec *CreateFourthvec_lf(int ndims, TSivector *n_iv);
TSdfourthvec *DestroyFourthvec_lf(TSdfourthvec *x_d4v);
TSdzvector *CreateVector_dz(int _n);
TSdzvector *DestroyVector_dz(TSdzvector *x_dzv);
TSdzmatrix *CreateMatrix_dz(int nrows, int ncols);
TSdzmatrix *DestroyMatrix_dz(TSdzmatrix *x_dzm);
/* //+ ansi-c*/
TSdmatrix *CreateZeroMatrix_lf(const int nrows, const int ncols);
TSdmatrix *CreateIdentityMatrix_lf(const int nrows, const int ncols);
/* //TSdvector *CreateZerosVector_lf(int _n); ansi-c*/
TSivector *CreateConstantVector_int( const int _n, const int _k);
TSimatrix *CreateConstantMatrix_int(const int nrows, const int ncols, const int _n);
TSicellvec *CreateConstantCellvec_int(TSivector *n_iv, const int _n);
TSicell *CreateConstantCell_int(TSivector *row_iv, TSivector *col_iv, const int _n);
TSdvector *CreateConstantVector_lf(const int _n, const double _alpha);
TSdmatrix *CreateConstantMatrix_lf(const int nrows, const int ncols, const double _alpha);
TSdcellvec *CreateConstantCellvec_lf(TSivector *n_iv, const double _alpha);
TSdcell *CreateConstantCell_lf(TSivector *row_iv, TSivector *col_iv, const double _alpha);
TSdvector *CreateDatesVector_lf(int nq_m, int yrstart, int qmstart, int yrend, int qmend);
/* //+ ansi-c*/
void InitializeConstantVector_lf(TSdvector *x_dv, const double _alpha);
void InitializeConstantVector_int(TSivector *x_iv, const int _k);
void InitializeConstantMatrix_lf(TSdmatrix *x_dm, const double _alpha);
void InitializeDiagonalMatrix_lf(TSdmatrix *x_dm, const double _alpha);
void InitializeConstantMatrix_int(TSimatrix *x_dm, const int _alpha);
void InitializeConstantCellvec_lf(TSdcellvec *x_dcv, const double _alpha);
void InitializeConstantCell_lf(TSdcell *x_dc, const double _alpha);
void InitializeConstantFourthvec_lf(TSdfourthvec *x_d4v, const double _alpha);
void InitializeConstantFourth_lf(TSdfourth *x_d4, const double _alpha);
void NegateColofMatrix_lf(TSdvector *y_dv, TSdmatrix *x_dm, int _j);
void InitializeConstantColofMatrix_lf(TSdmatrix *X_dm, int jx, double _alpha);
FILE *tzFopen(char *filename, char *mode);
#endif