SWZ: remove out of date code
parent
06fe0c850a
commit
39adf099c3
|
@ -1,6 +0,0 @@
|
|||
sbvar_draws
|
||||
sbvar_init_file
|
||||
sbvar_mhm_1
|
||||
sbvar_mhm_2
|
||||
sbvar_probabilities
|
||||
sbvar_estimation
|
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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].
|
||||
|
||||
|
||||
*/
|
||||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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);
|
|
@ -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);
|
||||
}
|
File diff suppressed because it is too large
Load Diff
|
@ -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.
|
||||
|
||||
********************************************************************************/
|
|
@ -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);
|
||||
}
|
||||
/**/
|
|
@ -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
|
|
@ -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);
|
||||
}
|
||||
/*******************************************************************************/
|
||||
/*******************************************************************************/
|
||||
/*******************************************************************************/
|
|
@ -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
|
|
@ -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;
|
||||
}
|
||||
|
||||
/******************************************************************************/
|
||||
/******************************************************************************/
|
||||
/******************************************************************************/
|
|
@ -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
|
|
@ -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;
|
||||
}
|
|
@ -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;
|
||||
}
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -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); */
|
||||
/* } */
|
||||
/*******************************************************************************/
|
||||
/*******************************************************************************/
|
||||
/*******************************************************************************/
|
||||
|
||||
|
||||
|
|
@ -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
|
|
@ -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;
|
||||
}
|
File diff suppressed because it is too large
Load Diff
|
@ -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);
|
||||
|
||||
}
|
|
@ -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
|
||||
};
|
||||
/*******************************************************************************/
|
||||
/*******************************************************************************/
|
||||
/*******************************************************************************/
|
|
@ -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
|
|
@ -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;
|
||||
}
|
||||
/******************************************************************************/
|
||||
/******************************************************************************/
|
||||
/******************************************************************************/
|
||||
|
||||
|
|
@ -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
|
|
@ -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;
|
||||
}
|
|
@ -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
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -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
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
@ -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
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
@ -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
|
|
@ -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 +0,0 @@
|
|||
#include "bmatrix_blas_lapack.c"
|
|
@ -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
|
||||
|
||||
|
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
@ -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
|
||||
|
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
|
@ -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
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
|
@ -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
|
|
@ -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]));
|
||||
}
|
||||
|
|
@ -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);
|
||||
|
|
@ -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;
|
||||
}
|
||||
|
||||
/******************************************************************************/
|
||||
/******************************************************************************/
|
||||
|
|
@ -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
|
|
@ -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 */
|
||||
/******************************************************************************/
|
||||
/******************************************************************************/
|
||||
/******************************************************************************/
|
|
@ -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
|
|
@ -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(¤time);
|
||||
/* //=== 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(¤time));
|
||||
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
|
|
@ -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
|
|
@ -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(¤time);
|
||||
/* //=== 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(¤time));
|
||||
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
|
||||
|
||||
|
||||
|
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
||||
|
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
||||
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
||||
|
|
@ -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
|
||||
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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.
|
||||
/*************************************************************************/
|
||||
|
|
@ -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);
|
||||
}
|
|
@ -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"
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue