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

K-Order Perturbation: Adding the Core subset of Dynare++ deemed needed for k-ord perturb. and the bare bones of the new interface (not compilable yet) 

git-svn-id: https://www.dynare.org/svn/dynare/dynare_v4@2136 ac1d8469-bf42-47a9-8791-bf33cf982152
time-shift
george 2008-10-06 10:25:09 +00:00
parent f51ba0bd93
commit f70374eb19
149 changed files with 30247 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1368
mex/sources/korderpert/Dyn_pp/extern/include/pthread.h vendored Normal file
View File

File diff suppressed because it is too large Load Diff

178
mex/sources/korderpert/Dyn_pp/extern/include/sched.h vendored Normal file
View File

@ -0,0 +1,178 @@
/*
* Module: sched.h
*
* Purpose:
* Provides an implementation of POSIX realtime extensions
* as defined in
*
* POSIX 1003.1b-1993 (POSIX.1b)
*
* --------------------------------------------------------------------------
*
* Pthreads-win32 - POSIX Threads Library for Win32
* Copyright(C) 1998 John E. Bossom
* Copyright(C) 1999,2005 Pthreads-win32 contributors
*
* Contact Email: rpj@callisto.canberra.edu.au
*
* The current list of contributors is contained
* in the file CONTRIBUTORS included with the source
* code distribution. The list can also be seen at the
* following World Wide Web location:
* http://sources.redhat.com/pthreads-win32/contributors.html
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library in the file COPYING.LIB;
* if not, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
*/
#ifndef _SCHED_H
#define _SCHED_H
#undef PTW32_LEVEL
#if defined(_POSIX_SOURCE)
#define PTW32_LEVEL 0
/* Early POSIX */
#endif
#if defined(_POSIX_C_SOURCE) && _POSIX_C_SOURCE >= 199309
#undef PTW32_LEVEL
#define PTW32_LEVEL 1
/* Include 1b, 1c and 1d */
#endif
#if defined(INCLUDE_NP)
#undef PTW32_LEVEL
#define PTW32_LEVEL 2
/* Include Non-Portable extensions */
#endif
#define PTW32_LEVEL_MAX 3
#if !defined(PTW32_LEVEL)
#define PTW32_LEVEL PTW32_LEVEL_MAX
/* Include everything */
#endif
#if __GNUC__ && ! defined (__declspec)
# error Please upgrade your GNU compiler to one that supports __declspec.
#endif
/*
* When building the DLL code, you should define PTW32_BUILD so that
* the variables/functions are exported correctly. When using the DLL,
* do NOT define PTW32_BUILD, and then the variables/functions will
* be imported correctly.
*/
#ifndef PTW32_STATIC_LIB
# ifdef PTW32_BUILD
# define PTW32_DLLPORT __declspec (dllexport)
# else
# define PTW32_DLLPORT __declspec (dllimport)
# endif
#else
# define PTW32_DLLPORT
#endif
/*
* This is a duplicate of what is in the autoconf config.h,
* which is only used when building the pthread-win32 libraries.
*/
#ifndef PTW32_CONFIG_H
# if defined(WINCE)
# define NEED_ERRNO
# define NEED_SEM
# endif
# if defined(_UWIN) || defined(__MINGW32__)
# define HAVE_MODE_T
# endif
#endif
/*
*
*/
#if PTW32_LEVEL >= PTW32_LEVEL_MAX
#ifdef NEED_ERRNO
#include "need_errno.h"
#else
#include <errno.h>
#endif
#endif /* PTW32_LEVEL >= PTW32_LEVEL_MAX */
#if defined(__MINGW32__) || defined(_UWIN)
#if PTW32_LEVEL >= PTW32_LEVEL_MAX
/* For pid_t */
# include <sys/types.h>
/* Required by Unix 98 */
# include <time.h>
#endif /* PTW32_LEVEL >= PTW32_LEVEL_MAX */
#else
typedef int pid_t;
#endif
/* Thread scheduling policies */
enum {
SCHED_OTHER = 0,
SCHED_FIFO,
SCHED_RR,
SCHED_MIN = SCHED_OTHER,
SCHED_MAX = SCHED_RR
};
struct sched_param {
int sched_priority;
};
#ifdef __cplusplus
extern "C"
{
#endif /* __cplusplus */
PTW32_DLLPORT int __cdecl sched_yield (void);
PTW32_DLLPORT int __cdecl sched_get_priority_min (int policy);
PTW32_DLLPORT int __cdecl sched_get_priority_max (int policy);
PTW32_DLLPORT int __cdecl sched_setscheduler (pid_t pid, int policy);
PTW32_DLLPORT int __cdecl sched_getscheduler (pid_t pid);
/*
* Note that this macro returns ENOTSUP rather than
* ENOSYS as might be expected. However, returning ENOSYS
* should mean that sched_get_priority_{min,max} are
* not implemented as well as sched_rr_get_interval.
* This is not the case, since we just don't support
* round-robin scheduling. Therefore I have chosen to
* return the same value as sched_setscheduler when
* SCHED_RR is passed to it.
*/
#define sched_rr_get_interval(_pid, _interval) \
( errno = ENOTSUP, (int) -1 )
#ifdef __cplusplus
} /* End of extern "C" */
#endif /* __cplusplus */
#undef PTW32_LEVEL
#undef PTW32_LEVEL_MAX
#endif /* !_SCHED_H */

166
mex/sources/korderpert/Dyn_pp/extern/include/semaphore.h vendored Normal file
View File

@ -0,0 +1,166 @@
/*
* Module: semaphore.h
*
* Purpose:
* Semaphores aren't actually part of the PThreads standard.
* They are defined by the POSIX Standard:
*
* POSIX 1003.1b-1993 (POSIX.1b)
*
* --------------------------------------------------------------------------
*
* Pthreads-win32 - POSIX Threads Library for Win32
* Copyright(C) 1998 John E. Bossom
* Copyright(C) 1999,2005 Pthreads-win32 contributors
*
* Contact Email: rpj@callisto.canberra.edu.au
*
* The current list of contributors is contained
* in the file CONTRIBUTORS included with the source
* code distribution. The list can also be seen at the
* following World Wide Web location:
* http://sources.redhat.com/pthreads-win32/contributors.html
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library in the file COPYING.LIB;
* if not, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
*/
#if !defined( SEMAPHORE_H )
#define SEMAPHORE_H
#undef PTW32_LEVEL
#if defined(_POSIX_SOURCE)
#define PTW32_LEVEL 0
/* Early POSIX */
#endif
#if defined(_POSIX_C_SOURCE) && _POSIX_C_SOURCE >= 199309
#undef PTW32_LEVEL
#define PTW32_LEVEL 1
/* Include 1b, 1c and 1d */
#endif
#if defined(INCLUDE_NP)
#undef PTW32_LEVEL
#define PTW32_LEVEL 2
/* Include Non-Portable extensions */
#endif
#define PTW32_LEVEL_MAX 3
#if !defined(PTW32_LEVEL)
#define PTW32_LEVEL PTW32_LEVEL_MAX
/* Include everything */
#endif
#if __GNUC__ && ! defined (__declspec)
# error Please upgrade your GNU compiler to one that supports __declspec.
#endif
/*
* When building the DLL code, you should define PTW32_BUILD so that
* the variables/functions are exported correctly. When using the DLL,
* do NOT define PTW32_BUILD, and then the variables/functions will
* be imported correctly.
*/
#ifndef PTW32_STATIC_LIB
# ifdef PTW32_BUILD
# define PTW32_DLLPORT __declspec (dllexport)
# else
# define PTW32_DLLPORT __declspec (dllimport)
# endif
#else
# define PTW32_DLLPORT
#endif
/*
* This is a duplicate of what is in the autoconf config.h,
* which is only used when building the pthread-win32 libraries.
*/
#ifndef PTW32_CONFIG_H
# if defined(WINCE)
# define NEED_ERRNO
# define NEED_SEM
# endif
# if defined(_UWIN) || defined(__MINGW32__)
# define HAVE_MODE_T
# endif
#endif
/*
*
*/
#if PTW32_LEVEL >= PTW32_LEVEL_MAX
#ifdef NEED_ERRNO
#include "need_errno.h"
#else
#include <errno.h>
#endif
#endif /* PTW32_LEVEL >= PTW32_LEVEL_MAX */
#define _POSIX_SEMAPHORES
#ifdef __cplusplus
extern "C"
{
#endif /* __cplusplus */
#ifndef HAVE_MODE_T
typedef unsigned int mode_t;
#endif
typedef struct sem_t_ * sem_t;
PTW32_DLLPORT int __cdecl sem_init (sem_t * sem,
int pshared,
unsigned int value);
PTW32_DLLPORT int __cdecl sem_destroy (sem_t * sem);
PTW32_DLLPORT int __cdecl sem_trywait (sem_t * sem);
PTW32_DLLPORT int __cdecl sem_wait (sem_t * sem);
PTW32_DLLPORT int __cdecl sem_timedwait (sem_t * sem,
const struct timespec * abstime);
PTW32_DLLPORT int __cdecl sem_post (sem_t * sem);
PTW32_DLLPORT int __cdecl sem_post_multiple (sem_t * sem,
int count);
PTW32_DLLPORT int __cdecl sem_open (const char * name,
int oflag,
mode_t mode,
unsigned int value);
PTW32_DLLPORT int __cdecl sem_close (sem_t * sem);
PTW32_DLLPORT int __cdecl sem_unlink (const char * name);
PTW32_DLLPORT int __cdecl sem_getvalue (sem_t * sem,
int * sval);
#ifdef __cplusplus
} /* End of extern "C" */
#endif /* __cplusplus */
#undef PTW32_LEVEL
#undef PTW32_LEVEL_MAX
#endif /* !SEMAPHORE_H */

129
mex/sources/korderpert/Dyn_pp/extern/matlab/Makefile vendored Normal file
View File

@ -0,0 +1,129 @@
CC = gcc
CC_FLAGS = -Wall -I../../sylv/cc -I../../tl/cc -I../../kord -I../../integ/cc \
$(CC_INCLUDE_PATH)
LDFLAGS = -llapack -lcblas -lf77blas -latlas -lg2c -lstdc++
ifeq ($(DEBUG),yes)
CC_FLAGS := $(CC_FLAGS) -g -DTL_DEBUG=2
else
CC_FLAGS := $(CC_FLAGS) -O3 -DPOSIX_THREADS
endif
ifeq ($(OS),Windows_NT)
CC_FLAGS := -mno-cygwin -mthreads $(CC_FLAGS)
LDFLAGS := -mno-cygwin -mthreads $(LDFLAGS) -lpthreadGC2
ARCH := w32
MEX_SUFFIX = dll
else
LDFLAGS := $(LDFLAGS) -lpthread
ARCH := linux
MEX_SUFFIX = mexglx
endif
sylvcppsource := $(wildcard ../../sylv/cc/*.cpp)
sylvhsource := $(wildcard ../../sylv/cc/*.h)
sylvobjects := $(patsubst %.cpp, %.o, $(sylvcppsource))
tlcwebsource := $(wildcard ../../tl/cc/*.cweb)
tlcppsource := $(patsubst %.cweb,%.cpp,$(tlcwebsource))
tlhwebsource := $(wildcard ../../tl/cc/*.hweb)
tlhsource := $(patsubst %.hweb,%.h,$(tlhwebsource))
tlobjects := $(patsubst %.cweb,%.o,$(tlcwebsource))
kordcwebsource := $(wildcard ../../kord/*.cweb)
kordcppsource := $(patsubst %.cweb,%.cpp,$(kordcwebsource))
kordhwebsource := $(wildcard ../../kord/*.hweb)
kordhsource := $(patsubst %.hweb,%.h,$(kordhwebsource))
kordobjects := $(patsubst %.cweb,%.o,$(kordcwebsource))
integcwebsource := $(wildcard ../../integ/cc/*.cweb)
integcppsource := $(patsubst %.cweb,%.cpp,$(integcwebsource))
integhwebsource := $(wildcard ../../integ/cc/*.hweb)
integhsource := $(patsubst %.hweb,%.h,$(integhwebsource))
integobjects := $(patsubst %.cweb,%.o,$(integcwebsource))
cppsource := $(wildcard *.cpp)
mexobjects := $(patsubst %.cpp,%_.$(MEX_SUFFIX),$(cppsource))
all: $(mexobjects)
../../tl/cc/dummy.ch:
make -C ../../tl/cc dummy.ch
../../tl/cc/%.cpp: ../../tl/cc/%.cweb ../../tl/cc/dummy.ch
make -C ../../tl/cc $*.cpp
../../tl/cc/%.h: ../../tl/cc/%.hweb ../../tl/cc/dummy.ch
make -C ../../tl/cc $*.h
../../tl/cc/%.o: ../../tl/cc/%.cpp $(tlhsource)
make -C ../../tl/cc $*.o
../../integ/cc/dummy.ch:
make -C ../../integ/cc dummy.ch
../../integ/cc/%.cpp: ../../integ/cc/%.cweb ../../integ/cc/dummy.ch
make -C ../../integ/cc $*.cpp
../../integ/cc/%.h: ../../integ/cc/%.hweb ../../integ/cc/dummy.ch
make -C ../../integ/cc $*.h
../../integ/cc/%.o: ../../integ/cc/%.cpp $(integhsource) $(tlhsource)
make -C ../../integ/cc $*.o
../../sylv/cc/%.o: ../../sylv/cc/%.cpp $(sylvhsource)
make -C ../../sylv/cc $*.o
../../kord/dummy.ch:
make -C ../../kord dummy.ch
../../kord/%.cpp: ../../kord/%.cweb ../../kord/dummy.ch
make -C ../../kord $*.cpp
../../kord/%.h: ../../kord/%.hweb ../../kord/dummy.ch
make -C ../../kord $*.h
../../kord/%.o: ../../kord/%.cpp $(tlhsource) $(kordhsource) $(integhsource)
make -C ../../kord $*.o
dynarelib.a: $(tlhwebsource) $(tlcwebsoure) $(tlhsource) $(tlcppsource) \
$(integhwebsource) $(integcwebsoure) $(integhsource) $(integcppsource) \
$(kordhwebsource) $(kordcwebsoure) $(kordhsource) $(kordcppsource) \
$(sylvhsource) $(sylvcppsource) \
$(kordobjects) $(tlobjects) $(integobjects) $(sylvobjects)
ar cr dynarelib.a $(kordobjects) $(tlobjects) $(integobjects) $(sylvobjects)
ranlib dynarelib.a
# to compile mex objects for Windows do:
# 1. install gnumex
# 2. create mexopts.bat via gnumex in this directory, specify MinGW compilation, and dll output
# 3. change -Ic:/MATLAB71/extern/include according your Matlab setup
# 4. pray it works
# OR: just use the mexopt.bat from the repository and check MATLAB root directory
%_.$(MEX_SUFFIX): %.cpp $(tlhwebsource) $(tlcwebsoure) $(tlhsource) $(tlcppsource) \
$(integhwebsource) $(integcwebsoure) $(integhsource) $(integcppsource) \
$(kordhwebsource) $(kordcwebsoure) $(kordhsource) $(kordcppsource) \
$(sylvhsource) $(sylvcppsource) \
dynarelib.a
ifeq ($(OS),Windows_NT)
mex.bat -I../../sylv/cc -I../../tl/cc -I../../kord -I../../integ/cc COMPFLAGS\#"-c -DMATLAB_MEX_FILE -DPOSIX_THREADS" OPTIMFLAGS\#"-O3 -fexceptions -Ic:/MATLAB71/extern/include" GM_ADD_LIBS\#"$(LDFLAGS)" $*.cpp dynarelib.a
else
mex -I../../sylv/cc/ -I../../tl/cc -I../../kord -I../../integ/cc $*.cpp CFLAGS='$$CFLAGS -fexceptions' dynarelib.a
endif
mv $*.$(MEX_SUFFIX) $*_.$(MEX_SUFFIX)
clear:
rm -f dynarelib.a
rm -f *.mexglx
rm -f *.dll
make -C ../../tl/testing clear
make -C ../../tl/cc clear
make -C ../../integ/testing clear
make -C ../../integ/cc clear
make -C ../../sylv/testing clear
make -C ../../sylv/cc clear
make -C ../../kord clear

133
mex/sources/korderpert/Dyn_pp/extern/matlab/dynare_simul.cpp vendored Normal file
View File

@ -0,0 +1,133 @@
// $Id: dynare_simul.cpp 1488 2007-12-19 14:16:30Z kamenik $
// Copyright 2005, Ondra Kamenik
// This is the mexFunction providing interface to
// DecisionRule<>::simulate(). It takes the following input
// parameters:
// order the order of approximation, needs order+1 derivatives
// nstat
// npred
// nboth
// nforw
// nexog
// ystart starting value (full vector of endogenous)
// shocks matrix of shocks (nexog x number of period)
// vcov covariance matrix of shocks (nexog x nexog)
// seed integer seed
// ysteady full vector of decision rule's steady
// ... order+1 matrices of derivatives
// output:
// res simulated results
#include "mex.h"
#include "decision_rule.h"
#include "fs_tensor.h"
#include "SylvException.h"
extern "C" {
void mexFunction(int nhls, mxArray* plhs[],
int nhrs, const mxArray* prhs[])
{
if (nhrs < 12)
mexErrMsgTxt("Must have at least 12 input parameters.\n");
if (nhls != 1)
mexErrMsgTxt("Must have exactly 1 output parameter.\n");
int order = (int)mxGetScalar(prhs[0]);
if (nhrs != 12 + order) {
mexErrMsgTxt("Must have exactly 11+order input parameters.\n");
return;
}
int nstat = (int)mxGetScalar(prhs[1]);
int npred = (int)mxGetScalar(prhs[2]);
int nboth = (int)mxGetScalar(prhs[3]);
int nforw = (int)mxGetScalar(prhs[4]);
int nexog = (int)mxGetScalar(prhs[5]);
const mxArray* const ystart = prhs[6];
const mxArray* const shocks = prhs[7];
const mxArray* const vcov = prhs[8];
int seed = (int)mxGetScalar(prhs[9]);
const mxArray* const ysteady = prhs[10];
const int* const ystart_dim = mxGetDimensions(ystart);
const int* const shocks_dim = mxGetDimensions(shocks);
const int* const vcov_dim = mxGetDimensions(vcov);
const int* const ysteady_dim = mxGetDimensions(ysteady);
int ny = nstat + npred + nboth + nforw;
if (ny != ystart_dim[0])
mexErrMsgTxt("ystart has wrong number of rows.\n");
if (1 != ystart_dim[1])
mexErrMsgTxt("ystart has wrong number of cols.\n");
int nper = shocks_dim[1];
if (nexog != shocks_dim[0])
mexErrMsgTxt("shocks has a wrong number of rows.\n");
if (nexog != vcov_dim[0])
mexErrMsgTxt("vcov has a wrong number of rows.\n");
if (nexog != vcov_dim[1])
mexErrMsgTxt("vcov has a wrong number of cols.\n");
if (ny != ysteady_dim[0])
mexErrMsgTxt("ysteady has wrong number of rows.\n");
if (1 != ysteady_dim[1])
mexErrMsgTxt("ysteady has wrong number of cols.\n");
mxArray* res = mxCreateDoubleMatrix(ny, nper, mxREAL);
try {
// initialize tensor library
tls.init(order, npred+nboth+nexog);
// form the polynomial
UTensorPolynomial pol(ny, npred+nboth+nexog);
for (int dim = 0; dim <= order; dim++) {
const mxArray* gk = prhs[11+dim];
const int* const gk_dim = mxGetDimensions(gk);
FFSTensor ft(ny, npred+nboth+nexog, dim);
if (ft.ncols() != gk_dim[1]) {
char buf[1000];
sprintf(buf, "Wrong number of columns for folded tensor: got %d but I want %d\n",
gk_dim[1], ft.ncols());
mexErrMsgTxt(buf);
}
if (ft.nrows() != gk_dim[0]) {
char buf[1000];
sprintf(buf, "Wrong number of rows for folded tensor: got %d but I want %d\n",
gk_dim[0], ft.nrows());
mexErrMsgTxt(buf);
}
ft.zeros();
ConstTwoDMatrix gk_mat(ft.nrows(), ft.ncols(), mxGetPr(gk));
ft.add(1.0, gk_mat);
UFSTensor* ut = new UFSTensor(ft);
pol.insert(ut);
}
// form the decision rule
UnfoldDecisionRule
dr(pol, PartitionY(nstat, npred, nboth, nforw),
nexog, ConstVector(mxGetPr(ysteady), ny));
// form the shock realization
TwoDMatrix shocks_mat(nexog, nper, (const double*)mxGetPr(shocks));
TwoDMatrix vcov_mat(nexog, nexog, (const double*)mxGetPr(vcov));
GenShockRealization sr(vcov_mat, shocks_mat, seed);
// simulate and copy the results
Vector ystart_vec((const double*)mxGetPr(ystart), ny);
TwoDMatrix* res_mat =
dr.simulate(DecisionRule::horner, nper,
ystart_vec, sr);
TwoDMatrix res_tmp_mat(ny, nper, mxGetPr(res));
res_tmp_mat = (const TwoDMatrix&)(*res_mat);
delete res_mat;
plhs[0] = res;
} catch (const KordException& e) {
mexErrMsgTxt("Caugth Kord exception.");
} catch (const TLException& e) {
mexErrMsgTxt("Caugth TL exception.");
} catch (SylvException& e) {
mexErrMsgTxt("Caught Sylv exception.");
}
}
};

160
mex/sources/korderpert/Dyn_pp/extern/matlab/dynare_simul.m vendored Normal file
View File

@ -0,0 +1,160 @@
%
% SYNOPSIS
%
% r = dynare_simul(name, shocks)
% r = dynare_simul(name, prefix, shocks)
% r = dynare_simul(name, shocks, start)
% r = dynare_simul(name, prefix, shocks, start)
%
% name name of MAT-file produced by dynare++
% prefix prefix of variables in the MAT-file
% shocks matrix of shocks
% start zero period value
%
% SEMANTICS
%
% The command reads a decision rule from the MAT-file having the given
% prefix. Then it starts simulating the decision rule with zero time value
% equal to the given start. It uses the given shocks for the simulation. If
% the start is not given, the state about which the decision rule is
% centralized is taken (called fix point, or stochastic steady state, take
% your pick).
%
% prefix Use the prefix with which you called dynare++, the default
% prefix in dynare++ is 'dyn'.
% shocks Number of rows must be a number of exogenous shocks,
% number of columns gives the number of simulated
% periods. NaNs and Infs in the matrix are substitued by
% draws from the normal distribution using the covariance
% matrix given in the model file.
% start Vector of endogenous variables in the ordering given by
% <prefix>_vars.
%
% Seed for random generator is derived from calling rand(1,1). Therefore,
% seeding can be controlled with rand('state') and rand('state',some_seed).
%
% EXAMPLES
%
% All examples suppose that the prefix is 'dyn' and that your_model.mat
% has been loaded into Matlab.
%
% 1. response to permanent negative shock to the third exo var EPS3 for
% 100 periods
%
% shocks = zeros(4,100); % 4 exogenous variables in the model
% shocks(dyn_i_EPS3,:) = -0.1; % the permanent shock to EPS3
% r = dynare_simul('your_model.mat',shocks);
%
% 2. one stochastic simulation for 100 periods
%
% shocks = zeros(4,100)./0; % put NaNs everywhere
% r = dynare_simul('your_model.mat',shocks);
%
% 3. one stochastic simulation starting at 75% undercapitalized economy
%
% shocks = zeros(4,100)./0; % put NaNs everywhere
% ystart = dyn_ss; % get copy of DR fix point
% ystart(dyn_i_K) = 0.75*dyn_ss(dyn_i_K); % scale down the capital
% r = dynare_simul('your_model.mat',shocks,ystart);
%
%
% SEE ALSO
%
% "DSGE Models with Dynare++. A Tutorial.", Ondra Kamenik, 2005
function r = dynare_simul(varargin)
% get the file name and load data
fname = varargin{1};
eval(['load ' fname]);
% set prefix, shocks, ystart
if ischar(varargin{2})
prefix = varargin{2};
if length(varargin) == 3
shocks = varargin{3};
ystart = NaN;
elseif length(varargin) == 4
shocks = varargin{3};
ystart = varargin{4};
else
error('Wrong number of parameters.');
end
else
prefix = 'dyn';
if length(varargin) == 2
shocks = varargin{2};
ystart = NaN;
elseif length(varargin) == 3
shocks = varargin{2};
ystart = varargin{3};
else
error('Wrong number of parameters.');
end
end
% load all needed variables but prefix_g_*
if (exist([prefix '_nstat']))
nstat = eval([prefix '_nstat']);
else
error(['Could not find variable ' prefix '_nstat in workspace']);
end
if (exist([prefix '_npred']))
npred = eval([prefix '_npred']);
else
error(['Could not find variable ' prefix '_npred in workspace']);
end
if (exist([prefix '_nboth']))
nboth = eval([prefix '_nboth']);
else
error(['Could not find variable ' prefix '_nboth in workspace']);
end
if (exist([prefix '_nforw']))
nforw = eval([prefix '_nforw']);
else
error(['Could not find variable ' prefix '_nforw in workspace']);
end
if (exist([prefix '_ss']))
ss = eval([prefix '_ss']);
else
error(['Could not find variable ' prefix '_ss in workspace']);
end
if (exist([prefix '_vcov_exo']))
vcov_exo = eval([prefix '_vcov_exo']);
else
error(['Could not find variable ' prefix '_vcov_exo in workspace']);
end
nexog = size(vcov_exo,1);
if isnan(ystart)
ystart = ss;
end
% newer version of dynare++ doesn't return prefix_g_0, we make it here if
% it does not exist in workspace
g_zero = [prefix '_g_0'];
if (~ exist(g_zero))
eval([ g_zero '= zeros(nstat+npred+nboth+nforw,1);']);
end
% make derstr a string of comma seperated existing prefix_g_*
derstr = [',' g_zero];
order = 1;
cont = 1;
while cont == 1
g_ord = [prefix '_g_' num2str(order)];
if (exist(g_ord))
derstr = [derstr ',' g_ord];
order = order + 1;
else
cont = 0;
end
end
% set seed
seed = ceil(10000*rand(1,1));
% call dynare_simul_
command = ['r=dynare_simul_(' num2str(order-1) ',nstat,npred,nboth,nforw,' ...
'nexog,ystart,shocks,vcov_exo,seed,ss' derstr ');'];
eval(command);

BIN
mex/sources/korderpert/Dyn_pp/extern/matlab/dynarelib.a vendored Normal file
View File

Binary file not shown.

58
mex/sources/korderpert/Dyn_pp/extern/matlab/mexopts.bat vendored Normal file
View File

@ -0,0 +1,58 @@
@echo off
rem C:\ondra\tmp\dynare++\extern\matlab\mexopts.bat
rem Generated by gnumex.m script in c:\fs\gnumex-1.11
rem gnumex version: 1.11
rem Compile and link options used for building MEX etc files with
rem the Mingw/Cygwin tools. Options here are:
rem Mingw linking
rem Mex (*.dll) creation
rem Safe linking to temporary libraries
rem Language: C / C++
rem Compiling for pentium and above
rem Matlab version 7
rem
set MATLAB=C:\MATLAB71
set GM_PERLPATH=C:\MATLAB71\sys\perl\win32\bin\perl.exe
set GM_UTIL_PATH=c:\fs\gnumex-1.11
set PATH=c:\fs\mingw\bin;%PATH%
rem
rem Added libraries for linking
set GM_ADD_LIBS=
rem
rem Type of file to compile (mex or engine)
set GM_MEXTYPE=mex
rem
rem Language for compilation
set GM_MEXLANG=c
rem
rem def files to be converted to libs
set GM_DEFS2LINK=libmx.def;libmex.def;libmat.def;
rem
rem dlltool command line
set GM_DLLTOOL=dlltool
rem
rem compiler options; add compiler flags to compflags as desired
set NAME_OBJECT=-o
set COMPILER=gcc
set COMPFLAGS=-c -DMATLAB_MEX_FILE
set OPTIMFLAGS=-O3 -malign-double -fno-exceptions -mcpu=pentium
set DEBUGFLAGS=-g
set CPPCOMPFLAGS=%COMPFLAGS% -x c++
set CPPOPTIMFLAGS=%OPTIMFLAGS%
set CPPDEBUGFLAGS=%DEBUGFLAGS%
rem
rem NB Library creation commands occur in linker scripts
rem
rem Linker parameters
set LINKER=%GM_PERLPATH% %GM_UTIL_PATH%\linkmex.pl
set LINKFLAGS=
set CPPLINKFLAGS=GM_ISCPP
set LINKOPTIMFLAGS=-s
set LINKDEBUGFLAGS=-g -Wl,--image-base,0x28000000\n
set LINK_FILE=
set LINK_LIB=
set NAME_OUTPUT=-o %OUTDIR%%MEX_NAME%.dll
rem
rem Resource compiler parameters
set RC_COMPILER=%GM_PERLPATH% %GM_UTIL_PATH%\rccompile.pl -o %OUTDIR%mexversion.res
set RC_LINKER=

360
mex/sources/korderpert/Dyn_pp/kord/Copy of journal.cpp Normal file
View File

@ -0,0 +1,360 @@
#define _W32_FT_OFFSET (116444736000000000LL)
/*1:*/
#line 6 "./journal.cweb"
#include "journal.h"
#include "kord_exception.h"
#ifndef __MINGW32__
# include <sys/resource.h>
# include <sys/utsname.h>
#endif
#include <stdlib.h>
#include <unistd.h>
#include <time.h>
SystemResources _sysres;
#ifdef __MINGW32__
/*16:*/
#line 249 "./journal.cweb"
typedef struct _filetime{
unsigned long dwLowDateTime;
unsigned long dwHighDateTime;
}filetime;
extern"C"{
void __stdcall GetSystemTimeAsFileTime(filetime*);
};
typedef union{
long long ns100;
filetime ft;
}w32_ftv;
void gettimeofday(struct timeval*p,struct timezone*tz)
{
w32_ftv _now;
GetSystemTimeAsFileTime(&(_now.ft));
p->tv_usec= (long)((_now.ns100/10LL)%1000000LL);
p->tv_sec= (long)((_now.ns100-_W32_FT_OFFSET)/10000000LL);
return;
}
/*:16*/
#line 20 "./journal.cweb"
;
/*17:*/
#line 282 "./journal.cweb"
#define _SC_PAGESIZE 1
#define _SC_PHYS_PAGES 2
#define _SC_AVPHYS_PAGES 3
#define _SC_NPROCESSORS_ONLN 4
struct Win32MemoryStatus{
unsigned long dwLength;
unsigned long dwMemoryLoad;
unsigned int dwTotalPhys;
unsigned int dwAvailPhys;
unsigned int dwTotalPageFile;
unsigned int dwAvailPageFile;
unsigned int dwTotalVirtual;
unsigned int dwAvailVirtual;
Win32MemoryStatus();
};
extern"C"{
void __stdcall GlobalMemoryStatus(Win32MemoryStatus*);
};
Win32MemoryStatus::Win32MemoryStatus()
{
dwLength= sizeof(Win32MemoryStatus);
GlobalMemoryStatus(this);
}
long sysconf(int name)
{
switch(name){
case _SC_PAGESIZE:
return 1024;
case _SC_PHYS_PAGES:
{
Win32MemoryStatus memstat;
return memstat.dwTotalPhys/1024;
}
case _SC_AVPHYS_PAGES:
{
Win32MemoryStatus memstat;
return memstat.dwAvailPhys/1024;
}
case _SC_NPROCESSORS_ONLN:
return-1;
default:
KORD_RAISE("Not implemented in Win32 sysconf.");
return-1;
}
}
/*:17*/
#line 21 "./journal.cweb"
;
#endif
/*2:*/
#line 40 "./journal.cweb"
SystemResources::SystemResources()
{
gettimeofday(&start,NULL);
}
/*:2*/
#line 24 "./journal.cweb"
;
/*3:*/
#line 48 "./journal.cweb"
long int SystemResources::pageSize()
{
return sysconf(_SC_PAGESIZE);
}
/*:3*/
#line 25 "./journal.cweb"
;
/*4:*/
#line 55 "./journal.cweb"
long int SystemResources::physicalPages()
{
return sysconf(_SC_PHYS_PAGES);
}
/*:4*/
#line 26 "./journal.cweb"
;
/*5:*/
#line 62 "./journal.cweb"
long int SystemResources::onlineProcessors()
{
return sysconf(_SC_NPROCESSORS_ONLN);
}
/*:5*/
#line 27 "./journal.cweb"
;
/*6:*/
#line 69 "./journal.cweb"
long int SystemResources::availableMemory()
{
return pageSize()*sysconf(_SC_AVPHYS_PAGES);
}
/*:6*/
#line 28 "./journal.cweb"
;
/*7:*/
#line 78 "./journal.cweb"
void SystemResources::getRUS(double&load_avg,long int&pg_avail,
double&utime,double&stime,double&elapsed,
long int&idrss,long int&majflt)
{
struct timeval now;
gettimeofday(&now,NULL);
elapsed= now.tv_sec-start.tv_sec+(now.tv_usec-start.tv_usec)*1.0e-6;
#ifndef __MINGW32__
struct rusage rus;
getrusage(RUSAGE_SELF,&rus);
utime= rus.ru_utime.tv_sec+rus.ru_utime.tv_usec*1.0e-6;
stime= rus.ru_stime.tv_sec+rus.ru_stime.tv_usec*1.0e-6;
idrss= rus.ru_idrss;
majflt= rus.ru_majflt;
getloadavg(&load_avg,1);
#else
utime= -1.0;
stime= -1.0;
idrss= -1;
majflt= -1;
load_avg= -1.0;
#endif
pg_avail= sysconf(_SC_AVPHYS_PAGES);
}
/*:7*/
#line 29 "./journal.cweb"
;
/*8:*/
#line 107 "./journal.cweb"
SystemResourcesFlash::SystemResourcesFlash()
{
_sysres.getRUS(load_avg,pg_avail,utime,stime,
elapsed,idrss,majflt);
}
/*:8*/
#line 30 "./journal.cweb"
;
/*9:*/
#line 115 "./journal.cweb"
void SystemResourcesFlash::diff(const SystemResourcesFlash&pre)
{
utime-= pre.utime;
stime-= pre.stime;
elapsed-= pre.elapsed;
idrss-= pre.idrss;
majflt-= pre.majflt;
}
/*:9*/
#line 31 "./journal.cweb"
;
/*10:*/
#line 126 "./journal.cweb"
JournalRecord&JournalRecord::operator<<(const IntSequence&s)
{
operator<<("[");
for(int i= 0;i<s.size();i++){
operator<<(s[i]);
if(i<s.size()-1)
operator<<(",");
}
operator<<("]");
return*this;
}
/*:10*/
#line 32 "./journal.cweb"
;
/*11:*/
#line 140 "./journal.cweb"
void JournalRecord::writePrefix(const SystemResourcesFlash&f)
{
for(int i= 0;i<MAXLEN;i++)
prefix[i]= ' ';
double mb= 1024*1024;
sprintf(prefix,"%07.6g",f.elapsed);
sprintf(prefix+7,":%c%05d",recChar,ord);
sprintf(prefix+14,":%1.1f",f.load_avg);
sprintf(prefix+18,":%05.4g",f.pg_avail*_sysres.pageSize()/mb);
sprintf(prefix+24,"%s",": : ");
for(int i= 0;i<2*journal.getDepth();i++)
prefix[i+33]= ' ';
prefix[2*journal.getDepth()+33]= '\0';
}
/*:11*/
#line 33 "./journal.cweb"
;
/*12:*/
#line 157 "./journal.cweb"
void JournalRecordPair::writePrefixForEnd(const SystemResourcesFlash&f)
{
for(int i= 0;i<MAXLEN;i++)
prefix_end[i]= ' ';
double mb= 1024*1024;
SystemResourcesFlash difnow;
difnow.diff(f);
sprintf(prefix_end,"%07.6g",f.elapsed+difnow.elapsed);
sprintf(prefix_end+7,":E%05d",ord);
sprintf(prefix_end+14,":%1.1f",difnow.load_avg);
sprintf(prefix_end+18,":%05.4g",difnow.pg_avail*_sysres.pageSize()/mb);
sprintf(prefix_end+24,":%06.5g",difnow.majflt*_sysres.pageSize()/mb);
sprintf(prefix_end+31,"%s",": ");
for(int i= 0;i<2*journal.getDepth();i++)
prefix_end[i+33]= ' ';
prefix_end[2*journal.getDepth()+33]= '\0';
}
/*:12*/
#line 34 "./journal.cweb"
;
/*13:*/
#line 177 "./journal.cweb"
JournalRecordPair::~JournalRecordPair()
{
journal.decrementDepth();
writePrefixForEnd(flash);
journal<<prefix_end;
journal<<mes;
journal<<endl;
journal.flush();
}
/*:13*/
#line 35 "./journal.cweb"
;
/*14:*/
#line 189 "./journal.cweb"
JournalRecord&endrec(JournalRecord&rec)
{
rec.journal<<rec.prefix;
rec.journal<<rec.mes;
rec.journal<<endl;
rec.journal.flush();
rec.journal.incrementOrd();
return rec;
}
/*:14*/
#line 36 "./journal.cweb"
;
/*15:*/
#line 201 "./journal.cweb"
void Journal::printHeader()
{
(*this)<<"This is Dynare++, Copyright (C) 2004,2005 Michel Juillard, Ondra Kamenik\n";
(*this)<<"Dynare++ comes with ABSOLUTELY NO WARRANTY and is distributed under\n";
(*this)<<"General Public License, see http://www.gnu.org/license/gpl.html\n";
(*this)<<"\n\n";
#ifndef __MINGW32__
utsname info;
uname(&info);
(*this)<<"System info: ";
(*this)<<info.sysname<<" "<<info.release<<" "<<info.version<<" ";
(*this)<<info.machine<<", processors online: "<<_sysres.onlineProcessors();
(*this)<<"\n\nStart time: ";
char ts[100];
time_t curtime= time(NULL);
tm loctime;
localtime_r(&curtime,&loctime);
asctime_r(&loctime,ts);
(*this)<<ts<<"\n";
#else
(*this)<<"System info: (not implemented for MINGW)\n";
(*this)<<"Start time: (not implemented for MINGW)\n\n";
#endif
(*this)<<" ------ elapsed time (seconds) \n";
(*this)<<" | ------ record unique identifier \n";
(*this)<<" | | ------ load average \n";
(*this)<<" | | | ------ available memory (MB) \n";
(*this)<<" | | | | ------ major faults (MB)\n";
(*this)<<" | | | | | \n";
(*this)<<" V V V V V \n";
(*this)<<"\n";
}
/*:15*/
#line 37 "./journal.cweb"
;
/*:1*/

96
mex/sources/korderpert/Dyn_pp/kord/Makefile Normal file
View File

@ -0,0 +1,96 @@
# $Id: Makefile 843 2006-07-28 08:54:19Z tamas $
# Copyright 2004, Ondra Kamenik
LD_LIBS := -llapack -lcblas -lf77blas -latlas -lg2c
CC_FLAGS := -Wall -I../tl/cc -I../sylv/cc -I../integ/cc \
$(CC_INCLUDE_PATH)
# -I/cygdrive/f/MinGW/include \
# -I/usr/local/atlas/include -I/usr/local/atlas/include/atlas \
# -I/cygdrive/f/Pthreads/Pre-built.2/include
ifeq ($(DEBUG),yes)
CC_FLAGS := $(CC_FLAGS) -g -DTL_DEBUG=2
else
CC_FLAGS := $(CC_FLAGS) -O2 -DPOSIX_THREADS
endif
ifeq ($(OS),Windows_NT)
CC_FLAGS := -mno-cygwin -mthreads $(CC_FLAGS)
LD_LIBS := -mno-cygwin -mthreads $(LD_LIBS) -lpthreadGC1
else
LD_LIBS := $(LD_LIBS) -lpthread
endif
sylvcppsource := $(wildcard ../sylv/cc/*.cpp)
sylvhsource := $(wildcard ../sylv/cc/*.h)
sylvobjects := $(patsubst %.cpp, %.o, $(sylvcppsource))
tlcwebsource := $(wildcard ../tl/cc/*.cweb)
tlcppsource := $(patsubst %.cweb,%.cpp,$(tlcwebsource))
tlhwebsource := $(wildcard ../tl/cc/*.hweb)
tlhsource := $(patsubst %.hweb,%.h,$(tlhwebsource))
tlobjects := $(patsubst %.cweb,%.o,$(tlcwebsource))
integhwebsource := $(wildcard ../integ/cc/*.hweb)
integhsource := $(patsubst %.hweb,%.h,$(integhwebsource))
cwebsource := $(wildcard *.cweb)
cppsource := $(patsubst %.cweb,%.cpp,$(cwebsource))
objects := $(patsubst %.cweb,%.o,$(cwebsource))
hwebsource := $(wildcard *.hweb)
hsource := $(patsubst %.hweb,%.h,$(hwebsource))
../integ/cc/dummy.ch:
make -C ../integ/cc dummy.ch
../tl/cc/dummy.ch:
make -C ../tl/cc dummy.ch
../tl/cc/%.cpp: ../tl/cc/%.cweb ../tl/cc/dummy.ch
make -C ../tl/cc $*.cpp
../tl/cc/%.h: ../tl/cc/%.hweb ../tl/cc/dummy.ch
make -C ../tl/cc $*.h
../integ/cc/%.h: ../integ/cc/%.hweb ../integ/cc/dummy.ch
make -C ../integ/cc $*.h
../tl/cc/%.o: ../tl/cc/%.cpp $(tlhsource)
make -C ../tl/cc $*.o
../sylv/cc/%.o: ../sylv/cc/%.cpp $(sylvhsource)
make -C ../sylv/cc $*.o
dummy.ch:
touch dummy.ch
%.cpp: %.cweb dummy.ch
ctangle -bhp $*.cweb dummy.ch $*.cpp
%.h: %.hweb dummy.ch
ctangle -bhp $*.hweb dummy.ch $*.h
%.o: %.cpp $(hwebsource) $(hsource) $(tlhwebsource) $(tlhsource) \
$(integhwebsource) $(integhsource)
$(CC) $(CC_FLAGS) -c $*.cpp
tests: $(hwebsource) $(cwebsoure) $(hsource) $(cppsource) \
$(tlhwebsource) $(tlcwebsoure) $(tlhsource) $(tlcppsource) \
$(sylvhsource) $(sylvcppsource) \
tests.o $(objects) $(tlobjects) $(sylvobjects)
$(CC) $(CC_FLAGS) $(objects) $(tlobjects) $(sylvobjects) tests.o -o tests $(LD_LIBS)
kord.pdf: doc
doc: main.web $(hwebsource) $(cwebsource)
cweave -bhp main.web
pdftex main
mv main.pdf kord.pdf
clear:
rm -f $(hsource)
rm -f $(cppsource)
rm -f *.o
rm -f tests
make -C ../tl/cc clear
make -C ../sylv/cc clear
rm -f main.{idx,dvi,pdf,scn,log,tex,toc}

394
mex/sources/korderpert/Dyn_pp/kord/approximation.cpp Normal file
View File

@ -0,0 +1,394 @@
/*1:*/
#line 6 "./approximation.cweb"
#include "kord_exception.h"
#include "approximation.h"
#include "first_order.h"
#include "korder_stoch.h"
/*2:*/
#line 26 "./approximation.cweb"
ZAuxContainer::ZAuxContainer(const _Ctype*gss,int ngss,int ng,int ny,int nu)
:StackContainer<FGSTensor> (4,1)
{
stack_sizes[0]= ngss;stack_sizes[1]= ng;
stack_sizes[2]= ny;stack_sizes[3]= nu;
conts[0]= gss;
calculateOffsets();
}
/*:2*/
#line 12 "./approximation.cweb"
;
/*3:*/
#line 41 "./approximation.cweb"
ZAuxContainer::itype ZAuxContainer::getType(int i,const Symmetry&s)const
{
if(i==0)
if(s[2]> 0)
return zero;
else
return matrix;
return zero;
}
/*:3*/
#line 13 "./approximation.cweb"
;
/*4:*/
#line 54 "./approximation.cweb"
Approximation::Approximation(DynamicModel&m,Journal&j,int ns)
:model(m),journal(j),rule_ders(NULL),rule_ders_ss(NULL),fdr(NULL),udr(NULL),
ypart(model.nstat(),model.npred(),model.nboth(),model.nforw()),
mom(UNormalMoments(model.order(),model.getVcov())),nvs(4),steps(ns),
ss(ypart.ny(),steps+1)
{
nvs[0]= ypart.nys();nvs[1]= model.nexog();
nvs[2]= model.nexog();nvs[3]= 1;
ss.nans();
}
/*:4*/
#line 14 "./approximation.cweb"
;
/*5:*/
#line 68 "./approximation.cweb"
Approximation::~Approximation()
{
if(rule_ders_ss)delete rule_ders_ss;
if(rule_ders)delete rule_ders;
if(fdr)delete fdr;
if(udr)delete udr;
}
/*:5*/
#line 15 "./approximation.cweb"
;
/*6:*/
#line 78 "./approximation.cweb"
const FoldDecisionRule&Approximation::getFoldDecisionRule()const
{
KORD_RAISE_IF(fdr==NULL,
"Folded decision rule has not been created in Approximation::getFoldDecisionRule");
return*fdr;
}
/*:6*/
#line 16 "./approximation.cweb"
;
/*7:*/
#line 88 "./approximation.cweb"
const UnfoldDecisionRule&Approximation::getUnfoldDecisionRule()const
{
KORD_RAISE_IF(udr==NULL,
"Unfolded decision rule has not been created in Approximation::getUnfoldDecisionRule");
return*udr;
}
/*:7*/
#line 17 "./approximation.cweb"
;
/*8:*/
#line 102 "./approximation.cweb"
void Approximation::approxAtSteady()
{
model.calcDerivativesAtSteady();
FirstOrder fo(model.nstat(),model.npred(),model.nboth(),model.nforw(),
model.nexog(),*(model.getModelDerivatives().get(Symmetry(1))),
journal);
KORD_RAISE_IF_X(!fo.isStable(),
"The model is not Blanchard-Kahn stable",
KORD_MD_NOT_STABLE);
if(model.order()>=2){
KOrder korder(model.nstat(),model.npred(),model.nboth(),model.nforw(),
model.getModelDerivatives(),fo.getGy(),fo.getGu(),
model.getVcov(),journal);
korder.switchToFolded();
for(int k= 2;k<=model.order();k++)
korder.performStep<KOrder::fold> (k);
saveRuleDerivs(korder.getFoldDers());
}else{
FirstOrderDerivs<KOrder::fold> fo_ders(fo);
saveRuleDerivs(fo_ders);
}
check(0.0);
}
/*:8*/
#line 18 "./approximation.cweb"
;
/*9:*/
#line 159 "./approximation.cweb"
void Approximation::walkStochSteady()
{
/*10:*/
#line 186 "./approximation.cweb"
model.solveDeterministicSteady();
approxAtSteady();
Vector steady0(ss,0);
steady0= (const Vector&)model.getSteady();
/*:10*/
#line 162 "./approximation.cweb"
;
double sigma_so_far= 0.0;
double dsigma= (steps==0)?0.0:1.0/steps;
for(int i= 1;i<=steps;i++){
JournalRecordPair pa(journal);
pa<<"Approximation about stochastic steady for sigma="<<sigma_so_far+dsigma<<endrec;
Vector last_steady((const Vector&)model.getSteady());
/*11:*/
#line 196 "./approximation.cweb"
DRFixPoint<KOrder::fold> fp(*rule_ders,ypart,model.getSteady(),dsigma);
bool converged= fp.calcFixPoint(DecisionRule::horner,model.getSteady());
JournalRecord rec(journal);
rec<<"Fix point calcs: iter="<<fp.getNumIter()<<", newton_iter="
<<fp.getNewtonTotalIter()<<", last_newton_iter="<<fp.getNewtonLastIter()<<".";
if(converged)
rec<<" Converged."<<endrec;
else{
rec<<" Not converged!!"<<endrec;
KORD_RAISE_X("Fix point calculation not converged",KORD_FP_NOT_CONV);
}
Vector steadyi(ss,i);
steadyi= (const Vector&)model.getSteady();
/*:11*/
#line 171 "./approximation.cweb"
;
/*12:*/
#line 216 "./approximation.cweb"
Vector dy((const Vector&)model.getSteady());
dy.add(-1.0,last_steady);
StochForwardDerivs<KOrder::fold> hh(ypart,model.nexog(),*rule_ders_ss,mom,dy,
dsigma,sigma_so_far);
JournalRecord rec1(journal);
rec1<<"Calculation of g** expectations done"<<endrec;
/*:12*/
#line 172 "./approximation.cweb"
;
/*13:*/
#line 229 "./approximation.cweb"
model.calcDerivativesAtSteady();
KOrderStoch korder_stoch(ypart,model.nexog(),model.getModelDerivatives(),
hh,journal);
for(int d= 1;d<=model.order();d++){
korder_stoch.performStep<KOrder::fold> (d);
}
saveRuleDerivs(korder_stoch.getFoldDers());
/*:13*/
#line 173 "./approximation.cweb"
;
check(sigma_so_far+dsigma);
sigma_so_far+= dsigma;
}
/*14:*/
#line 240 "./approximation.cweb"
if(fdr){
delete fdr;
fdr= NULL;
}
if(udr){
delete udr;
udr= NULL;
}
fdr= new FoldDecisionRule(*rule_ders,ypart,model.nexog(),
model.getSteady(),1.0-sigma_so_far);
if(steps==0){
/*15:*/
#line 258 "./approximation.cweb"
DRFixPoint<KOrder::fold> fp(*rule_ders,ypart,model.getSteady(),1.0);
bool converged= fp.calcFixPoint(DecisionRule::horner,model.getSteady());
JournalRecord rec(journal);
rec<<"Fix point calcs: iter="<<fp.getNumIter()<<", newton_iter="
<<fp.getNewtonTotalIter()<<", last_newton_iter="<<fp.getNewtonLastIter()<<".";
if(converged)
rec<<" Converged."<<endrec;
else{
rec<<" Not converged!!"<<endrec;
KORD_RAISE_X("Fix point calculation not converged",KORD_FP_NOT_CONV);
}
{
JournalRecordPair recp(journal);
recp<<"Centralizing about fix-point."<<endrec;
FoldDecisionRule*dr_backup= fdr;
fdr= new FoldDecisionRule(*dr_backup,model.getSteady());
delete dr_backup;
}
/*:15*/
#line 253 "./approximation.cweb"
;
}
/*:14*/
#line 179 "./approximation.cweb"
;
}
/*:9*/
#line 19 "./approximation.cweb"
;
/*16:*/
#line 285 "./approximation.cweb"
void Approximation::saveRuleDerivs(const FGSContainer&g)
{
if(rule_ders){
delete rule_ders;
delete rule_ders_ss;
}
rule_ders= new FGSContainer(g);
rule_ders_ss= new FGSContainer(4);
for(FGSContainer::iterator run= (*rule_ders).begin();run!=(*rule_ders).end();++run){
FGSTensor*ten= new FGSTensor(ypart.nstat+ypart.npred,ypart.nyss(),*((*run).second));
rule_ders_ss->insert(ten);
}
}
/*:16*/
#line 20 "./approximation.cweb"
;
/*17:*/
#line 312 "./approximation.cweb"
void Approximation::calcStochShift(Vector&out,double at_sigma)const
{
KORD_RAISE_IF(out.length()!=ypart.ny(),
"Wrong length of output vector for Approximation::calcStochShift");
out.zeros();
ZAuxContainer zaux(rule_ders_ss,ypart.nyss(),ypart.ny(),
ypart.nys(),model.nexog());
int dfac= 1;
for(int d= 1;d<=rule_ders->getMaxDim();d++,dfac*= d){
if(KOrder::is_even(d)){
Symmetry sym(0,d,0,0);
/*18:*/
#line 333 "./approximation.cweb"
FGSTensor*ten= new FGSTensor(ypart.ny(),TensorDimens(sym,nvs));
ten->zeros();
for(int l= 1;l<=d;l++){
const FSSparseTensor*f= model.getModelDerivatives().get(Symmetry(l));
zaux.multAndAdd(*f,*ten);
}
/*:18*/
#line 326 "./approximation.cweb"
;
/*19:*/
#line 342 "./approximation.cweb"
FGSTensor*tmp= new FGSTensor(ypart.ny(),TensorDimens(Symmetry(0,0,0,0),nvs));
tmp->zeros();
ten->contractAndAdd(1,*tmp,*(mom.get(Symmetry(d))));
out.add(pow(at_sigma,d)/dfac,tmp->getData());
delete ten;
delete tmp;
/*:19*/
#line 327 "./approximation.cweb"
;
}
}
}
/*:17*/
#line 21 "./approximation.cweb"
;
/*20:*/
#line 359 "./approximation.cweb"
void Approximation::check(double at_sigma)const
{
Vector stoch_shift(ypart.ny());
Vector system_resid(ypart.ny());
Vector xx(model.nexog());
xx.zeros();
model.evaluateSystem(system_resid,model.getSteady(),xx);
calcStochShift(stoch_shift,at_sigma);
stoch_shift.add(1.0,system_resid);
JournalRecord rec1(journal);
rec1<<"Error of current approximation for shocks at sigma "<<at_sigma
<<" is "<<stoch_shift.getMax()<<endrec;
calcStochShift(stoch_shift,1.0);
stoch_shift.add(1.0,system_resid);
JournalRecord rec2(journal);
rec2<<"Error of current approximation for full shocks is "<<stoch_shift.getMax()<<endrec;
}
/*:20*/
#line 22 "./approximation.cweb"
;
/*21:*/
#line 394 "./approximation.cweb"
TwoDMatrix*Approximation::calcYCov()const
{
const TwoDMatrix&gy= *(rule_ders->get(Symmetry(1,0,0,0)));
const TwoDMatrix&gu= *(rule_ders->get(Symmetry(0,1,0,0)));
TwoDMatrix G(model.numeq(),model.numeq());
G.zeros();
G.place(gy,0,model.nstat());
TwoDMatrix B((const TwoDMatrix&)G);
B.mult(-1.0);
TwoDMatrix C(G,"transpose");
TwoDMatrix A(model.numeq(),model.numeq());
A.zeros();
for(int i= 0;i<model.numeq();i++)
A.get(i,i)= 1.0;
TwoDMatrix guSigma(gu,model.getVcov());
TwoDMatrix guTrans(gu,"transpose");
TwoDMatrix*X= new TwoDMatrix(guSigma,guTrans);
GeneralSylvester gs(1,model.numeq(),model.numeq(),0,
A.base(),B.base(),C.base(),X->base());
gs.solve();
return X;
}
/*:21*/
#line 23 "./approximation.cweb"
;
/*:1*/

71
mex/sources/korderpert/Dyn_pp/kord/approximation.h Normal file
View File

@ -0,0 +1,71 @@
/*1:*/
#line 53 "./approximation.hweb"
#ifndef APPROXIMATION_H
#define APPROXIMATION_H
#include "dynamic_model.h"
#include "decision_rule.h"
#include "korder.h"
#include "journal.h"
/*2:*/
#line 80 "./approximation.hweb"
class ZAuxContainer:public StackContainer<FGSTensor> ,public FoldedStackContainer{
public:
typedef StackContainer<FGSTensor> ::_Ctype _Ctype;
typedef StackContainer<FGSTensor> ::itype itype;
ZAuxContainer(const _Ctype*gss,int ngss,int ng,int ny,int nu);
itype getType(int i,const Symmetry&s)const;
};
/*:2*/
#line 62 "./approximation.hweb"
;
/*3:*/
#line 115 "./approximation.hweb"
class Approximation{
DynamicModel&model;
Journal&journal;
FGSContainer*rule_ders;
FGSContainer*rule_ders_ss;
FoldDecisionRule*fdr;
UnfoldDecisionRule*udr;
const PartitionY ypart;
const FNormalMoments mom;
IntSequence nvs;
int steps;
TwoDMatrix ss;
public:
Approximation(DynamicModel&m,Journal&j,int ns);
virtual~Approximation();
const FoldDecisionRule&getFoldDecisionRule()const;
const UnfoldDecisionRule&getUnfoldDecisionRule()const;
const TwoDMatrix&getSS()const
{return ss;}
const DynamicModel&getModel()const
{return model;}
void walkStochSteady();
TwoDMatrix*calcYCov()const;
protected:
void approxAtSteady();
void calcStochShift(Vector&out,double at_sigma)const;
void saveRuleDerivs(const FGSContainer&g);
void check(double at_sigma)const;
};
/*:3*/
#line 63 "./approximation.hweb"
;
#endif
/*:1*/

793
mex/sources/korderpert/Dyn_pp/kord/decision_rule.cpp Normal file
View File

@ -0,0 +1,793 @@
/*1:*/
#line 5 "./decision_rule.cweb"
#include "kord_exception.h"
#include "decision_rule.h"
#include "dynamic_model.h"
#include "SymSchurDecomp.h"
#include "cpplapack.h"
#include <limits>
template<>
int DRFixPoint<KOrder::fold> ::max_iter= 10000;
template<>
int DRFixPoint<KOrder::unfold> ::max_iter= 10000;
template<>
double DRFixPoint<KOrder::fold> ::tol= 1.e-10;
template<>
double DRFixPoint<KOrder::unfold> ::tol= 1.e-10;
template<>
int DRFixPoint<KOrder::fold> ::max_newton_iter= 50;
template<>
int DRFixPoint<KOrder::unfold> ::max_newton_iter= 50;
template<>
int DRFixPoint<KOrder::fold> ::newton_pause= 100;
template<>
int DRFixPoint<KOrder::unfold> ::newton_pause= 100;
/*2:*/
#line 72 "./decision_rule.cweb"
FoldDecisionRule::FoldDecisionRule(const UnfoldDecisionRule&udr)
:DecisionRuleImpl<KOrder::fold> (ctraits<KOrder::fold> ::Tpol(udr.nrows(),udr.nvars()),
udr.ypart,udr.nu,udr.ysteady)
{
for(ctraits<KOrder::unfold> ::Tpol::const_iterator it= udr.begin();
it!=udr.end();++it){
insert(new ctraits<KOrder::fold> ::Ttensym(*((*it).second)));
}
}
/*:2*/
#line 33 "./decision_rule.cweb"
;
/*3:*/
#line 84 "./decision_rule.cweb"
UnfoldDecisionRule::UnfoldDecisionRule(const FoldDecisionRule&fdr)
:DecisionRuleImpl<KOrder::unfold> (ctraits<KOrder::unfold> ::Tpol(fdr.nrows(),fdr.nvars()),
fdr.ypart,fdr.nu,fdr.ysteady)
{
for(ctraits<KOrder::fold> ::Tpol::const_iterator it= fdr.begin();
it!=fdr.end();++it){
insert(new ctraits<KOrder::unfold> ::Ttensym(*((*it).second)));
}
}
/*:3*/
#line 34 "./decision_rule.cweb"
;
/*4:*/
#line 96 "./decision_rule.cweb"
SimResults::~SimResults()
{
for(int i= 0;i<getNumSets();i++){
delete data[i];
delete shocks[i];
}
}
/*:4*/
#line 35 "./decision_rule.cweb"
;
/*5:*/
#line 108 "./decision_rule.cweb"
void SimResults::simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov,Journal&journal)
{
JournalRecordPair paa(journal);
paa<<"Performing "<<num_sim<<" stochastic simulations for "
<<num_per<<" periods"<<endrec;
simulate(num_sim,dr,start,vcov);
int thrown= num_sim-data.size();
if(thrown> 0){
JournalRecord rec(journal);
rec<<"I had to throw "<<thrown<<" simulations away due to Nan or Inf"<<endrec;
}
}
/*:5*/
#line 36 "./decision_rule.cweb"
;
/*6:*/
#line 127 "./decision_rule.cweb"
void SimResults::simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov)
{
std::vector<RandomShockRealization> rsrs;
rsrs.reserve(num_sim);
THREAD_GROUP gr;
for(int i= 0;i<num_sim;i++){
RandomShockRealization sr(vcov,system_random_generator.int_uniform());
rsrs.push_back(sr);
THREAD*worker= new
SimulationWorker(*this,dr,DecisionRule::horner,
num_per,start,rsrs.back());
gr.insert(worker);
}
gr.run();
}
/*:6*/
#line 37 "./decision_rule.cweb"
;
/*7:*/
#line 149 "./decision_rule.cweb"
bool SimResults::addDataSet(TwoDMatrix*d,ExplicitShockRealization*sr)
{
KORD_RAISE_IF(d->nrows()!=num_y,
"Incompatible number of rows for SimResults::addDataSets");
KORD_RAISE_IF(d->ncols()!=num_per,
"Incompatible number of cols for SimResults::addDataSets");
if(d->isFinite()){
data.push_back(d);
shocks.push_back(sr);
return true;
}else{
delete d;
delete sr;
return false;
}
}
/*:7*/
#line 38 "./decision_rule.cweb"
;
/*8:*/
#line 168 "./decision_rule.cweb"
void SimResults::writeMat4(const char*base,const char*lname)const
{
char matfile_name[100];
sprintf(matfile_name,"%s.mat",base);
FILE*out;
if(NULL!=(out= fopen(matfile_name,"wb"))){
writeMat4(out,lname);
fclose(out);
}
}
/*:8*/
#line 39 "./decision_rule.cweb"
;
/*9:*/
#line 183 "./decision_rule.cweb"
void SimResults::writeMat4(FILE*fd,const char*lname)const
{
char tmp[100];
for(int i= 0;i<getNumSets();i++){
if(getNumSets()> 1)
sprintf(tmp,"%s_data%d",lname,i+1);
else
sprintf(tmp,"%s_data",lname);
ConstTwoDMatrix m(*(data[i]));
m.writeMat4(fd,tmp);
}
}
/*:9*/
#line 40 "./decision_rule.cweb"
;
/*10:*/
#line 198 "./decision_rule.cweb"
void SimResultsStats::simulate(int num_sim,const DecisionRule&dr,
const Vector&start,
const TwoDMatrix&vcov,Journal&journal)
{
SimResults::simulate(num_sim,dr,start,vcov,journal);
{
JournalRecordPair paa(journal);
paa<<"Calculating means from the simulations."<<endrec;
calcMean();
}
{
JournalRecordPair paa(journal);
paa<<"Calculating covariances from the simulations."<<endrec;
calcVcov();
}
}
/*:10*/
#line 41 "./decision_rule.cweb"
;
/*11:*/
#line 218 "./decision_rule.cweb"
void SimResultsStats::writeMat4(FILE*fd,const char*lname)const
{
char tmp[100];
sprintf(tmp,"%s_mean",lname);
ConstTwoDMatrix m(num_y,1,mean.base());
m.writeMat4(fd,tmp);
sprintf(tmp,"%s_vcov",lname);
ConstTwoDMatrix(vcov).writeMat4(fd,tmp);
}
/*:11*/
#line 42 "./decision_rule.cweb"
;
/*12:*/
#line 230 "./decision_rule.cweb"
void SimResultsStats::calcMean()
{
mean.zeros();
if(data.size()*num_per> 0){
double mult= 1.0/data.size()/num_per;
for(unsigned int i= 0;i<data.size();i++){
for(int j= 0;j<num_per;j++){
ConstVector col(*data[i],j);
mean.add(mult,col);
}
}
}
}
/*:12*/
#line 43 "./decision_rule.cweb"
;
/*13:*/
#line 246 "./decision_rule.cweb"
void SimResultsStats::calcVcov()
{
if(data.size()*num_per> 1){
vcov.zeros();
double mult= 1.0/(data.size()*num_per-1);
for(unsigned int i= 0;i<data.size();i++){
const TwoDMatrix&d= *(data[i]);
for(int j= 0;j<num_per;j++){
for(int m= 0;m<num_y;m++){
for(int n= m;n<num_y;n++){
double s= (d.get(m,j)-mean[m])*(d.get(n,j)-mean[n]);
vcov.get(m,n)+= mult*s;
if(m!=n)
vcov.get(n,m)+= mult*s;
}
}
}
}
}else{
vcov.infs();
}
}
/*:13*/
#line 44 "./decision_rule.cweb"
;
/*14:*/
#line 271 "./decision_rule.cweb"
void SimResultsDynamicStats::simulate(int num_sim,const DecisionRule&dr,
const Vector&start,
const TwoDMatrix&vcov,Journal&journal)
{
SimResults::simulate(num_sim,dr,start,vcov,journal);
{
JournalRecordPair paa(journal);
paa<<"Calculating means of the conditional simulations."<<endrec;
calcMean();
}
{
JournalRecordPair paa(journal);
paa<<"Calculating variances of the conditional simulations."<<endrec;
calcVariance();
}
}
/*:14*/
#line 45 "./decision_rule.cweb"
;
/*15:*/
#line 290 "./decision_rule.cweb"
void SimResultsDynamicStats::writeMat4(FILE*fd,const char*lname)const
{
char tmp[100];
sprintf(tmp,"%s_cond_mean",lname);
ConstTwoDMatrix(mean).writeMat4(fd,tmp);
sprintf(tmp,"%s_cond_variance",lname);
ConstTwoDMatrix(variance).writeMat4(fd,tmp);
}
/*:15*/
#line 46 "./decision_rule.cweb"
;
/*16:*/
#line 301 "./decision_rule.cweb"
void SimResultsDynamicStats::calcMean()
{
mean.zeros();
if(data.size()> 0){
double mult= 1.0/data.size();
for(int j= 0;j<num_per;j++){
Vector meanj(mean,j);
for(unsigned int i= 0;i<data.size();i++){
ConstVector col(*data[i],j);
meanj.add(mult,col);
}
}
}
}
/*:16*/
#line 47 "./decision_rule.cweb"
;
/*17:*/
#line 318 "./decision_rule.cweb"
void SimResultsDynamicStats::calcVariance()
{
if(data.size()> 1){
variance.zeros();
double mult= 1.0/(data.size()-1);
for(int j= 0;j<num_per;j++){
ConstVector meanj(mean,j);
Vector varj(variance,j);
for(int i= 0;i<(int)data.size();i++){
Vector col(ConstVector((*data[i]),j));
col.add(-1.0,meanj);
for(int k= 0;k<col.length();k++)
col[k]= col[k]*col[k];
varj.add(mult,col);
}
}
}else{
variance.infs();
}
}
/*:17*/
#line 48 "./decision_rule.cweb"
;
/*18:*/
#line 342 "./decision_rule.cweb"
void SimResultsIRF::simulate(const DecisionRule&dr,const Vector&start,
Journal&journal)
{
JournalRecordPair paa(journal);
paa<<"Performing "<<control.getNumSets()<<" IRF simulations for "
<<num_per<<" periods; shock="<<ishock<<", impulse="<<imp<<endrec;
simulate(dr,start);
int thrown= control.getNumSets()-data.size();
if(thrown> 0){
JournalRecord rec(journal);
rec<<"I had to throw "<<thrown
<<" simulations away due to Nan or Inf"<<endrec;
}
calcMeans();
calcVariances();
}
/*:18*/
#line 49 "./decision_rule.cweb"
;
/*19:*/
#line 361 "./decision_rule.cweb"
void SimResultsIRF::simulate(const DecisionRule&dr,const Vector&start)
{
THREAD_GROUP gr;
for(int idata= 0;idata<control.getNumSets();idata++){
THREAD*worker= new
SimulationIRFWorker(*this,dr,DecisionRule::horner,
num_per,start,idata,ishock,imp);
gr.insert(worker);
}
gr.run();
}
/*:19*/
#line 50 "./decision_rule.cweb"
;
/*20:*/
#line 375 "./decision_rule.cweb"
void SimResultsIRF::calcMeans()
{
means.zeros();
if(data.size()> 0){
for(unsigned int i= 0;i<data.size();i++)
means.add(1.0,*(data[i]));
means.mult(1.0/data.size());
}
}
/*:20*/
#line 51 "./decision_rule.cweb"
;
/*21:*/
#line 387 "./decision_rule.cweb"
void SimResultsIRF::calcVariances()
{
if(data.size()> 1){
variances.zeros();
for(unsigned int i= 0;i<data.size();i++){
TwoDMatrix d((const TwoDMatrix&)(*(data[i])));
d.add(-1.0,means);
for(int j= 0;j<d.nrows();j++)
for(int k= 0;k<d.ncols();k++)
variances.get(j,k)+= d.get(j,k)*d.get(j,k);
d.mult(1.0/(data.size()-1));
}
}else{
variances.infs();
}
}
/*:21*/
#line 52 "./decision_rule.cweb"
;
/*22:*/
#line 406 "./decision_rule.cweb"
void SimResultsIRF::writeMat4(FILE*fd,const char*lname)const
{
char tmp[100];
sprintf(tmp,"%s_mean",lname);
means.writeMat4(fd,tmp);
sprintf(tmp,"%s_var",lname);
variances.writeMat4(fd,tmp);
}
/*:22*/
#line 53 "./decision_rule.cweb"
;
/*23:*/
#line 417 "./decision_rule.cweb"
void RTSimResultsStats::simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&v,Journal&journal)
{
JournalRecordPair paa(journal);
paa<<"Performing "<<num_sim<<" real-time stochastic simulations for "
<<num_per<<" periods"<<endrec;
simulate(num_sim,dr,start,v);
mean= nc.getMean();
mean.add(1.0,dr.getSteady());
nc.getVariance(vcov);
if(thrown_periods> 0){
JournalRecord rec(journal);
rec<<"I had to throw "<<thrown_periods<<" periods away due to Nan or Inf"<<endrec;
JournalRecord rec1(journal);
rec1<<"This affected "<<incomplete_simulations<<" out of "
<<num_sim<<" simulations"<<endrec;
}
}
/*:23*/
#line 54 "./decision_rule.cweb"
;
/*24:*/
#line 438 "./decision_rule.cweb"
void RTSimResultsStats::simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov)
{
std::vector<RandomShockRealization> rsrs;
rsrs.reserve(num_sim);
THREAD_GROUP gr;
for(int i= 0;i<num_sim;i++){
RandomShockRealization sr(vcov,system_random_generator.int_uniform());
rsrs.push_back(sr);
THREAD*worker= new
RTSimulationWorker(*this,dr,DecisionRule::horner,
num_per,start,rsrs.back());
gr.insert(worker);
}
gr.run();
}
/*:24*/
#line 55 "./decision_rule.cweb"
;
/*25:*/
#line 458 "./decision_rule.cweb"
void RTSimResultsStats::writeMat4(FILE*fd,const char*lname)
{
char tmp[100];
sprintf(tmp,"%s_rt_mean",lname);
ConstTwoDMatrix m(nc.getDim(),1,mean.base());
m.writeMat4(fd,tmp);
sprintf(tmp,"%s_rt_vcov",lname);
ConstTwoDMatrix(vcov).writeMat4(fd,tmp);
}
/*:25*/
#line 56 "./decision_rule.cweb"
;
/*26:*/
#line 470 "./decision_rule.cweb"
IRFResults::IRFResults(const DynamicModel&mod,const DecisionRule&dr,
const SimResults&control,const vector<int> &ili,
Journal&journal)
:model(mod),irf_list_ind(ili)
{
int num_per= control.getNumPer();
JournalRecordPair pa(journal);
pa<<"Calculating IRFs against control for "<<(int)irf_list_ind.size()<<" shocks and for "
<<num_per<<" periods"<<endrec;
const TwoDMatrix&vcov= mod.getVcov();
for(unsigned int ii= 0;ii<irf_list_ind.size();ii++){
int ishock= irf_list_ind[ii];
double stderror= sqrt(vcov.get(ishock,ishock));
irf_res.push_back(new SimResultsIRF(control,model.numeq(),num_per,
ishock,stderror));
irf_res.push_back(new SimResultsIRF(control,model.numeq(),num_per,
ishock,-stderror));
}
for(unsigned int ii= 0;ii<irf_list_ind.size();ii++){
irf_res[2*ii]->simulate(dr,model.getSteady(),journal);
irf_res[2*ii+1]->simulate(dr,model.getSteady(),journal);
}
}
/*:26*/
#line 57 "./decision_rule.cweb"
;
/*27:*/
#line 497 "./decision_rule.cweb"
IRFResults::~IRFResults()
{
for(unsigned int i= 0;i<irf_res.size();i++)
delete irf_res[i];
}
/*:27*/
#line 58 "./decision_rule.cweb"
;
/*28:*/
#line 505 "./decision_rule.cweb"
void IRFResults::writeMat4(FILE*fd,const char*prefix)const
{
for(unsigned int i= 0;i<irf_list_ind.size();i++){
char tmp[100];
int ishock= irf_list_ind[i];
const char*shockname= model.getExogNames().getName(ishock);
sprintf(tmp,"%s_irfp_%s",prefix,shockname);
irf_res[2*i]->writeMat4(fd,tmp);
sprintf(tmp,"%s_irfm_%s",prefix,shockname);
irf_res[2*i+1]->writeMat4(fd,tmp);
}
}
/*:28*/
#line 59 "./decision_rule.cweb"
;
/*29:*/
#line 520 "./decision_rule.cweb"
void SimulationWorker::operator()()
{
ExplicitShockRealization*esr= new ExplicitShockRealization(sr,np);
TwoDMatrix*m= dr.simulate(em,np,st,*esr);
{
SYNCHRO syn(&res,"simulation");
res.addDataSet(m,esr);
}
}
/*:29*/
#line 60 "./decision_rule.cweb"
;
/*30:*/
#line 534 "./decision_rule.cweb"
void SimulationIRFWorker::operator()()
{
ExplicitShockRealization*esr=
new ExplicitShockRealization(res.control.getShocks(idata));
esr->addToShock(ishock,0,imp);
TwoDMatrix*m= dr.simulate(em,np,st,*esr);
m->add(-1.0,res.control.getData(idata));
{
SYNCHRO syn(&res,"simulation");
res.addDataSet(m,esr);
}
}
/*:30*/
#line 61 "./decision_rule.cweb"
;
/*31:*/
#line 549 "./decision_rule.cweb"
void RTSimulationWorker::operator()()
{
NormalConj nc(res.nc.getDim());
const PartitionY&ypart= dr.getYPart();
int nu= dr.nexog();
const Vector&ysteady= dr.getSteady();
/*32:*/
#line 571 "./decision_rule.cweb"
Vector dyu(ypart.nys()+nu);
ConstVector ystart_pred(ystart,ypart.nstat,ypart.nys());
ConstVector ysteady_pred(ysteady,ypart.nstat,ypart.nys());
Vector dy(dyu,0,ypart.nys());
Vector u(dyu,ypart.nys(),nu);
Vector y(nc.getDim());
ConstVector ypred(y,ypart.nstat,ypart.nys());
/*:32*/
#line 557 "./decision_rule.cweb"
;
/*33:*/
#line 581 "./decision_rule.cweb"
int ip= 0;
dy= ystart_pred;
dy.add(-1.0,ysteady_pred);
sr.get(ip,u);
dr.eval(em,y,dyu);
nc.update(y);
/*:33*/
#line 558 "./decision_rule.cweb"
;
/*34:*/
#line 590 "./decision_rule.cweb"
while(y.isFinite()&&ip<res.num_per){
ip++;
dy= ypred;
sr.get(ip,u);
dr.eval(em,y,dyu);
nc.update(y);
}
/*:34*/
#line 559 "./decision_rule.cweb"
;
{
SYNCHRO syn(&res,"rtsimulation");
res.nc.update(nc);
if(res.num_per-ip> 0){
res.incomplete_simulations++;
res.thrown_periods+= res.num_per-ip;
}
}
}
/*:31*/
#line 62 "./decision_rule.cweb"
;
/*35:*/
#line 602 "./decision_rule.cweb"
void RandomShockRealization::choleskyFactor(const TwoDMatrix&v)
{
factor= v;
int rows= factor.nrows();
for(int i= 0;i<rows;i++)
for(int j= i+1;j<rows;j++)
factor.get(i,j)= 0.0;
int info;
LAPACK_dpotrf("L",&rows,factor.base(),&rows,&info);
KORD_RAISE_IF(info!=0,
"Info!=0 in RandomShockRealization::choleskyFactor");
}
/*:35*/
#line 63 "./decision_rule.cweb"
;
/*36:*/
#line 620 "./decision_rule.cweb"
void RandomShockRealization::schurFactor(const TwoDMatrix&v)
{
SymSchurDecomp ssd(v);
ssd.getFactor(factor);
}
/*:36*/
#line 64 "./decision_rule.cweb"
;
/*37:*/
#line 628 "./decision_rule.cweb"
void RandomShockRealization::get(int n,Vector&out)
{
KORD_RAISE_IF(out.length()!=numShocks(),
"Wrong length of out vector in RandomShockRealization::get");
Vector d(out.length());
for(int i= 0;i<d.length();i++){
d[i]= mtwister.normal();
}
out.zeros();
factor.multaVec(out,ConstVector(d));
}
/*:37*/
#line 65 "./decision_rule.cweb"
;
/*38:*/
#line 642 "./decision_rule.cweb"
ExplicitShockRealization::ExplicitShockRealization(ShockRealization&sr,
int num_per)
:shocks(sr.numShocks(),num_per)
{
for(int j= 0;j<num_per;j++){
Vector jcol(shocks,j);
sr.get(j,jcol);
}
}
/*:38*/
#line 66 "./decision_rule.cweb"
;
/*39:*/
#line 654 "./decision_rule.cweb"
void ExplicitShockRealization::get(int n,Vector&out)
{
KORD_RAISE_IF(out.length()!=numShocks(),
"Wrong length of out vector in ExplicitShockRealization::get");
int i= n%shocks.ncols();
ConstVector icol(shocks,i);
out= icol;
}
/*:39*/
#line 67 "./decision_rule.cweb"
;
/*40:*/
#line 665 "./decision_rule.cweb"
void ExplicitShockRealization::addToShock(int ishock,int iper,double val)
{
KORD_RAISE_IF(ishock<0||ishock> numShocks(),
"Wrong index of shock in ExplicitShockRealization::addToShock");
int j= iper%shocks.ncols();
shocks.get(ishock,j)+= val;
}
/*:40*/
#line 68 "./decision_rule.cweb"
;
/*41:*/
#line 676 "./decision_rule.cweb"
void GenShockRealization::get(int n,Vector&out)
{
KORD_RAISE_IF(out.length()!=numShocks(),
"Wrong length of out vector in GenShockRealization::get");
ExplicitShockRealization::get(n,out);
Vector r(numShocks());
RandomShockRealization::get(n,r);
for(int j= 0;j<numShocks();j++)
if(!isfinite(out[j]))
out[j]= r[j];
}
/*:41*/
#line 69 "./decision_rule.cweb"
;
/*:1*/

828
mex/sources/korderpert/Dyn_pp/kord/decision_rule.h Normal file
View File

@ -0,0 +1,828 @@
/*1:*/
#line 38 "./decision_rule.hweb"
#ifndef DECISION_RULE_H
#define DECISION_RULE_H
#include "kord_exception.h"
#include "korder.h"
#include "normal_conjugate.h"
#include "mersenne_twister.h"
/*2:*/
#line 73 "./decision_rule.hweb"
class ShockRealization{
public:
virtual~ShockRealization(){}
virtual void get(int n,Vector&out)= 0;
virtual int numShocks()const= 0;
};
/*:2*/
#line 47 "./decision_rule.hweb"
;
/*3:*/
#line 94 "./decision_rule.hweb"
class DecisionRule{
public:
enum emethod{horner,trad};
virtual~DecisionRule(){}
virtual TwoDMatrix*simulate(emethod em,int np,const Vector&ystart,
ShockRealization&sr)const= 0;
virtual void eval(emethod em,Vector&out,const ConstVector&v)const= 0;
virtual void evaluate(emethod em,Vector&out,const ConstVector&ys,
const ConstVector&u)const= 0;
virtual void writeMat4(FILE*fd,const char*prefix)const= 0;
virtual DecisionRule*centralizedClone(const Vector&fixpoint)const= 0;
virtual const Vector&getSteady()const= 0;
virtual int nexog()const= 0;
virtual const PartitionY&getYPart()const= 0;
};
/*:3*/
#line 48 "./decision_rule.hweb"
;
/*4:*/
#line 134 "./decision_rule.hweb"
template<int t>
class DecisionRuleImpl:public ctraits<t> ::Tpol,public DecisionRule{
protected:
typedef typename ctraits<t> ::Tpol _Tparent;
const Vector ysteady;
const PartitionY ypart;
const int nu;
public:
DecisionRuleImpl(const _Tparent&pol,const PartitionY&yp,int nuu,
const Vector&ys)
:ctraits<t> ::Tpol(pol),ysteady(ys),ypart(yp),nu(nuu){}
DecisionRuleImpl(_Tparent&pol,const PartitionY&yp,int nuu,
const Vector&ys)
:ctraits<t> ::Tpol(0,yp.ny(),pol),ysteady(ys),ypart(yp),
nu(nuu){}
DecisionRuleImpl(const _Tg&g,const PartitionY&yp,int nuu,
const Vector&ys,double sigma)
:ctraits<t> ::Tpol(yp.ny(),yp.nys()+nuu),ysteady(ys),ypart(yp),nu(nuu)
{fillTensors(g,sigma);}
DecisionRuleImpl(const DecisionRuleImpl<t> &dr,const ConstVector&fixpoint)
:ctraits<t> ::Tpol(dr.ypart.ny(),dr.ypart.nys()+dr.nu),
ysteady(fixpoint),ypart(dr.ypart),nu(dr.nu)
{centralize(dr);}
const Vector&getSteady()const
{return ysteady;}
/*8:*/
#line 290 "./decision_rule.hweb"
TwoDMatrix*simulate(emethod em,int np,const Vector&ystart,
ShockRealization&sr)const
{
KORD_RAISE_IF(ysteady.length()!=ystart.length(),
"Start and steady lengths differ in DecisionRuleImpl::simulate");
TwoDMatrix*res= new TwoDMatrix(ypart.ny(),np);
/*9:*/
#line 309 "./decision_rule.hweb"
Vector dyu(ypart.nys()+nu);
ConstVector ystart_pred(ystart,ypart.nstat,ypart.nys());
ConstVector ysteady_pred(ysteady,ypart.nstat,ypart.nys());
Vector dy(dyu,0,ypart.nys());
Vector u(dyu,ypart.nys(),nu);
/*:9*/
#line 298 "./decision_rule.hweb"
;
/*10:*/
#line 320 "./decision_rule.hweb"
dy= ystart_pred;
dy.add(-1.0,ysteady_pred);
sr.get(0,u);
Vector out(*res,0);
eval(em,out,dyu);
/*:10*/
#line 299 "./decision_rule.hweb"
;
/*11:*/
#line 330 "./decision_rule.hweb"
for(int i= 1;i<np;i++){
ConstVector ym(*res,i-1);
ConstVector dym(ym,ypart.nstat,ypart.nys());
dy= dym;
sr.get(i,u);
Vector out(*res,i);
eval(em,out,dyu);
if(!out.isFinite()){
if(i+1<np){
TwoDMatrix rest(*res,i+1,np-i-1);
rest.zeros();
}
return res;
}
}
/*:11*/
#line 300 "./decision_rule.hweb"
;
/*12:*/
#line 348 "./decision_rule.hweb"
for(int i= 0;i<res->ncols();i++){
Vector col(*res,i);
col.add(1.0,ysteady);
}
/*:12*/
#line 301 "./decision_rule.hweb"
;
return res;
}
/*:8*/
#line 160 "./decision_rule.hweb"
;
/*13:*/
#line 360 "./decision_rule.hweb"
void evaluate(emethod em,Vector&out,const ConstVector&ys,
const ConstVector&u)const
{
KORD_RAISE_IF(ys.length()!=ypart.nys()||u.length()!=nu,
"Wrong dimensions of input vectors in DecisionRuleImpl::evaluate");
KORD_RAISE_IF(out.length()!=ypart.ny(),
"Wrong dimension of output vector in DecisionRuleImpl::evaluate");
ConstVector ysteady_pred(ysteady,ypart.nstat,ypart.nys());
Vector ys_u(ypart.nys()+nu);
Vector ys_u1(ys_u,0,ypart.nys());
ys_u1= ys;
ys_u1.add(-1.0,ysteady_pred);
Vector ys_u2(ys_u,ypart.nys(),nu);
ys_u2= u;
eval(em,out,ys_u);
out.add(1.0,ysteady);
}
/*:13*/
#line 161 "./decision_rule.hweb"
;
/*14:*/
#line 382 "./decision_rule.hweb"
DecisionRule*centralizedClone(const Vector&fixpoint)const
{
return new DecisionRuleImpl<t> (*this,fixpoint);
}
/*:14*/
#line 162 "./decision_rule.hweb"
;
/*16:*/
#line 401 "./decision_rule.hweb"
void writeMat4(FILE*fd,const char*prefix)const
{
ctraits<t> ::Tpol::writeMat4(fd,prefix);
TwoDMatrix dum(ysteady.length(),1);
dum.getData()= ysteady;
char tmp[100];
sprintf(tmp,"%s_ss",prefix);
ConstTwoDMatrix(dum).writeMat4(fd,tmp);
}
/*:16*/
#line 163 "./decision_rule.hweb"
;
int nexog()const
{return nu;}
const PartitionY&getYPart()const
{return ypart;}
protected:
/*5:*/
#line 210 "./decision_rule.hweb"
void fillTensors(const _Tg&g,double sigma)
{
IntSequence tns(2);
tns[0]= ypart.nys();tns[1]= nu;
int dfact= 1;
for(int d= 0;d<=g.getMaxDim();d++,dfact*= d){
_Ttensym*g_yud= new _Ttensym(ypart.ny(),ypart.nys()+nu,d);
g_yud->zeros();
/*6:*/
#line 234 "./decision_rule.hweb"
for(int i= 0;i<=d;i++){
int j= d-i;
int kfact= 1;
_Ttensor tmp(ypart.ny(),
TensorDimens(Symmetry(i,j),tns));
tmp.zeros();
for(int k= 0;k+d<=g.getMaxDim();k++,kfact*= k){
Symmetry sym(i,j,0,k);
if(g.check(sym)){
double mult= pow(sigma,k)/dfact/kfact;
tmp.add(mult,*(g.get(sym)));
}
}
g_yud->addSubTensor(tmp);
}
/*:6*/
#line 219 "./decision_rule.hweb"
;
insert(g_yud);
}
}
/*:5*/
#line 169 "./decision_rule.hweb"
;
/*7:*/
#line 260 "./decision_rule.hweb"
void centralize(const DecisionRuleImpl&dr)
{
Vector dstate(ypart.nys()+nu);
dstate.zeros();
Vector dstate_star(dstate,0,ypart.nys());
ConstVector newsteady_star(ysteady,ypart.nstat,ypart.nys());
ConstVector oldsteady_star(dr.ysteady,ypart.nstat,ypart.nys());
dstate_star.add(1.0,newsteady_star);
dstate_star.add(-1.0,oldsteady_star);
_Tpol pol(dr);
for(int d= 1;d<=dr.getMaxDim();d++){
pol.derivative(d-1);
_Ttensym*der= pol.evalPartially(d,dstate);
insert(der);
}
}
/*:7*/
#line 170 "./decision_rule.hweb"
;
/*15:*/
#line 391 "./decision_rule.hweb"
void eval(emethod em,Vector&out,const ConstVector&v)const
{
if(em==DecisionRule::horner)
_Tparent::evalHorner(out,v);
else
_Tparent::evalTrad(out,v);
}
/*:15*/
#line 171 "./decision_rule.hweb"
;
};
/*:4*/
#line 49 "./decision_rule.hweb"
;
/*17:*/
#line 417 "./decision_rule.hweb"
class UnfoldDecisionRule;
class FoldDecisionRule:public DecisionRuleImpl<KOrder::fold> {
friend class UnfoldDecisionRule;
public:
FoldDecisionRule(const ctraits<KOrder::fold> ::Tpol&pol,const PartitionY&yp,int nuu,
const Vector&ys)
:DecisionRuleImpl<KOrder::fold> (pol,yp,nuu,ys){}
FoldDecisionRule(ctraits<KOrder::fold> ::Tpol&pol,const PartitionY&yp,int nuu,
const Vector&ys)
:DecisionRuleImpl<KOrder::fold> (pol,yp,nuu,ys){}
FoldDecisionRule(const ctraits<KOrder::fold> ::Tg&g,const PartitionY&yp,int nuu,
const Vector&ys,double sigma)
:DecisionRuleImpl<KOrder::fold> (g,yp,nuu,ys,sigma){}
FoldDecisionRule(const DecisionRuleImpl<KOrder::fold> &dr,const ConstVector&fixpoint)
:DecisionRuleImpl<KOrder::fold> (dr,fixpoint){}
FoldDecisionRule(const UnfoldDecisionRule&udr);
};
/*:17*/
#line 50 "./decision_rule.hweb"
;
/*18:*/
#line 440 "./decision_rule.hweb"
class UnfoldDecisionRule:public DecisionRuleImpl<KOrder::unfold> {
friend class FoldDecisionRule;
public:
UnfoldDecisionRule(const ctraits<KOrder::unfold> ::Tpol&pol,const PartitionY&yp,int nuu,
const Vector&ys)
:DecisionRuleImpl<KOrder::unfold> (pol,yp,nuu,ys){}
UnfoldDecisionRule(ctraits<KOrder::unfold> ::Tpol&pol,const PartitionY&yp,int nuu,
const Vector&ys)
:DecisionRuleImpl<KOrder::unfold> (pol,yp,nuu,ys){}
UnfoldDecisionRule(const ctraits<KOrder::unfold> ::Tg&g,const PartitionY&yp,int nuu,
const Vector&ys,double sigma)
:DecisionRuleImpl<KOrder::unfold> (g,yp,nuu,ys,sigma){}
UnfoldDecisionRule(const DecisionRuleImpl<KOrder::unfold> &dr,const ConstVector&fixpoint)
:DecisionRuleImpl<KOrder::unfold> (dr,fixpoint){}
UnfoldDecisionRule(const FoldDecisionRule&udr);
};
/*:18*/
#line 51 "./decision_rule.hweb"
;
/*19:*/
#line 472 "./decision_rule.hweb"
template<int t>
class DRFixPoint:public ctraits<t> ::Tpol{
typedef typename ctraits<t> ::Tpol _Tparent;
static int max_iter;
static int max_newton_iter;
static int newton_pause;
static double tol;
const Vector ysteady;
const PartitionY ypart;
_Tparent*bigf;
_Tparent*bigfder;
public:
typedef typename DecisionRule::emethod emethod;
/*20:*/
#line 511 "./decision_rule.hweb"
DRFixPoint(const _Tg&g,const PartitionY&yp,
const Vector&ys,double sigma)
:ctraits<t> ::Tpol(yp.ny(),yp.nys()),
ysteady(ys),ypart(yp),bigf(NULL),bigfder(NULL)
{
fillTensors(g,sigma);
_Tparent yspol(ypart.nstat,ypart.nys(),*this);
bigf= new _Tparent((const _Tparent&)yspol);
_Ttensym*frst= bigf->get(Symmetry(1));
for(int i= 0;i<ypart.nys();i++)
frst->get(i,i)= frst->get(i,i)-1;
bigfder= new _Tparent(*bigf,0);
}
/*:20*/
#line 486 "./decision_rule.hweb"
;
/*21:*/
#line 527 "./decision_rule.hweb"
virtual~DRFixPoint()
{
if(bigf)
delete bigf;
if(bigfder)
delete bigfder;
}
/*:21*/
#line 487 "./decision_rule.hweb"
;
/*25:*/
#line 650 "./decision_rule.hweb"
bool calcFixPoint(emethod em,Vector&out)
{
KORD_RAISE_IF(out.length()!=ypart.ny(),
"Wrong length of out in DRFixPoint::calcFixPoint");
Vector delta(ypart.nys());
Vector ystar(ypart.nys());
ystar.zeros();
iter= 0;
newton_iter_last= 0;
newton_iter_total= 0;
bool converged= false;
do{
if((iter/newton_pause)*newton_pause==iter)
converged= solveNewton(ystar);
if(!converged){
bigf->evalHorner(delta,ystar);
KORD_RAISE_IF_X(!delta.isFinite(),
"NaN or Inf asserted in DRFixPoint::calcFixPoint",
KORD_FP_NOT_FINITE);
ystar.add(1.0,delta);
converged= delta.getNorm()<tol;
}
iter++;
}while(iter<max_iter&&!converged);
if(converged){
_Tparent::evalHorner(out,ystar);
out.add(1.0,ysteady);
}
return converged;
}
/*:25*/
#line 488 "./decision_rule.hweb"
;
int getNumIter()const
{return iter;}
int getNewtonLastIter()const
{return newton_iter_last;}
int getNewtonTotalIter()const
{return newton_iter_total;}
protected:
/*22:*/
#line 542 "./decision_rule.hweb"
void fillTensors(const _Tg&g,double sigma)
{
int dfact= 1;
for(int d= 0;d<=g.getMaxDim();d++,dfact*= d){
_Ttensym*g_yd= new _Ttensym(ypart.ny(),ypart.nys(),d);
g_yd->zeros();
int kfact= 1;
for(int k= 0;d+k<=g.getMaxDim();k++,kfact*= k){
if(g.check(Symmetry(d,0,0,k))){
const _Ttensor*ten= g.get(Symmetry(d,0,0,k));
double mult= pow(sigma,k)/dfact/kfact;
g_yd->add(mult,*ten);
}
}
insert(g_yd);
}
}
/*:22*/
#line 496 "./decision_rule.hweb"
;
/*23:*/
#line 575 "./decision_rule.hweb"
bool solveNewton(Vector&y)
{
const double urelax_threshold= 1.e-5;
Vector sol((const Vector&)y);
Vector delta(y.length());
newton_iter_last= 0;
bool delta_finite= true;
double flastnorm= 0.0;
double fnorm= 0.0;
bool converged= false;
double urelax= 1.0;
do{
_Ttensym*jacob= bigfder->evalPartially(1,sol);
bigf->evalHorner(delta,sol);
if(newton_iter_last==0)
flastnorm= delta.getNorm();
delta_finite= delta.isFinite();
if(delta_finite){
ConstTwoDMatrix(*jacob).multInvLeft(delta);
/*24:*/
#line 620 "./decision_rule.hweb"
bool urelax_found= false;
urelax= 1.0;
while(!urelax_found&&urelax> urelax_threshold){
Vector soltmp((const Vector&)sol);
soltmp.add(-urelax,delta);
Vector f(sol.length());
bigf->evalHorner(f,soltmp);
fnorm= f.getNorm();
if(fnorm<=flastnorm)
urelax_found= true;
else
urelax*= std::min(0.5,flastnorm/fnorm);
}
/*:24*/
#line 596 "./decision_rule.hweb"
;
sol.add(-urelax,delta);
delta_finite= delta.isFinite();
}
delete jacob;
newton_iter_last++;
converged= delta_finite&&fnorm<tol;
flastnorm= fnorm;
}while(!converged&&newton_iter_last<max_newton_iter
&&urelax> urelax_threshold);
newton_iter_total+= newton_iter_last;
if(!converged)
newton_iter_last= 0;
y= (const Vector&)sol;
return converged;
}
/*:23*/
#line 497 "./decision_rule.hweb"
;
private:
int iter;
int newton_iter_last;
int newton_iter_total;
};
/*:19*/
#line 52 "./decision_rule.hweb"
;
/*26:*/
#line 691 "./decision_rule.hweb"
class ExplicitShockRealization;
class SimResults{
protected:
int num_y;
int num_per;
vector<TwoDMatrix*> data;
vector<ExplicitShockRealization*> shocks;
public:
SimResults(int ny,int nper)
:num_y(ny),num_per(nper){}
virtual~SimResults();
void simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov,Journal&journal);
void simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov);
int getNumPer()const
{return num_per;}
int getNumSets()const
{return(int)data.size();}
const TwoDMatrix&getData(int i)const
{return*(data[i]);}
const ExplicitShockRealization&getShocks(int i)const
{return*(shocks[i]);}
bool addDataSet(TwoDMatrix*d,ExplicitShockRealization*sr);
void writeMat4(const char*base,const char*lname)const;
void writeMat4(FILE*fd,const char*lname)const;
};
/*:26*/
#line 53 "./decision_rule.hweb"
;
/*27:*/
#line 723 "./decision_rule.hweb"
class SimResultsStats:public SimResults{
protected:
Vector mean;
TwoDMatrix vcov;
public:
SimResultsStats(int ny,int nper)
:SimResults(ny,nper),mean(ny),vcov(ny,ny){}
void simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov,Journal&journal);
void writeMat4(FILE*fd,const char*lname)const;
protected:
void calcMean();
void calcVcov();
};
/*:27*/
#line 54 "./decision_rule.hweb"
;
/*28:*/
#line 743 "./decision_rule.hweb"
class SimResultsDynamicStats:public SimResults{
protected:
TwoDMatrix mean;
TwoDMatrix variance;
public:
SimResultsDynamicStats(int ny,int nper)
:SimResults(ny,nper),mean(ny,nper),variance(ny,nper){}
void simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov,Journal&journal);
void writeMat4(FILE*fd,const char*lname)const;
protected:
void calcMean();
void calcVariance();
};
/*:28*/
#line 55 "./decision_rule.hweb"
;
/*29:*/
#line 767 "./decision_rule.hweb"
class SimulationIRFWorker;
class SimResultsIRF:public SimResults{
friend class SimulationIRFWorker;
protected:
const SimResults&control;
int ishock;
double imp;
TwoDMatrix means;
TwoDMatrix variances;
public:
SimResultsIRF(const SimResults&cntl,int ny,int nper,int i,double impulse)
:SimResults(ny,nper),control(cntl),
ishock(i),imp(impulse),
means(ny,nper),variances(ny,nper){}
void simulate(const DecisionRule&dr,const Vector&start,
Journal&journal);
void simulate(const DecisionRule&dr,const Vector&start);
void writeMat4(FILE*fd,const char*lname)const;
protected:
void calcMeans();
void calcVariances();
};
/*:29*/
#line 56 "./decision_rule.hweb"
;
/*30:*/
#line 797 "./decision_rule.hweb"
class RTSimulationWorker;
class RTSimResultsStats{
friend class RTSimulationWorker;
protected:
Vector mean;
TwoDMatrix vcov;
int num_per;
NormalConj nc;
int incomplete_simulations;
int thrown_periods;
public:
RTSimResultsStats(int ny,int nper)
:mean(ny),vcov(ny,ny),
num_per(nper),nc(ny),
incomplete_simulations(0),thrown_periods(0){}
void simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov,Journal&journal);
void simulate(int num_sim,const DecisionRule&dr,const Vector&start,
const TwoDMatrix&vcov);
void writeMat4(FILE*fd,const char*lname);
};
/*:30*/
#line 57 "./decision_rule.hweb"
;
/*31:*/
#line 834 "./decision_rule.hweb"
class DynamicModel;
class IRFResults{
vector<SimResultsIRF*> irf_res;
const DynamicModel&model;
vector<int> irf_list_ind;
public:
IRFResults(const DynamicModel&mod,const DecisionRule&dr,
const SimResults&control,const vector<int> &ili,
Journal&journal);
~IRFResults();
void writeMat4(FILE*fd,const char*prefix)const;
};
/*:31*/
#line 58 "./decision_rule.hweb"
;
/*32:*/
#line 851 "./decision_rule.hweb"
class SimulationWorker:public THREAD{
protected:
SimResults&res;
const DecisionRule&dr;
DecisionRule::emethod em;
int np;
const Vector&st;
ShockRealization&sr;
public:
SimulationWorker(SimResults&sim_res,
const DecisionRule&dec_rule,
DecisionRule::emethod emet,int num_per,
const Vector&start,ShockRealization&shock_r)
:res(sim_res),dr(dec_rule),em(emet),np(num_per),st(start),sr(shock_r){}
void operator()();
};
/*:32*/
#line 59 "./decision_rule.hweb"
;
/*33:*/
#line 874 "./decision_rule.hweb"
class SimulationIRFWorker:public THREAD{
SimResultsIRF&res;
const DecisionRule&dr;
DecisionRule::emethod em;
int np;
const Vector&st;
int idata;
int ishock;
double imp;
public:
SimulationIRFWorker(SimResultsIRF&sim_res,
const DecisionRule&dec_rule,
DecisionRule::emethod emet,int num_per,
const Vector&start,int id,
int ishck,double impulse)
:res(sim_res),dr(dec_rule),em(emet),np(num_per),st(start),
idata(id),ishock(ishck),imp(impulse){}
void operator()();
};
/*:33*/
#line 60 "./decision_rule.hweb"
;
/*34:*/
#line 901 "./decision_rule.hweb"
class RTSimulationWorker:public THREAD{
protected:
RTSimResultsStats&res;
const DecisionRule&dr;
DecisionRule::emethod em;
int np;
const Vector&ystart;
ShockRealization&sr;
public:
RTSimulationWorker(RTSimResultsStats&sim_res,
const DecisionRule&dec_rule,
DecisionRule::emethod emet,int num_per,
const Vector&start,ShockRealization&shock_r)
:res(sim_res),dr(dec_rule),em(emet),np(num_per),ystart(start),sr(shock_r){}
void operator()();
};
/*:34*/
#line 61 "./decision_rule.hweb"
;
/*35:*/
#line 923 "./decision_rule.hweb"
class RandomShockRealization:virtual public ShockRealization{
protected:
MersenneTwister mtwister;
TwoDMatrix factor;
public:
RandomShockRealization(const TwoDMatrix&v,unsigned int iseed)
:mtwister(iseed),factor(v.nrows(),v.nrows())
{schurFactor(v);}
RandomShockRealization(const RandomShockRealization&sr)
:mtwister(sr.mtwister),factor(sr.factor){}
virtual~RandomShockRealization(){}
void get(int n,Vector&out);
int numShocks()const
{return factor.nrows();}
protected:
void choleskyFactor(const TwoDMatrix&v);
void schurFactor(const TwoDMatrix&v);
};
/*:35*/
#line 62 "./decision_rule.hweb"
;
/*36:*/
#line 946 "./decision_rule.hweb"
class ExplicitShockRealization:virtual public ShockRealization{
TwoDMatrix shocks;
public:
ExplicitShockRealization(const TwoDMatrix&sh)
:shocks(sh){}
ExplicitShockRealization(const ExplicitShockRealization&sr)
:shocks(sr.shocks){}
ExplicitShockRealization(ShockRealization&sr,int num_per);
void get(int n,Vector&out);
int numShocks()const
{return shocks.nrows();}
void addToShock(int ishock,int iper,double val);
void print()const
{shocks.print();}
};
/*:36*/
#line 63 "./decision_rule.hweb"
;
/*37:*/
#line 972 "./decision_rule.hweb"
class GenShockRealization:public RandomShockRealization,public ExplicitShockRealization{
public:
GenShockRealization(const TwoDMatrix&v,const TwoDMatrix&sh,int seed)
:RandomShockRealization(v,seed),ExplicitShockRealization(sh)
{
KORD_RAISE_IF(sh.nrows()!=v.nrows()||v.nrows()!=v.ncols(),
"Wrong dimension of input matrix in GenShockRealization constructor");
}
void get(int n,Vector&out);
int numShocks()const
{return RandomShockRealization::numShocks();}
};
/*:37*/
#line 64 "./decision_rule.hweb"
;
#endif
/*:1*/

65
mex/sources/korderpert/Dyn_pp/kord/dynamic_model.cpp Normal file
View File

@ -0,0 +1,65 @@
/*1:*/
#line 6 "./dynamic_model.cweb"
#include "dynamic_model.h"
/*2:*/
#line 14 "./dynamic_model.cweb"
void NameList::print()const
{
for(int i= 0;i<getNum();i++)
printf("%s\n",getName(i));
}
/*:2*/
#line 9 "./dynamic_model.cweb"
;
/*3:*/
#line 22 "./dynamic_model.cweb"
void NameList::writeMat4(FILE*fd,const char*vname)const
{
int maxlen= 0;
for(int i= 0;i<getNum();i++)
if(maxlen<(int)strlen(getName(i)))
maxlen= (int)strlen(getName(i));
if(maxlen==0)
return;
TwoDMatrix m(getNum(),maxlen);
for(int i= 0;i<getNum();i++)
for(int j= 0;j<maxlen;j++)
if(j<(int)strlen(getName(i)))
m.get(i,j)= (double)(getName(i)[j]);
else
m.get(i,j)= (double)(' ');
Mat4Header header(m,vname,"text matrix");
header.write(fd);
fwrite(m.getData().base(),sizeof(double),m.nrows()*m.ncols(),fd);
}
/*:3*/
#line 10 "./dynamic_model.cweb"
;
/*4:*/
#line 47 "./dynamic_model.cweb"
void NameList::writeMat4Indices(FILE*fd,const char*prefix)const
{
char tmp[100];
TwoDMatrix aux(1,1);
for(int i= 0;i<getNum();i++){
sprintf(tmp,"%s_i_%s",prefix,getName(i));
aux.get(0,0)= i+1;
aux.writeMat4(fd,tmp);
}
}
/*:4*/
#line 11 "./dynamic_model.cweb"
;
/*:1*/

67
mex/sources/korderpert/Dyn_pp/kord/dynamic_model.h Normal file
View File

@ -0,0 +1,67 @@
/*1:*/
#line 13 "./dynamic_model.hweb"
#ifndef DYNAMIC_MODEL_H
#define DYNAMIC_MODEL_H
#include "t_container.h"
#include "sparse_tensor.h"
#include "Vector.h"
/*2:*/
#line 29 "./dynamic_model.hweb"
class NameList{
public:
virtual~NameList(){}
virtual int getNum()const= 0;
virtual const char*getName(int i)const= 0;
void print()const;
void writeMat4(FILE*fd,const char*vname)const;
void writeMat4Indices(FILE*fd,const char*prefix)const;
};
/*:2*/
#line 22 "./dynamic_model.hweb"
;
/*3:*/
#line 89 "./dynamic_model.hweb"
class DynamicModel{
public:
virtual DynamicModel*clone()const= 0;
virtual~DynamicModel(){}
virtual int nstat()const= 0;
virtual int nboth()const= 0;
virtual int npred()const= 0;
virtual int nforw()const= 0;
virtual int nexog()const= 0;
virtual int order()const= 0;
int numeq()const
{return nstat()+nboth()+npred()+nforw();}
virtual const NameList&getAllEndoNames()const= 0;
virtual const NameList&getStateNames()const= 0;
virtual const NameList&getExogNames()const= 0;
virtual const TwoDMatrix&getVcov()const= 0;
virtual const TensorContainer<FSSparseTensor> &getModelDerivatives()const= 0;
virtual const Vector&getSteady()const= 0;
virtual Vector&getSteady()= 0;
virtual void solveDeterministicSteady()= 0;
virtual void evaluateSystem(Vector&out,const Vector&yy,const Vector&xx)= 0;
virtual void evaluateSystem(Vector&out,const Vector&yym,const Vector&yy,
const Vector&yyp,const Vector&xx)= 0;
virtual void calcDerivativesAtSteady()= 0;
};
/*:3*/
#line 23 "./dynamic_model.hweb"
;
#endif
/*:1*/

130
mex/sources/korderpert/Dyn_pp/kord/faa_di_bruno.cpp Normal file
View File

@ -0,0 +1,130 @@
/*1:*/
#line 9 "./faa_di_bruno.cweb"
#include "faa_di_bruno.h"
#include "fine_container.h"
#include <math.h>
double FaaDiBruno::magic_mult= 1.5;
/*2:*/
#line 25 "./faa_di_bruno.cweb"
void FaaDiBruno::calculate(const StackContainer<FGSTensor> &cont,
const TensorContainer<FSSparseTensor> &f,
FGSTensor&out)
{
out.zeros();
for(int l= 1;l<=out.dimen();l++){
int mem_mb,p_size_mb;
int max= estimRefinment(out.getDims(),out.nrows(),l,mem_mb,p_size_mb);
FoldedFineContainer fine_cont(cont,max);
fine_cont.multAndAdd(l,f,out);
JournalRecord recc(journal);
recc<<"dim="<<l<<" avmem="<<mem_mb<<" tmpmem="<<p_size_mb<<" max="<<max
<<" stacks="<<cont.numStacks()<<"->"<<fine_cont.numStacks()<<endrec;
}
}
/*:2*/
#line 16 "./faa_di_bruno.cweb"
;
/*3:*/
#line 45 "./faa_di_bruno.cweb"
void FaaDiBruno::calculate(const FoldedStackContainer&cont,const FGSContainer&g,
FGSTensor&out)
{
out.zeros();
for(int l= 1;l<=out.dimen();l++){
long int mem= SystemResources::availableMemory();
cont.multAndAdd(l,g,out);
JournalRecord rec(journal);
int mem_mb= mem/1024/1024;
rec<<"dim="<<l<<" avmem="<<mem_mb<<endrec;
}
}
/*:3*/
#line 17 "./faa_di_bruno.cweb"
;
/*4:*/
#line 63 "./faa_di_bruno.cweb"
void FaaDiBruno::calculate(const StackContainer<UGSTensor> &cont,
const TensorContainer<FSSparseTensor> &f,
UGSTensor&out)
{
out.zeros();
for(int l= 1;l<=out.dimen();l++){
int mem_mb,p_size_mb;
int max= estimRefinment(out.getDims(),out.nrows(),l,mem_mb,p_size_mb);
UnfoldedFineContainer fine_cont(cont,max);
fine_cont.multAndAdd(l,f,out);
JournalRecord recc(journal);
recc<<"dim="<<l<<" avmem="<<mem_mb<<" tmpmem="<<p_size_mb<<" max="<<max
<<" stacks="<<cont.numStacks()<<"->"<<fine_cont.numStacks()<<endrec;
}
}
/*:4*/
#line 18 "./faa_di_bruno.cweb"
;
/*5:*/
#line 81 "./faa_di_bruno.cweb"
void FaaDiBruno::calculate(const UnfoldedStackContainer&cont,const UGSContainer&g,
UGSTensor&out)
{
out.zeros();
for(int l= 1;l<=out.dimen();l++){
long int mem= SystemResources::availableMemory();
cont.multAndAdd(l,g,out);
JournalRecord rec(journal);
int mem_mb= mem/1024/1024;
rec<<"dim="<<l<<" avmem="<<mem_mb<<endrec;
}
}
/*:5*/
#line 19 "./faa_di_bruno.cweb"
;
/*6:*/
#line 126 "./faa_di_bruno.cweb"
int FaaDiBruno::estimRefinment(const TensorDimens&tdims,int nr,int l,
int&avmem_mb,int&tmpmem_mb)
{
int nthreads= THREAD_GROUP::max_parallel_threads;
long int per_size1= tdims.calcUnfoldMaxOffset();
long int per_size2= (long int)pow((double)tdims.getNVS().getMax(),l);
double lambda= 0.0;
long int per_size= sizeof(double)*nr
*(long int)(lambda*per_size1+(1-lambda)*per_size2);
long int mem= SystemResources::availableMemory();
int max= 0;
double num_cols= ((double)(mem-magic_mult*nthreads*per_size))
/nthreads/sizeof(double)/nr;
if(num_cols> 0){
double maxd= pow(num_cols,((double)1)/l);
max= (int)floor(maxd);
}
if(max==0){
max= 10;
JournalRecord rec(journal);
rec<<"dim="<<l<<" run out of memory, imposing max="<<max;
if(nthreads> 1)
rec<<" (decrease number of threads)";
rec<<endrec;
}
avmem_mb= mem/1024/1024;
tmpmem_mb= (nthreads*per_size)/1024/1024;
return max;
}
/*:6*/
#line 20 "./faa_di_bruno.cweb"
;
/*:1*/

40
mex/sources/korderpert/Dyn_pp/kord/faa_di_bruno.h Normal file
View File

@ -0,0 +1,40 @@
/*1:*/
#line 13 "./faa_di_bruno.hweb"
#ifndef FAA_DI_BRUNO_H
#define FAA_DI_BRUNO_H
#include "journal.h"
#include "stack_container.h"
#include "t_container.h"
#include "sparse_tensor.h"
#include "gs_tensor.h"
/*2:*/
#line 30 "./faa_di_bruno.hweb"
class FaaDiBruno{
Journal&journal;
public:
FaaDiBruno(Journal&jr)
:journal(jr){}
void calculate(const StackContainer<FGSTensor> &cont,const TensorContainer<FSSparseTensor> &f,
FGSTensor&out);
void calculate(const FoldedStackContainer&cont,const FGSContainer&g,
FGSTensor&out);
void calculate(const StackContainer<UGSTensor> &cont,const TensorContainer<FSSparseTensor> &f,
UGSTensor&out);
void calculate(const UnfoldedStackContainer&cont,const UGSContainer&g,
UGSTensor&out);
protected:
int estimRefinment(const TensorDimens&tdims,int nr,int l,int&avmem_mb,int&tmpmem_mb);
static double magic_mult;
};
/*:2*/
#line 23 "./faa_di_bruno.hweb"
;
#endif
/*:1*/

233
mex/sources/korderpert/Dyn_pp/kord/first_order.cpp Normal file
View File

@ -0,0 +1,233 @@
/*1:*/
#line 6 "./first_order.cweb"
#include "kord_exception.h"
#include "first_order.h"
#include "cpplapack.h"
/*2:*/
#line 20 "./first_order.cweb"
int order_eigs(const double*alphar,const double*alphai,const double*beta)
{
return(*alphar**alphar+*alphai**alphai<*beta**beta);
}
/*:2*/
#line 12 "./first_order.cweb"
;
/*3:*/
#line 40 "./first_order.cweb"
void FirstOrder::solve(const TwoDMatrix&fd)
{
JournalRecordPair pa(journal);
pa<<"Recovering first order derivatives "<<endrec;
/*4:*/
#line 132 "./first_order.cweb"
/*5:*/
#line 145 "./first_order.cweb"
int off= 0;
ConstTwoDMatrix fyplus(fd,off,ypart.nyss());
off+= ypart.nyss();
ConstTwoDMatrix fyszero(fd,off,ypart.nstat);
off+= ypart.nstat;
ConstTwoDMatrix fypzero(fd,off,ypart.npred);
off+= ypart.npred;
ConstTwoDMatrix fybzero(fd,off,ypart.nboth);
off+= ypart.nboth;
ConstTwoDMatrix fyfzero(fd,off,ypart.nforw);
off+= ypart.nforw;
ConstTwoDMatrix fymins(fd,off,ypart.nys());
off+= ypart.nys();
ConstTwoDMatrix fuzero(fd,off,nu);
off+= nu;
/*:5*/
#line 133 "./first_order.cweb"
;
/*6:*/
#line 163 "./first_order.cweb"
int n= ypart.ny()+ypart.nboth;
TwoDMatrix matD(n,n);
matD.zeros();
matD.place(fypzero,0,0);
matD.place(fybzero,0,ypart.npred);
matD.place(fyplus,0,ypart.nys()+ypart.nstat);
for(int i= 0;i<ypart.nboth;i++)
matD.get(ypart.ny()+i,ypart.npred+i)= 1.0;
/*:6*/
#line 134 "./first_order.cweb"
;
/*7:*/
#line 175 "./first_order.cweb"
TwoDMatrix matE(n,n);
matE.zeros();
matE.place(fymins,0,0);
matE.place(fyszero,0,ypart.nys());
matE.place(fyfzero,0,ypart.nys()+ypart.nstat+ypart.nboth);
for(int i= 0;i<ypart.nboth;i++)
matE.get(ypart.ny()+i,ypart.nys()+ypart.nstat+i)= -1.0;
matE.mult(-1.0);
/*:7*/
#line 135 "./first_order.cweb"
;
/*8:*/
#line 186 "./first_order.cweb"
TwoDMatrix vsl(n,n);
TwoDMatrix vsr(n,n);
int lwork= 100*n+16;
Vector work(lwork);
IntSequence bwork(n);
int info;
LAPACK_dgges("N","V","S",order_eigs,&n,matE.getData().base(),&n,
matD.getData().base(),&n,&sdim,alphar.base(),alphai.base(),
beta.base(),vsl.getData().base(),&n,vsr.getData().base(),&n,
work.base(),&lwork,&(bwork[0]),&info);
bk_cond= (sdim==ypart.nys());
/*:8*/
#line 136 "./first_order.cweb"
;
/*9:*/
#line 201 "./first_order.cweb"
ConstGeneralMatrix z11(vsr,0,0,ypart.nys(),ypart.nys());
ConstGeneralMatrix z12(vsr,0,ypart.nys(),ypart.nys(),n-ypart.nys());
ConstGeneralMatrix z21(vsr,ypart.nys(),0,n-ypart.nys(),ypart.nys());
ConstGeneralMatrix z22(vsr,ypart.nys(),ypart.nys(),n-ypart.nys(),n-ypart.nys());
/*:9*/
#line 137 "./first_order.cweb"
;
/*10:*/
#line 208 "./first_order.cweb"
GeneralMatrix sfder(z12,"transpose");
z22.multInvLeftTrans(sfder);
sfder.mult(-1);
/*:10*/
#line 138 "./first_order.cweb"
;
/*11:*/
#line 217 "./first_order.cweb"
ConstGeneralMatrix s11(matE,0,0,ypart.nys(),ypart.nys());
ConstGeneralMatrix t11(matD,0,0,ypart.nys(),ypart.nys());
GeneralMatrix dumm(s11,"transpose");
z11.multInvLeftTrans(dumm);
GeneralMatrix preder(dumm,"transpose");
t11.multInvLeft(preder);
preder.multLeft(z11);
/*:11*/
#line 139 "./first_order.cweb"
;
/*12:*/
#line 227 "./first_order.cweb"
gy.place(preder,ypart.nstat,0);
GeneralMatrix sder(sfder,0,0,ypart.nstat,ypart.nys());
gy.place(sder,0,0);
GeneralMatrix fder(sfder,ypart.nstat+ypart.nboth,0,ypart.nforw,ypart.nys());
gy.place(fder,ypart.nstat+ypart.nys(),0);
/*:12*/
#line 140 "./first_order.cweb"
;
/*13:*/
#line 235 "./first_order.cweb"
GeneralMatrix bder((const GeneralMatrix&)sfder,ypart.nstat,0,ypart.nboth,ypart.nys());
GeneralMatrix bder2(preder,ypart.npred,0,ypart.nboth,ypart.nys());
bder.add(-1,bder2);
b_error= bder.getData().getMax();
/*:13*/
#line 141 "./first_order.cweb"
;
/*:4*/
#line 46 "./first_order.cweb"
;
/*14:*/
#line 255 "./first_order.cweb"
GeneralMatrix matA(ypart.ny(),ypart.ny());
matA.zeros();
ConstGeneralMatrix gss(gy,ypart.nstat+ypart.npred,0,ypart.nyss(),ypart.nys());
GeneralMatrix aux(fyplus,gss);
matA.place(aux,0,ypart.nstat);
ConstGeneralMatrix fyzero(fd,0,ypart.nyss(),ypart.ny(),ypart.ny());
matA.add(1.0,fyzero);
gu.zeros();
gu.add(-1.0,fuzero);
ConstGeneralMatrix(matA).multInvLeft(gu);
/*:14*/
#line 47 "./first_order.cweb"
;
journalEigs();
if(!gy.isFinite()||!gu.isFinite()){
throw KordException(__FILE__,__LINE__,
"NaN or Inf asserted in first order derivatives in FirstOrder::solve");
}
}
/*:3*/
#line 13 "./first_order.cweb"
;
/*15:*/
#line 268 "./first_order.cweb"
void FirstOrder::journalEigs()
{
if(bk_cond){
JournalRecord jr(journal);
jr<<"Blanchard-Kahn conditition satisfied, model stable"<<endrec;
}else{
JournalRecord jr(journal);
jr<<"Blanchard-Kahn condition not satisfied, model not stable: sdim="<<sdim
<<" "<<"npred="<<ypart.nys()<<endrec;
}
if(!bk_cond){
for(int i= 0;i<alphar.length();i++){
if(i==sdim||i==ypart.nys()){
JournalRecord jr(journal);
jr<<"---------------------------------------------------- ";
if(i==sdim)
jr<<"sdim";
else
jr<<"npred";
jr<<endrec;
}
JournalRecord jr(journal);
double mod= sqrt(alphar[i]*alphar[i]+alphai[i]*alphai[i]);
mod= mod/round(100000*std::abs(beta[i]))*100000;
jr<<i<<"\t("<<alphar[i]<<","<<alphai[i]<<") / "<<beta[i]
<<" \t"<<mod<<endrec;
}
}
}
/*:15*/
#line 14 "./first_order.cweb"
;
/*:1*/

80
mex/sources/korderpert/Dyn_pp/kord/first_order.h Normal file
View File

@ -0,0 +1,80 @@
/*1:*/
#line 10 "./first_order.hweb"
#ifndef FIRST_ORDER_H
#define FIRST_ORDER_H
#include "korder.h"
/*2:*/
#line 23 "./first_order.hweb"
template<int> class FirstOrderDerivs;
class FirstOrder{
template<int> friend class FirstOrderDerivs;
PartitionY ypart;
int nu;
TwoDMatrix gy;
TwoDMatrix gu;
bool bk_cond;
double b_error;
int sdim;
Vector alphar;
Vector alphai;
Vector beta;
Journal&journal;
public:
FirstOrder(int num_stat,int num_pred,int num_both,int num_forw,
int num_u,const FSSparseTensor&f,Journal&jr)
:ypart(num_stat,num_pred,num_both,num_forw),
nu(num_u),
gy(ypart.ny(),ypart.nys()),
gu(ypart.ny(),nu),
alphar(ypart.ny()+ypart.nboth),
alphai(ypart.ny()+ypart.nboth),
beta(ypart.ny()+ypart.nboth),
journal(jr)
{solve(FFSTensor(f));}
bool isStable()const
{return bk_cond;}
const TwoDMatrix&getGy()const
{return gy;}
const TwoDMatrix&getGu()const
{return gu;}
protected:
void solve(const TwoDMatrix&f);
void journalEigs();
};
/*:2*/
#line 17 "./first_order.hweb"
;
/*3:*/
#line 64 "./first_order.hweb"
template<int t>
class FirstOrderDerivs:public ctraits<t> ::Tg{
public:
FirstOrderDerivs(const FirstOrder&fo)
:ctraits<t> ::Tg(4)
{
IntSequence nvs(4);
nvs[0]= fo.ypart.nys();nvs[1]= fo.nu;nvs[2]= fo.nu;nvs[3]= 1;
_Ttensor*ten= new _Ttensor(fo.ypart.ny(),TensorDimens(Symmetry(1,0,0,0),nvs));
ten->zeros();ten->add(1.0,fo.gy);
insert(ten);
ten= new _Ttensor(fo.ypart.ny(),TensorDimens(Symmetry(0,1,0,0),nvs));
ten->zeros();ten->add(1.0,fo.gu);
insert(ten);
}
};
/*:3*/
#line 18 "./first_order.hweb"
;
#endif
/*:1*/

469
mex/sources/korderpert/Dyn_pp/kord/global_check.cpp Normal file
View File

@ -0,0 +1,469 @@
/*1:*/
#line 6 "./global_check.cweb"
#include "SymSchurDecomp.h"
#include "global_check.h"
#include "smolyak.h"
#include "product.h"
#include "quasi_mcarlo.h"
#include "cpplapack.h"
/*2:*/
#line 31 "./global_check.cweb"
ResidFunction::ResidFunction(const Approximation&app)
:VectorFunction(app.getModel().nexog(),app.getModel().numeq()),approx(app),
model(app.getModel().clone()),
yplus(NULL),ystar(NULL),u(NULL),hss(NULL)
{
}
/*:2*/
#line 17 "./global_check.cweb"
;
/*3:*/
#line 40 "./global_check.cweb"
ResidFunction::ResidFunction(const ResidFunction&rf)
:VectorFunction(rf),approx(rf.approx),model(rf.model->clone()),
yplus(NULL),ystar(NULL),u(NULL),hss(NULL)
{
if(rf.yplus)
yplus= new Vector(*(rf.yplus));
if(rf.ystar)
ystar= new Vector(*(rf.ystar));
if(rf.u)
u= new Vector(*(rf.u));
if(rf.hss)
hss= new FTensorPolynomial(*(rf.hss));
}
/*:3*/
#line 18 "./global_check.cweb"
;
/*4:*/
#line 57 "./global_check.cweb"
ResidFunction::~ResidFunction()
{
delete model;
/*5:*/
#line 65 "./global_check.cweb"
if(yplus)
delete yplus;
if(ystar)
delete ystar;
if(u)
delete u;
if(hss)
delete hss;
/*:5*/
#line 61 "./global_check.cweb"
;
}
/*:4*/
#line 19 "./global_check.cweb"
;
/*6:*/
#line 79 "./global_check.cweb"
void ResidFunction::setYU(const Vector&ys,const Vector&xx)
{
/*5:*/
#line 65 "./global_check.cweb"
if(yplus)
delete yplus;
if(ystar)
delete ystar;
if(u)
delete u;
if(hss)
delete hss;
/*:5*/
#line 82 "./global_check.cweb"
;
ystar= new Vector(ys);
u= new Vector(xx);
yplus= new Vector(model->numeq());
approx.getFoldDecisionRule().evaluate(DecisionRule::horner,
*yplus,*ystar,*u);
/*7:*/
#line 103 "./global_check.cweb"
union{const FoldDecisionRule*c;FoldDecisionRule*n;}dr;
dr.c= &(approx.getFoldDecisionRule());
FTensorPolynomial dr_ss(model->nstat()+model->npred(),model->nboth()+model->nforw(),
*(dr.n));
/*:7*/
#line 90 "./global_check.cweb"
;
/*8:*/
#line 110 "./global_check.cweb"
Vector ytmp_star(ConstVector(*yplus,model->nstat(),model->npred()+model->nboth()));
ConstVector ysteady_star(dr.c->getSteady(),model->nstat(),
model->npred()+model->nboth());
ytmp_star.add(-1.0,ysteady_star);
/*:8*/
#line 91 "./global_check.cweb"
;
/*9:*/
#line 117 "./global_check.cweb"
hss= new FTensorPolynomial(dr_ss,ytmp_star);
ConstVector ysteady_ss(dr.c->getSteady(),model->nstat()+model->npred(),
model->nboth()+model->nforw());
if(hss->check(Symmetry(0))){
hss->get(Symmetry(0))->getData().add(1.0,ysteady_ss);
}else{
FFSTensor*ten= new FFSTensor(hss->nrows(),hss->nvars(),0);
ten->getData()= ysteady_ss;
hss->insert(ten);
}
/*:9*/
#line 92 "./global_check.cweb"
;
}
/*:6*/
#line 20 "./global_check.cweb"
;
/*10:*/
#line 132 "./global_check.cweb"
void ResidFunction::eval(const Vector&point,const ParameterSignal&sig,Vector&out)
{
KORD_RAISE_IF(point.length()!=hss->nvars(),
"Wrong dimension of input vector in ResidFunction::eval");
KORD_RAISE_IF(out.length()!=model->numeq(),
"Wrong dimension of output vector in ResidFunction::eval");
Vector yss(hss->nrows());
hss->evalHorner(yss,point);
model->evaluateSystem(out,*ystar,*yplus,yss,*u);
}
/*:10*/
#line 21 "./global_check.cweb"
;
/*11:*/
#line 148 "./global_check.cweb"
void GlobalChecker::check(const Quadrature&quad,int level,
const ConstVector&ys,const ConstVector&x,Vector&out)
{
for(int ifunc= 0;ifunc<vfs.getNum();ifunc++)
((GResidFunction&)(vfs.getFunc(ifunc))).setYU(ys,x);
quad.integrate(vfs,level,out);
}
/*:11*/
#line 22 "./global_check.cweb"
;
/*12:*/
#line 165 "./global_check.cweb"
void GlobalChecker::check(int max_evals,const ConstTwoDMatrix&y,
const ConstTwoDMatrix&x,TwoDMatrix&out)
{
JournalRecordPair pa(journal);
pa<<"Checking approximation error for "<<y.ncols()
<<" states with at most "<<max_evals<<" evaluations"<<endrec;
/*13:*/
#line 182 "./global_check.cweb"
GaussHermite gh;
SmolyakQuadrature dummy_sq(model.nexog(),1,gh);
int smol_evals;
int smol_level;
dummy_sq.designLevelForEvals(max_evals,smol_level,smol_evals);
ProductQuadrature dummy_pq(model.nexog(),gh);
int prod_evals;
int prod_level;
dummy_pq.designLevelForEvals(max_evals,prod_level,prod_evals);
bool take_smolyak= (smol_evals<prod_evals)&&(smol_level>=prod_level-1);
/*:13*/
#line 173 "./global_check.cweb"
;
Quadrature*quad;
int lev;
/*14:*/
#line 198 "./global_check.cweb"
if(take_smolyak){
quad= new SmolyakQuadrature(model.nexog(),smol_level,gh);
lev= smol_level;
JournalRecord rec(journal);
rec<<"Selected Smolyak (level,evals)=("<<smol_level<<","
<<smol_evals<<") over product ("<<prod_level<<","
<<prod_evals<<")"<<endrec;
}else{
quad= new ProductQuadrature(model.nexog(),gh);
lev= prod_level;
JournalRecord rec(journal);
rec<<"Selected product (level,evals)=("<<prod_level<<","
<<prod_evals<<") over Smolyak ("<<smol_level<<","
<<smol_evals<<")"<<endrec;
}
/*:14*/
#line 176 "./global_check.cweb"
;
/*15:*/
#line 216 "./global_check.cweb"
int first_row= (y.nrows()==model.numeq())?model.nstat():0;
ConstTwoDMatrix ysmat(y,first_row,0,model.npred()+model.nboth(),y.ncols());
for(int j= 0;j<y.ncols();j++){
ConstVector yj(ysmat,j);
ConstVector xj(x,j);
Vector outj(out,j);
check(*quad,lev,yj,xj,outj);
}
/*:15*/
#line 177 "./global_check.cweb"
;
delete quad;
}
/*:12*/
#line 23 "./global_check.cweb"
;
/*16:*/
#line 233 "./global_check.cweb"
void GlobalChecker::checkAlongShocksAndSave(FILE*fd,const char*prefix,
int m,double mult,int max_evals)
{
JournalRecordPair pa(journal);
pa<<"Calculating errors along shocks +/- "
<<mult<<" std errors, granularity "<<m<<endrec;
/*17:*/
#line 250 "./global_check.cweb"
TwoDMatrix y_mat(model.numeq(),2*m*model.nexog()+1);
for(int j= 0;j<2*m*model.nexog()+1;j++){
Vector yj(y_mat,j);
yj= (const Vector&)model.getSteady();
}
/*:17*/
#line 240 "./global_check.cweb"
;
/*18:*/
#line 258 "./global_check.cweb"
TwoDMatrix exo_mat(model.nexog(),2*m*model.nexog()+1);
exo_mat.zeros();
for(int ishock= 0;ishock<model.nexog();ishock++){
double max_sigma= sqrt(model.getVcov().get(ishock,ishock));
for(int j= 0;j<2*m;j++){
int jmult= (j<m)?j-m:j-m+1;
exo_mat.get(ishock,1+2*m*ishock+j)=
mult*jmult*max_sigma/m;
}
}
/*:18*/
#line 241 "./global_check.cweb"
;
TwoDMatrix errors(model.numeq(),2*m*model.nexog()+1);
check(max_evals,y_mat,exo_mat,errors);
/*19:*/
#line 271 "./global_check.cweb"
TwoDMatrix res(model.nexog(),2*m+1);
JournalRecord rec(journal);
rec<<"Shock value error"<<endrec;
ConstVector err0(errors,0);
char shock[9];
char erbuf[17];
for(int ishock= 0;ishock<model.nexog();ishock++){
TwoDMatrix err_out(model.numeq(),2*m+1);
sprintf(shock,"%-8s",model.getExogNames().getName(ishock));
for(int j= 0;j<2*m+1;j++){
int jj;
Vector error(err_out,j);
if(j!=m){
if(j<m)
jj= 1+2*m*ishock+j;
else
jj= 1+2*m*ishock+j-1;
ConstVector coljj(errors,jj);
error= coljj;
}else{
jj= 0;
error= err0;
}
JournalRecord rec1(journal);
sprintf(erbuf,"%12.7g ",error.getMax());
rec1<<shock<<" "<<exo_mat.get(ishock,jj)
<<"\t"<<erbuf<<endrec;
}
char tmp[100];
sprintf(tmp,"%s_shock_%s_errors",prefix,model.getExogNames().getName(ishock));
err_out.writeMat4(fd,tmp);
}
/*:19*/
#line 246 "./global_check.cweb"
;
}
/*:16*/
#line 24 "./global_check.cweb"
;
/*20:*/
#line 320 "./global_check.cweb"
void GlobalChecker::checkOnEllipseAndSave(FILE*fd,const char*prefix,
int m,double mult,int max_evals)
{
JournalRecordPair pa(journal);
pa<<"Calculating errors at "<<m
<<" ellipse points scaled by "<<mult<<endrec;
/*21:*/
#line 338 "./global_check.cweb"
TwoDMatrix*ycov= approx.calcYCov();
TwoDMatrix ycovpred((const TwoDMatrix&)*ycov,model.nstat(),model.nstat(),
model.npred()+model.nboth(),model.npred()+model.nboth());
delete ycov;
SymSchurDecomp ssd(ycovpred);
ssd.correctDefinitness(1.e-05);
TwoDMatrix ycovfac(ycovpred.nrows(),ycovpred.ncols());
KORD_RAISE_IF(!ssd.isPositiveSemidefinite(),
"Covariance matrix of the states not positive \
semidefinite in GlobalChecker::checkOnEllipseAndSave");
ssd.getFactor(ycovfac);
/*:21*/
#line 327 "./global_check.cweb"
;
/*22:*/
#line 363 "./global_check.cweb"
int d= model.npred()+model.nboth()-1;
TwoDMatrix ymat(model.npred()+model.nboth(),(d==0)?2:m);
if(d==0){
ymat.get(0,0)= 1;
ymat.get(0,1)= -1;
}else{
int icol= 0;
ReversePerScheme ps;
QMCarloCubeQuadrature qmc(d,m,ps);
qmcpit beg= qmc.start(m);
qmcpit end= qmc.end(m);
for(qmcpit run= beg;run!=end;++run,icol++){
Vector ycol(ymat,icol);
Vector x(run.point());
x.mult(2*M_PI);
ycol[0]= 1;
for(int i= 0;i<d;i++){
Vector subsphere(ycol,0,i+1);
subsphere.mult(cos(x[i]));
ycol[i+1]= sin(x[i]);
}
}
}
/*:22*/
#line 328 "./global_check.cweb"
;
/*23:*/
#line 392 "./global_check.cweb"
TwoDMatrix umat(model.nexog(),ymat.ncols());
umat.zeros();
ymat.mult(mult);
ymat.multLeft(ycovfac);
ConstVector ys(model.getSteady(),model.nstat(),
model.npred()+model.nboth());
for(int icol= 0;icol<ymat.ncols();icol++){
Vector ycol(ymat,icol);
ycol.add(1.0,ys);
}
/*:23*/
#line 329 "./global_check.cweb"
;
/*24:*/
#line 405 "./global_check.cweb"
TwoDMatrix out(model.numeq(),ymat.ncols());
check(max_evals,ymat,umat,out);
char tmp[100];
sprintf(tmp,"%s_ellipse_points",prefix);
ymat.writeMat4(fd,tmp);
sprintf(tmp,"%s_ellipse_errors",prefix);
out.writeMat4(fd,tmp);
/*:24*/
#line 330 "./global_check.cweb"
;
}
/*:20*/
#line 25 "./global_check.cweb"
;
/*25:*/
#line 418 "./global_check.cweb"
void GlobalChecker::checkAlongSimulationAndSave(FILE*fd,const char*prefix,
int m,int max_evals)
{
JournalRecordPair pa(journal);
pa<<"Calculating errors at "<<m
<<" simulated points"<<endrec;
RandomShockRealization sr(model.getVcov(),system_random_generator.int_uniform());
TwoDMatrix*y= approx.getFoldDecisionRule().simulate(DecisionRule::horner,
m,model.getSteady(),sr);
TwoDMatrix x(model.nexog(),m);
x.zeros();
TwoDMatrix out(model.numeq(),m);
check(max_evals,*y,x,out);
char tmp[100];
sprintf(tmp,"%s_simul_points",prefix);
y->writeMat4(fd,tmp);
sprintf(tmp,"%s_simul_errors",prefix);
out.writeMat4(fd,tmp);
delete y;
}
/*:25*/
#line 26 "./global_check.cweb"
;
/*:1*/

104
mex/sources/korderpert/Dyn_pp/kord/global_check.h Normal file
View File

@ -0,0 +1,104 @@
/*1:*/
#line 49 "./global_check.hweb"
#ifndef GLOBAL_CHECK_H
#define GLOBAL_CHECK_H
#include "vector_function.h"
#include "quadrature.h"
#include "dynamic_model.h"
#include "journal.h"
#include "approximation.h"
/*2:*/
#line 85 "./global_check.hweb"
class ResidFunction:public VectorFunction{
protected:
const Approximation&approx;
DynamicModel*model;
Vector*yplus;
Vector*ystar;
Vector*u;
FTensorPolynomial*hss;
public:
ResidFunction(const Approximation&app);
ResidFunction(const ResidFunction&rf);
virtual~ResidFunction();
virtual VectorFunction*clone()const
{return new ResidFunction(*this);}
virtual void eval(const Vector&point,const ParameterSignal&sig,Vector&out);
void setYU(const Vector&ys,const Vector&xx);
};
/*:2*/
#line 60 "./global_check.hweb"
;
/*3:*/
#line 106 "./global_check.hweb"
class GResidFunction:public GaussConverterFunction{
public:
GResidFunction(const Approximation&app)
:GaussConverterFunction(new ResidFunction(app),app.getModel().getVcov()){}
GResidFunction(const GResidFunction&rf)
:GaussConverterFunction(rf){}
virtual~GResidFunction(){}
virtual VectorFunction*clone()const
{return new GResidFunction(*this);}
void setYU(const Vector&ys,const Vector&xx)
{((ResidFunction*)func)->setYU(ys,xx);}
};
/*:3*/
#line 61 "./global_check.hweb"
;
/*4:*/
#line 133 "./global_check.hweb"
class GlobalChecker{
const Approximation&approx;
const DynamicModel&model;
Journal&journal;
GResidFunction rf;
VectorFunctionSet vfs;
public:
GlobalChecker(const Approximation&app,int n,Journal&jr)
:approx(app),model(approx.getModel()),journal(jr),
rf(approx),vfs(rf,n){}
void check(int max_evals,const ConstTwoDMatrix&y,
const ConstTwoDMatrix&x,TwoDMatrix&out);
void checkAlongShocksAndSave(FILE*fd,const char*prefix,
int m,double mult,int max_evals);
void checkOnEllipseAndSave(FILE*fd,const char*prefix,
int m,double mult,int max_evals);
void checkAlongSimulationAndSave(FILE*fd,const char*prefix,
int m,int max_evals);
void checkUnconditionalAndSave(FILE*fd,const char*prefix,
int m,int max_evals);
protected:
void check(const Quadrature&quad,int level,
const ConstVector&y,const ConstVector&x,Vector&out);
};
/*:4*/
#line 62 "./global_check.hweb"
;
/*5:*/
#line 161 "./global_check.hweb"
class ResidFunctionSig:public ResidFunction{
public:
ResidFunctionSig(const Approximation&app,const Vector&ys,const Vector&xx);
};
/*:5*/
#line 63 "./global_check.hweb"
;
#endif
/*:1*/

360
mex/sources/korderpert/Dyn_pp/kord/journal.cpp Normal file
View File

@ -0,0 +1,360 @@
#define _W32_FT_OFFSET (116444736000000000LL)
/*1:*/
#line 6 "./journal.cweb"
#include "journal.h"
#include "kord_exception.h"
#ifndef __MINGW32__
# include <sys/resource.h>
# include <sys/utsname.h>
#endif
#include <stdlib.h>
#include <unistd.h>
#include <time.h>
SystemResources _sysres;
#ifdef __MINGW32__
/*16:*/
#line 249 "./journal.cweb"
typedef struct _filetime{
unsigned long dwLowDateTime;
unsigned long dwHighDateTime;
}filetime;
extern"C"{
void __stdcall GetSystemTimeAsFileTime(filetime*);
};
typedef union{
long long ns100;
filetime ft;
}w32_ftv;
void D_gettimeofday(struct timeval*p,struct timezone*tz)
{
w32_ftv _now;
GetSystemTimeAsFileTime(&(_now.ft));
p->tv_usec= (long)((_now.ns100/10LL)%1000000LL);
p->tv_sec= (long)((_now.ns100-_W32_FT_OFFSET)/10000000LL);
return;
}
/*:16*/
#line 20 "./journal.cweb"
;
/*17:*/
#line 282 "./journal.cweb"
#define _SC_PAGESIZE 1
#define _SC_PHYS_PAGES 2
#define _SC_AVPHYS_PAGES 3
#define _SC_NPROCESSORS_ONLN 4
struct Win32MemoryStatus{
unsigned long dwLength;
unsigned long dwMemoryLoad;
unsigned int dwTotalPhys;
unsigned int dwAvailPhys;
unsigned int dwTotalPageFile;
unsigned int dwAvailPageFile;
unsigned int dwTotalVirtual;
unsigned int dwAvailVirtual;
Win32MemoryStatus();
};
extern"C"{
void __stdcall GlobalMemoryStatus(Win32MemoryStatus*);
};
Win32MemoryStatus::Win32MemoryStatus()
{
dwLength= sizeof(Win32MemoryStatus);
GlobalMemoryStatus(this);
}
long sysconf(int name)
{
switch(name){
case _SC_PAGESIZE:
return 1024;
case _SC_PHYS_PAGES:
{
Win32MemoryStatus memstat;
return memstat.dwTotalPhys/1024;
}
case _SC_AVPHYS_PAGES:
{
Win32MemoryStatus memstat;
return memstat.dwAvailPhys/1024;
}
case _SC_NPROCESSORS_ONLN:
return-1;
default:
KORD_RAISE("Not implemented in Win32 sysconf.");
return-1;
}
}
/*:17*/
#line 21 "./journal.cweb"
;
#endif
/*2:*/
#line 40 "./journal.cweb"
SystemResources::SystemResources()
{
D_gettimeofday(&start,NULL);
}
/*:2*/
#line 24 "./journal.cweb"
;
/*3:*/
#line 48 "./journal.cweb"
long int SystemResources::pageSize()
{
return sysconf(_SC_PAGESIZE);
}
/*:3*/
#line 25 "./journal.cweb"
;
/*4:*/
#line 55 "./journal.cweb"
long int SystemResources::physicalPages()
{
return sysconf(_SC_PHYS_PAGES);
}
/*:4*/
#line 26 "./journal.cweb"
;
/*5:*/
#line 62 "./journal.cweb"
long int SystemResources::onlineProcessors()
{
return sysconf(_SC_NPROCESSORS_ONLN);
}
/*:5*/
#line 27 "./journal.cweb"
;
/*6:*/
#line 69 "./journal.cweb"
long int SystemResources::availableMemory()
{
return pageSize()*sysconf(_SC_AVPHYS_PAGES);
}
/*:6*/
#line 28 "./journal.cweb"
;
/*7:*/
#line 78 "./journal.cweb"
void SystemResources::getRUS(double&load_avg,long int&pg_avail,
double&utime,double&stime,double&elapsed,
long int&idrss,long int&majflt)
{
struct timeval now;
D_gettimeofday(&now,NULL);
elapsed= now.tv_sec-start.tv_sec+(now.tv_usec-start.tv_usec)*1.0e-6;
#ifndef __MINGW32__
struct rusage rus;
getrusage(RUSAGE_SELF,&rus);
utime= rus.ru_utime.tv_sec+rus.ru_utime.tv_usec*1.0e-6;
stime= rus.ru_stime.tv_sec+rus.ru_stime.tv_usec*1.0e-6;
idrss= rus.ru_idrss;
majflt= rus.ru_majflt;
getloadavg(&load_avg,1);
#else
utime= -1.0;
stime= -1.0;
idrss= -1;
majflt= -1;
load_avg= -1.0;
#endif
pg_avail= sysconf(_SC_AVPHYS_PAGES);
}
/*:7*/
#line 29 "./journal.cweb"
;
/*8:*/
#line 107 "./journal.cweb"
SystemResourcesFlash::SystemResourcesFlash()
{
_sysres.getRUS(load_avg,pg_avail,utime,stime,
elapsed,idrss,majflt);
}
/*:8*/
#line 30 "./journal.cweb"
;
/*9:*/
#line 115 "./journal.cweb"
void SystemResourcesFlash::diff(const SystemResourcesFlash&pre)
{
utime-= pre.utime;
stime-= pre.stime;
elapsed-= pre.elapsed;
idrss-= pre.idrss;
majflt-= pre.majflt;
}
/*:9*/
#line 31 "./journal.cweb"
;
/*10:*/
#line 126 "./journal.cweb"
JournalRecord&JournalRecord::operator<<(const IntSequence&s)
{
operator<<("[");
for(int i= 0;i<s.size();i++){
operator<<(s[i]);
if(i<s.size()-1)
operator<<(",");
}
operator<<("]");
return*this;
}
/*:10*/
#line 32 "./journal.cweb"
;
/*11:*/
#line 140 "./journal.cweb"
void JournalRecord::writePrefix(const SystemResourcesFlash&f)
{
for(int i= 0;i<MAXLEN;i++)
prefix[i]= ' ';
double mb= 1024*1024;
sprintf(prefix,"%07.6g",f.elapsed);
sprintf(prefix+7,":%c%05d",recChar,ord);
sprintf(prefix+14,":%1.1f",f.load_avg);
sprintf(prefix+18,":%05.4g",f.pg_avail*_sysres.pageSize()/mb);
sprintf(prefix+24,"%s",": : ");
for(int i= 0;i<2*journal.getDepth();i++)
prefix[i+33]= ' ';
prefix[2*journal.getDepth()+33]= '\0';
}
/*:11*/
#line 33 "./journal.cweb"
;
/*12:*/
#line 157 "./journal.cweb"
void JournalRecordPair::writePrefixForEnd(const SystemResourcesFlash&f)
{
for(int i= 0;i<MAXLEN;i++)
prefix_end[i]= ' ';
double mb= 1024*1024;
SystemResourcesFlash difnow;
difnow.diff(f);
sprintf(prefix_end,"%07.6g",f.elapsed+difnow.elapsed);
sprintf(prefix_end+7,":E%05d",ord);
sprintf(prefix_end+14,":%1.1f",difnow.load_avg);
sprintf(prefix_end+18,":%05.4g",difnow.pg_avail*_sysres.pageSize()/mb);
sprintf(prefix_end+24,":%06.5g",difnow.majflt*_sysres.pageSize()/mb);
sprintf(prefix_end+31,"%s",": ");
for(int i= 0;i<2*journal.getDepth();i++)
prefix_end[i+33]= ' ';
prefix_end[2*journal.getDepth()+33]= '\0';
}
/*:12*/
#line 34 "./journal.cweb"
;
/*13:*/
#line 177 "./journal.cweb"
JournalRecordPair::~JournalRecordPair()
{
journal.decrementDepth();
writePrefixForEnd(flash);
journal<<prefix_end;
journal<<mes;
journal<<endl;
journal.flush();
}
/*:13*/
#line 35 "./journal.cweb"
;
/*14:*/
#line 189 "./journal.cweb"
JournalRecord&endrec(JournalRecord&rec)
{
rec.journal<<rec.prefix;
rec.journal<<rec.mes;
rec.journal<<endl;
rec.journal.flush();
rec.journal.incrementOrd();
return rec;
}
/*:14*/
#line 36 "./journal.cweb"
;
/*15:*/
#line 201 "./journal.cweb"
void Journal::printHeader()
{
(*this)<<"This is Dynare++, Copyright (C) 2004,2005 Michel Juillard, Ondra Kamenik\n";
(*this)<<"Dynare++ comes with ABSOLUTELY NO WARRANTY and is distributed under\n";
(*this)<<"General Public License, see http://www.gnu.org/license/gpl.html\n";
(*this)<<"\n\n";
#ifndef __MINGW32__
utsname info;
uname(&info);
(*this)<<"System info: ";
(*this)<<info.sysname<<" "<<info.release<<" "<<info.version<<" ";
(*this)<<info.machine<<", processors online: "<<_sysres.onlineProcessors();
(*this)<<"\n\nStart time: ";
char ts[100];
time_t curtime= time(NULL);
tm loctime;
localtime_r(&curtime,&loctime);
asctime_r(&loctime,ts);
(*this)<<ts<<"\n";
#else
(*this)<<"System info: (not implemented for MINGW)\n";
(*this)<<"Start time: (not implemented for MINGW)\n\n";
#endif
(*this)<<" ------ elapsed time (seconds) \n";
(*this)<<" | ------ record unique identifier \n";
(*this)<<" | | ------ load average \n";
(*this)<<" | | | ------ available memory (MB) \n";
(*this)<<" | | | | ------ major faults (MB)\n";
(*this)<<" | | | | | \n";
(*this)<<" V V V V V \n";
(*this)<<"\n";
}
/*:15*/
#line 37 "./journal.cweb"
;
/*:1*/

140
mex/sources/korderpert/Dyn_pp/kord/journal.h Normal file
View File

@ -0,0 +1,140 @@
#define MAXLEN 1000 \
/*1:*/
#line 14 "./journal.hweb"
#ifndef JOURNAL_H
#define JOURNAL_H
#include "int_sequence.h"
#include <sys/time.h>
#include <stdio.h>
#include <iostream>
#include <fstream>
/*2:*/
#line 34 "./journal.hweb"
class SystemResources{
timeval start;
public:
SystemResources();
static long int pageSize();
static long int physicalPages();
static long int onlineProcessors();
static long int availableMemory();
void getRUS(double&load_avg,long int&pg_avail,double&utime,
double&stime,double&elapsed,long int&idrss,
long int&majflt);
};
/*:2*/
#line 25 "./journal.hweb"
;
/*3:*/
#line 49 "./journal.hweb"
struct SystemResourcesFlash{
double load_avg;
long int pg_avail;
double utime;
double stime;
double elapsed;
long int idrss;
long int majflt;
SystemResourcesFlash();
void diff(const SystemResourcesFlash&pre);
};
/*:3*/
#line 26 "./journal.hweb"
;
/*6:*/
#line 113 "./journal.hweb"
class Journal:public ofstream{
int ord;
int depth;
public:
Journal(const char*fname)
:ofstream(fname),ord(0),depth(0)
{printHeader();}
~Journal()
{flush();}
void printHeader();
void incrementOrd()
{ord++;}
int getOrd()const
{return ord;}
void incrementDepth()
{depth++;}
void decrementDepth()
{depth--;}
int getDepth()const
{return depth;}
};
/*:6*/
#line 27 "./journal.hweb"
;
/*4:*/
#line 67 "./journal.hweb"
class JournalRecord;
JournalRecord&endrec(JournalRecord&);
class JournalRecord{
protected:
char recChar;
int ord;
public:
Journal&journal;
char prefix[MAXLEN];
char mes[MAXLEN];
SystemResourcesFlash flash;
typedef JournalRecord&(*_Tfunc)(JournalRecord&);
JournalRecord(Journal&jr,char rc= 'M')
:recChar(rc),ord(jr.getOrd()),journal(jr)
{prefix[0]= '\0';mes[0]= '\0';writePrefix(flash);}
virtual~JournalRecord(){}
JournalRecord&operator<<(const IntSequence&s);
JournalRecord&operator<<(_Tfunc f)
{(*f)(*this);return*this;}
JournalRecord&operator<<(const char*s)
{strcat(mes,s);return*this;}
JournalRecord&operator<<(int i)
{sprintf(mes+strlen(mes),"%d",i);return*this;}
JournalRecord&operator<<(double d)
{sprintf(mes+strlen(mes),"%f",d);return*this;}
protected:
void writePrefix(const SystemResourcesFlash&f);
};
/*:4*/
#line 28 "./journal.hweb"
;
/*5:*/
#line 100 "./journal.hweb"
class JournalRecordPair:public JournalRecord{
char prefix_end[MAXLEN];
public:
JournalRecordPair(Journal&jr)
:JournalRecord(jr,'S')
{prefix_end[0]= '\0';journal.incrementDepth();}
~JournalRecordPair();
private:
void writePrefixForEnd(const SystemResourcesFlash&f);
};
/*:5*/
#line 29 "./journal.hweb"
;
#endif
/*:1*/

64
mex/sources/korderpert/Dyn_pp/kord/kord_exception.h Normal file
View File

@ -0,0 +1,64 @@
/*1:*/
#line 9 "./kord_exception.hweb"
#ifndef KORD_EXCEPTION_H
#define KORD_EXCEPTION_H
#include <string.h>
#include <stdio.h>
#define KORD_RAISE(mes) \
throw KordException(__FILE__, __LINE__, mes);
#define KORD_RAISE_IF(expr, mes) \
if (expr) throw KordException(__FILE__, __LINE__, mes);
#define KORD_RAISE_X(mes, c) \
throw KordException(__FILE__, __LINE__, mes, c);
#define KORD_RAISE_IF_X(expr, mes, c) \
if (expr) throw KordException(__FILE__, __LINE__, mes, c);
/*2:*/
#line 34 "./kord_exception.hweb"
class KordException{
protected:
char fname[50];
int lnum;
char message[500];
int cd;
public:
KordException(const char*f,int l,const char*mes,int c= 255)
{
strncpy(fname,f,50);fname[49]= '\0';
strncpy(message,mes,500);message[499]= '\0';
lnum= l;
cd= c;
}
virtual~KordException(){}
virtual void print()const
{printf("At %s:%d:(%d):%s\n",fname,lnum,cd,message);}
virtual int code()const
{return cd;}
const char*get_message()const
{return message;}
};
/*:2*/
#line 28 "./kord_exception.hweb"
;
/*3:*/
#line 59 "./kord_exception.hweb"
#define KORD_FP_NOT_CONV 254
#define KORD_FP_NOT_FINITE 253
#define KORD_MD_NOT_STABLE 252
/*:3*/
#line 29 "./kord_exception.hweb"
;
#endif
/*:1*/

326
mex/sources/korderpert/Dyn_pp/kord/korder.cpp Normal file
View File

@ -0,0 +1,326 @@
/*1:*/
#line 6 "./korder.cweb"
#include "kord_exception.h"
#include "korder.h"
#include "cpplapack.h"
/*2:*/
#line 25 "./korder.cweb"
PLUMatrix::PLUMatrix(const PLUMatrix&plu)
:TwoDMatrix(plu),inv(plu.inv),ipiv(new int[nrows()])
{
memcpy(ipiv,plu.ipiv,nrows()*sizeof(int));
}
/*:2*/
#line 13 "./korder.cweb"
;
/*3:*/
#line 37 "./korder.cweb"
void PLUMatrix::calcPLU()
{
int info;
int rows= nrows();
inv= (const Vector&)getData();
LAPACK_dgetrf(&rows,&rows,inv.base(),&rows,ipiv,&info);
}
/*:3*/
#line 14 "./korder.cweb"
;
/*4:*/
#line 48 "./korder.cweb"
void PLUMatrix::multInv(TwoDMatrix&m)const
{
KORD_RAISE_IF(m.nrows()!=ncols(),
"The matrix is not square in PLUMatrix::multInv");
int info;
int mcols= m.ncols();
int mrows= m.nrows();
double*mbase= m.getData().base();
LAPACK_dgetrs("N",&mrows,&mcols,inv.base(),&mrows,ipiv,
mbase,&mrows,&info);
KORD_RAISE_IF(info!=0,
"Info!=0 in PLUMatrix::multInv");
}
/*:4*/
#line 15 "./korder.cweb"
;
/*5:*/
#line 69 "./korder.cweb"
MatrixA::MatrixA(const FSSparseTensor&f,const IntSequence&ss,
const TwoDMatrix&gy,const PartitionY&ypart)
:PLUMatrix(ypart.ny())
{
zeros();
IntSequence c(1);c[0]= 1;
FGSTensor f_y(f,ss,c,TensorDimens(ss,c));
add(1.0,f_y);
ConstTwoDMatrix gss_ys(ypart.nstat+ypart.npred,ypart.nyss(),gy);
c[0]= 0;
FGSTensor f_yss(f,ss,c,TensorDimens(ss,c));
TwoDMatrix sub(*this,ypart.nstat,ypart.nys());
sub.multAndAdd(ConstTwoDMatrix(f_yss),gss_ys);
calcPLU();
}
/*:5*/
#line 16 "./korder.cweb"
;
/*6:*/
#line 97 "./korder.cweb"
MatrixS::MatrixS(const FSSparseTensor&f,const IntSequence&ss,
const TwoDMatrix&gy,const PartitionY&ypart)
:PLUMatrix(ypart.ny())
{
zeros();
IntSequence c(1);c[0]= 1;
FGSTensor f_y(f,ss,c,TensorDimens(ss,c));
add(1.0,f_y);
ConstTwoDMatrix gss_ys(ypart.nstat+ypart.npred,ypart.nyss(),gy);
c[0]= 0;
FGSTensor f_yss(f,ss,c,TensorDimens(ss,c));
TwoDMatrix sub(*this,ypart.nstat,ypart.nys());
sub.multAndAdd(ConstTwoDMatrix(f_yss),gss_ys);
TwoDMatrix sub2(*this,ypart.nstat+ypart.npred,ypart.nyss());
sub2.add(1.0,f_yss);
calcPLU();
}
/*:6*/
#line 17 "./korder.cweb"
;
/*13:*/
#line 281 "./korder.cweb"
template<> ctraits<KOrder::unfold> ::Tg&KOrder::g<KOrder::unfold> ()
{return _ug;}
template<> const ctraits<KOrder::unfold> ::Tg&KOrder::g<KOrder::unfold> ()const
{return _ug;}
template<> ctraits<KOrder::fold> ::Tg&KOrder::g<KOrder::fold> ()
{return _fg;}
template<> const ctraits<KOrder::fold> ::Tg&KOrder::g<KOrder::fold> ()const
{return _fg;}
template<> ctraits<KOrder::unfold> ::Tgs&KOrder::gs<KOrder::unfold> ()
{return _ugs;}
template<> const ctraits<KOrder::unfold> ::Tgs&KOrder::gs<KOrder::unfold> ()const
{return _ugs;}
template<> ctraits<KOrder::fold> ::Tgs&KOrder::gs<KOrder::fold> ()
{return _fgs;}
template<> const ctraits<KOrder::fold> ::Tgs&KOrder::gs<KOrder::fold> ()const
{return _fgs;}
template<> ctraits<KOrder::unfold> ::Tgss&KOrder::gss<KOrder::unfold> ()
{return _ugss;}
template<> const ctraits<KOrder::unfold> ::Tgss&KOrder::gss<KOrder::unfold> ()const
{return _ugss;}
template<> ctraits<KOrder::fold> ::Tgss&KOrder::gss<KOrder::fold> ()
{return _fgss;}
template<> const ctraits<KOrder::fold> ::Tgss&KOrder::gss<KOrder::fold> ()const
{return _fgss;}
template<> ctraits<KOrder::unfold> ::TG&KOrder::G<KOrder::unfold> ()
{return _uG;}
template<> const ctraits<KOrder::unfold> ::TG&KOrder::G<KOrder::unfold> ()const
{return _uG;}
template<> ctraits<KOrder::fold> ::TG&KOrder::G<KOrder::fold> ()
{return _fG;}
template<> const ctraits<KOrder::fold> ::TG&KOrder::G<KOrder::fold> ()const
{return _fG;}
template<> ctraits<KOrder::unfold> ::TZstack&KOrder::Zstack<KOrder::unfold> ()
{return _uZstack;}
template<> const ctraits<KOrder::unfold> ::TZstack&KOrder::Zstack<KOrder::unfold> ()const
{return _uZstack;}
template<> ctraits<KOrder::fold> ::TZstack&KOrder::Zstack<KOrder::fold> ()
{return _fZstack;}
template<> const ctraits<KOrder::fold> ::TZstack&KOrder::Zstack<KOrder::fold> ()const
{return _fZstack;}
template<> ctraits<KOrder::unfold> ::TGstack&KOrder::Gstack<KOrder::unfold> ()
{return _uGstack;}
template<> const ctraits<KOrder::unfold> ::TGstack&KOrder::Gstack<KOrder::unfold> ()const
{return _uGstack;}
template<> ctraits<KOrder::fold> ::TGstack&KOrder::Gstack<KOrder::fold> ()
{return _fGstack;}
template<> const ctraits<KOrder::fold> ::TGstack&KOrder::Gstack<KOrder::fold> ()const
{return _fGstack;}
template<> ctraits<KOrder::unfold> ::Tm&KOrder::m<KOrder::unfold> ()
{return _um;}
template<> const ctraits<KOrder::unfold> ::Tm&KOrder::m<KOrder::unfold> ()const
{return _um;}
template<> ctraits<KOrder::fold> ::Tm&KOrder::m<KOrder::fold> ()
{return _fm;}
template<> const ctraits<KOrder::fold> ::Tm&KOrder::m<KOrder::fold> ()const
{return _fm;}
/*:13*/
#line 18 "./korder.cweb"
;
/*10:*/
#line 211 "./korder.cweb"
template<>
void KOrder::sylvesterSolve<KOrder::unfold> (ctraits<unfold> ::Ttensor&der)const
{
JournalRecordPair pa(journal);
pa<<"Sylvester equation for dimension = "<<der.getSym()[0]<<endrec;
if(ypart.nys()> 0&&ypart.nyss()> 0){
KORD_RAISE_IF(!der.isFinite(),
"RHS of Sylverster is not finite");
TwoDMatrix gs_y(*(gs<unfold> ().get(Symmetry(1,0,0,0))));
GeneralSylvester sylv(der.getSym()[0],ny,ypart.nys(),
ypart.nstat+ypart.npred,
matA.getData().base(),matB.getData().base(),
gs_y.getData().base(),der.getData().base());
sylv.solve();
}else if(ypart.nys()> 0&&ypart.nyss()==0){
matA.multInv(der);
}
}
/*:10*/
#line 19 "./korder.cweb"
;
/*11:*/
#line 235 "./korder.cweb"
template<>
void KOrder::sylvesterSolve<KOrder::fold> (ctraits<fold> ::Ttensor&der)const
{
ctraits<unfold> ::Ttensor tmp(der);
sylvesterSolve<unfold> (tmp);
ctraits<fold> ::Ttensor ftmp(tmp);
der.getData()= (const Vector&)(ftmp.getData());
}
/*:11*/
#line 20 "./korder.cweb"
;
/*12:*/
#line 246 "./korder.cweb"
void KOrder::switchToFolded()
{
JournalRecordPair pa(journal);
pa<<"Switching from unfolded to folded"<<endrec;
int maxdim= g<unfold> ().getMaxDim();
for(int dim= 1;dim<=maxdim;dim++){
SymmetrySet ss(dim,4);
for(symiterator si(ss);!si.isEnd();++si){
if((*si)[2]==0&&g<unfold> ().check(*si)){
FGSTensor*ft= new FGSTensor(*(g<unfold> ().get(*si)));
insertDerivative<fold> (ft);
if(dim> 1){
gss<unfold> ().remove(*si);
gs<unfold> ().remove(*si);
g<unfold> ().remove(*si);
}
}
if(G<unfold> ().check(*si)){
FGSTensor*ft= new FGSTensor(*(G<unfold> ().get(*si)));
G<fold> ().insert(ft);
if(dim> 1){
G<fold> ().remove(*si);
}
}
}
}
}
/*:12*/
#line 21 "./korder.cweb"
;
/*7:*/
#line 133 "./korder.cweb"
KOrder::KOrder(int num_stat,int num_pred,int num_both,int num_forw,
const TensorContainer<FSSparseTensor> &fcont,
const TwoDMatrix&gy,const TwoDMatrix&gu,const TwoDMatrix&v,
Journal&jr)
:ypart(num_stat,num_pred,num_both,num_forw),
ny(ypart.ny()),nu(gu.ncols()),maxk(fcont.getMaxDim()),
nvs(4),
_ug(4),_fg(4),_ugs(4),_fgs(4),_ugss(4),_fgss(4),
_uG(4),_fG(4),
_uZstack(&_uG,ypart.nyss(),&_ug,ny,ypart.nys(),nu),
_fZstack(&_fG,ypart.nyss(),&_fg,ny,ypart.nys(),nu),
_uGstack(&_ugs,ypart.nys(),nu),
_fGstack(&_fgs,ypart.nys(),nu),
_um(maxk,v),_fm(_um),f(fcont),
matA(*(f.get(Symmetry(1))),_uZstack.getStackSizes(),gy,ypart),
matS(*(f.get(Symmetry(1))),_uZstack.getStackSizes(),gy,ypart),
matB(*(f.get(Symmetry(1))),_uZstack.getStackSizes()),
journal(jr)
{
KORD_RAISE_IF(gy.ncols()!=ypart.nys(),
"Wrong number of columns in gy in KOrder constructor");
KORD_RAISE_IF(v.ncols()!=nu,
"Wrong number of columns of Vcov in KOrder constructor");
KORD_RAISE_IF(nu!=v.nrows(),
"Wrong number of rows of Vcov in KOrder constructor");
KORD_RAISE_IF(maxk<2,
"Order of approximation must be at least 2 in KOrder constructor");
KORD_RAISE_IF(gy.nrows()!=ypart.ny(),
"Wrong number of rows in gy in KOrder constructor");
KORD_RAISE_IF(gu.nrows()!=ypart.ny(),
"Wrong number of rows in gu in KOrder constuctor");
KORD_RAISE_IF(gu.ncols()!=nu,
"Wrong number of columns in gu in KOrder constuctor");
nvs[0]= ypart.nys();nvs[1]= nu;nvs[2]= nu;nvs[3]= 1;
/*8:*/
#line 178 "./korder.cweb"
UGSTensor*tgy= new UGSTensor(ny,TensorDimens(Symmetry(1,0,0,0),nvs));
tgy->getData()= gy.getData();
insertDerivative<unfold> (tgy);
UGSTensor*tgu= new UGSTensor(ny,TensorDimens(Symmetry(0,1,0,0),nvs));
tgu->getData()= gu.getData();
insertDerivative<unfold> (tgu);
/*:8*/
#line 171 "./korder.cweb"
;
/*9:*/
#line 187 "./korder.cweb"
UGSTensor*tGy= faaDiBrunoG<unfold> (Symmetry(1,0,0,0));
G<unfold> ().insert(tGy);
UGSTensor*tGu= faaDiBrunoG<unfold> (Symmetry(0,1,0,0));
G<unfold> ().insert(tGu);
UGSTensor*tGup= faaDiBrunoG<unfold> (Symmetry(0,0,1,0));
G<unfold> ().insert(tGup);
/*:9*/
#line 172 "./korder.cweb"
;
}
/*:7*/
#line 22 "./korder.cweb"
;
/*:1*/

736
mex/sources/korderpert/Dyn_pp/kord/korder.h Normal file
View File

@ -0,0 +1,736 @@
#define _Ttensor TYPENAME ctraits<t> ::Ttensor
#define _Ttensym TYPENAME ctraits<t> ::Ttensym
#define _Tg TYPENAME ctraits<t> ::Tg
#define _Tgs TYPENAME ctraits<t> ::Tgs
#define _Tgss TYPENAME ctraits<t> ::Tgss
#define _TG TYPENAME ctraits<t> ::TG
#define _TZstack TYPENAME ctraits<t> ::TZstack
#define _TGstack TYPENAME ctraits<t> ::TGstack
#define _TZXstack TYPENAME ctraits<t> ::TZXstack
#define _TGXstack TYPENAME ctraits<t> ::TGXstack
#define _Tm TYPENAME ctraits<t> ::Tm
#define _Tpol TYPENAME ctraits<t> ::Tpol \
\
/*1:*/
#line 62 "./korder.hweb"
#ifndef KORDER_H
#define KORDER_H
#include "int_sequence.h"
#include "fs_tensor.h"
#include "gs_tensor.h"
#include "t_container.h"
#include "stack_container.h"
#include "normal_moments.h"
#include "t_polynomial.h"
#include "faa_di_bruno.h"
#include "journal.h"
#include "kord_exception.h"
#include "GeneralSylvester.h"
#include <cmath>
#define TYPENAME typename
/*2:*/
#line 106 "./korder.hweb"
class FoldedZXContainer;
class UnfoldedZXContainer;
class FoldedGXContainer;
class UnfoldedGXContainer;
template<bool condition,class Then,class Else>
struct IF{
typedef Then RET;
};
template<class Then,class Else>
struct IF<false,Then,Else> {
typedef Else RET;
};
template<int type>
class ctraits{
public:
enum{fold,unfold};
typedef TYPENAME IF<type==fold,FGSTensor,UGSTensor> ::RET Ttensor;
typedef TYPENAME IF<type==fold,FFSTensor,UFSTensor> ::RET Ttensym;
typedef TYPENAME IF<type==fold,FGSContainer,UGSContainer> ::RET Tg;
typedef TYPENAME IF<type==fold,FGSContainer,UGSContainer> ::RET Tgs;
typedef TYPENAME IF<type==fold,FGSContainer,UGSContainer> ::RET Tgss;
typedef TYPENAME IF<type==fold,FGSContainer,UGSContainer> ::RET TG;
typedef TYPENAME IF<type==fold,FoldedZContainer,UnfoldedZContainer> ::RET TZstack;
typedef TYPENAME IF<type==fold,FoldedGContainer,UnfoldedGContainer> ::RET TGstack;
typedef TYPENAME IF<type==fold,FNormalMoments,UNormalMoments> ::RET Tm;
typedef TYPENAME IF<type==fold,FTensorPolynomial,UTensorPolynomial> ::RET Tpol;
typedef TYPENAME IF<type==fold,FoldedZXContainer,UnfoldedZXContainer> ::RET TZXstack;
typedef TYPENAME IF<type==fold,FoldedGXContainer,UnfoldedGXContainer> ::RET TGXstack;
};
/*:2*/
#line 83 "./korder.hweb"
;
/*3:*/
#line 156 "./korder.hweb"
struct PartitionY{
const int nstat;
const int npred;
const int nboth;
const int nforw;
PartitionY(int num_stat,int num_pred,
int num_both,int num_forw)
:nstat(num_stat),npred(num_pred),
nboth(num_both),nforw(num_forw)
{}
int ny()const
{return nstat+npred+nboth+nforw;}
int nys()const
{return npred+nboth;}
int nyss()const
{return nboth+nforw;}
};
/*:3*/
#line 84 "./korder.hweb"
;
/*4:*/
#line 183 "./korder.hweb"
class PLUMatrix:public TwoDMatrix{
public:
PLUMatrix(int n)
:TwoDMatrix(n,n),
inv(nrows()*ncols()),
ipiv(new int[nrows()]){}
PLUMatrix(const PLUMatrix&plu);
virtual~PLUMatrix()
{delete[]ipiv;}
void multInv(TwoDMatrix&m)const;
private:
Vector inv;
int*ipiv;
protected:
void calcPLU();
};
/*:4*/
#line 85 "./korder.hweb"
;
/*5:*/
#line 205 "./korder.hweb"
class MatrixA:public PLUMatrix{
public:
MatrixA(const FSSparseTensor&f,const IntSequence&ss,
const TwoDMatrix&gy,const PartitionY&ypart);
};
/*:5*/
#line 86 "./korder.hweb"
;
/*6:*/
#line 218 "./korder.hweb"
class MatrixS:public PLUMatrix{
public:
MatrixS(const FSSparseTensor&f,const IntSequence&ss,
const TwoDMatrix&gy,const PartitionY&ypart);
};
/*:6*/
#line 87 "./korder.hweb"
;
/*7:*/
#line 229 "./korder.hweb"
class MatrixB:public TwoDMatrix{
public:
MatrixB(const FSSparseTensor&f,const IntSequence&ss)
:TwoDMatrix(FGSTensor(f,ss,IntSequence(1,0),
TensorDimens(ss,IntSequence(1,0))))
{}
};
/*:7*/
#line 88 "./korder.hweb"
;
/*8:*/
#line 325 "./korder.hweb"
class KOrder{
protected:
const PartitionY ypart;
const int ny;
const int nu;
const int maxk;
IntSequence nvs;
/*30:*/
#line 919 "./korder.hweb"
UGSContainer _ug;
FGSContainer _fg;
UGSContainer _ugs;
FGSContainer _fgs;
UGSContainer _ugss;
FGSContainer _fgss;
UGSContainer _uG;
FGSContainer _fG;
UnfoldedZContainer _uZstack;
FoldedZContainer _fZstack;
UnfoldedGContainer _uGstack;
FoldedGContainer _fGstack;
UNormalMoments _um;
FNormalMoments _fm;
const TensorContainer<FSSparseTensor> &f;
/*:30*/
#line 333 "./korder.hweb"
;
const MatrixA matA;
const MatrixS matS;
const MatrixB matB;
/*31:*/
#line 939 "./korder.hweb"
template<int t> _Tg&g();
template<int t> const _Tg&g()const;
template<int t> _Tgs&gs();
template<int t> const _Tgs&gs()const;
template<int t> _Tgss&gss();
template<int t> const _Tgss&gss()const;
template<int t> _TG&G();
template<int t> const _TG&G()const;
template<int t> _TZstack&Zstack();
template<int t> const _TZstack&Zstack()const;
template<int t> _TGstack&Gstack();
template<int t> const _TGstack&Gstack()const;
template<int t> _Tm&m();
template<int t> const _Tm&m()const;
/*:31*/
#line 337 "./korder.hweb"
;
Journal&journal;
public:
KOrder(int num_stat,int num_pred,int num_both,int num_forw,
const TensorContainer<FSSparseTensor> &fcont,
const TwoDMatrix&gy,const TwoDMatrix&gu,const TwoDMatrix&v,
Journal&jr);
enum{fold,unfold};
/*24:*/
#line 796 "./korder.hweb"
template<int t>
void performStep(int order)
{
KORD_RAISE_IF(order-1!=g<t> ().getMaxDim(),
"Wrong order for KOrder::performStep");
JournalRecordPair pa(journal);
pa<<"Performing step for order = "<<order<<endrec;
recover_y<t> (order);
for(int i= 0;i<order;i++){
recover_yu<t> (i,order-i);
}
for(int j= 1;j<order;j++){
for(int i= j-1;i>=1;i--){
recover_yus<t> (order-j,i,j-i);
}
recover_ys<t> (order-j,j);
}
for(int i= order-1;i>=1;i--){
recover_yus<t> (0,i,order-i);
}
recover_s<t> (order);
}
/*:24*/
#line 345 "./korder.hweb"
;
/*25:*/
#line 828 "./korder.hweb"
template<int t>
double check(int dim)const
{
KORD_RAISE_IF(dim> g<t> ().getMaxDim(),
"Wrong dimension for KOrder::check");
JournalRecordPair pa(journal);
pa<<"Checking residuals for order = "<<dim<<endrec;
double maxerror= 0.0;
/*26:*/
#line 848 "./korder.hweb"
for(int i= 0;i<=dim;i++){
Symmetry sym(dim-i,i,0,0);
_Ttensor*r= faaDiBrunoZ<t> (sym);
double err= r->getData().getMax();
JournalRecord(journal)<<"\terror for symmetry "<<sym<<"\tis "<<err<<endrec;
if(err> maxerror)
maxerror= err;
delete r;
}
/*:26*/
#line 839 "./korder.hweb"
;
/*27:*/
#line 860 "./korder.hweb"
SymmetrySet ss(dim,3);
for(symiterator si(ss);!si.isEnd();++si){
int i= (*si)[0];
int j= (*si)[1];
int k= (*si)[2];
if(i+j> 0&&k> 0){
Symmetry sym(i,j,0,k);
_Ttensor*r= faaDiBrunoZ<t> (sym);
_Ttensor*D_ijk= calcD_ijk<t> (i,j,k);
r->add(1.0,*D_ijk);
delete D_ijk;
_Ttensor*E_ijk= calcE_ijk<t> (i,j,k);
r->add(1.0,*E_ijk);
delete E_ijk;
double err= r->getData().getMax();
JournalRecord(journal)<<"\terror for symmetry "<<sym<<"\tis "<<err<<endrec;
delete r;
}
}
/*:27*/
#line 840 "./korder.hweb"
;
/*28:*/
#line 883 "./korder.hweb"
_Ttensor*r= faaDiBrunoZ<t> (Symmetry(0,0,0,dim));
_Ttensor*D_k= calcD_k<t> (dim);
r->add(1.0,*D_k);
delete D_k;
_Ttensor*E_k= calcE_k<t> (dim);
r->add(1.0,*E_k);
delete E_k;
double err= r->getData().getMax();
Symmetry sym(0,0,0,dim);
JournalRecord(journal)<<"\terror for symmetry "<<sym<<"\tis "<<err<<endrec;
if(err> maxerror)
maxerror= err;
delete r;
/*:28*/
#line 841 "./korder.hweb"
;
return maxerror;
}
/*:25*/
#line 346 "./korder.hweb"
;
/*29:*/
#line 899 "./korder.hweb"
template<int t>
Vector*calcStochShift(int order,double sigma)const
{
Vector*res= new Vector(ny);
res->zeros();
int jfac= 1;
for(int j= 1;j<=order;j++,jfac*= j)
if(is_even(j)){
_Ttensor*ten= calcD_k<t> (j);
res->add(std::pow(sigma,j)/jfac,ten->getData());
delete ten;
}
return res;
}
/*:29*/
#line 347 "./korder.hweb"
;
void switchToFolded();
const PartitionY&getPartY()const
{return ypart;}
const FGSContainer&getFoldDers()const
{return _fg;}
const UGSContainer&getUnfoldDers()const
{return _ug;}
static bool is_even(int i)
{return(i/2)*2==i;}
protected:
/*9:*/
#line 386 "./korder.hweb"
template<int t>
void insertDerivative(_Ttensor*der)
{
g<t> ().insert(der);
gs<t> ().insert(new _Ttensor(ypart.nstat,ypart.nys(),*der));
gss<t> ().insert(new _Ttensor(ypart.nstat+ypart.npred,
ypart.nyss(),*der));
}
/*:9*/
#line 358 "./korder.hweb"
;
template<int t>
void sylvesterSolve(_Ttensor&der)const;
/*10:*/
#line 404 "./korder.hweb"
template<int t>
_Ttensor*faaDiBrunoZ(const Symmetry&sym)const
{
JournalRecordPair pa(journal);
pa<<"Faa Di Bruno Z container for "<<sym<<endrec;
_Ttensor*res= new _Ttensor(ny,TensorDimens(sym,nvs));
FaaDiBruno bruno(journal);
bruno.calculate(Zstack<t> (),f,*res);
return res;
}
/*:10*/
#line 362 "./korder.hweb"
;
/*11:*/
#line 419 "./korder.hweb"
template<int t>
_Ttensor*faaDiBrunoG(const Symmetry&sym)const
{
JournalRecordPair pa(journal);
pa<<"Faa Di Bruno G container for "<<sym<<endrec;
TensorDimens tdims(sym,nvs);
_Ttensor*res= new _Ttensor(ypart.nyss(),tdims);
FaaDiBruno bruno(journal);
bruno.calculate(Gstack<t> (),gss<t> (),*res);
return res;
}
/*:11*/
#line 363 "./korder.hweb"
;
/*12:*/
#line 444 "./korder.hweb"
template<int t>
void recover_y(int i)
{
Symmetry sym(i,0,0,0);
JournalRecordPair pa(journal);
pa<<"Recovering symmetry "<<sym<<endrec;
_Ttensor*G_yi= faaDiBrunoG<t> (sym);
G<t> ().insert(G_yi);
_Ttensor*g_yi= faaDiBrunoZ<t> (sym);
g_yi->mult(-1.0);
sylvesterSolve<t> (*g_yi);
insertDerivative<t> (g_yi);
_Ttensor*gss_y= gss<t> ().get(Symmetry(1,0,0,0));
gs<t> ().multAndAdd(*gss_y,*G_yi);
_Ttensor*gss_yi= gss<t> ().get(sym);
gs<t> ().multAndAdd(*gss_yi,*G_yi);
}
/*:12*/
#line 365 "./korder.hweb"
;
/*13:*/
#line 480 "./korder.hweb"
template<int t>
void recover_yu(int i,int j)
{
Symmetry sym(i,j,0,0);
JournalRecordPair pa(journal);
pa<<"Recovering symmetry "<<sym<<endrec;
_Ttensor*G_yiuj= faaDiBrunoG<t> (sym);
G<t> ().insert(G_yiuj);
_Ttensor*g_yiuj= faaDiBrunoZ<t> (sym);
g_yiuj->mult(-1.0);
matA.multInv(*g_yiuj);
insertDerivative<t> (g_yiuj);
gs<t> ().multAndAdd(*(gss<t> ().get(Symmetry(1,0,0,0))),*G_yiuj);
}
/*:13*/
#line 366 "./korder.hweb"
;
/*14:*/
#line 519 "./korder.hweb"
template<int t>
void recover_ys(int i,int j)
{
Symmetry sym(i,0,0,j);
JournalRecordPair pa(journal);
pa<<"Recovering symmetry "<<sym<<endrec;
fillG<t> (i,0,j);
if(is_even(j)){
_Ttensor*G_yisj= faaDiBrunoG<t> (sym);
G<t> ().insert(G_yisj);
_Ttensor*g_yisj= faaDiBrunoZ<t> (sym);
{
_Ttensor*D_ij= calcD_ik<t> (i,j);
g_yisj->add(1.0,*D_ij);
delete D_ij;
}
if(j>=3){
_Ttensor*E_ij= calcE_ik<t> (i,j);
g_yisj->add(1.0,*E_ij);
delete E_ij;
}
g_yisj->mult(-1.0);
sylvesterSolve<t> (*g_yisj);
insertDerivative<t> (g_yisj);
Gstack<t> ().multAndAdd(1,gss<t> (),*G_yisj);
Gstack<t> ().multAndAdd(i+j,gss<t> (),*G_yisj);
}
}
/*:14*/
#line 367 "./korder.hweb"
;
/*15:*/
#line 577 "./korder.hweb"
template<int t>
void recover_yus(int i,int j,int k)
{
Symmetry sym(i,j,0,k);
JournalRecordPair pa(journal);
pa<<"Recovering symmetry "<<sym<<endrec;
fillG<t> (i,j,k);
if(is_even(k)){
_Ttensor*G_yiujsk= faaDiBrunoG<t> (sym);
G<t> ().insert(G_yiujsk);
_Ttensor*g_yiujsk= faaDiBrunoZ<t> (sym);
{
_Ttensor*D_ijk= calcD_ijk<t> (i,j,k);
g_yiujsk->add(1.0,*D_ijk);
delete D_ijk;
}
if(k>=3){
_Ttensor*E_ijk= calcE_ijk<t> (i,j,k);
g_yiujsk->add(1.0,*E_ijk);
delete E_ijk;
}
g_yiujsk->mult(-1.0);
matA.multInv(*g_yiujsk);
insertDerivative<t> (g_yiujsk);
Gstack<t> ().multAndAdd(1,gss<t> (),*G_yiujsk);
}
}
/*:15*/
#line 368 "./korder.hweb"
;
/*16:*/
#line 642 "./korder.hweb"
template<int t>
void recover_s(int i)
{
Symmetry sym(0,0,0,i);
JournalRecordPair pa(journal);
pa<<"Recovering symmetry "<<sym<<endrec;
fillG<t> (0,0,i);
if(is_even(i)){
_Ttensor*G_si= faaDiBrunoG<t> (sym);
G<t> ().insert(G_si);
_Ttensor*g_si= faaDiBrunoZ<t> (sym);
{
_Ttensor*D_i= calcD_k<t> (i);
g_si->add(1.0,*D_i);
delete D_i;
}
if(i>=3){
_Ttensor*E_i= calcE_k<t> (i);
g_si->add(1.0,*E_i);
delete E_i;
}
g_si->mult(-1.0);
matS.multInv(*g_si);
insertDerivative<t> (g_si);
Gstack<t> ().multAndAdd(1,gss<t> (),*G_si);
Gstack<t> ().multAndAdd(i,gss<t> (),*G_si);
}
}
/*:16*/
#line 369 "./korder.hweb"
;
/*17:*/
#line 685 "./korder.hweb"
template<int t>
void fillG(int i,int j,int k)
{
for(int m= 1;m<=k;m++){
if(is_even(k-m)){
_Ttensor*G_yiujupms= faaDiBrunoG<t> (Symmetry(i,j,m,k-m));
G<t> ().insert(G_yiujupms);
}
}
}
/*:17*/
#line 370 "./korder.hweb"
;
/*18:*/
#line 705 "./korder.hweb"
template<int t>
_Ttensor*calcD_ijk(int i,int j,int k)const
{
_Ttensor*res= new _Ttensor(ny,TensorDimens(Symmetry(i,j,0,0),nvs));
res->zeros();
if(is_even(k)){
_Ttensor*tmp= faaDiBrunoZ<t> (Symmetry(i,j,k,0));
tmp->contractAndAdd(2,*res,*(m<t> ().get(Symmetry(k))));
delete tmp;
}
return res;
}
/*:18*/
#line 372 "./korder.hweb"
;
/*20:*/
#line 743 "./korder.hweb"
template<int t>
_Ttensor*calcD_ik(int i,int k)const
{
return calcD_ijk<t> (i,0,k);
}
/*:20*/
#line 373 "./korder.hweb"
;
/*21:*/
#line 751 "./korder.hweb"
template<int t>
_Ttensor*calcD_k(int k)const
{
return calcD_ijk<t> (0,0,k);
}
/*:21*/
#line 374 "./korder.hweb"
;
/*19:*/
#line 727 "./korder.hweb"
template<int t>
_Ttensor*calcE_ijk(int i,int j,int k)const
{
_Ttensor*res= new _Ttensor(ny,TensorDimens(Symmetry(i,j,0,0),nvs));
res->zeros();
for(int n= 2;n<=k-1;n+= 2){
_Ttensor*tmp= faaDiBrunoZ<t> (Symmetry(i,j,n,k-n));
tmp->mult((double)(Tensor::noverk(k,n)));
tmp->contractAndAdd(2,*res,*(m<t> ().get(Symmetry(n))));
delete tmp;
}
return res;
}
/*:19*/
#line 376 "./korder.hweb"
;
/*22:*/
#line 759 "./korder.hweb"
template<int t>
_Ttensor*calcE_ik(int i,int k)const
{
return calcE_ijk<t> (i,0,k);
}
/*:22*/
#line 377 "./korder.hweb"
;
/*23:*/
#line 767 "./korder.hweb"
template<int t>
_Ttensor*calcE_k(int k)const
{
return calcE_ijk<t> (0,0,k);
}
/*:23*/
#line 378 "./korder.hweb"
;
};
/*:8*/
#line 89 "./korder.hweb"
;
#endif
/*:1*/

137
mex/sources/korderpert/Dyn_pp/kord/korder_stoch.cpp Normal file
View File

@ -0,0 +1,137 @@
/*1:*/
#line 5 "./korder_stoch.cweb"
#include "korder_stoch.h"
/*2:*/
#line 14 "./korder_stoch.cweb"
MatrixAA::MatrixAA(const FSSparseTensor&f,const IntSequence&ss,
const TwoDMatrix&gss_ys,const PartitionY&ypart)
:PLUMatrix(ypart.ny())
{
zeros();
IntSequence c(1);c[0]= 1;
FGSTensor f_y(f,ss,c,TensorDimens(ss,c));
add(1.0,f_y);
c[0]= 0;
FGSTensor f_yss(f,ss,c,TensorDimens(ss,c));
TwoDMatrix sub(*this,ypart.nstat,ypart.nys());
sub.multAndAdd(f_yss,gss_ys);
calcPLU();
}
/*:2*/
#line 8 "./korder_stoch.cweb"
;
/*3:*/
#line 35 "./korder_stoch.cweb"
KOrderStoch::KOrderStoch(const PartitionY&yp,int nu,
const TensorContainer<FSSparseTensor> &fcont,
const FGSContainer&hh,Journal&jr)
:nvs(4),ypart(yp),journal(jr),
_ug(4),_fg(4),_ugs(4),_fgs(4),_uG(4),_fG(4),
_uh(NULL),_fh(&hh),
_uZstack(&_uG,ypart.nyss(),&_ug,ypart.ny(),ypart.nys(),nu),
_fZstack(&_fG,ypart.nyss(),&_fg,ypart.ny(),ypart.nys(),nu),
_uGstack(&_ugs,ypart.nys(),nu),
_fGstack(&_fgs,ypart.nys(),nu),
f(fcont),
matA(*(fcont.get(Symmetry(1))),_uZstack.getStackSizes(),*(hh.get(Symmetry(1,0,0,0))),
ypart)
{
nvs[0]= ypart.nys();
nvs[1]= nu;
nvs[2]= nu;
nvs[3]= 1;
}
/*:3*/
#line 9 "./korder_stoch.cweb"
;
/*4:*/
#line 57 "./korder_stoch.cweb"
KOrderStoch::KOrderStoch(const PartitionY&yp,int nu,
const TensorContainer<FSSparseTensor> &fcont,
const UGSContainer&hh,Journal&jr)
:nvs(4),ypart(yp),journal(jr),
_ug(4),_fg(4),_ugs(4),_fgs(4),_uG(4),_fG(4),
_uh(&hh),_fh(NULL),
_uZstack(&_uG,ypart.nyss(),&_ug,ypart.ny(),ypart.nys(),nu),
_fZstack(&_fG,ypart.nyss(),&_fg,ypart.ny(),ypart.nys(),nu),
_uGstack(&_ugs,ypart.nys(),nu),
_fGstack(&_fgs,ypart.nys(),nu),
f(fcont),
matA(*(fcont.get(Symmetry(1))),_uZstack.getStackSizes(),*(hh.get(Symmetry(1,0,0,0))),
ypart)
{
nvs[0]= ypart.nys();
nvs[1]= nu;
nvs[2]= nu;
nvs[3]= 1;
}
/*:4*/
#line 10 "./korder_stoch.cweb"
;
/*5:*/
#line 80 "./korder_stoch.cweb"
template<> ctraits<KOrder::unfold> ::Tg&KOrderStoch::g<KOrder::unfold> ()
{return _ug;}
template<> const ctraits<KOrder::unfold> ::Tg&KOrderStoch::g<KOrder::unfold> ()const
{return _ug;}
template<> ctraits<KOrder::fold> ::Tg&KOrderStoch::g<KOrder::fold> ()
{return _fg;}
template<> const ctraits<KOrder::fold> ::Tg&KOrderStoch::g<KOrder::fold> ()const
{return _fg;}
template<> ctraits<KOrder::unfold> ::Tgs&KOrderStoch::gs<KOrder::unfold> ()
{return _ugs;}
template<> const ctraits<KOrder::unfold> ::Tgs&KOrderStoch::gs<KOrder::unfold> ()const
{return _ugs;}
template<> ctraits<KOrder::fold> ::Tgs&KOrderStoch::gs<KOrder::fold> ()
{return _fgs;}
template<> const ctraits<KOrder::fold> ::Tgs&KOrderStoch::gs<KOrder::fold> ()const
{return _fgs;}
template<> const ctraits<KOrder::unfold> ::Tgss&KOrderStoch::h<KOrder::unfold> ()const
{return*_uh;}
template<> const ctraits<KOrder::fold> ::Tgss&KOrderStoch::h<KOrder::fold> ()const
{return*_fh;}
template<> ctraits<KOrder::unfold> ::TG&KOrderStoch::G<KOrder::unfold> ()
{return _uG;}
template<> const ctraits<KOrder::unfold> ::TG&KOrderStoch::G<KOrder::unfold> ()const
{return _uG;}
template<> ctraits<KOrder::fold> ::TG&KOrderStoch::G<KOrder::fold> ()
{return _fG;}
template<> const ctraits<KOrder::fold> ::TG&KOrderStoch::G<KOrder::fold> ()const
{return _fG;}
template<> ctraits<KOrder::unfold> ::TZXstack&KOrderStoch::Zstack<KOrder::unfold> ()
{return _uZstack;}
template<> const ctraits<KOrder::unfold> ::TZXstack&KOrderStoch::Zstack<KOrder::unfold> ()const
{return _uZstack;}
template<> ctraits<KOrder::fold> ::TZXstack&KOrderStoch::Zstack<KOrder::fold> ()
{return _fZstack;}
template<> const ctraits<KOrder::fold> ::TZXstack&KOrderStoch::Zstack<KOrder::fold> ()const
{return _fZstack;}
template<> ctraits<KOrder::unfold> ::TGXstack&KOrderStoch::Gstack<KOrder::unfold> ()
{return _uGstack;}
template<> const ctraits<KOrder::unfold> ::TGXstack&KOrderStoch::Gstack<KOrder::unfold> ()const
{return _uGstack;}
template<> ctraits<KOrder::fold> ::TGXstack&KOrderStoch::Gstack<KOrder::fold> ()
{return _fGstack;}
template<> const ctraits<KOrder::fold> ::TGXstack&KOrderStoch::Gstack<KOrder::fold> ()const
{return _fGstack;}
/*:5*/
#line 11 "./korder_stoch.cweb"
;
/*:1*/

444
mex/sources/korderpert/Dyn_pp/kord/korder_stoch.h Normal file
View File

@ -0,0 +1,444 @@
/*1:*/
#line 40 "./korder_stoch.hweb"
#include "korder.h"
#include "faa_di_bruno.h"
#include "journal.h"
/*2:*/
#line 60 "./korder_stoch.hweb"
template<int t>
class IntegDerivs:public ctraits<t> ::Tgss{
public:
/*3:*/
#line 106 "./korder_stoch.hweb"
IntegDerivs(int r,const IntSequence&nvs,const _Tgss&g,const _Tm&mom,
double at_sigma)
:ctraits<t> ::Tgss(4)
{
int maxd= g.getMaxDim();
for(int d= 1;d<=maxd;d++){
for(int i= 0;i<=d;i++){
int p= d-i;
Symmetry sym(i,0,0,p);
_Ttensor*ten= new _Ttensor(r,TensorDimens(sym,nvs));
/*4:*/
#line 129 "./korder_stoch.hweb"
ten->zeros();
for(int n= 0;n<=p;n++){
int k= p-n;
int povern= Tensor::noverk(p,n);
int mfac= 1;
for(int m= 0;i+m+n+k<=maxd;m++,mfac*= m){
double mult= (pow(at_sigma,m)*povern)/mfac;
Symmetry sym_mn(i,m+n,0,k);
if(m+n==0&&g.check(sym_mn))
ten->add(mult,*(g.get(sym_mn)));
if(m+n> 0&&KOrder::is_even(m+n)&&g.check(sym_mn)){
_Ttensor gtmp(*(g.get(sym_mn)));
gtmp.mult(mult);
gtmp.contractAndAdd(1,*ten,*(mom.get(Symmetry(m+n))));
}
}
}
/*:4*/
#line 117 "./korder_stoch.hweb"
;
insert(ten);
}
}
}
/*:3*/
#line 64 "./korder_stoch.hweb"
;
};
/*:2*/
#line 46 "./korder_stoch.hweb"
;
/*5:*/
#line 156 "./korder_stoch.hweb"
template<int t>
class StochForwardDerivs:public ctraits<t> ::Tgss{
public:
/*6:*/
#line 180 "./korder_stoch.hweb"
StochForwardDerivs(const PartitionY&ypart,int nu,
const _Tgss&g,const _Tm&m,
const Vector&ydelta,double sdelta,
double at_sigma)
:ctraits<t> ::Tgss(4)
{
int maxd= g.getMaxDim();
int r= ypart.nyss();
/*7:*/
#line 201 "./korder_stoch.hweb"
IntSequence nvs(4);
nvs[0]= ypart.nys();nvs[1]= 0;nvs[2]= 0;nvs[3]= 1;
IntegDerivs<t> g_int(r,nvs,g,m,at_sigma);
/*:7*/
#line 190 "./korder_stoch.hweb"
;
/*8:*/
#line 209 "./korder_stoch.hweb"
_Tpol g_int_sym(r,ypart.nys()+1);
for(int d= 1;d<=maxd;d++){
_Ttensym*ten= new _Ttensym(r,ypart.nys()+1,d);
ten->zeros();
for(int i= 0;i<=d;i++){
int k= d-i;
if(g_int.check(Symmetry(i,0,0,k)))
ten->addSubTensor(*(g_int.get(Symmetry(i,0,0,k))));
}
g_int_sym.insert(ten);
}
/*:8*/
#line 191 "./korder_stoch.hweb"
;
/*9:*/
#line 229 "./korder_stoch.hweb"
Vector delta(ypart.nys()+1);
Vector dy(delta,0,ypart.nys());
ConstVector dy_in(ydelta,ypart.nstat,ypart.nys());
dy= dy_in;
delta[ypart.nys()]= sdelta;
_Tpol g_int_cent(r,ypart.nys()+1);
for(int d= 1;d<=maxd;d++){
g_int_sym.derivative(d-1);
_Ttensym*der= g_int_sym.evalPartially(d,delta);
g_int_cent.insert(der);
}
/*:9*/
#line 192 "./korder_stoch.hweb"
;
/*10:*/
#line 245 "./korder_stoch.hweb"
IntSequence ss(4);
ss[0]= ypart.nys();ss[1]= 0;ss[2]= 0;ss[3]= 1;
IntSequence pp(4);
pp[0]= 0;pp[1]= 1;pp[2]= 2;pp[3]= 3;
IntSequence true_nvs(nvs);
true_nvs[1]= nu;true_nvs[2]= nu;
for(int d= 1;d<=maxd;d++){
if(g_int_cent.check(Symmetry(d))){
for(int i= 0;i<=d;i++){
Symmetry sym(i,0,0,d-i);
IntSequence coor(sym,pp);
_Ttensor*ten= new _Ttensor(*(g_int_cent.get(Symmetry(d))),ss,coor,
TensorDimens(sym,true_nvs));
insert(ten);
}
}
}
/*:10*/
#line 193 "./korder_stoch.hweb"
;
}
/*:6*/
#line 160 "./korder_stoch.hweb"
;
};
/*:5*/
#line 47 "./korder_stoch.hweb"
;
/*11:*/
#line 270 "./korder_stoch.hweb"
template<class _Ttype>
class GXContainer:public GContainer<_Ttype> {
public:
typedef StackContainerInterface<_Ttype> _Stype;
typedef typename StackContainer<_Ttype> ::_Ctype _Ctype;
typedef typename StackContainer<_Ttype> ::itype itype;
GXContainer(const _Ctype*gs,int ngs,int nu)
:GContainer<_Ttype> (gs,ngs,nu){}
/*12:*/
#line 285 "./korder_stoch.hweb"
itype getType(int i,const Symmetry&s)const
{
if(i==0)
if(s[2]> 0)
return _Stype::zero;
else
return _Stype::matrix;
if(i==1)
return _Stype::zero;
if(i==2)
return _Stype::zero;
if(i==3)
if(s==Symmetry(0,0,0,1))
return _Stype::unit;
else
return _Stype::zero;
KORD_RAISE("Wrong stack index in GXContainer::getType");
}
/*:12*/
#line 279 "./korder_stoch.hweb"
;
};
/*:11*/
#line 48 "./korder_stoch.hweb"
;
/*13:*/
#line 312 "./korder_stoch.hweb"
template<class _Ttype>
class ZXContainer:public ZContainer<_Ttype> {
public:
typedef StackContainerInterface<_Ttype> _Stype;
typedef typename StackContainer<_Ttype> ::_Ctype _Ctype;
typedef typename StackContainer<_Ttype> ::itype itype;
ZXContainer(const _Ctype*gss,int ngss,const _Ctype*g,int ng,int ny,int nu)
:ZContainer<_Ttype> (gss,ngss,g,ng,ny,nu){}
/*14:*/
#line 327 "./korder_stoch.hweb"
itype getType(int i,const Symmetry&s)const
{
if(i==0)
if(s[2]> 0)
return _Stype::zero;
else
return _Stype::matrix;
if(i==1)
if(s[2]> 0)
return _Stype::zero;
else
return _Stype::matrix;
if(i==2)
if(s==Symmetry(1,0,0,0))
return _Stype::unit;
else
return _Stype::zero;
if(i==3)
if(s==Symmetry(0,1,0,0))
return _Stype::unit;
else
return _Stype::zero;
KORD_RAISE("Wrong stack index in ZXContainer::getType");
}
/*:14*/
#line 321 "./korder_stoch.hweb"
;
};
/*:13*/
#line 49 "./korder_stoch.hweb"
;
/*15:*/
#line 355 "./korder_stoch.hweb"
class UnfoldedGXContainer:public GXContainer<UGSTensor> ,public UnfoldedStackContainer{
public:
typedef TensorContainer<UGSTensor> _Ctype;
UnfoldedGXContainer(const _Ctype*gs,int ngs,int nu)
:GXContainer<UGSTensor> (gs,ngs,nu){}
};
/*:15*/
#line 50 "./korder_stoch.hweb"
;
/*16:*/
#line 364 "./korder_stoch.hweb"
class FoldedGXContainer:public GXContainer<FGSTensor> ,public FoldedStackContainer{
public:
typedef TensorContainer<FGSTensor> _Ctype;
FoldedGXContainer(const _Ctype*gs,int ngs,int nu)
:GXContainer<FGSTensor> (gs,ngs,nu){}
};
/*:16*/
#line 51 "./korder_stoch.hweb"
;
/*17:*/
#line 373 "./korder_stoch.hweb"
class UnfoldedZXContainer:public ZXContainer<UGSTensor> ,public UnfoldedStackContainer{
public:
typedef TensorContainer<UGSTensor> _Ctype;
UnfoldedZXContainer(const _Ctype*gss,int ngss,const _Ctype*g,int ng,int ny,int nu)
:ZXContainer<UGSTensor> (gss,ngss,g,ng,ny,nu){}
};
/*:17*/
#line 52 "./korder_stoch.hweb"
;
/*18:*/
#line 382 "./korder_stoch.hweb"
class FoldedZXContainer:public ZXContainer<FGSTensor> ,public FoldedStackContainer{
public:
typedef TensorContainer<FGSTensor> _Ctype;
FoldedZXContainer(const _Ctype*gss,int ngss,const _Ctype*g,int ng,int ny,int nu)
:ZXContainer<FGSTensor> (gss,ngss,g,ng,ny,nu){}
};
/*:18*/
#line 53 "./korder_stoch.hweb"
;
/*19:*/
#line 397 "./korder_stoch.hweb"
class MatrixAA:public PLUMatrix{
public:
MatrixAA(const FSSparseTensor&f,const IntSequence&ss,
const TwoDMatrix&gyss,const PartitionY&ypart);
};
/*:19*/
#line 54 "./korder_stoch.hweb"
;
/*20:*/
#line 418 "./korder_stoch.hweb"
class KOrderStoch{
protected:
IntSequence nvs;
PartitionY ypart;
Journal&journal;
UGSContainer _ug;
FGSContainer _fg;
UGSContainer _ugs;
FGSContainer _fgs;
UGSContainer _uG;
FGSContainer _fG;
const UGSContainer*_uh;
const FGSContainer*_fh;
UnfoldedZXContainer _uZstack;
FoldedZXContainer _fZstack;
UnfoldedGXContainer _uGstack;
FoldedGXContainer _fGstack;
const TensorContainer<FSSparseTensor> &f;
MatrixAA matA;
public:
KOrderStoch(const PartitionY&ypart,int nu,const TensorContainer<FSSparseTensor> &fcont,
const FGSContainer&hh,Journal&jr);
KOrderStoch(const PartitionY&ypart,int nu,const TensorContainer<FSSparseTensor> &fcont,
const UGSContainer&hh,Journal&jr);
/*23:*/
#line 496 "./korder_stoch.hweb"
template<int t>
void performStep(int order)
{
int maxd= g<t> ().getMaxDim();
KORD_RAISE_IF(order-1!=maxd&&(order!=1||maxd!=-1),
"Wrong order for KOrderStoch::performStep");
SymmetrySet ss(order,4);
for(symiterator si(ss);!si.isEnd();++si){
if((*si)[2]==0){
JournalRecordPair pa(journal);
pa<<"Recovering symmetry "<<*si<<endrec;
_Ttensor*G_sym= faaDiBrunoG<t> (*si);
G<t> ().insert(G_sym);
_Ttensor*g_sym= faaDiBrunoZ<t> (*si);
g_sym->mult(-1.0);
matA.multInv(*g_sym);
g<t> ().insert(g_sym);
gs<t> ().insert(new _Ttensor(ypart.nstat,ypart.nys(),*g_sym));
Gstack<t> ().multAndAdd(1,h<t> (),*G_sym);
}
}
}
/*:23*/
#line 443 "./korder_stoch.hweb"
;
const FGSContainer&getFoldDers()const
{return _fg;}
const UGSContainer&getUnfoldDers()const
{return _ug;}
protected:
/*21:*/
#line 457 "./korder_stoch.hweb"
template<int t>
_Ttensor*faaDiBrunoZ(const Symmetry&sym)const
{
JournalRecordPair pa(journal);
pa<<"Faa Di Bruno ZX container for "<<sym<<endrec;
_Ttensor*res= new _Ttensor(ypart.ny(),TensorDimens(sym,nvs));
FaaDiBruno bruno(journal);
bruno.calculate(Zstack<t> (),f,*res);
return res;
}
/*:21*/
#line 449 "./korder_stoch.hweb"
;
/*22:*/
#line 472 "./korder_stoch.hweb"
template<int t>
_Ttensor*faaDiBrunoG(const Symmetry&sym)const
{
JournalRecordPair pa(journal);
pa<<"Faa Di Bruno GX container for "<<sym<<endrec;
TensorDimens tdims(sym,nvs);
_Ttensor*res= new _Ttensor(ypart.nyss(),tdims);
FaaDiBruno bruno(journal);
bruno.calculate(Gstack<t> (),h<t> (),*res);
return res;
}
/*:22*/
#line 450 "./korder_stoch.hweb"
;
/*24:*/
#line 524 "./korder_stoch.hweb"
template<int t> _Tg&g();
template<int t> const _Tg&g()const;
template<int t> _Tgs&gs();
template<int t> const _Tgs&gs()const;
template<int t> const _Tgss&h()const;
template<int t> _TG&G();
template<int t> const _TG&G()const;
template<int t> _TZXstack&Zstack();
template<int t> const _TZXstack&Zstack()const;
template<int t> _TGXstack&Gstack();
template<int t> const _TGXstack&Gstack()const;
/*:24*/
#line 451 "./korder_stoch.hweb"
;
};
/*:20*/
#line 55 "./korder_stoch.hweb"
;
/*:1*/

157
mex/sources/korderpert/Dyn_pp/kord/mersenne_twister.h Normal file
View File

@ -0,0 +1,157 @@
/*1:*/
#line 14 "./mersenne_twister.hweb"
#ifndef MERSENNE_TWISTER_H
#define MERSENNE_TWISTER_H
#include "random.h"
#include <string.h>
/*2:*/
#line 27 "./mersenne_twister.hweb"
class MersenneTwister:public RandomGenerator{
protected:
typedef unsigned int uint32;
enum{STATE_SIZE= 624};
enum{RECUR_OFFSET= 397};
uint32 statevec[STATE_SIZE];
int stateptr;
public:
MersenneTwister(uint32 iseed);
MersenneTwister(const MersenneTwister&mt);
virtual~MersenneTwister(){}
uint32 lrand();
double drand();
double uniform()
{return drand();}
protected:
void seed(uint32 iseed);
void refresh();
private:
/*3:*/
#line 51 "./mersenne_twister.hweb"
static uint32 hibit(uint32 u)
{return u&0x80000000UL;}
static uint32 lobit(uint32 u)
{return u&0x00000001UL;}
static uint32 lobits(uint32 u)
{return u&0x7fffffffUL;}
static uint32 mixbits(uint32 u,uint32 v)
{return hibit(u)|lobits(v);}
static uint32 twist(uint32 m,uint32 s0,uint32 s1)
{return m^(mixbits(s0,s1)>>1)^(-lobit(s1)&0x9908b0dfUL);}
/*:3*/
#line 47 "./mersenne_twister.hweb"
;
};
/*:2*/
#line 21 "./mersenne_twister.hweb"
;
/*4:*/
#line 65 "./mersenne_twister.hweb"
/*5:*/
#line 74 "./mersenne_twister.hweb"
inline MersenneTwister::MersenneTwister(uint32 iseed)
{
seed(iseed);
}
/*:5*/
#line 66 "./mersenne_twister.hweb"
;
/*6:*/
#line 81 "./mersenne_twister.hweb"
inline MersenneTwister::MersenneTwister(const MersenneTwister&mt)
:stateptr(mt.stateptr)
{
memcpy(statevec,mt.statevec,sizeof(uint32)*STATE_SIZE);
}
/*:6*/
#line 67 "./mersenne_twister.hweb"
;
/*7:*/
#line 89 "./mersenne_twister.hweb"
inline MersenneTwister::uint32 MersenneTwister::lrand()
{
if(stateptr>=STATE_SIZE)
refresh();
register uint32 v= statevec[stateptr++];
v^= v>>11;
v^= (v<<7)&0x9d2c5680;
v^= (v<<15)&0xefc60000;
return(v^(v>>18));
}
/*:7*/
#line 68 "./mersenne_twister.hweb"
;
/*8:*/
#line 103 "./mersenne_twister.hweb"
inline double MersenneTwister::drand()
{
uint32 a= lrand()>>5;
uint32 b= lrand()>>6;
return(a*67108864.0+b)*(1.0/9007199254740992.0);
}
/*:8*/
#line 69 "./mersenne_twister.hweb"
;
/*9:*/
#line 112 "./mersenne_twister.hweb"
inline void MersenneTwister::seed(uint32 iseed)
{
statevec[0]= iseed&0xffffffffUL;
for(int i= 1;i<STATE_SIZE;i++){
register uint32 val= statevec[i-1]>>30;
val^= statevec[i-1];
val*= 1812433253ul;
val+= i;
statevec[i]= val&0xffffffffUL;
}
refresh();
}
/*:9*/
#line 70 "./mersenne_twister.hweb"
;
/*10:*/
#line 128 "./mersenne_twister.hweb"
inline void MersenneTwister::refresh()
{
register uint32*p= statevec;
for(int i= STATE_SIZE-RECUR_OFFSET;i--;++p)
*p= twist(p[RECUR_OFFSET],p[0],p[1]);
for(int i= RECUR_OFFSET;--i;++p)
*p= twist(p[RECUR_OFFSET-STATE_SIZE],p[0],p[1]);
*p= twist(p[RECUR_OFFSET-STATE_SIZE],p[0],statevec[0]);
stateptr= 0;
}
/*:10*/
#line 71 "./mersenne_twister.hweb"
;
/*:4*/
#line 22 "./mersenne_twister.hweb"
;
#endif
/*:1*/

130
mex/sources/korderpert/Dyn_pp/kord/normal_conjugate.cpp Normal file
View File

@ -0,0 +1,130 @@
/*1:*/
#line 6 "./normal_conjugate.cweb"
#include "normal_conjugate.h"
#include "kord_exception.h"
/*2:*/
#line 20 "./normal_conjugate.cweb"
NormalConj::NormalConj(int d)
:mu(d),kappa(0),nu(-1),lambda(d,d)
{
mu.zeros();
lambda.zeros();
}
/*:2*/
#line 11 "./normal_conjugate.cweb"
;
/*3:*/
#line 29 "./normal_conjugate.cweb"
NormalConj::NormalConj(const ConstTwoDMatrix&ydata)
:mu(ydata.numRows()),kappa(ydata.numCols()),nu(ydata.numCols()-1),
lambda(ydata.numRows(),ydata.numRows())
{
mu.zeros();
for(int i= 0;i<ydata.numCols();i++)
mu.add(1.0/ydata.numCols(),ConstVector(ydata,i));
lambda.zeros();
for(int i= 0;i<ydata.numCols();i++){
Vector diff(ConstVector(ydata,i));
diff.add(-1,mu);
lambda.addOuter(diff);
}
}
/*:3*/
#line 12 "./normal_conjugate.cweb"
;
/*4:*/
#line 47 "./normal_conjugate.cweb"
NormalConj::NormalConj(const NormalConj&nc)
:mu(nc.mu),kappa(nc.kappa),nu(nc.nu),lambda(nc.lambda)
{
}
/*:4*/
#line 13 "./normal_conjugate.cweb"
;
/*5:*/
#line 61 "./normal_conjugate.cweb"
void NormalConj::update(const ConstVector&y)
{
KORD_RAISE_IF(y.length()!=mu.length(),
"Wrong length of a vector in NormalConj::update");
mu.mult(kappa/(1.0+kappa));
mu.add(1.0/(1.0+kappa),y);
Vector diff(y);
diff.add(-1,mu);
lambda.addOuter(diff,kappa/(1.0+kappa));
kappa++;
nu++;
}
/*:5*/
#line 14 "./normal_conjugate.cweb"
;
/*6:*/
#line 80 "./normal_conjugate.cweb"
void NormalConj::update(const ConstTwoDMatrix&ydata)
{
NormalConj nc(ydata);
update(nc);
}
/*:6*/
#line 15 "./normal_conjugate.cweb"
;
/*7:*/
#line 89 "./normal_conjugate.cweb"
void NormalConj::update(const NormalConj&nc)
{
double wold= ((double)kappa)/(kappa+nc.kappa);
double wnew= 1-wold;
mu.mult(wold);
mu.add(wnew,nc.mu);
Vector diff(nc.mu);
diff.add(-1,mu);
lambda.add(1.0,nc.lambda);
lambda.addOuter(diff);
kappa= kappa+nc.kappa;
nu= nu+nc.kappa;
}
/*:7*/
#line 16 "./normal_conjugate.cweb"
;
/*8:*/
#line 112 "./normal_conjugate.cweb"
void NormalConj::getVariance(TwoDMatrix&v)const
{
if(nu> getDim()+1){
v= (const TwoDMatrix&)lambda;
v.mult(1.0/(nu-getDim()-1));
}else
v.nans();
}
/*:8*/
#line 17 "./normal_conjugate.cweb"
;
/*:1*/

47
mex/sources/korderpert/Dyn_pp/kord/normal_conjugate.h Normal file
View File

@ -0,0 +1,47 @@
/*1:*/
#line 37 "./normal_conjugate.hweb"
#ifndef NORMAL_CONJUGATE_H
#define NORMAL_CONJUGATE_H
#include "twod_matrix.h"
/*2:*/
#line 49 "./normal_conjugate.hweb"
class NormalConj{
protected:
Vector mu;
int kappa;
int nu;
TwoDMatrix lambda;
public:
/*3:*/
#line 76 "./normal_conjugate.hweb"
NormalConj(int d);
NormalConj(const ConstTwoDMatrix&ydata);
NormalConj(const NormalConj&nc);
/*:3*/
#line 57 "./normal_conjugate.hweb"
;
virtual~NormalConj(){}
void update(const ConstVector&y);
void update(const ConstTwoDMatrix&ydata);
void update(const NormalConj&nc);
int getDim()const
{return mu.length();}
const Vector&getMean()const
{return mu;}
void getVariance(TwoDMatrix&v)const;
};
/*:2*/
#line 43 "./normal_conjugate.hweb"
;
#endif
/*:1*/

73
mex/sources/korderpert/Dyn_pp/kord/random.cpp Normal file
View File

@ -0,0 +1,73 @@
/*1:*/
#line 5 "./random.cweb"
#include "random.h"
#include <stdlib.h>
#include <limits>
#include <cmath>
/*2:*/
#line 20 "./random.cweb"
int RandomGenerator::int_uniform()
{
double s= std::numeric_limits<int> ::max()*uniform();
return(int)s;
}
/*:2*/
#line 13 "./random.cweb"
;
/*3:*/
#line 28 "./random.cweb"
double RandomGenerator::normal()
{
double x1,x2;
double w;
do{
x1= 2*uniform()-1;
x2= 2*uniform()-1;
w= x1*x1+x2*x2;
}while(w>=1.0||w<1.0e-30);
return x1*std::sqrt((-2.0*std::log(w))/w);
}
/*:3*/
#line 14 "./random.cweb"
;
SystemRandomGenerator system_random_generator;
/*4:*/
#line 42 "./random.cweb"
double SystemRandomGenerator::uniform()
{
#ifndef __MINGW32__
return drand48();
#else
return((double)rand())/RAND_MAX;
#endif
}
/*:4*/
#line 16 "./random.cweb"
;
/*5:*/
#line 53 "./random.cweb"
void SystemRandomGenerator::initSeed(int seed)
{
#ifndef __MINGW32__
srand48(seed);
#else
srand(seed);
#endif
}
/*:5*/
#line 17 "./random.cweb"
;
/*:1*/

36
mex/sources/korderpert/Dyn_pp/kord/random.h Normal file
View File

@ -0,0 +1,36 @@
/*1:*/
#line 9 "./random.hweb"
#ifndef RANDOM_H
#define RANDOM_H
/*2:*/
#line 22 "./random.hweb"
class RandomGenerator{
public:
virtual double uniform()= 0;
int int_uniform();
double normal();
};
/*:2*/
#line 13 "./random.hweb"
;
/*3:*/
#line 32 "./random.hweb"
class SystemRandomGenerator:public RandomGenerator{
public:
double uniform();
void initSeed(int seed);
};
/*:3*/
#line 14 "./random.hweb"
;
extern SystemRandomGenerator system_random_generator;
#endif
/*:1*/

413
mex/sources/korderpert/Dyn_pp/kord/tests.cpp Normal file
View File

@ -0,0 +1,413 @@
/* $Id: tests.cpp 148 2005-04-19 15:12:26Z kamenik $ */
/* Copyright 2004, Ondra Kamenik */
#include "korder.h"
#include "SylvException.h"
struct Rand {
static void init(int n1, int n2, int n3, int n4, int n5);
static double get(double m);
static int get(int m);
static bool discrete(double prob); // answers true with given probability
};
void Rand::init(int n1, int n2, int n3, int n4, int n5)
{
long int seed = n1;
seed = 256*seed+n2;
seed = 256*seed+n3;
seed = 256*seed+n4;
seed = 256*seed+n5;
srand48(seed);
}
double Rand::get(double m)
{
return 2*m*(drand48()-0.5);
}
int Rand::get(int m)
{
return (int)(Rand::get(0.9999*m));
}
bool Rand::discrete(double prob)
{
return drand48() < prob;
}
struct SparseGenerator {
static FSSparseTensor* makeTensor(int dim, int nv, int r,
double fill, double m);
static void fillContainer(TensorContainer<FSSparseTensor>& c,
int maxdim, int nv, int r, double m);
};
FSSparseTensor* SparseGenerator::makeTensor(int dim, int nv, int r,
double fill, double m)
{
FSSparseTensor* res = new FSSparseTensor(dim, nv, r);
FFSTensor dummy(0, nv, dim);
for (Tensor::index fi = dummy.begin(); fi != dummy.end(); ++fi) {
for (int i = 0; i < r; i++) {
if (Rand::discrete(fill)) {
double x = Rand::get(m);
res->insert(fi.getCoor(), i, x);
}
}
}
return res;
}
void SparseGenerator::fillContainer(TensorContainer<FSSparseTensor>& c,
int maxdim, int nv, int r,
double m)
{
Rand::init(maxdim, nv, r, (int)(5*m), 0);
double fill = 0.5;
for (int d = 1; d <= maxdim; d++) {
c.insert(makeTensor(d,nv,r,fill,m));
fill *= 0.3;
}
}
const double vdata [] = { // 3x3
0.1307870268, 0.1241940078, 0.1356703123,
0.1241940078, 0.1986920419, 0.2010160581,
0.1356703123, 0.2010160581, 0.2160336975
};
const double gy_data [] = { // 8x4
0.3985178619, -0.5688233582, 0.9572900437, -0.6606847776, 0.1453004017,
0.3025310675, -0.8627437750, -0.6903410191, 0.4751910580, -0.7270018589,
-0.0939612498, -0.1463831989, 0.6742110220, 0.6046671043, 0.5215893126,
-1.0412969986, -0.3524898417, -1.0986703430, 0.8006531522, 0.8879776376,
-0.1037608317, -0.5587378073, -0.1010366945, 0.9462411248, -0.2439199881,
1.3420621236, -0.7820285935, 0.3205293447, 0.3606124791, 0.2975422208,
-0.5452861965, 1.6320340279
};
const double gu_data [] = { // just some numbers, no structure
1.8415286914, -0.2638743845, 1.7690713274, 0.9668585956, 0.2303143646,
-0.2229624279, -0.4381991822, 1.0082401405, -0.3186555860, -0.0624691529,
-0.5189085756, 1.4269672156, 0.1163282969, 1.4020183445, -0.0952660426,
0.2099097124, 0.6912400502, -0.5180935114, 0.5288316624, 0.2188053448,
0.5715516767, 0.7813893410, -0.6385073106, 0.8335131513, 0.3605202168,
-1.1167944865, -1.2263750934, 0.6113636081, 0.6964915482, -0.6451217688,
0.4062810500, -2.0552251116, -1.6383406284, 0.0198915095, 0.0111014458,
-1.2421792262, -1.0724161722, -0.4276904972, 0.1801494950, -2.0716473264
};
const double vdata2 [] = { // 10x10 positive definite
0.79666, -0.15536, 0.05667, -0.21026, 0.20262, 0.28505, 0.60341, -0.09703, 0.32363, 0.13299,
-0.15536, 0.64380, -0.01131, 0.00980, 0.03755, 0.43791, 0.21784, -0.31755, -0.55911, -0.29655,
0.05667, -0.01131, 0.56165, -0.34357, -0.40584, 0.20990, 0.28348, 0.20398, -0.19856, 0.35820,
-0.21026, 0.00980, -0.34357, 0.56147, 0.10972, -0.34146, -0.49906, -0.19685, 0.21088, -0.31560,
0.20262, 0.03755, -0.40584, 0.10972, 0.72278, 0.02155, 0.04089, -0.19696, 0.03446, -0.12919,
0.28505, 0.43791, 0.20990, -0.34146, 0.02155, 0.75867, 0.77699, -0.31125, -0.55141, -0.02155,
0.60341, 0.21784, 0.28348, -0.49906, 0.04089, 0.77699, 1.34553, -0.18613, -0.25811, -0.19016,
-0.09703, -0.31755, 0.20398, -0.19685, -0.19696, -0.31125, -0.18613, 0.59470, 0.08386, 0.41750,
0.32363, -0.55911, -0.19856, 0.21088, 0.03446, -0.55141, -0.25811, 0.08386, 0.98917, -0.12992,
0.13299, -0.29655, 0.35820, -0.31560, -0.12919, -0.02155, -0.19016, 0.41750, -0.12992, 0.89608
};
const double gy_data2 [] = { // 600 items make gy 30x20, whose gy(6:25,:) has spectrum within unit
0.39414, -0.29766, 0.08948, -0.19204, -0.00750, 0.21159, 0.05494, 0.06225, 0.01771, 0.21913,
-0.01373, 0.20086, -0.06086, -0.10955, 0.14424, -0.08390, 0.03948, -0.14713, 0.11674, 0.05091,
0.24039, 0.28307, -0.11835, 0.13030, 0.11682, -0.27444, -0.19311, -0.16654, 0.12867, 0.25116,
-0.19781, 0.45242, -0.15862, 0.24428, -0.11966, 0.11483, -0.32279, 0.29727, 0.20934, -0.18190,
-0.15080, -0.09477, -0.30551, -0.02672, -0.26919, 0.11165, -0.06390, 0.03449, -0.26622, 0.22197,
0.45141, -0.41683, 0.09760, 0.31094, -0.01652, 0.05809, -0.04514, -0.05645, 0.00554, 0.47980,
0.11726, 0.42459, -0.13136, -0.30902, -0.14648, 0.11455, 0.02947, -0.03835, -0.04044, 0.03559,
-0.26575, -0.01783, 0.31243, -0.14412, -0.13218, -0.05080, 0.18576, 0.13840, -0.05560, 0.35530,
-0.25573, -0.11560, 0.15187, -0.18431, 0.08193, -0.32278, 0.17560, -0.05529, -0.10020, -0.23088,
-0.20979, -0.49245, 0.09915, -0.16909, -0.03443, 0.19497, 0.18473, 0.25662, 0.29605, -0.20531,
-0.39244, -0.43369, 0.05588, 0.24823, -0.14236, -0.08311, 0.16371, -0.19975, 0.30605, -0.17087,
-0.01270, 0.00123, -0.22426, -0.13810, 0.05079, 0.06971, 0.01922, -0.09952, -0.23177, -0.41962,
-0.41991, 0.41430, -0.04247, -0.13706, -0.12048, -0.28906, -0.22813, -0.25057, -0.18579, -0.20642,
-0.47976, 0.25490, -0.05138, -0.30794, 0.31651, 0.02034, 0.12954, -0.20110, 0.13336, -0.40775,
-0.30195, -0.13704, 0.12396, 0.28152, 0.02986, 0.27669, 0.24623, 0.08635, -0.11956, -0.02949,
0.37401, 0.20838, 0.24801, -0.26872, 0.11195, 0.00315, -0.19069, 0.12839, -0.23036, -0.48228,
0.08434, -0.39872, -0.28896, -0.28754, 0.24668, 0.23285, 0.25437, 0.10456, -0.14124, 0.20483,
-0.19117, -0.33836, -0.24875, 0.08207, -0.03930, 0.20364, 0.15384, -0.15270, 0.24372, -0.11199,
-0.46591, 0.30319, 0.05745, 0.09084, 0.06058, 0.31884, 0.05071, -0.28899, -0.30793, -0.03566,
0.02286, 0.28178, 0.00736, -0.31378, -0.18144, -0.22346, -0.27239, 0.31043, -0.26228, 0.22181,
-0.15096, -0.36953, -0.06032, 0.21496, 0.29545, -0.13112, 0.16420, -0.07573, -0.43111, -0.43057,
0.26716, -0.31209, -0.05866, -0.29101, -0.27437, -0.18727, 0.28732, -0.19014, 0.08837, 0.30405,
0.06103, -0.35612, 0.00173, 0.25134, -0.08987, -0.22766, -0.03254, -0.18662, -0.08491, 0.49401,
-0.12145, -0.02961, -0.03668, -0.30043, -0.08555, 0.01701, -0.12544, 0.10969, -0.48202, 0.07245,
0.20673, 0.11408, 0.04343, -0.01815, -0.31594, -0.23632, -0.06258, -0.27474, 0.12180, 0.16613,
-0.37931, 0.30219, 0.15765, 0.25489, 0.17529, -0.17020, -0.30060, 0.22058, -0.02450, -0.42143,
0.49642, 0.46899, -0.28552, -0.22549, -0.01333, 0.21567, 0.22251, 0.21639, -0.19194, -0.19140,
-0.24106, 0.10952, -0.11019, 0.29763, -0.02039, -0.25748, 0.23169, 0.01357, 0.09802, -0.19022,
0.37604, -0.40777, 0.18131, -0.10258, 0.29573, -0.31773, 0.09069, -0.02198, -0.26594, 0.48302,
-0.10041, 0.20210, -0.05609, -0.01169, -0.17339, 0.17862, -0.22502, 0.29009, -0.45160, 0.19771,
0.27634, 0.31695, -0.09993, 0.17167, 0.12394, 0.28088, -0.12502, -0.16967, -0.06296, -0.17036,
0.27320, 0.01595, 0.16955, 0.30146, -0.15173, -0.29807, 0.08178, -0.06811, 0.21655, 0.26348,
0.06316, 0.45661, -0.29756, -0.05742, -0.14715, -0.03037, -0.16656, -0.08768, 0.38078, 0.40679,
-0.32779, -0.09106, 0.16107, -0.07301, 0.07700, -0.22694, -0.15692, -0.02548, 0.38749, -0.12203,
-0.02980, -0.22067, 0.00680, -0.23058, -0.29112, 0.23032, -0.16026, 0.23392, -0.09990, 0.03628,
-0.42592, -0.33474, -0.09499, -0.17442, -0.20110, 0.24618, -0.06418, -0.06715, 0.40754, 0.29377,
0.29543, -0.16832, -0.08468, 0.06491, -0.01410, 0.19988, 0.24950, 0.14626, -0.27851, 0.06079,
0.48134, -0.13475, 0.25398, 0.11738, 0.23369, -0.00661, -0.16811, -0.04557, -0.12030, -0.39527,
-0.35760, 0.01840, -0.15941, 0.03290, 0.09988, -0.08307, 0.06644, -0.24637, 0.34112, -0.08026,
0.00951, 0.27656, 0.16247, 0.28217, 0.17198, -0.16389, -0.03835, -0.02675, -0.08032, -0.21045,
-0.38946, 0.23207, 0.10987, -0.31674, -0.28653, -0.27430, -0.29109, -0.00648, 0.38431, -0.38478,
-0.41195, -0.19364, -0.20977, -0.05524, 0.05558, -0.20109, 0.11803, -0.19884, 0.43318, -0.39255,
0.26612, -0.21771, 0.12471, 0.12856, -0.15104, -0.11676, 0.17582, -0.25330, 0.00298, -0.31712,
0.21532, -0.20319, 0.14507, -0.04588, -0.22995, -0.06470, 0.18849, -0.13444, 0.37107, 0.07387,
-0.14008, 0.09896, 0.13727, -0.28417, -0.09461, -0.18703, 0.04080, 0.02343, -0.49988, 0.17993,
0.23189, -0.30581, -0.18334, -0.09667, -0.27699, -0.05998, 0.09118, -0.32453, 0.46251, 0.41500,
-0.45314, -0.00544, 0.08529, 0.29099, -0.00937, -0.31650, 0.26163, 0.14506, 0.37498, -0.16454,
0.35215, 0.31642, -0.09161, -0.31452, -0.04792, -0.04677, -0.19523, 0.27998, 0.05491, 0.44461,
-0.01258, -0.27887, 0.18361, -0.04539, -0.02977, 0.30821, 0.29454, -0.17932, 0.16193, 0.23934,
0.47923, 0.25373, 0.23258, 0.31484, -0.17958, -0.01136, 0.17681, 0.12869, 0.03235, 0.43762,
0.13734, -0.09433, -0.03735, 0.17949, 0.14122, -0.17814, 0.06359, 0.16044, 0.12249, -0.22314,
0.40775, 0.05147, 0.12389, 0.04290, -0.01642, 0.00082, -0.18056, 0.02875, 0.32690, 0.17712,
0.34001, -0.21581, -0.01086, -0.18180, 0.17480, -0.17774, -0.07503, 0.28438, -0.19747, 0.29595,
-0.28002, -0.02073, -0.16522, -0.18234, -0.20565, 0.29620, 0.07502, 0.01429, -0.31418, 0.43693,
-0.12212, 0.11178, -0.28503, 0.04683, 0.00072, 0.05566, 0.18857, 0.26101, -0.38891, -0.21216,
-0.21850, -0.15147, -0.30749, -0.23762, 0.14984, 0.03535, -0.02862, -0.00105, -0.39907, -0.06909,
-0.36094, 0.21717, 0.15930, -0.18924, 0.13741, 0.01039, 0.13613, 0.00659, 0.07676, -0.13711,
0.24285, -0.07564, -0.28349, -0.15658, 0.03135, -0.30909, -0.22534, 0.17363, -0.19376, 0.26038,
0.05546, -0.22607, 0.32420, -0.02552, -0.05400, 0.13388, 0.04643, -0.31535, -0.06181, 0.30237,
-0.04680, -0.29441, 0.12231, 0.03960, -0.01188, 0.01406, 0.25402, 0.03315, 0.25026, -0.10922
};
const double gu_data2 [] = { // raw data 300 items
0.26599, 0.41329, 0.31846, 0.92590, 0.43050, 0.17466, 0.02322, 0.72621, 0.37921, 0.70597,
0.97098, 0.14023, 0.57619, 0.09938, 0.02281, 0.92341, 0.72654, 0.71000, 0.76687, 0.70182,
0.88752, 0.49524, 0.42549, 0.42806, 0.57615, 0.76051, 0.15341, 0.47457, 0.60066, 0.40880,
0.20668, 0.41949, 0.97620, 0.94318, 0.71491, 0.56402, 0.23553, 0.94387, 0.78567, 0.06362,
0.85252, 0.86262, 0.25190, 0.03274, 0.93216, 0.37971, 0.08797, 0.14596, 0.73871, 0.06574,
0.67447, 0.28575, 0.43911, 0.92133, 0.12327, 0.87762, 0.71060, 0.07141, 0.55443, 0.53310,
0.91529, 0.25121, 0.07593, 0.94490, 0.28656, 0.82174, 0.68887, 0.67337, 0.99291, 0.03316,
0.02849, 0.33891, 0.25594, 0.90071, 0.01248, 0.67871, 0.65953, 0.65369, 0.97574, 0.31578,
0.23678, 0.39220, 0.06706, 0.80943, 0.57694, 0.08220, 0.18151, 0.19969, 0.37096, 0.37858,
0.70153, 0.46816, 0.76511, 0.02520, 0.39387, 0.25527, 0.39050, 0.60141, 0.30322, 0.46195,
0.12025, 0.33616, 0.04174, 0.00196, 0.68886, 0.74445, 0.15869, 0.18994, 0.95195, 0.62874,
0.82874, 0.53369, 0.34383, 0.50752, 0.97023, 0.22695, 0.62407, 0.25840, 0.71279, 0.28785,
0.31611, 0.20391, 0.19702, 0.40760, 0.85158, 0.68369, 0.63760, 0.09879, 0.11924, 0.32920,
0.53052, 0.15900, 0.21229, 0.84080, 0.33933, 0.93651, 0.42705, 0.06199, 0.50092, 0.47192,
0.57152, 0.01818, 0.31404, 0.50173, 0.87725, 0.50530, 0.10717, 0.04035, 0.32901, 0.33538,
0.04780, 0.40984, 0.78216, 0.91288, 0.11314, 0.25248, 0.23823, 0.74001, 0.48089, 0.55531,
0.82486, 0.01058, 0.05409, 0.44357, 0.52641, 0.68188, 0.94629, 0.61627, 0.33037, 0.11961,
0.57988, 0.19653, 0.91902, 0.59838, 0.52974, 0.28364, 0.45767, 0.65836, 0.63045, 0.76140,
0.27918, 0.27256, 0.46035, 0.77418, 0.92918, 0.14095, 0.89645, 0.25146, 0.21172, 0.47910,
0.95451, 0.34377, 0.29927, 0.79220, 0.97654, 0.67591, 0.44385, 0.38434, 0.44860, 0.28170,
0.90712, 0.20337, 0.00292, 0.55046, 0.62255, 0.45127, 0.80896, 0.43965, 0.59145, 0.23801,
0.33601, 0.30119, 0.89935, 0.40850, 0.98226, 0.75430, 0.68318, 0.65407, 0.68067, 0.32942,
0.11756, 0.27626, 0.83879, 0.72174, 0.75430, 0.13702, 0.03402, 0.58781, 0.07393, 0.23067,
0.92537, 0.29445, 0.43437, 0.47685, 0.54548, 0.66082, 0.23805, 0.60208, 0.94337, 0.21363,
0.72637, 0.57181, 0.77679, 0.63931, 0.72860, 0.38901, 0.94920, 0.04535, 0.12863, 0.40550,
0.90095, 0.21418, 0.13953, 0.99639, 0.02526, 0.70018, 0.21828, 0.20294, 0.20191, 0.30954,
0.39490, 0.68955, 0.11506, 0.15748, 0.40252, 0.91680, 0.61547, 0.78443, 0.19693, 0.67630,
0.56552, 0.58556, 0.53554, 0.53507, 0.09831, 0.21229, 0.83135, 0.26375, 0.89287, 0.97069,
0.70615, 0.42041, 0.43117, 0.21291, 0.26086, 0.26978, 0.77340, 0.43833, 0.46179, 0.54418,
0.67878, 0.42776, 0.61454, 0.55915, 0.36363, 0.31999, 0.42442, 0.86649, 0.62513, 0.02047
};
class TestRunnable {
char name[100];
public:
int dim; // dimension of the solved problem
int nvar; // number of variable of the solved problem
TestRunnable(const char* n, int d, int nv)
: dim(d), nvar(nv)
{strncpy(name, n, 100);}
bool test() const;
virtual bool run() const =0;
const char* getName() const
{return name;}
protected:
static double korder_unfold_fold(int maxdim, int unfold_dim,
int nstat, int npred, int nboth, int forw,
const TwoDMatrix& gy, const TwoDMatrix& gu,
const TwoDMatrix& v);
};
bool TestRunnable::test() const
{
printf("Running test <%s>\n",name);
clock_t start = clock();
bool passed = run();
clock_t end = clock();
printf("CPU time %8.4g (CPU seconds)..................",
((double)(end-start))/CLOCKS_PER_SEC);
if (passed) {
printf("passed\n\n");
return passed;
} else {
printf("FAILED\n\n");
return passed;
}
}
double TestRunnable::korder_unfold_fold(int maxdim, int unfold_dim,
int nstat, int npred, int nboth, int nforw,
const TwoDMatrix& gy, const TwoDMatrix& gu,
const TwoDMatrix& v)
{
TensorContainer<FSSparseTensor> c(1);
int ny = nstat+npred+nboth+nforw;
int nu = v.nrows();
int nz = nboth+nforw+ny+nboth+npred+nu;
SparseGenerator::fillContainer(c, maxdim, nz, ny, 5.0);
for (int d = 1; d <= maxdim; d++) {
printf("\ttensor fill for dim=%d is: %3.2f %%\n",
d, c.get(Symmetry(d))->getFillFactor()*100.0);
}
Journal jr("out.txt");
KOrder kord(nstat, npred, nboth, nforw, c, gy, gu, v, jr);
// perform unfolded steps until unfold_dim
double maxerror = 0.0;
for (int d = 2; d <= unfold_dim; d++) {
clock_t pertime = clock();
kord.performStep<KOrder::unfold>(d);
pertime = clock()-pertime;
printf("\ttime for unfolded step dim=%d: %8.4g\n",
d, ((double)(pertime))/CLOCKS_PER_SEC);
clock_t checktime = clock();
double err = kord.check<KOrder::unfold>(d);
checktime = clock()-checktime;
printf("\ttime for step check dim=%d: %8.4g\n",
d, ((double)(checktime))/CLOCKS_PER_SEC);
printf("\tmax error in step dim=%d: %10.6g\n",
d, err);
if (maxerror < err)
maxerror = err;
}
// perform folded steps until maxdim
if (unfold_dim < maxdim) {
clock_t swtime = clock();
kord.switchToFolded();
swtime = clock()-swtime;
printf("\ttime for switching dim=%d: %8.4g\n",
unfold_dim, ((double)(swtime))/CLOCKS_PER_SEC);
for (int d = unfold_dim+1; d <= maxdim; d++) {
clock_t pertime = clock();
kord.performStep<KOrder::fold>(d);
pertime = clock()-pertime;
printf("\ttime for folded step dim=%d: %8.4g\n",
d, ((double)(pertime))/CLOCKS_PER_SEC);
clock_t checktime = clock();
double err = kord.check<KOrder::fold>(d);
checktime = clock()-checktime;
printf("\ttime for step check dim=%d: %8.4g\n",
d, ((double)(checktime))/CLOCKS_PER_SEC);
printf("\tmax error in step dim=%d: %10.6g\n",
d, err);
if (maxerror < err)
maxerror = err;
}
}
return maxerror;
}
class UnfoldKOrderSmall : public TestRunnable {
public:
UnfoldKOrderSmall()
: TestRunnable("unfold-3 fold-4 korder (stat=2,pred=3,both=1,forw=2,u=3,dim=4)",
4, 18) {}
bool run() const
{
TwoDMatrix gy(8, 4, gy_data);
TwoDMatrix gu(8, 3, gu_data);
TwoDMatrix v(3, 3, vdata);
double err = korder_unfold_fold(4, 3, 2, 3, 1, 2,
gy, gu, v);
return err < 0.08;
}
};
// same dimension as Smets & Wouters
class UnfoldKOrderSW : public TestRunnable {
public:
UnfoldKOrderSW()
: TestRunnable("unfold S&W korder (stat=5,pred=12,both=8,forw=5,u=10,dim=4)",
4, 73) {}
bool run() const
{
TwoDMatrix gy(30, 20, gy_data2);
TwoDMatrix gu(30, 10, gu_data2);
TwoDMatrix v(10, 10, vdata2);
v.mult(0.001);
gu.mult(.01);
double err = korder_unfold_fold(4, 4, 5, 12, 8, 5,
gy, gu, v);
return err < 0.08;
}
};
class UnfoldFoldKOrderSW : public TestRunnable {
public:
UnfoldFoldKOrderSW()
: TestRunnable("unfold-2 fold-3 S&W korder (stat=5,pred=12,both=8,forw=5,u=10,dim=3)",
4, 73) {}
bool run() const
{
TwoDMatrix gy(30, 20, gy_data2);
TwoDMatrix gu(30, 10, gu_data2);
TwoDMatrix v(10, 10, vdata2);
v.mult(0.001);
gu.mult(.01);
double err = korder_unfold_fold(4, 3, 5, 12, 8, 5,
gy, gu, v);
return err < 0.08;
}
};
int main()
{
TestRunnable* all_tests[50];
// fill in vector of all tests
int num_tests = 0;
all_tests[num_tests++] = new UnfoldKOrderSmall();
all_tests[num_tests++] = new UnfoldKOrderSW();
all_tests[num_tests++] = new UnfoldFoldKOrderSW();
// find maximum dimension and maximum nvar
int dmax=0;
int nvmax = 0;
for (int i = 0; i < num_tests; i++) {
if (dmax < all_tests[i]->dim)
dmax = all_tests[i]->dim;
if (nvmax < all_tests[i]->nvar)
nvmax = all_tests[i]->nvar;
}
tls.init(dmax, nvmax); // initialize library
// launch the tests
int success = 0;
for (int i = 0; i < num_tests; i++) {
try {
if (all_tests[i]->test())
success++;
} catch (const TLException& e) {
printf("Caugth TL exception in <%s>:\n", all_tests[i]->getName());
e.print();
} catch (SylvException& e) {
printf("Caught Sylv exception in <%s>:\n", all_tests[i]->getName());
e.printMessage();
}
}
printf("There were %d tests that failed out of %d tests run.\n",
num_tests - success, num_tests);
// destroy
for (int i = 0; i < num_tests; i++) {
delete all_tests[i];
}
return 0;
}

216
mex/sources/korderpert/Dyn_pp/src/Makefile Normal file
View File

@ -0,0 +1,216 @@
CC_FLAGS = -Wall -I../sylv/cc -I../tl/cc -I../kord -I../integ/cc -I.. \
$(CC_INCLUDE_PATH)
LDFLAGS = -llapack -lcblas -lf77blas -latlas -lg2c -lstdc++ -lcygwin
DYNVERSION = 1.3.7
tmpdir = /tmp/aaabbb123321
pthreadGC2 = `which pthreadGC2.dll`
mingwm10 = `which mingwm10.dll`
ifeq ($(CC),)
CC := gcc
endif
ifneq ($(LD_LIBRARY_PATH),) # use LD_LIBRARY_PATH from environment
# LDFLAGS := -Wl,--library-path $(LD_LIBRARY_PATH) $(LDFLAGS)
LDFLAGS := -Wl,--library-path $(LD_LIBRARY_LIST) $(LDFLAGS)
# LDFLAGS := $(LD_LIBRARY_LIST) $(LDFLAGS)
endif
ifeq ($(DEBUG),yes)
CC_FLAGS := $(CC_FLAGS) -g -DTL_DEBUG=2
else
CC_FLAGS := $(CC_FLAGS) -O3 -DPOSIX_THREADS
endif
ifeq ($(OS),Windows_NT)
CC_FLAGS := -mno-cygwin -mthreads $(CC_FLAGS)
LDFLAGS := -mno-cygwin -mthreads $(LDFLAGS) -lpthreadGC2
ARCH := w32
MEX_SUFFIX = dll
else
LDFLAGS := $(LDFLAGS) -lpthread
ARCH := linux
MEX_SUFFIX = mexglx
endif
sylvcppsource := $(wildcard ../sylv/cc/*.cpp)
sylvhsource := $(wildcard ../sylv/cc/*.h)
sylvobjects := $(patsubst %.cpp, %.o, $(sylvcppsource))
tlcwebsource := $(wildcard ../tl/cc/*.cweb)
tlcppsource := $(patsubst %.cweb,%.cpp,$(tlcwebsource))
tlhwebsource := $(wildcard ../tl/cc/*.hweb)
tlhsource := $(patsubst %.hweb,%.h,$(tlhwebsource))
tlobjects := $(patsubst %.cweb,%.o,$(tlcwebsource))
kordcwebsource := $(wildcard ../kord/*.cweb)
kordcppsource := $(patsubst %.cweb,%.cpp,$(kordcwebsource))
kordhwebsource := $(wildcard ../kord/*.hweb)
kordhsource := $(patsubst %.hweb,%.h,$(kordhwebsource))
kordobjects := $(patsubst %.cweb,%.o,$(kordcwebsource))
integcwebsource := $(wildcard ../integ/cc/*.cweb)
integcppsource := $(patsubst %.cweb,%.cpp,$(integcwebsource))
integhwebsource := $(wildcard ../integ/cc/*.hweb)
integhsource := $(patsubst %.hweb,%.h,$(integhwebsource))
integobjects := $(patsubst %.cweb,%.o,$(integcwebsource))
parserhsource := $(wildcard ../parser/cc/*.h)
parsercppsource := $(wildcard ../parser/cc/*.cpp)
utilshsource := $(wildcard ../utils/cc/*.h)
utilscppsource := $(wildcard ../utils/cc/*.cpp)
cppsource := $(wildcard *.cpp) $(patsubst %.y,%_ll.cc,$(wildcard *.y)) $(patsubst %.lex,%_tab.cc,$(wildcard *.lex))
hsource := $(wildcard *.h) $(patsubst %.lex,%_tab.hh,$(wildcard *.lex))
objects := $(patsubst %.cpp,%.o,$(wildcard *.cpp)) $(patsubst %.y,%_ll.o,$(wildcard *.y)) $(patsubst %.lex,%_tab.o,$(wildcard *.lex))
all: dynare++
../tl/cc/dummy.ch:
make -C ../tl/cc dummy.ch
../tl/cc/%.cpp: ../tl/cc/%.cweb ../tl/cc/dummy.ch
make -C ../tl/cc $*.cpp
../tl/cc/%.h: ../tl/cc/%.hweb ../tl/cc/dummy.ch
make -C ../tl/cc $*.h
../tl/cc/%.o: ../tl/cc/%.cpp $(tlhsource)
make -C ../tl/cc $*.o
../integ/cc/dummy.ch:
make -C ../integ/cc dummy.ch
../integ/cc/%.cpp: ../integ/cc/%.cweb ../integ/cc/dummy.ch
make -C ../integ/cc $*.cpp
../integ/cc/%.h: ../integ/cc/%.hweb ../integ/cc/dummy.ch
make -C ../integ/cc $*.h
../integ/cc/%.o: ../integ/cc/%.cpp $(integhsource) $(tlhsource)
make -C ../integ/cc $*.o
../sylv/cc/%.o: ../sylv/cc/%.cpp $(sylvhsource)
make -C ../sylv/cc $*.o
../kord/dummy.ch:
make -C ../kord dummy.ch
../kord/%.cpp: ../kord/%.cweb ../kord/dummy.ch
make -C ../kord $*.cpp
../kord/%.h: ../kord/%.hweb ../kord/dummy.ch
make -C ../kord $*.h
../kord/%.o: ../kord/%.cpp $(tlhsource) $(kordhsource) $(integhsource)
make -C ../kord $*.o
# for some reason, the pattern rules didn't work here, so the rules
# are expanded:
dynglob_tab.cc: dynglob.y dynare_atoms.h dynare_model.h
bison -d -t --verbose -odynglob_tab.cc dynglob.y
dynglob_tab.hh: dynglob.y dynare_atoms.h dynare_model.h
bison -d -t --verbose -odynglob_tab.cc dynglob.y
dynglob_ll.cc: dynglob.lex dynglob_tab.hh
flex -i -odynglob_ll.cc dynglob.lex
dynglob_ll.o: dynglob_ll.cc $(hsource)
$(CC) -I.. -I../sylv/cc -I../tl/cc -O3 -c dynglob_ll.cc
dynglob_tab.o: dynglob_tab.cc $(hsource)
$(CC) -I.. -I../sylv/cc -I../tl/cc -O3 -c dynglob_tab.cc
%.o: %.cpp $(hsource) $(kordhsource) $(tlhsource) $(sylvhsource) $(parserhsource)
$(CC) $(CC_FLAGS) -DDYNVERSION=\"$(DYNVERSION)\" -o $*.o -c $*.cpp
../parser/cc/parser.a: $(parserhsource) $(parsercppsource)
make -C ../parser/cc parser.a
../utils/cc/utils.a: $(utilshsource) $(utilscppsource)
make -C ../utils/cc utils.a
dynare++: $(tlhwebsource) $(tlcwebsoure) $(tlhsource) $(tlcppsource) \
$(integhwebsource) $(integcwebsoure) $(integhsource) $(integcppsource) \
$(kordhwebsource) $(kordcwebsoure) $(kordhsource) $(kordcppsource) \
$(sylvhsource) $(sylvcppsource) \
$(kordobjects) $(tlobjects) $(integobjects) $(sylvobjects) $(objects) \
../parser/cc/parser.a ../utils/cc/utils.a
$(CC) -g -o dynare++ $(objects) $(kordobjects) $(integobjects) $(tlobjects) ../parser/cc/parser.a ../utils/cc/utils.a $(sylvobjects) $(LDFLAGS)
../extern/matlab/dynare_simul_.$(MEX_SUFFIX):
make -C ../extern/matlab all
srcball:
rm -rf $(tmpdir)
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/tests
cp ../tests/*.mod ../tests/*.dyn $(tmpdir)/dynare++-$(DYNVERSION)/tests
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/src
cp *.h *.cpp *.y *.lex Makefile $(tmpdir)/dynare++-$(DYNVERSION)/src
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/tl/cc
cp ../tl/cc/*web ../tl/cc/Makefile $(tmpdir)/dynare++-$(DYNVERSION)/tl/cc
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/tl/testing
cp ../tl/testing/*.cpp ../tl/testing/*.h ../tl/testing/Makefile $(tmpdir)/dynare++-$(DYNVERSION)/tl/testing
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/integ/cc
cp ../integ/cc/*web ../integ/cc/Makefile ../integ/cc/*.dat $(tmpdir)/dynare++-$(DYNVERSION)/integ/cc
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/integ/testing
cp ../integ/testing/*.cpp ../integ/testing/Makefile $(tmpdir)/dynare++-$(DYNVERSION)/integ/testing
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/sylv/cc
cp ../sylv/cc/*.cpp ../sylv/cc/*.h ../sylv/cc/Makefile $(tmpdir)/dynare++-$(DYNVERSION)/sylv/cc
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/sylv/testing
cp ../sylv/testing/*.cpp ../sylv/testing/*.h ../sylv/testing/Makefile $(tmpdir)/dynare++-$(DYNVERSION)/sylv/testing
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/kord
cp ../kord/*web ../kord/Makefile ../kord/tests.cpp $(tmpdir)/dynare++-$(DYNVERSION)/kord
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/parser/cc
cp ../parser/cc/*.cpp ../parser/cc/*.h ../parser/cc/*.lex ../parser/cc/*.y ../parser/cc/Makefile $(tmpdir)/dynare++-$(DYNVERSION)/parser/cc
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/utils/cc
cp ../utils/cc/*.cpp ../utils/cc/*.h ../utils/cc/Makefile $(tmpdir)/dynare++-$(DYNVERSION)/utils/cc
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/extern/matlab
cp ../extern/matlab/*.cpp ../extern/matlab/*.m ../extern/matlab/Makefile ../extern/matlab/*.bat $(tmpdir)/dynare++-$(DYNVERSION)/extern/matlab
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/doc
cp ../doc/*.tex $(tmpdir)/dynare++-$(DYNVERSION)/doc
cp ../change_log.html $(tmpdir)/dynare++-$(DYNVERSION)/
cd $(tmpdir); tar czf dynare++-$(DYNVERSION).src.tgz dynare++-$(DYNVERSION)/*
mv $(tmpdir)/dynare++-$(DYNVERSION).src.tgz ..
rm -rf $(tmpdir)
binball: dynare++ ../extern/matlab/dynare_simul_.$(MEX_SUFFIX)
rm -rf $(tmpdir)
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/tests
cp ../tests/*.mod ../tests/*.dyn $(tmpdir)/dynare++-$(DYNVERSION)/tests
mkdir -p $(tmpdir)/dynare++-$(DYNVERSION)/doc
cp ../doc/*.pdf $(tmpdir)/dynare++-$(DYNVERSION)/doc
cp dynare++* $(tmpdir)/dynare++-$(DYNVERSION)
cp ../extern/matlab/*.m $(tmpdir)/dynare++-$(DYNVERSION)
cp ../extern/matlab/dynare_simul_.$(MEX_SUFFIX) $(tmpdir)/dynare++-$(DYNVERSION)
cp ../change_log.html $(tmpdir)/dynare++-$(DYNVERSION)
ifeq ($(OS),Windows_NT)
cp $(pthreadGC2) $(tmpdir)/dynare++-$(DYNVERSION)
cp $(mingwm10) $(tmpdir)/dynare++-$(DYNVERSION)
cd $(tmpdir); zip -r dynare++-$(DYNVERSION)-$(ARCH).ix86.zip dynare++-$(DYNVERSION)/*
mv $(tmpdir)/dynare++-$(DYNVERSION)-$(ARCH).ix86.zip ..
else
cd $(tmpdir); tar czf dynare++-$(DYNVERSION)-$(ARCH).ix86.tgz dynare++-$(DYNVERSION)/*
mv $(tmpdir)/dynare++-$(DYNVERSION)-$(ARCH).ix86.tgz ..
endif
rm -rf $(tmpdir)
clear:
rm -f *.o
rm -f dynare++*
rm -f *_ll.cc *_tab.hh *_tab.cc *.output
make -C ../tl/testing clear
make -C ../tl/cc clear
make -C ../integ/testing clear
make -C ../integ/cc clear
make -C ../sylv/testing clear
make -C ../sylv/cc clear
make -C ../kord clear
make -C ../parser/cc clear
make -C ../utils/cc clear

41
mex/sources/korderpert/Dyn_pp/src/dynare_exception.h Normal file
View File

@ -0,0 +1,41 @@
// Copyright (C) 2006, Ondra Kamenik
// $Id: dynare_exception.h 853 2006-08-01 08:42:42Z kamenik $
#ifndef DYNARE_EXCEPTION_H
#define DYNARE_EXCEPTION_H
#include <string>
class DynareException {
char* mes;
public:
DynareException(const char* m, const char* fname, int line, int col)
{
mes = new char[strlen(m) + strlen(fname) + 100];
sprintf(mes, "Parse error at %s, line %d, column %d: %s", fname, line, col, m);
}
DynareException(const char* fname, int line, const std::string& m)
{
mes = new char[m.size() + strlen(fname) + 50];
sprintf(mes, "%s:%d: %s", fname, line, m.c_str());
}
DynareException(const char* m, int offset)
{
mes = new char[strlen(m) + 100];
sprintf(mes, "Parse error in provided string at offset %d: %s", offset, m);
}
DynareException(const DynareException& e)
: mes(new char[strlen(e.mes)+1])
{strcpy(mes, e.mes);}
virtual ~DynareException()
{delete [] mes;}
const char* message() const
{return mes;}
};
#endif
// Local Variables:
// mode:C++
// End:

245
mex/sources/korderpert/Dyn_pp/src/dynare_params.cpp Normal file
View File

@ -0,0 +1,245 @@
// $Id: dynare_params.cpp 1520 2008-01-02 14:46:44Z kamenik $
//Copyright 2004, Ondra Kamenik
#include "dynare_params.h"
#include <getopt.h>
#include <stdio.h>
#include <string.h>
const char* help_str =
"usage: dynare++ [--help] [--version] [options] <model file>\n"
"\n"
" --help print this message and return\n"
" --version print version and return\n"
"\n"
"options:\n"
" --per <num> number of periods simulated [100]\n"
" --sim <num> number of simulations [80]\n"
" --rtper <num> number of RT periods simulated [0]\n"
" --rtsim <num> number of RT simulations [0]\n"
" --condper <num> number of periods in cond. simulations [0]\n"
" --condsim <num> number of conditional simulations [0]\n"
" --steps <num> steps towards stoch. SS [0=deter.]\n"
" --prefix <string> prefix of variables in Mat-4 file [\"dyn\"]\n"
" --seed <num> random number generator seed [934098]\n"
" --order <num> order of approximation [no default]\n"
" --threads <num> number of max parallel threads [2]\n"
" --ss-tol <num> steady state calcs tolerance [1.e-13]\n"
" --check pesPES check model residuals [no checks]\n"
" lower/upper case switches off/on\n"
" pP checking along simulation path\n"
" eE checking on ellipse\n"
" sS checking along shocks\n"
" --check-evals <num> max number of evals per residual [1000]\n"
" --check-num <num> number of checked points [10]\n"
" --check-scale <num> scaling of checked points [2.0]\n"
" --no-irfs shuts down IRF simulations [do IRFs]\n"
" --irfs performs IRF simulations [do IRFs]\n"
"\n\n";
// returns the pointer to the first character after the last slash or
// backslash in the string
const char* dyn_basename(const char* str);
DynareParams::DynareParams(int argc, char** argv)
: modname(NULL), num_per(100), num_sim(80),
num_rtper(0), num_rtsim(0),
num_condper(0), num_condsim(0),
num_threads(2), num_steps(0),
prefix("dyn"), seed(934098), order(-1), ss_tol(1.e-13),
check_along_path(false), check_along_shocks(false),
check_on_ellipse(false), check_evals(1000), check_num(10), check_scale(2.0),
do_irfs_all(true), help(false), version(false)
{
if (argc == 1 || !strcmp(argv[1],"--help")) {
help = true;
return;
}
if (argc == 1 || !strcmp(argv[1],"--version")) {
version = true;
return;
}
modname = argv[argc-1];
argc--;
struct option const opts [] = {
{"periods", required_argument, NULL, opt_per},
{"per", required_argument, NULL, opt_per},
{"simulations", required_argument, NULL, opt_sim},
{"sim", required_argument, NULL, opt_sim},
{"rtperiods", required_argument, NULL, opt_rtper},
{"rtper", required_argument, NULL, opt_rtper},
{"rtsimulations", required_argument, NULL, opt_rtsim},
{"rtsim", required_argument, NULL, opt_rtsim},
{"condperiods", required_argument, NULL, opt_condper},
{"condper", required_argument, NULL, opt_condper},
{"condsimulations", required_argument, NULL, opt_condsim},
{"condsim", required_argument, NULL, opt_condsim},
{"prefix", required_argument, NULL, opt_prefix},
{"threads", required_argument, NULL, opt_threads},
{"steps", required_argument, NULL, opt_steps},
{"seed", required_argument, NULL, opt_seed},
{"order", required_argument, NULL, opt_order},
{"ss-tol", required_argument, NULL, opt_ss_tol},
{"check", required_argument, NULL, opt_check},
{"check-scale", required_argument, NULL, opt_check_scale},
{"check-evals", required_argument, NULL, opt_check_evals},
{"check-num", required_argument, NULL, opt_check_num},
{"no-irfs", no_argument, NULL, opt_noirfs},
{"irfs", no_argument, NULL, opt_irfs},
{"help", no_argument, NULL, opt_help},
{"version", no_argument, NULL, opt_version},
{NULL, 0, NULL, 0}
};
int ret;
int index;
while (-1 != (ret = getopt_long(argc, argv, "", opts, &index))) {
switch (ret) {
case opt_per:
if (1 != sscanf(optarg, "%d", &num_per))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_sim:
if (1 != sscanf(optarg, "%d", &num_sim))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_rtper:
if (1 != sscanf(optarg, "%d", &num_rtper))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_rtsim:
if (1 != sscanf(optarg, "%d", &num_rtsim))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_condper:
if (1 != sscanf(optarg, "%d", &num_condper))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_condsim:
if (1 != sscanf(optarg, "%d", &num_condsim))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_prefix:
prefix = optarg;
break;
case opt_threads:
if (1 != sscanf(optarg, "%d", &num_threads))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_steps:
if (1 != sscanf(optarg, "%d", &num_steps))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_seed:
if (1 != sscanf(optarg, "%d", &seed))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_order:
if (1 != sscanf(optarg, "%d", &order))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_ss_tol:
if (1 != sscanf(optarg, "%lf", &ss_tol))
fprintf(stderr, "Couldn't parse float %s, ignored\n", optarg);
break;
case opt_check:
processCheckFlags(optarg);
break;
case opt_check_scale:
if (1 != sscanf(optarg, "%lf", &check_scale))
fprintf(stderr, "Couldn't parse float %s, ignored\n", optarg);
break;
case opt_check_evals:
if (1 != sscanf(optarg, "%d", &check_evals))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_check_num:
if (1 != sscanf(optarg, "%d", &check_num))
fprintf(stderr, "Couldn't parse integer %s, ignored\n", optarg);
break;
case opt_noirfs:
irf_list.clear();
do_irfs_all = false;
break;
case opt_irfs:
processIRFList(argc, argv);
if (irf_list.empty())
do_irfs_all = true;
else
do_irfs_all = false;
break;
case opt_help:
help = true;
break;
case opt_version:
version = true;
break;
case '?':
fprintf(stderr, "Unknown option, ignored\n");
break;
}
}
// make basename (get rid of the extension)
basename = dyn_basename(modname);
std::string::size_type i = basename.rfind('.');
if (i != std::string::npos)
basename.erase(i);
}
void DynareParams::printHelp() const
{
printf("%s", help_str);
}
void DynareParams::processCheckFlags(const char* flags)
{
for (unsigned int i = 0; i < strlen(flags); i++) {
switch (flags[i]) {
case 'p':
check_along_path = false;
break;
case 'P':
check_along_path = true;
break;
case 'e':
check_on_ellipse = false;
break;
case 'E':
check_on_ellipse = true;
break;
case 's':
check_along_shocks = false;
break;
case 'S':
check_along_shocks = true;
break;
default:
fprintf(stderr, "Unknown check type selection character <%c>, ignored.\n", flags[i]);
}
}
}
void DynareParams::processIRFList(int argc, char** argv)
{
irf_list.clear();
while (optind < argc && *(argv[optind]) != '-') {
irf_list.push_back(argv[optind]);
optind++;
}
}
const char* dyn_basename(const char* str)
{
int i = strlen(str);
while (i > 0 && str[i-1] != '/' && str[i-1] != '\\')
i--;
return str+i;
}
// Local Variables:
// mode:C++
// End:

71
mex/sources/korderpert/Dyn_pp/src/dynare_params.h Normal file
View File

@ -0,0 +1,71 @@
// $Id: dynare_params.h 1520 2008-01-02 14:46:44Z kamenik $
// Copyright 2004, Ondra Kamenik
/*
along shocks: m mult max_evals
ellipse: m mult max_evals (10*m) (0.5*mult)
simul: m max_evals (10*m)
--check-scale 2.0 --check-evals 1000 --check-num 10 --check PES
*/
#include <vector>
#include <string>
struct DynareParams {
const char* modname;
std::string basename;
int num_per;
int num_sim;
int num_rtper;
int num_rtsim;
int num_condper;
int num_condsim;
int num_threads;
int num_steps;
const char* prefix;
int seed;
int order;
/** Tolerance used for steady state calcs. */
double ss_tol;
bool check_along_path;
bool check_along_shocks;
bool check_on_ellipse;
int check_evals;
int check_num;
double check_scale;
/** Flag for doing IRFs even if the irf_list is empty. */
bool do_irfs_all;
/** List of shocks for which IRF will be calculated. */
std::vector<const char*> irf_list;
bool help;
bool version;
DynareParams(int argc, char** argv);
void printHelp() const;
int getCheckShockPoints() const
{return check_num;}
double getCheckShockScale() const
{return check_scale;}
int getCheckEllipsePoints() const
{return 10*check_num;}
double getCheckEllipseScale() const
{return 0.5*check_scale;}
int getCheckPathPoints() const
{return 10*check_num;}
private:
enum {opt_per, opt_sim, opt_rtper, opt_rtsim, opt_condper, opt_condsim, opt_prefix, opt_threads,
opt_steps, opt_seed, opt_order, opt_ss_tol, opt_check,
opt_check_along_path, opt_check_along_shocks, opt_check_on_ellipse,
opt_check_evals, opt_check_scale, opt_check_num, opt_noirfs, opt_irfs,
opt_help, opt_version};
void processCheckFlags(const char* flags);
/** This gathers strings from argv[optind] and on not starting
* with '-' to the irf_list. It stops one item before the end,
* since this is the model file. */
void processIRFList(int argc, char** argv);
};
// Local Variables:
// mode:C++
// End:

122
mex/sources/korderpert/Dyn_pp/src/forw_subst_builder.cpp Normal file
View File

@ -0,0 +1,122 @@
// Copyright (C) 2006, Ondra Kamenik
// $Id$
#include "forw_subst_builder.h"
using namespace ogdyn;
ForwSubstBuilder::ForwSubstBuilder(DynareModel& m)
: model(m)
{
info.num_new_terms -= model.getParser().getTree().get_num_op();
// go through all equations
int neq = model.eqs.nformulas();
for (int i = 0; i < neq; i++) {
int ft = model.eqs.formula(i);
int mlead, mlag;
model.termspan(ft, mlead, mlag);
// if equation is too forward looking
if (mlead > 1) {
info.num_affected_equations++;
// break it to non-linear terms
hash_set<int> nlt = model.get_nonlinear_subterms(ft);
int j = 0; // indexes subterms
// and make substitutions for all these non-linear subterms
for (hash_set<int>::const_iterator it = nlt.begin();
it != nlt.end(); ++it, ++j)
substitute_for_term(*it, i, j);
}
}
// unassign all variables with lead greater than 1
unassign_gt_1_leads();
// forget the derivatives in the tree because some variables could
// have been unassigned
model.eqs.getTree().forget_derivative_maps();
info.num_new_terms += model.getParser().getTree().get_num_op();
}
void ForwSubstBuilder::substitute_for_term(int t, int i, int j)
{
int mlead, mlag;
model.termspan(t, mlead, mlag);
if (mlead > 1) {
info.num_subst_terms++;
// Example for comments: let t = f(x(+4))
// first make lagsubst be substitution setting f(x(+4)) to f(x(+1))
// this is lag = -3 (1-mlead)
map<int,int> lagsubst;
model.variable_shift_map(model.eqs.nulary_of_term(t), 1-mlead, lagsubst);
int lagt = model.eqs.add_substitution(t, lagsubst);
// now maxlead of lagt is +1
// add AUXLD_*_*_1 = f(x(+1)) to the model
char name[100];
sprintf(name, "AUXLD_%d_%d_%d", i, j, 1);
model.atoms.register_uniq_endo(name);
info.num_aux_variables++;
const char* ss = model.atoms.get_name_storage().query(name);
int auxt = model.eqs.add_nulary(name);
model.eqs.add_formula(model.eqs.add_binary(ogp::MINUS, auxt, lagt));
aux_map.insert(Tsubstmap::value_type(ss, lagt));
// now add variables and equations
// AUXLD_*_*_2 = AUXLD_*_*_1(+1) through
// AUXLD_*_*_{mlead-1} = AUXLD_*_*_{mlead-2}(+1)
for (int ll = 1; ll <= mlead-2; ll++) {
// create AUXLD_*_*_{ll}(+1)
sprintf(name, "AUXLD_%d_%d_%d(+1)", i, j, ll);
int lastauxt_lead = model.eqs.add_nulary(name);
// create AUXLD_*_*{ll+1}
sprintf(name, "AUXLD_%d_%d_%d", i, j, ll+1);
model.atoms.register_uniq_endo(name);
info.num_aux_variables++;
ss = model.atoms.get_name_storage().query(name);
auxt = model.eqs.add_nulary(name);
// add AUXLD_*_*_{ll+1} = AUXLD_*_*_{ll}(+1)
model.eqs.add_formula(model.eqs.add_binary(ogp::MINUS, auxt, lastauxt_lead));
// add substitution to the map; todo: this
// works well because in the context where
// aux_map is used the timing doesn't matter,
// however, it is misleading, needs to be
// changed
aux_map.insert(Tsubstmap::value_type(ss, lagt));
}
// now we have to substitute AUXLEAD_*_*{mlead-1}(+1) for t
model.substitute_atom_for_term(ss, +1, t);
}
}
void ForwSubstBuilder::unassign_gt_1_leads(const char* name)
{
const char* ss = model.atoms.get_name_storage().query(name);
int mlead, mlag;
model.atoms.varspan(name, mlead, mlag);
for (int ll = 2; ll <= mlead; ll++) {
int t = model.atoms.index(ss, ll);
if (t != -1)
model.atoms.unassign_variable(ss, ll, t);
}
}
void ForwSubstBuilder::unassign_gt_1_leads()
{
const vector<const char*>& endovars = model.atoms.get_endovars();
for (unsigned int i = 0; i < endovars.size(); i++)
unassign_gt_1_leads(endovars[i]);
const vector<const char*>& exovars = model.atoms.get_exovars();
for (unsigned int i = 0; i < exovars.size(); i++)
unassign_gt_1_leads(exovars[i]);
}
ForwSubstBuilder::ForwSubstBuilder(const ForwSubstBuilder& b, DynareModel& m)
: model(m)
{
for (Tsubstmap::const_iterator it = b.aux_map.begin();
it != b.aux_map.end(); ++it) {
const char* ss = m.atoms.get_name_storage().query((*it).first);
aux_map.insert(Tsubstmap::value_type(ss, (*it).second));
}
}

83
mex/sources/korderpert/Dyn_pp/src/forw_subst_builder.h Normal file
View File

@ -0,0 +1,83 @@
// Copyright (C) 2006, Ondra Kamenik
// $Id$
#ifndef FORW_SUBST_BUILDER_H
#define FORW_SUBST_BUILDER_H
#include "dynare_model.h"
namespace ogdyn {
/** This struct encapsulates information about the process of
* forward substitutions. */
struct ForwSubstInfo {
int num_affected_equations;
int num_subst_terms;
int num_aux_variables;
int num_new_terms;
ForwSubstInfo()
: num_affected_equations(0),
num_subst_terms(0),
num_aux_variables(0),
num_new_terms(0) {}
};
class ForwSubstBuilder {
typedef map<int, const char*> Ttermauxmap;
protected:
/** Reference to the model, to which we will add equations and
* change some equations. */
DynareModel& model;
/** A map mapping new auxiliary variables to the terms in the
* tree in the DynareModel. */
Tsubstmap aux_map;
/** Information about the substitutions. */
ForwSubstInfo info;
public:
/** Do all the jobs needed. This scans all equations in the
* model, and for equations containing forward looking
* variables greater than 1 lead, it makes corresponding
* substitutions. Basically, it breaks each equation to its
* non-linear components and creates substitutions for these
* components, not for whole equation. This is because the
* expectation operator can go through the linear part of the
* function. This will save us many occurrences of other
* variables involved in the equation. */
ForwSubstBuilder(DynareModel& m);
/** Copy constructor with a new instance of the model. */
ForwSubstBuilder(const ForwSubstBuilder& b, DynareModel& m);
/** Return the auxiliary variable mapping. */
const Tsubstmap& get_aux_map() const
{return aux_map;}
/** Return the information. */
const ForwSubstInfo& get_info() const
{return info;}
private:
ForwSubstBuilder(const ForwSubstBuilder& b);
/** This method takes a nonlinear term t, and if it has leads
* of greater than 1, then it substitutes the term for the new
* variable (or string of variables). Note that the
* substitution is done by DynamicAtoms::assign_variable. This
* means that the substitution is made for all other
* ocurrences of t in the model. So there is no need of
* tracking already substituted terms. The other two
* parameters are just for identification of the new auxiliary
* variables. When called from the constructor, i is an
* equation number, j is an order of the non-linear term in
* the equation. */
void substitute_for_term(int t, int i, int j);
/** This is called just at the end of the job. It unassigns
* all nulary terms with a lead greater than 1. */
void unassign_gt_1_leads();
/** This unassigns all leads greater than 1 of the given name. */
void unassign_gt_1_leads(const char* name);
};
};
#endif
// Local Variables:
// mode:C++
// End:

230
mex/sources/korderpert/Dyn_pp/src/nlsolve.cpp Normal file
View File

@ -0,0 +1,230 @@
// Copyright (C) 2006, Ondra Kamenik
// $Id: nlsolve.cpp 762 2006-05-22 13:00:07Z kamenik $
#include "nlsolve.h"
#include "dynare_exception.h"
#include <cmath>
using namespace ogu;
/** This should not be greater than DBL_EPSILON^(1/2). */
double GoldenSectionSearch::tol = 1.e-4;
/** This is equal to the golden section ratio. */
double GoldenSectionSearch::golden = (3.-std::sqrt(5.))/2;
double GoldenSectionSearch::search(OneDFunction& f, double x1, double x2)
{
double b;
if (init_bracket(f, x1, x2, b)) {
double fb = f.eval(b);
double f1 = f.eval(x1);
double f2 = f.eval(x2);
double dx;
do {
double w = (b-x1)/(x2-x1);
dx = std::abs((1-2*w)*(x2-x1));
double x;
if (b-x1 > x2-b)
x = b - dx;
else
x = b + dx;
double fx = f.eval(x);
if (! std::isfinite(fx))
return x1;
if (b-x1 > x2-b) {
// x is on the left from b
if (f1 > fx && fx < fb) {
// pickup bracket [f1,fx,fb]
f2 = fb;
x2 = b;
fb = fx;
b = x;
} else {
// pickup bracket [fx,fb,fx2]
f1 = fx;
x1 = x;
}
} else {
// x is on the right from b
if (f1 > fb && fb < fx) {
// pickup bracket [f1,fb,fx]
f2 = fx;
x2 = x;
} else {
// pickup bracket [fb,fx,f2]
f1 = fb;
x1 = b;
fb = fx;
b = x;
}
}
} while(dx > tol);
}
return b;
}
bool GoldenSectionSearch::init_bracket(OneDFunction& f, double x1, double& x2, double& b)
{
double f1 = f.eval(x1);
if (! std::isfinite(f1))
throw DynareException(__FILE__, __LINE__,
"Safer point not finite in GoldenSectionSearch::init_bracket");
int cnt = 0;
bool bracket_found = false;
do {
bool finite_found = search_for_finite(f, x1, x2, b);
if (! finite_found) {
b = x1;
return false;
}
double f2 = f.eval(x2);
double fb = f.eval(b);
double bsym = 2*x2 - b;
double fbsym = f.eval(bsym);
// now we know that f1, f2, and fb are finite
if (std::isfinite(fbsym)) {
// we have four numbers f1, fb, f2, fbsym, we test for the
// following combinations to find the bracket:
// [f1,f2,fbsym], [f1,fb,fbsym] and [f1,fb,fbsym]
if (f1 > f2 && f2 < fbsym) {
bracket_found = true;
b = x2;
x2 = bsym;
} else if (f1 > fb && fb < fbsym) {
bracket_found = true;
x2 = bsym;
} else if (f1 > fb && fb < f2) {
bracket_found = true;
} else {
double newx2 = b;
// choose the smallest value in case we end
if (f1 > fbsym) {
// the smallest value is on the other end, we do
// not want to continue
b = bsym;
return false;
} else
b = x1;
// move x2 to b in case we continue
x2 = newx2;
}
} else {
// we have only three numbers, we test for the bracket,
// and if not found, we set b as potential result and
// shorten x2 as potential init value for next cycle
if (f1 > fb && fb < f2)
bracket_found = true;
else {
double newx2 = b;
// choose the smaller value in case we end
if (f1 > f2)
b = x2;
else
b = x1;
// move x2 to b in case we continue
x2 = newx2;
}
}
cnt++;
} while (! bracket_found && cnt < 5);
return bracket_found;
}
/** This moves x2 toward to x1 until the function at x2 is finite and
* b as a golden section between x1 and x2 yields also finite f. */
bool GoldenSectionSearch::search_for_finite(OneDFunction& f, double x1, double& x2, double&b)
{
int cnt = 0;
bool found = false;
do {
double f2 = f.eval(x2);
b = (1-golden)*x1 + golden*x2;
double fb = f.eval(b);
found = std::isfinite(f2) && std::isfinite(fb);
if (! found)
x2 = b;
cnt++;
} while (! found && cnt < 5);
return found;
}
void VectorFunction::check_for_eval(const ConstVector& in, Vector& out) const
{
if (inDim() != in.length() || outDim() != out.length())
throw DynareException(__FILE__, __LINE__,
"Wrong dimensions in VectorFunction::check_for_eval");
}
double NLSolver::eval(double lambda)
{
Vector xx((const Vector&)x);
xx.add(1-lambda, xcauchy);
xx.add(lambda, xnewton);
Vector ff(func.outDim());
func.eval(xx, ff);
return ff.dot(ff);
}
bool NLSolver::solve(Vector& xx, int& iter)
{
JournalRecord rec(journal);
rec << "Iter lambda residual" << endrec;
JournalRecord rec1(journal);
rec1 << "---------------------------" << endrec;
char tmpbuf[14];
x = (const Vector&)xx;
iter = 0;
// setup fx
Vector fx(func.outDim());
func.eval(x, fx);
if (!fx.isFinite())
throw DynareException(__FILE__,__LINE__,
"Initial guess does not yield finite residual in NLSolver::solve");
bool converged = fx.getMax() < tol;
JournalRecord rec2(journal);
sprintf(tmpbuf, "%10.6g", fx.getMax());
rec2 << iter << " N/A " << tmpbuf << endrec;
while (! converged && iter < max_iter) {
// setup Jacobian
jacob.eval(x);
// calculate cauchy step
Vector g(func.inDim());
g.zeros();
ConstTwoDMatrix(jacob).multaVecTrans(g, fx);
Vector Jg(func.inDim());
Jg.zeros();
ConstTwoDMatrix(jacob).multaVec(Jg, g);
double m = -g.dot(g)/Jg.dot(Jg);
xcauchy = (const Vector&) g;
xcauchy.mult(m);
// calculate newton step
xnewton = (const Vector&) fx;
ConstTwoDMatrix(jacob).multInvLeft(xnewton);
xnewton.mult(-1);
// line search
double lambda = GoldenSectionSearch::search(*this, 0, 1);
x.add(1-lambda, xcauchy);
x.add(lambda, xnewton);
// evaluate func
func.eval(x, fx);
converged = fx.getMax() < tol;
// iter
iter++;
JournalRecord rec3(journal);
sprintf(tmpbuf, "%10.6g", fx.getMax());
rec3 << iter << " " << lambda << " " << tmpbuf << endrec;
}
xx = (const Vector&)x;
return converged;
}

94
mex/sources/korderpert/Dyn_pp/src/nlsolve.h Normal file
View File

@ -0,0 +1,94 @@
// Copyright (C) 2006, Ondra Kamenik
// $Id: nlsolve.h 762 2006-05-22 13:00:07Z kamenik $
#ifndef OGU_NLSOLVE_H
#define OGU_NLSOLVE_H
#include "twod_matrix.h"
#include "journal.h"
namespace ogu {
class OneDFunction {
public:
virtual ~OneDFunction() {}
virtual double eval(double) = 0;
};
class GoldenSectionSearch {
protected:
static double tol;
static double golden;
public:
static double search(OneDFunction& f, double x1, double x2);
protected:
/** This initializes a bracket by moving x2 and b (as a golden
* section of x1,x2) so that f(x1)>f(b) && f(b)<f(x2). The point
* x1 is not moved, since it is considered as reliable and f(x1)
* is supposed to be finite. If initialization of a bracket
* succeeded, then [x1, b, x2] is the bracket and true is
* returned. Otherwise, b is the minimum found and false is
* returned. */
static bool init_bracket(OneDFunction& f, double x1, double& x2, double& b);
/** This supposes that f(x1) is finite and it moves x2 toward x1
* until x2 and b (as a golden section of x1,x2) are finite. If
* succeeded, the routine returns true and x2, and b. Otherwise,
* it returns false. */
static bool search_for_finite(OneDFunction& f, double x1, double& x2, double& b);
};
class VectorFunction {
public:
VectorFunction() {}
virtual ~VectorFunction() {}
virtual int inDim() const = 0;
virtual int outDim() const = 0;
/** Check dimensions of eval parameters. */
void check_for_eval(const ConstVector& in, Vector& out) const;
/** Evaluate the vector function. */
virtual void eval(const ConstVector& in, Vector& out) = 0;
};
class Jacobian : public TwoDMatrix {
public:
Jacobian(int n)
: TwoDMatrix(n,n) {}
virtual ~Jacobian() {}
virtual void eval(const Vector& in) = 0;
};
class NLSolver : public OneDFunction {
protected:
Journal& journal;
VectorFunction& func;
Jacobian& jacob;
const int max_iter;
const double tol;
private:
Vector xnewton;
Vector xcauchy;
Vector x;
public:
NLSolver(VectorFunction& f, Jacobian& j, int maxit, double tl, Journal& jr)
: journal(jr), func(f), jacob(j), max_iter(maxit), tol(tl),
xnewton(f.inDim()), xcauchy(f.inDim()), x(f.inDim())
{xnewton.zeros(); xcauchy.zeros(); x.zeros();}
virtual ~NLSolver() {}
/** Returns true if the problem has converged. xx as input is the
* starting value, as output it is a solution. */
bool solve(Vector& xx, int& iter);
/** To implement OneDFunction interface. It returns
* func(xx)^T*func(xx), where
* xx=x+lambda*xcauchy+(1-lambda)*xnewton. It is non-const only
* because it calls func, x, xnewton, xcauchy is not changed. */
double eval(double lambda);
};
};
#endif
// Local Variables:
// mode:C++
// End:

321
mex/sources/korderpert/Dyn_pp/sylv/cc/BlockDiagonal.cpp Normal file
View File

@ -0,0 +1,321 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/BlockDiagonal.cpp,v 1.1.1.1 2004/06/04 13:00:20 kamenik Exp $ */
/* Tag $Name: $ */
#include "BlockDiagonal.h"
#include <stdio.h>
#include <string.h>
BlockDiagonal::BlockDiagonal(const double* d, int d_size)
: QuasiTriangular(d, d_size),
row_len(new int[d_size]), col_len(new int[d_size])
{
for (int i = 0; i < d_size; i++) {
row_len[i] = d_size;
col_len[i] = 0;
}
}
BlockDiagonal::BlockDiagonal(const QuasiTriangular& t)
: QuasiTriangular(t),
row_len(new int[t.numRows()]), col_len(new int[t.numRows()])
{
for (int i = 0; i < t.numRows(); i++) {
row_len[i] = t.numRows();
col_len[i] = 0;
}
}
BlockDiagonal::BlockDiagonal(int p, const BlockDiagonal& b)
: QuasiTriangular(p, b),
row_len(new int[b.numRows()]), col_len(new int[b.numRows()])
{
memcpy(row_len, b.row_len, b.numRows()*sizeof(int));
memcpy(col_len, b.col_len, b.numRows()*sizeof(int));
}
BlockDiagonal::BlockDiagonal(const BlockDiagonal& b)
: QuasiTriangular(b),
row_len(new int[b.numRows()]), col_len(new int[b.numRows()])
{
memcpy(row_len, b.row_len, b.numRows()*sizeof(int));
memcpy(col_len, b.col_len, b.numRows()*sizeof(int));
}
/* put zeroes to right upper submatrix whose first column is defined
* by 'edge' */
void BlockDiagonal::setZerosToRU(diag_iter edge)
{
int iedge = (*edge).getIndex();
for (int i = 0; i < iedge; i++)
for (int j = iedge; j < numCols(); j++)
get(i,j) = 0.0;
}
/* Updates row_len and col_len so that there are zeroes in upper right part, this
* |T1 0 |
* |0 T2|. The first column of T2 is given by diagonal iterator 'edge'.
* Note the semantics of row_len and col_len. row_len[i] is distance
* of the right-most non-zero element of i-th row from the left, and
* col_len[j] is distance of top-most non-zero element of j-th column
* to the top. (First element has distance 1).
*/
void BlockDiagonal::setZeroBlockEdge(diag_iter edge)
{
setZerosToRU(edge);
int iedge = (*edge).getIndex();
for (diag_iter run = diag_begin(); run != edge; ++run) {
int ind = (*run).getIndex();
if (row_len[ind] > iedge) {
row_len[ind] = iedge;
if (!(*run).isReal())
row_len[ind+1] = iedge;
}
}
for (diag_iter run = edge; run != diag_end(); ++run) {
int ind = (*run).getIndex();
if (col_len[ind] < iedge) {
col_len[ind] = iedge;
if (!(*run).isReal())
col_len[ind+1] = iedge;
}
}
}
BlockDiagonal::const_col_iter
BlockDiagonal::col_begin(const DiagonalBlock& b) const
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return const_col_iter(&getData()[jbar*d_size + col_len[jbar]], d_size,
b.isReal(), col_len[jbar]);
}
BlockDiagonal::col_iter
BlockDiagonal::col_begin(const DiagonalBlock& b)
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return col_iter(&getData()[jbar*d_size + col_len[jbar]], d_size,
b.isReal(), col_len[jbar]);
}
BlockDiagonal::const_row_iter
BlockDiagonal::row_end(const DiagonalBlock& b) const
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return const_row_iter(&getData()[d_size*row_len[jbar]+jbar], d_size,
b.isReal(), row_len[jbar]);
}
BlockDiagonal::row_iter
BlockDiagonal::row_end(const DiagonalBlock& b)
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return row_iter(&getData()[d_size*row_len[jbar]+jbar], d_size,
b.isReal(), row_len[jbar]);
}
int BlockDiagonal::getNumZeros() const
{
int sum = 0;
for (int i = 0; i < diagonal.getSize(); i++) {
sum += diagonal.getSize() - row_len[i];
}
return sum;
}
QuasiTriangular::const_diag_iter
BlockDiagonal::findBlockStart(const_diag_iter from) const
{
if (from != diag_end()) {
++from;
while (from != diag_end() &&
col_len[(*from).getIndex()] != (*from).getIndex())
++from;
}
return from;
}
int BlockDiagonal::getLargestBlock() const
{
int largest = 0;
const_diag_iter start = diag_begin();
const_diag_iter end = findBlockStart(start);
while (start != diag_end()) {
int si = (*start).getIndex();
int ei = diagonal.getSize();
if (end != diag_end())
ei = (*end).getIndex();
if (largest < ei-si)
largest = ei-si;
start = end;
end = findBlockStart(start);
}
return largest;
}
void BlockDiagonal::savePartOfX(int si, int ei, const KronVector& x, Vector& work)
{
for (int i = si; i < ei; i++) {
ConstKronVector xi(x, i);
Vector target(work, (i-si)*xi.length(), xi.length());
target = xi;
}
}
void BlockDiagonal::multKronBlock(const_diag_iter start, const_diag_iter end,
KronVector& x, Vector& work) const
{
int si = (*start).getIndex();
int ei = diagonal.getSize();
if (end != diag_end())
ei = (*end).getIndex();
savePartOfX(si, ei, x, work);
for (const_diag_iter di = start; di != end; ++di) {
int jbar = (*di).getIndex();
if ((*di).isReal()) {
KronVector xi(x, jbar);
xi.zeros();
Vector wi(work, (jbar-si)*xi.length(), xi.length());
xi.add(*((*di).getAlpha()), wi);
for (const_row_iter ri = row_begin(*di); ri != row_end(*di); ++ri) {
int col = ri.getCol();
Vector wj(work, (col-si)*xi.length(), xi.length());
xi.add(*ri, wj);
}
} else {
KronVector xi(x, jbar);
KronVector xii(x, jbar+1);
xi.zeros();
xii.zeros();
Vector wi(work, (jbar-si)*xi.length(), xi.length());
Vector wii(work, (jbar+1-si)*xi.length(), xi.length());
xi.add(*((*di).getAlpha()), wi);
xi.add((*di).getBeta1(), wii);
xii.add((*di).getBeta2(), wi);
xii.add(*((*di).getAlpha()), wii);
for (const_row_iter ri = row_begin(*di); ri != row_end(*di); ++ri) {
int col = ri.getCol();
Vector wj(work, (col-si)*xi.length(), xi.length());
xi.add(ri.a(), wj);
xii.add(ri.b(), wj);
}
}
}
}
void BlockDiagonal::multKronBlockTrans(const_diag_iter start, const_diag_iter end,
KronVector& x, Vector& work) const
{
int si = (*start).getIndex();
int ei = diagonal.getSize();
if (end != diag_end())
ei = (*end).getIndex();
savePartOfX(si, ei, x, work);
for (const_diag_iter di = start; di != end; ++di) {
int jbar = (*di).getIndex();
if ((*di).isReal()) {
KronVector xi(x, jbar);
xi.zeros();
Vector wi(work, (jbar-si)*xi.length(), xi.length());
xi.add(*((*di).getAlpha()), wi);
for (const_col_iter ci = col_begin(*di); ci != col_end(*di); ++ci) {
int row = ci.getRow();
Vector wj(work, (row-si)*xi.length(), xi.length());
xi.add(*ci, wj);
}
} else {
KronVector xi(x, jbar);
KronVector xii(x, jbar+1);
xi.zeros();
xii.zeros();
Vector wi(work, (jbar-si)*xi.length(), xi.length());
Vector wii(work, (jbar+1-si)*xi.length(), xi.length());
xi.add(*((*di).getAlpha()), wi);
xi.add((*di).getBeta2(), wii);
xii.add((*di).getBeta1(), wi);
xii.add(*((*di).getAlpha()), wii);
for (const_col_iter ci = col_begin(*di); ci != col_end(*di); ++ci) {
int row = ci.getRow();
Vector wj(work, (row-si)*xi.length(), xi.length());
xi.add(ci.a(), wj);
xii.add(ci.b(), wj);
}
}
}
}
void BlockDiagonal::multKron(KronVector& x) const
{
int largest = getLargestBlock();
Vector work(largest*x.getN()*power(x.getM(),x.getDepth()-1));
const_diag_iter start = diag_begin();
const_diag_iter end = findBlockStart(start);
while (start != diag_end()) {
multKronBlock(start, end, x, work);
start = end;
end = findBlockStart(start);
}
}
void BlockDiagonal::multKronTrans(KronVector& x) const
{
int largest = getLargestBlock();
Vector work(largest*x.getN()*power(x.getM(),x.getDepth()-1));
const_diag_iter start = diag_begin();
const_diag_iter end = findBlockStart(start);
while (start != diag_end()) {
multKronBlockTrans(start, end, x, work);
start = end;
end = findBlockStart(start);
}
}
void BlockDiagonal::printInfo() const
{
printf("Block sizes:");
int num_blocks = 0;
const_diag_iter start = diag_begin();
const_diag_iter end = findBlockStart(start);
while (start != diag_end()) {
int si = (*start).getIndex();
int ei = diagonal.getSize();
if (end != diag_end())
ei = (*end).getIndex();
printf(" %d", ei-si);
num_blocks++;
start = end;
end = findBlockStart(start);
}
printf("\nNum blocks: %d\n", num_blocks);
printf("There are %d zeros out of %d\n",
getNumZeros(), getNumOffdiagonal());
}
int BlockDiagonal::getNumBlocks() const
{
int num_blocks = 0;
const_diag_iter start = diag_begin();
const_diag_iter end = findBlockStart(start);
while (start != diag_end()) {
num_blocks++;
start = end;
end = findBlockStart(start);
}
return num_blocks;
}
// Local Variables:
// mode:C++
// End:

53
mex/sources/korderpert/Dyn_pp/sylv/cc/BlockDiagonal.h Normal file
View File

@ -0,0 +1,53 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/BlockDiagonal.h,v 1.1.1.1 2004/06/04 13:00:20 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef BLOCK_DIAGONAL_H
#define BLOCK_DIAGONAL_H
#include "QuasiTriangular.h"
class BlockDiagonal : public QuasiTriangular {
int* const row_len;
int* const col_len;
public:
BlockDiagonal(const double* d, int d_size);
BlockDiagonal(int p, const BlockDiagonal& b);
BlockDiagonal(const BlockDiagonal& b);
BlockDiagonal(const QuasiTriangular& t);
const BlockDiagonal& operator=(const QuasiTriangular& t)
{GeneralMatrix::operator=(t); return *this;}
const BlockDiagonal& operator=(const BlockDiagonal& b);
~BlockDiagonal() {delete [] row_len; delete [] col_len;}
void setZeroBlockEdge(diag_iter edge);
int getNumZeros() const;
int getNumBlocks() const;
int getLargestBlock() const;
void printInfo() const;
void multKron(KronVector& x) const;
void multKronTrans(KronVector& x) const;
const_col_iter col_begin(const DiagonalBlock& b) const;
col_iter col_begin(const DiagonalBlock& b);
const_row_iter row_end(const DiagonalBlock& b) const;
row_iter row_end(const DiagonalBlock& b);
QuasiTriangular* clone() const
{return new BlockDiagonal(*this);}
private:
void setZerosToRU(diag_iter edge);
const_diag_iter findBlockStart(const_diag_iter from) const;
static void savePartOfX(int si, int ei, const KronVector& x, Vector& work);
void multKronBlock(const_diag_iter start, const_diag_iter end,
KronVector& x, Vector& work) const;
void multKronBlockTrans(const_diag_iter start, const_diag_iter end,
KronVector& x, Vector& work) const;
};
#endif /* BLOCK_DIAGONAL_H */
// Local Variables:
// mode:C++
// End:

482
mex/sources/korderpert/Dyn_pp/sylv/cc/GeneralMatrix.cpp Normal file
View File

@ -0,0 +1,482 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/GeneralMatrix.cpp,v 1.4 2004/11/24 20:41:59 kamenik Exp $ */
/* Tag $Name: $ */
#include "SylvException.h"
#include "GeneralMatrix.h"
#include "cppblas.h"
#include "cpplapack.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <cmath>
#include <limits>
int GeneralMatrix::md_length = 32;
GeneralMatrix::GeneralMatrix(const GeneralMatrix& m)
: data(m.rows*m.cols), rows(m.rows), cols(m.cols), ld(m.rows)
{
copy(m);
}
GeneralMatrix::GeneralMatrix(const ConstGeneralMatrix& m)
: data(m.rows*m.cols), rows(m.rows), cols(m.cols), ld(m.rows)
{
copy(m);
}
GeneralMatrix::GeneralMatrix(const GeneralMatrix& m, const char* dummy)
: data(m.rows*m.cols), rows(m.cols), cols(m.rows), ld(m.cols)
{
for (int i = 0; i < m.rows; i++)
for (int j = 0; j < m.cols; j++)
get(j,i) = m.get(i,j);
}
GeneralMatrix::GeneralMatrix(const ConstGeneralMatrix& m, const char* dummy)
: data(m.rows*m.cols), rows(m.cols), cols(m.rows), ld(m.cols)
{
for (int i = 0; i < m.rows; i++)
for (int j = 0; j < m.cols; j++)
get(j,i) = m.get(i,j);
}
GeneralMatrix::GeneralMatrix(const GeneralMatrix& m, int i, int j, int nrows, int ncols)
: data(nrows*ncols), rows(nrows), cols(ncols), ld(nrows)
{
copy(m, i, j);
}
GeneralMatrix::GeneralMatrix(GeneralMatrix& m, int i, int j, int nrows, int ncols)
: data(m.base()+m.ld*j+i, m.ld*(ncols-1)+nrows), rows(nrows), cols(ncols), ld(m.ld)
{}
GeneralMatrix::GeneralMatrix(const GeneralMatrix& a, const GeneralMatrix& b)
: data(a.rows*b.cols), rows(a.rows), cols(b.cols), ld(a.rows)
{
gemm("N", a, "N", b, 1.0, 0.0);
}
GeneralMatrix::GeneralMatrix(const GeneralMatrix& a, const GeneralMatrix& b, const char* dum)
: data(a.rows*b.rows), rows(a.rows), cols(b.rows), ld(a.rows)
{
gemm("N", a, "T", b, 1.0, 0.0);
}
GeneralMatrix::GeneralMatrix(const GeneralMatrix& a, const char* dum, const GeneralMatrix& b)
: data(a.cols*b.cols), rows(a.cols), cols(b.cols), ld(a.cols)
{
gemm("T", a, "N", b, 1.0, 0.0);
}
GeneralMatrix::GeneralMatrix(const GeneralMatrix& a, const char* dum1,
const GeneralMatrix& b, const char* dum2)
: data(a.cols*b.rows), rows(a.cols), cols(b.rows), ld(a.cols)
{
gemm("T", a, "T", b, 1.0, 0.0);
}
GeneralMatrix::~GeneralMatrix()
{
}
void GeneralMatrix::place(const ConstGeneralMatrix& m, int i, int j)
{
if (i + m.numRows() > numRows() ||
j + m.numCols() > numCols())
throw SYLV_MES_EXCEPTION("Bad submatrix placement, matrix dimensions exceeded.");
GeneralMatrix tmpsub(*this, i, j, m.numRows(), m.numCols());
tmpsub.copy(m);
}
void GeneralMatrix::mult(const ConstGeneralMatrix& a, const ConstGeneralMatrix& b)
{
gemm("N", a, "N", b, 1.0, 0.0);
}
void GeneralMatrix::multAndAdd(const ConstGeneralMatrix& a, const ConstGeneralMatrix& b,
double mult)
{
gemm("N", a, "N", b, mult, 1.0);
}
void GeneralMatrix::multAndAdd(const ConstGeneralMatrix& a, const ConstGeneralMatrix& b,
const char* dum, double mult)
{
gemm("N", a, "T", b, mult, 1.0);
}
void GeneralMatrix::multAndAdd(const ConstGeneralMatrix& a, const char* dum,
const ConstGeneralMatrix& b, double mult)
{
gemm("T", a, "N", b, mult, 1.0);
}
void GeneralMatrix::multAndAdd(const ConstGeneralMatrix& a, const char* dum1,
const ConstGeneralMatrix& b, const char* dum2, double mult)
{
gemm("T", a, "T", b, mult, 1.0);
}
void GeneralMatrix::addOuter(const ConstVector& a, double mult)
{
if (numRows() != numCols())
throw SYLV_MES_EXCEPTION("Matrix is not square in GeneralMatrix::addOuter.");
if (numRows() != a.length())
throw SYLV_MES_EXCEPTION("Wrong length of a vector in GeneralMatrix::addOuter.");
// since BLAS dsyr (symmetric rank 1 update) assumes symmetricity, we do this manually
for (int i = 0; i < numRows(); i++)
for (int j = i; j < numRows(); j++) {
double s = mult*a[i]*a[j];
get(i,j) = get(i,j) + s;
if (i != j)
get(j,i) = get(j,i) + s;
}
}
void GeneralMatrix::multRight(const ConstGeneralMatrix& m)
{
gemm_partial_right("N", m, 1.0, 0.0);
}
void GeneralMatrix::multLeft(const ConstGeneralMatrix& m)
{
gemm_partial_left("N", m, 1.0, 0.0);
}
void GeneralMatrix::multRightTrans(const ConstGeneralMatrix& m)
{
gemm_partial_right("T", m, 1.0, 0.0);
}
void GeneralMatrix::multLeftTrans(const ConstGeneralMatrix& m)
{
gemm_partial_left("T", m, 1.0, 0.0);
}
// here we must be careful for ld
void GeneralMatrix::zeros()
{
if (ld == rows)
data.zeros();
else {
for (int i = 0; i < rows; i++)
for (int j = 0; j < cols; j++)
get(i,j) = 0;
}
}
void GeneralMatrix::unit()
{
for (int i = 0; i < rows; i++)
for (int j = 0; j < cols; j++)
if (i == j)
get(i,j) = 1.0;
else
get(i,j) = 0.0;
}
void GeneralMatrix::nans()
{
for (int i = 0; i < rows; i++)
for (int j = 0; j < cols; j++)
get(i,j) = std::numeric_limits<double>::quiet_NaN();
}
void GeneralMatrix::infs()
{
for (int i = 0; i < rows; i++)
for (int j = 0; j < cols; j++)
get(i,j) = std::numeric_limits<double>::infinity();
}
// here we must be careful for ld
void GeneralMatrix::mult(double a)
{
if (ld == rows)
data.mult(a);
else {
for (int i = 0; i < rows; i++)
for (int j = 0; j < cols; j++)
get(i,j) *= a;
}
}
// here we must be careful for ld
void GeneralMatrix::add(double a, const ConstGeneralMatrix& m)
{
if (m.numRows() != rows || m.numCols() != cols)
throw SYLV_MES_EXCEPTION("Matrix has different size in GeneralMatrix::add.");
if (ld == rows && m.ld == m.rows)
data.add(a, m.data);
else {
for (int i = 0; i < rows; i++)
for (int j = 0; j < cols; j++)
get(i,j) += a*m.get(i,j);
}
}
void GeneralMatrix::add(double a, const ConstGeneralMatrix& m, const char* dum)
{
if (m.numRows() != cols || m.numCols() != rows)
throw SYLV_MES_EXCEPTION("Matrix has different size in GeneralMatrix::add.");
for (int i = 0; i < rows; i++)
for (int j = 0; j < cols; j++)
get(i,j) += a*m.get(j,i);
}
void GeneralMatrix::copy(const ConstGeneralMatrix& m, int ioff, int joff)
{
for (int i = 0; i < rows; i++)
for (int j = 0; j < cols; j++)
get(i,j) = m.get(i+ioff,j+joff);
}
void GeneralMatrix::gemm(const char* transa, const ConstGeneralMatrix& a,
const char* transb, const ConstGeneralMatrix& b,
double alpha, double beta)
{
int opa_rows = a.numRows();
int opa_cols = a.numCols();
if (!strcmp(transa, "T")) {
opa_rows = a.numCols();
opa_cols = a.numRows();
}
int opb_rows = b.numRows();
int opb_cols = b.numCols();
if (!strcmp(transb, "T")) {
opb_rows = b.numCols();
opb_cols = b.numRows();
}
if (opa_rows != numRows() ||
opb_cols != numCols() ||
opa_cols != opb_rows) {
throw SYLV_MES_EXCEPTION("Wrong dimensions for matrix multiplication.");
}
int m = opa_rows;
int n = opb_cols;
int k = opa_cols;
int lda = a.ld;
int ldb = b.ld;
int ldc = ld;
if (lda > 0 && ldb > 0 && ldc > 0) {
BLAS_dgemm(transa, transb, &m, &n, &k, &alpha, a.data.base(), &lda,
b.data.base(), &ldb, &beta, data.base(), &ldc);
} else if (numRows()*numCols() > 0) {
if (beta == 0.0)
zeros();
else
mult(beta);
}
}
void GeneralMatrix::gemm_partial_left(const char* trans, const ConstGeneralMatrix& m,
double alpha, double beta)
{
int icol;
for (icol = 0; icol + md_length < cols; icol += md_length) {
GeneralMatrix incopy((const GeneralMatrix&)*this, 0, icol, rows, md_length);
GeneralMatrix inplace((GeneralMatrix&)*this, 0, icol, rows, md_length);
inplace.gemm(trans, m, "N", ConstGeneralMatrix(incopy), alpha, beta);
}
if (cols > icol) {
GeneralMatrix incopy((const GeneralMatrix&)*this, 0, icol, rows, cols - icol);
GeneralMatrix inplace((GeneralMatrix&)*this, 0, icol, rows, cols - icol);
inplace.gemm(trans, m, "N", ConstGeneralMatrix(incopy), alpha, beta);
}
}
void GeneralMatrix::gemm_partial_right(const char* trans, const ConstGeneralMatrix& m,
double alpha, double beta)
{
int irow;
for (irow = 0; irow + md_length < rows; irow += md_length) {
GeneralMatrix incopy((const GeneralMatrix&)*this, irow, 0, md_length, cols);
GeneralMatrix inplace((GeneralMatrix&)*this, irow, 0, md_length, cols);
inplace.gemm("N", ConstGeneralMatrix(incopy), trans, m, alpha, beta);
}
if (rows > irow) {
GeneralMatrix incopy((const GeneralMatrix&)*this, irow, 0, rows - irow, cols);
GeneralMatrix inplace((GeneralMatrix&)*this, irow, 0, rows - irow, cols);
inplace.gemm("N", ConstGeneralMatrix(incopy), trans, m, alpha, beta);
}
}
ConstGeneralMatrix::ConstGeneralMatrix(const GeneralMatrix& m, int i, int j, int nrows, int ncols)
: data(m.getData(), j*m.getLD()+i, (ncols-1)*m.getLD()+nrows), rows(nrows), cols(ncols), ld(m.getLD())
{
// can check that the submatirx is fully in the matrix
}
ConstGeneralMatrix::ConstGeneralMatrix(const ConstGeneralMatrix& m, int i, int j, int nrows, int ncols)
: data(m.getData(), j*m.getLD()+i, (ncols-1)*m.getLD()+nrows), rows(nrows), cols(ncols), ld(m.getLD())
{
// can check that the submatirx is fully in the matrix
}
ConstGeneralMatrix::ConstGeneralMatrix(const GeneralMatrix& m)
: data(m.data), rows(m.rows), cols(m.cols), ld(m.ld) {}
double ConstGeneralMatrix::getNormInf() const
{
double norm = 0.0;
for (int i = 0; i < numRows(); i++) {
ConstVector rowi(data.base()+i, ld, cols);
double normi = rowi.getNorm1();
if (norm < normi)
norm = normi;
}
return norm;
}
double ConstGeneralMatrix::getNorm1() const
{
double norm = 0.0;
for (int j = 0; j < numCols(); j++) {
ConstVector colj(data.base()+ld*j, 1, rows);
double normj = colj.getNorm1();
if (norm < normj)
norm = normj;
}
return norm;
}
void ConstGeneralMatrix::multVec(double a, Vector& x, double b, const ConstVector& d) const
{
if (x.length() != rows || cols != d.length()) {
throw SYLV_MES_EXCEPTION("Wrong dimensions for vector multiply.");
}
if (rows > 0) {
int mm = rows;
int nn = cols;
double alpha = b;
int lda = ld;
int incx = d.skip();
double beta = a;
int incy = x.skip();
BLAS_dgemv("N", &mm, &nn, &alpha, data.base(), &lda, d.base(), &incx,
&beta, x.base(), &incy);
}
}
void ConstGeneralMatrix::multVecTrans(double a, Vector& x, double b,
const ConstVector& d) const
{
if (x.length() != cols || rows != d.length()) {
throw SYLV_MES_EXCEPTION("Wrong dimensions for vector multiply.");
}
if (rows > 0) {
int mm = rows;
int nn = cols;
double alpha = b;
int lda = rows;
int incx = d.skip();
double beta = a;
int incy = x.skip();
BLAS_dgemv("T", &mm, &nn, &alpha, data.base(), &lda, d.base(), &incx,
&beta, x.base(), &incy);
}
}
/* m = inv(this)*m */
void ConstGeneralMatrix::multInvLeft(const char* trans, int mrows, int mcols, int mld, double* d) const
{
if (rows != cols) {
throw SYLV_MES_EXCEPTION("The matrix is not square for inversion.");
}
if (cols != mrows) {
throw SYLV_MES_EXCEPTION("Wrong dimensions for matrix inverse mutliply.");
}
if (rows > 0) {
GeneralMatrix inv(*this);
int* ipiv = new int[rows];
int info;
LAPACK_dgetrf(&rows, &rows, inv.getData().base(), &rows, ipiv, &info);
LAPACK_dgetrs(trans, &rows, &mcols, inv.base(), &rows, ipiv, d,
&mld, &info);
delete [] ipiv;
}
}
/* m = inv(this)*m */
void ConstGeneralMatrix::multInvLeft(GeneralMatrix& m) const
{
multInvLeft("N", m.numRows(), m.numCols(), m.getLD(), m.getData().base());
}
/* m = inv(this')*m */
void ConstGeneralMatrix::multInvLeftTrans(GeneralMatrix& m) const
{
multInvLeft("T", m.numRows(), m.numCols(), m.getLD(), m.getData().base());
}
/* d = inv(this)*d */
void ConstGeneralMatrix::multInvLeft(Vector& d) const
{
if (d.skip() != 1) {
throw SYLV_MES_EXCEPTION("Skip!=1 not implemented in ConstGeneralMatrix::multInvLeft(Vector&)");
}
multInvLeft("N", d.length(), 1, d.length(), d.base());
}
/* d = inv(this')*d */
void ConstGeneralMatrix::multInvLeftTrans(Vector& d) const
{
if (d.skip() != 1) {
throw SYLV_MES_EXCEPTION("Skip!=1 not implemented in ConstGeneralMatrix::multInvLeft(Vector&)");
}
multInvLeft("T", d.length(), 1, d.length(), d.base());
}
bool ConstGeneralMatrix::isFinite() const
{
for (int i = 0; i < numRows(); i++)
for (int j = 0; j < numCols(); j++)
if (! std::isfinite(get(i,j)))
return false;
return true;
}
bool ConstGeneralMatrix::isZero() const
{
for (int i = 0; i < numRows(); i++)
for (int j = 0; j < numCols(); j++)
if (get(i,j) != 0.0)
return false;
return true;
}
void ConstGeneralMatrix::print() const
{
printf("rows=%d, cols=%d\n",rows, cols);
for (int i = 0; i < rows; i++) {
printf("row %d:\n",i);
for (int j = 0; j < cols; j++) {
printf("%6.3g ",get(i,j));
}
printf("\n");
}
}

284
mex/sources/korderpert/Dyn_pp/sylv/cc/GeneralMatrix.h Normal file
View File

@ -0,0 +1,284 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/GeneralMatrix.h,v 1.3 2004/11/24 20:41:59 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef GENERAL_MATRIX_H
#define GENERAL_MATRIX_H
#include "Vector.h"
class GeneralMatrix;
class ConstGeneralMatrix {
friend class GeneralMatrix;
protected:
ConstVector data;
int rows;
int cols;
int ld;
public:
ConstGeneralMatrix(const double* d, int m, int n)
: data(d, m*n), rows(m), cols(n), ld(m) {}
ConstGeneralMatrix(const GeneralMatrix& m);
ConstGeneralMatrix(const GeneralMatrix& m, int i, int j, int nrows, int ncols);
ConstGeneralMatrix(const ConstGeneralMatrix& m, int i, int j, int nrows, int ncols);
virtual ~ConstGeneralMatrix() {}
const double& get(int i, int j) const
{return data[j*ld+i];}
int numRows() const {return rows;}
int numCols() const {return cols;}
int getLD() const {return ld;}
const double* base() const {return data.base();}
const ConstVector& getData() const {return data;}
double getNormInf() const;
double getNorm1() const;
/* x = scalar(a)*x + scalar(b)*this*d */
void multVec(double a, Vector& x, double b, const ConstVector& d) const;
/* x = scalar(a)*x + scalar(b)*this'*d */
void multVecTrans(double a, Vector& x, double b, const ConstVector& d) const;
/* x = x + this*d */
void multaVec(Vector& x, const ConstVector& d) const
{multVec(1.0, x, 1.0, d);}
/* x = x + this'*d */
void multaVecTrans(Vector& x, const ConstVector& d) const
{multVecTrans(1.0, x, 1.0, d);}
/* x = x - this*d */
void multsVec(Vector& x, const ConstVector& d) const
{multVec(1.0, x, -1.0, d);}
/* x = x - this'*d */
void multsVecTrans(Vector& x, const ConstVector& d) const
{multVecTrans(1.0, x, -1.0, d);}
/* m = inv(this)*m */
void multInvLeft(GeneralMatrix& m) const;
/* m = inv(this')*m */
void multInvLeftTrans(GeneralMatrix& m) const;
/* d = inv(this)*d */
void multInvLeft(Vector& d) const;
/* d = inv(this')*d */
void multInvLeftTrans(Vector& d) const;
bool isFinite() const;
/** Returns true of the matrix is exactly zero. */
bool isZero() const;
virtual void print() const;
protected:
void multInvLeft(const char* trans, int mrows, int mcols, int mld, double* d) const;
};
class GeneralMatrix {
friend class ConstGeneralMatrix;
protected:
Vector data;
int rows;
int cols;
int ld;
public:
GeneralMatrix(int m, int n)
: data(m*n), rows(m), cols(n), ld(m) {}
GeneralMatrix(const double* d, int m, int n)
: data(d, m*n), rows(m), cols(n), ld(m) {}
GeneralMatrix(double* d, int m, int n)
: data(d, m*n), rows(m), cols(n), ld(m) {}
GeneralMatrix(const GeneralMatrix& m);
GeneralMatrix(const ConstGeneralMatrix& m);
GeneralMatrix(const GeneralMatrix&m, const char* dummy); // transpose
GeneralMatrix(const ConstGeneralMatrix&m, const char* dummy); // transpose
GeneralMatrix(const GeneralMatrix& m, int i, int j, int nrows, int ncols);
GeneralMatrix(GeneralMatrix& m, int i, int j, int nrows, int ncols);
/* this = a*b */
GeneralMatrix(const GeneralMatrix& a, const GeneralMatrix& b);
/* this = a*b' */
GeneralMatrix(const GeneralMatrix& a, const GeneralMatrix& b, const char* dum);
/* this = a'*b */
GeneralMatrix(const GeneralMatrix& a, const char* dum, const GeneralMatrix& b);
/* this = a'*b */
GeneralMatrix(const GeneralMatrix& a, const char* dum1,
const GeneralMatrix& b, const char* dum2);
virtual ~GeneralMatrix();
const GeneralMatrix& operator=(const GeneralMatrix& m)
{data=m.data; rows=m.rows; cols=m.cols; ld=m.ld; return *this;}
const double& get(int i, int j) const
{return data[j*ld+i];}
double& get(int i, int j)
{return data[j*ld+i];}
int numRows() const {return rows;}
int numCols() const {return cols;}
int getLD() const {return ld;}
double* base() {return data.base();}
const double* base() const {return data.base();}
Vector& getData() {return data;}
const Vector& getData() const {return data;}
double getNormInf() const
{return ConstGeneralMatrix(*this).getNormInf();}
double getNorm1() const
{return ConstGeneralMatrix(*this).getNorm1();}
/* place matrix m to the position (i,j) */
void place(const ConstGeneralMatrix& m, int i, int j);
void place(const GeneralMatrix& m, int i, int j)
{place(ConstGeneralMatrix(m), i, j);}
/* this = a*b */
void mult(const ConstGeneralMatrix& a, const ConstGeneralMatrix& b);
void mult(const GeneralMatrix& a, const GeneralMatrix& b)
{mult(ConstGeneralMatrix(a), ConstGeneralMatrix(b));}
/* this = this + scalar*a*b */
void multAndAdd(const ConstGeneralMatrix& a, const ConstGeneralMatrix& b,
double mult=1.0);
void multAndAdd(const GeneralMatrix& a, const GeneralMatrix& b,
double mult=1.0)
{multAndAdd(ConstGeneralMatrix(a), ConstGeneralMatrix(b), mult);}
/* this = this + scalar*a*b' */
void multAndAdd(const ConstGeneralMatrix& a, const ConstGeneralMatrix& b,
const char* dum, double mult=1.0);
void multAndAdd(const GeneralMatrix& a, const GeneralMatrix& b,
const char* dum, double mult=1.0)
{multAndAdd(ConstGeneralMatrix(a), ConstGeneralMatrix(b), dum, mult);}
/* this = this + scalar*a'*b */
void multAndAdd(const ConstGeneralMatrix& a, const char* dum, const ConstGeneralMatrix& b,
double mult=1.0);
void multAndAdd(const GeneralMatrix& a, const char* dum, const GeneralMatrix& b,
double mult=1.0)
{multAndAdd(ConstGeneralMatrix(a), dum, ConstGeneralMatrix(b), mult);}
/* this = this + scalar*a'*b' */
void multAndAdd(const ConstGeneralMatrix& a, const char* dum1,
const ConstGeneralMatrix& b, const char* dum2, double mult=1.0);
void multAndAdd(const GeneralMatrix& a, const char* dum1,
const GeneralMatrix& b, const char* dum2, double mult=1.0)
{multAndAdd(ConstGeneralMatrix(a), dum1, ConstGeneralMatrix(b),dum2, mult);}
/* this = this + scalar*a*a' */
void addOuter(const ConstVector& a, double mult=1.0);
void addOuter(const Vector& a, double mult=1.0)
{addOuter(ConstVector(a), mult);}
/* this = this * m */
void multRight(const ConstGeneralMatrix& m);
void multRight(const GeneralMatrix& m)
{multRight(ConstGeneralMatrix(m));}
/* this = m * this */
void multLeft(const ConstGeneralMatrix& m);
void multLeft(const GeneralMatrix& m)
{multLeft(ConstGeneralMatrix(m));}
/* this = this * m' */
void multRightTrans(const ConstGeneralMatrix& m);
void multRightTrans(const GeneralMatrix& m)
{multRightTrans(ConstGeneralMatrix(m));}
/* this = m' * this */
void multLeftTrans(const ConstGeneralMatrix& m);
void multLeftTrans(const GeneralMatrix& m)
{multLeftTrans(ConstGeneralMatrix(m));}
/* x = scalar(a)*x + scalar(b)*this*d */
void multVec(double a, Vector& x, double b, const ConstVector& d) const
{ConstGeneralMatrix(*this).multVec(a, x, b, d);}
/* x = scalar(a)*x + scalar(b)*this'*d */
void multVecTrans(double a, Vector& x, double b, const ConstVector& d) const
{ConstGeneralMatrix(*this).multVecTrans(a, x, b, d);}
/* x = x + this*d */
void multaVec(Vector& x, const ConstVector& d) const
{ConstGeneralMatrix(*this).multaVec(x, d);}
/* x = x + this'*d */
void multaVecTrans(Vector& x, const ConstVector& d) const
{ConstGeneralMatrix(*this).multaVecTrans(x, d);}
/* x = x - this*d */
void multsVec(Vector& x, const ConstVector& d) const
{ConstGeneralMatrix(*this).multsVec(x, d);}
/* x = x - this'*d */
void multsVecTrans(Vector& x, const ConstVector& d) const
{ConstGeneralMatrix(*this).multsVecTrans(x, d);}
/* this = zero */
void zeros();
/** this = unit (on main diagonal) */
void unit();
/* this = NaN */
void nans();
/* this = Inf */
void infs();
/* this = scalar*this */
void mult(double a);
/* this = this + scalar*m */
void add(double a, const ConstGeneralMatrix& m);
void add(double a, const GeneralMatrix& m)
{add(a, ConstGeneralMatrix(m));}
/* this = this + scalar*m' */
void add(double a, const ConstGeneralMatrix& m, const char* dum);
void add(double a, const GeneralMatrix& m, const char* dum)
{add(a, ConstGeneralMatrix(m), dum);}
bool isFinite() const
{return (ConstGeneralMatrix(*this)).isFinite();}
bool isZero() const
{return (ConstGeneralMatrix(*this)).isZero();}
virtual void print() const
{ConstGeneralMatrix(*this).print();}
private:
void copy(const ConstGeneralMatrix& m, int ioff = 0, int joff = 0);
void copy(const GeneralMatrix& m, int ioff = 0, int joff = 0)
{copy(ConstGeneralMatrix(m), ioff, joff);}
void gemm(const char* transa, const ConstGeneralMatrix& a,
const char* transb, const ConstGeneralMatrix& b,
double alpha, double beta);
void gemm(const char* transa, const GeneralMatrix& a,
const char* transb, const GeneralMatrix& b,
double alpha, double beta)
{gemm(transa, ConstGeneralMatrix(a), transb, ConstGeneralMatrix(b),
alpha, beta);}
/* this = this * op(m) (without whole copy of this) */
void gemm_partial_right(const char* trans, const ConstGeneralMatrix& m,
double alpha, double beta);
void gemm_partial_right(const char* trans, const GeneralMatrix& m,
double alpha, double beta)
{gemm_partial_right(trans, ConstGeneralMatrix(m), alpha, beta);}
/* this = op(m) *this (without whole copy of this) */
void gemm_partial_left(const char* trans, const ConstGeneralMatrix& m,
double alpha, double beta);
void gemm_partial_left(const char* trans, const GeneralMatrix& m,
double alpha, double beta)
{gemm_partial_left(trans, ConstGeneralMatrix(m), alpha, beta);}
/* number of rows/columns for copy used in gemm_partial_* */
static int md_length;
};
#endif /* GENERAL_MATRIX_H */
// Local Variables:
// mode:C++
// End:

138
mex/sources/korderpert/Dyn_pp/sylv/cc/GeneralSylvester.cpp Normal file
View File

@ -0,0 +1,138 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/GeneralSylvester.cpp,v 1.1.1.1 2004/06/04 13:00:20 kamenik Exp $ */
/* Tag $Name: $ */
#include "GeneralSylvester.h"
#include "SchurDecomp.h"
#include "SylvException.h"
#include "TriangularSylvester.h"
#include "IterativeSylvester.h"
#include <time.h>
GeneralSylvester::GeneralSylvester(int ord, int n, int m, int zero_cols,
const double* da, const double* db,
const double* dc, const double* dd,
const SylvParams& ps)
: pars(ps),
mem_driver(pars, 1, m, n, ord), order(ord), a(da, n),
b(db, n, n-zero_cols), c(dc, m), d(dd, n, power(m, order)),
solved(false)
{
init();
}
GeneralSylvester::GeneralSylvester(int ord, int n, int m, int zero_cols,
const double* da, const double* db,
const double* dc, double* dd,
const SylvParams& ps)
: pars(ps),
mem_driver(pars, 0, m, n, ord), order(ord), a(da, n),
b(db, n, n-zero_cols), c(dc, m), d(dd, n, power(m, order)),
solved(false)
{
init();
}
GeneralSylvester::GeneralSylvester(int ord, int n, int m, int zero_cols,
const double* da, const double* db,
const double* dc, const double* dd,
bool alloc_for_check)
: pars(alloc_for_check),
mem_driver(pars, 1, m, n, ord), order(ord), a(da, n),
b(db, n, n-zero_cols), c(dc, m), d(dd, n, power(m, order)),
solved(false)
{
init();
}
GeneralSylvester::GeneralSylvester(int ord, int n, int m, int zero_cols,
const double* da, const double* db,
const double* dc, double* dd,
bool alloc_for_check)
: pars(alloc_for_check),
mem_driver(pars, 0, m, n, ord), order(ord), a(da, n),
b(db, n, n-zero_cols), c(dc, m), d(dd, n, power(m, order)),
solved(false)
{
init();
}
void GeneralSylvester::init()
{
GeneralMatrix ainvb(b);
double rcond1;
double rcondinf;
a.multInvLeft2(ainvb, d, rcond1, rcondinf);
pars.rcondA1 = rcond1;
pars.rcondAI = rcondinf;
bdecomp = new SchurDecompZero(ainvb);
cdecomp = new SimilarityDecomp(c.getData().base(), c.numRows(), *(pars.bs_norm));
cdecomp->check(pars, c);
cdecomp->infoToPars(pars);
if (*(pars.method) == SylvParams::recurse)
sylv = new TriangularSylvester(*bdecomp, *cdecomp);
else
sylv = new IterativeSylvester(*bdecomp, *cdecomp);
}
void GeneralSylvester::solve()
{
if (solved)
throw SYLV_MES_EXCEPTION("Attempt to run solve() more than once.");
mem_driver.setStackMode(true);
clock_t start = clock();
// multiply d
d.multLeftITrans(bdecomp->getQ());
d.multRightKron(cdecomp->getQ(), order);
// convert to KronVector
KronVector dkron(d.getData(), getM(), getN(), order);
// solve
sylv->solve(pars, dkron);
// multiply d back
d.multLeftI(bdecomp->getQ());
d.multRightKron(cdecomp->getInvQ(), order);
clock_t end = clock();
pars.cpu_time = ((double)(end-start))/CLOCKS_PER_SEC;
mem_driver.setStackMode(false);
solved = true;
}
void GeneralSylvester::check(const double* ds)
{
if (!solved)
throw SYLV_MES_EXCEPTION("Cannot run check on system, which is not solved yet.");
mem_driver.setStackMode(true);
// calculate xcheck = AX+BXC^i-D
SylvMatrix dcheck(d.numRows(), d.numCols());
dcheck.multLeft(b.numRows()-b.numCols(), b, d);
dcheck.multRightKron(c, order);
dcheck.multAndAdd(a,d);
ConstVector dv(ds, d.numRows()*d.numCols());
dcheck.getData().add(-1.0, dv);
// calculate relative norms
pars.mat_err1 = dcheck.getNorm1()/d.getNorm1();
pars.mat_errI = dcheck.getNormInf()/d.getNormInf();
pars.mat_errF = dcheck.getData().getNorm()/d.getData().getNorm();
pars.vec_err1 = dcheck.getData().getNorm1()/d.getData().getNorm1();
pars.vec_errI = dcheck.getData().getMax()/d.getData().getMax();
mem_driver.setStackMode(false);
}
GeneralSylvester::~GeneralSylvester()
{
delete bdecomp;
delete cdecomp;
delete sylv;
}
// Local Variables:
// mode:C++
// End:

61
mex/sources/korderpert/Dyn_pp/sylv/cc/GeneralSylvester.h Normal file
View File

@ -0,0 +1,61 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/GeneralSylvester.h,v 1.1.1.1 2004/06/04 13:00:20 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef GENERAL_SYLVESTER_H
#define GENERAL_SYLVESTER_H
#include "SylvMatrix.h"
#include "SylvMemory.h"
#include "SimilarityDecomp.h"
#include "SylvesterSolver.h"
class GeneralSylvester {
SylvParams pars;
SylvMemoryDriver mem_driver;
int order;
const SqSylvMatrix a;
const SylvMatrix b;
const SqSylvMatrix c;
SylvMatrix d;
bool solved;
SchurDecompZero* bdecomp;
SimilarityDecomp* cdecomp;
SylvesterSolver* sylv;
public:
/* construct with my copy of d*/
GeneralSylvester(int ord, int n, int m, int zero_cols,
const double* da, const double* db,
const double* dc, const double* dd,
const SylvParams& ps);
GeneralSylvester(int ord, int n, int m, int zero_cols,
const double* da, const double* db,
const double* dc, const double* dd,
bool alloc_for_check = false);
/* construct with provided storage for d */
GeneralSylvester(int ord, int n, int m, int zero_cols,
const double* da, const double* db,
const double* dc, double* dd,
bool alloc_for_check = false);
GeneralSylvester(int ord, int n, int m, int zero_cols,
const double* da, const double* db,
const double* dc, double* dd,
const SylvParams& ps);
virtual ~GeneralSylvester();
int getM() const {return c.numRows();}
int getN() const {return a.numRows();}
const double* getResult() const {return d.base();}
const SylvParams& getParams() const {return pars;}
SylvParams& getParams() {return pars;}
void solve();
void check(const double* ds);
private:
void init();
};
#endif /* GENERAL_SYLVESTER_H */
// Local Variables:
// mode:C++
// End:

53
mex/sources/korderpert/Dyn_pp/sylv/cc/IterativeSylvester.cpp Normal file
View File

@ -0,0 +1,53 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/IterativeSylvester.cpp,v 1.1.1.1 2004/06/04 13:00:20 kamenik Exp $ */
/* Tag $Name: $ */
#include "IterativeSylvester.h"
#include "KronUtils.h"
void IterativeSylvester::solve(SylvParams& pars, KronVector& x) const
{
int max_steps = *(pars.max_num_iter);
int steps = 1;
double max_norm = *(pars.convergence_tol);
double norm = performFirstStep(x);
QuasiTriangular* kpow = matrixK->clone();
QuasiTriangular* fpow = matrixF->clone();
while (steps < max_steps && norm > max_norm) {
kpow->multRight(SqSylvMatrix(*kpow)); // be careful to make copy
fpow->multRight(SqSylvMatrix(*fpow)); // also here
norm = performStep(*kpow, *fpow, x);
steps++;
}
delete fpow;
delete kpow;
pars.converged = (norm <= max_norm);
pars.iter_last_norm = norm;
pars.num_iter = steps;
}
double IterativeSylvester::performFirstStep(KronVector& x) const
{
KronVector xtmp((const KronVector&)x);
KronUtils::multKron(*matrixF, *matrixK, xtmp);
x.add(-1., xtmp);
double norm = xtmp.getMax();
return norm;
}
double IterativeSylvester::performStep(const QuasiTriangular& k, const QuasiTriangular& f,
KronVector& x)
{
KronVector xtmp((const KronVector&)x);
KronUtils::multKron(f, k, xtmp);
x.add(1.0, xtmp);
double norm = xtmp.getMax();
return norm;
}
// Local Variables:
// mode:C++
// End:

33
mex/sources/korderpert/Dyn_pp/sylv/cc/IterativeSylvester.h Normal file
View File

@ -0,0 +1,33 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/IterativeSylvester.h,v 1.1.1.1 2004/06/04 13:00:20 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef ITERATIVE_SYLVESTER_H
#define ITERATIVE_SYLVESTER_H
#include "SylvesterSolver.h"
#include "KronVector.h"
#include "QuasiTriangular.h"
#include "SimilarityDecomp.h"
class IterativeSylvester : public SylvesterSolver {
public:
IterativeSylvester(const QuasiTriangular& k, const QuasiTriangular& f)
: SylvesterSolver(k, f) {}
IterativeSylvester(const SchurDecompZero& kdecomp, const SchurDecomp& fdecomp)
: SylvesterSolver(kdecomp, fdecomp) {}
IterativeSylvester(const SchurDecompZero& kdecomp, const SimilarityDecomp& fdecomp)
: SylvesterSolver(kdecomp, fdecomp) {}
void solve(SylvParams& pars, KronVector& x) const;
private:
double performFirstStep(KronVector& x) const;
static double performStep(const QuasiTriangular& k, const QuasiTriangular& f,
KronVector& x);
};
#endif /* ITERATIVE_SYLVESTER_H */
// Local Variables:
// mode:C++
// End:

53
mex/sources/korderpert/Dyn_pp/sylv/cc/KronUtils.cpp Normal file
View File

@ -0,0 +1,53 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/KronUtils.cpp,v 1.1.1.1 2004/06/04 13:00:31 kamenik Exp $ */
/* Tag $Name: $ */
#include "KronUtils.h"
void KronUtils::multAtLevel(int level, const QuasiTriangular& t,
KronVector& x)
{
if (0 < level && level < x.getDepth()) {
for (int i = 0; i < x.getM(); i++) {
KronVector xi(x, i);
multAtLevel(level, t, xi);
}
} else if (0 == level && 0 < x.getDepth()) {
GeneralMatrix tmp(x.base(), x.getN(), power(x.getM(),x.getDepth()));
t.multLeftOther(tmp);
} else if (0 == level && 0 == x.getDepth()) {
Vector b((const Vector&)x);
t.multVec(x,b);
} else { // 0 < level == depth
t.multKron(x);
}
}
void KronUtils::multAtLevelTrans(int level, const QuasiTriangular& t,
KronVector& x)
{
if (0 < level && level < x.getDepth()) {
for (int i = 0; i < x.getM(); i++) {
KronVector xi(x, i);
multAtLevelTrans(level, t, xi);
}
} else if (0 == level && 0 < x.getDepth()) {
GeneralMatrix tmp(x.base(), x.getN(), power(x.getM(),x.getDepth()));
t.multLeftOtherTrans(tmp);
} else if (level == 0 && 0 == x.getDepth()) {
Vector b((const Vector&)x);
t.multVecTrans(x,b);
} else { // 0 < level == depth
t.multKronTrans(x);
}
}
void KronUtils::multKron(const QuasiTriangular& f, const QuasiTriangular& k,
KronVector& x)
{
multAtLevel(0, k, x);
if (x.getDepth() > 0) {
for (int level = 1; level <= x.getDepth(); level++)
multAtLevelTrans(level, f, x);
}
}

32
mex/sources/korderpert/Dyn_pp/sylv/cc/KronUtils.h Normal file
View File

@ -0,0 +1,32 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/KronUtils.h,v 1.1.1.1 2004/06/04 13:00:31 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef KRON_UTILS_H
#define KRON_UTILS_H
#include "KronVector.h"
#include "QuasiTriangular.h"
class KronUtils {
public:
/* multiplies I_m\otimes..\I_m\otimes T\otimes I_m...I_m\otimes I_n
with given b and returns x. T must be (m,m), number of
\otimes is b.getDepth(), level is a number of I_m's between T
and I_n plus 1. If level=0, then we multiply
\I_m\otimes ..\otimes I_m\otimes T, T is (n,n) */
static void multAtLevel(int level, const QuasiTriangular& t,
KronVector& x);
static void multAtLevelTrans(int level, const QuasiTriangular& t,
KronVector& x);
/* multiplies x=(F'\otimes F'\otimes..\otimes K)x */
static void multKron(const QuasiTriangular& f, const QuasiTriangular& k,
KronVector& x);
};
#endif /* KRON_UTILS_H */
// Local Variables:
// mode:C++
// End:

109
mex/sources/korderpert/Dyn_pp/sylv/cc/KronVector.cpp Normal file
View File

@ -0,0 +1,109 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/KronVector.cpp,v 1.1.1.1 2004/06/04 13:00:31 kamenik Exp $ */
/* Tag $Name: $ */
#include "KronVector.h"
#include "SylvException.h"
int power(int m, int depth)
{
int p = 1;
for (int i = 0; i < depth; i++) {
p *= m;
}
return p;
}
KronVector::KronVector(int mm, int nn, int dp)
: Vector(power(mm,dp)*nn), m(mm), n(nn), depth(dp)
{}
KronVector::KronVector(Vector& v, int mm, int nn, int dp)
: Vector(v), m(mm), n(nn), depth(dp)
{
len = power(m,depth)*n;
if (v.length() != length()) {
throw SYLV_MES_EXCEPTION("Bad conversion KronVector from Vector.");
}
}
KronVector::KronVector(KronVector& v, int i)
: Vector(v, i*power(v.m,v.depth-1)*v.n, power(v.m, v.depth-1)*v.n), m(v.m), n(v.n),
depth(v.depth-1)
{
if (depth < 0) {
throw SYLV_MES_EXCEPTION("Bad KronVector pick, depth < 0.");
}
}
KronVector::KronVector(const ConstKronVector& v)
: Vector(v.length()), m(v.getM()), n(v.getN()), depth(v.getDepth())
{
Vector::operator=(v);
}
const KronVector& KronVector::operator=(const ConstKronVector& v)
{
Vector::operator=(v);
m=v.getM();
n=v.getN();
depth = v.getDepth();
return *this;
}
const KronVector& KronVector::operator=(const Vector& v)
{
if (length() != v.length()) {
throw SYLV_MES_EXCEPTION("Wrong lengths for vector operator =.");
}
Vector::operator=(v);
return *this;
}
ConstKronVector::ConstKronVector(const KronVector& v)
: ConstVector(v), m(v.getM()), n(v.getN()), depth(v.getDepth())
{}
ConstKronVector::ConstKronVector(const ConstKronVector& v)
: ConstVector(power(v.getM(),v.getDepth())*v.getN()), m(v.getM()), n(v.getN()),
depth(v.getDepth())
{}
ConstKronVector::ConstKronVector(const Vector& v, int mm, int nn, int dp)
: ConstVector(v), m(mm), n(nn), depth(dp)
{
len = power(m,depth)*n;
if (v.length() != length()) {
throw SYLV_MES_EXCEPTION("Bad conversion KronVector from Vector.");
}
}
ConstKronVector::ConstKronVector(const ConstVector& v, int mm, int nn, int dp)
: ConstVector(v), m(mm), n(nn), depth(dp)
{
len = power(m,depth)*n;
if (v.length() != length()) {
throw SYLV_MES_EXCEPTION("Bad conversion KronVector from Vector.");
}
}
ConstKronVector::ConstKronVector(const KronVector& v, int i)
: ConstVector(v, i*power(v.getM(),v.getDepth()-1)*v.getN(),
power(v.getM(),v.getDepth()-1)*v.getN()),
m(v.getM()), n(v.getN()), depth(v.getDepth()-1)
{
if (depth < 0) {
throw SYLV_MES_EXCEPTION("Bad KronVector pick, depth < 0.");
}
}
ConstKronVector::ConstKronVector(const ConstKronVector& v, int i)
: ConstVector(v, i*power(v.m,v.depth-1)*v.n, power(v.m,v.depth-1)*v.n),
m(v.getM()), n(v.getN()), depth(v.getDepth()-1)
{
if (depth < 0) {
throw SYLV_MES_EXCEPTION("Bad KronVector pick, depth < 0.");
}
}

58
mex/sources/korderpert/Dyn_pp/sylv/cc/KronVector.h Normal file
View File

@ -0,0 +1,58 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/KronVector.h,v 1.1.1.1 2004/06/04 13:00:31 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef KRON_VECTOR_H
#define KRON_VECTOR_H
#include "Vector.h"
class ConstKronVector;
class KronVector : public Vector {
protected:
int m;
int n;
int depth;
public:
KronVector() : Vector((double*)0, 0), m(0), n(0), depth(0) {}
KronVector(int mm, int nn, int dp); // new instance
KronVector(Vector& v, int mm, int nn, int dp); // conversion
KronVector(KronVector&, int i); // picks i-th subvector
KronVector(const ConstKronVector& v); // new instance and copy
const KronVector& operator=(KronVector& v)
{Vector::operator=(v); m=v.m; n=v.n; depth = v.depth; return *this;}
const KronVector& operator=(const KronVector& v)
{Vector::operator=(v); m=v.m; n=v.n; depth = v.depth; return *this;}
const KronVector& operator=(const ConstKronVector& v);
const KronVector& operator=(const Vector& v);
int getM() const {return m;}
int getN() const {return n;}
int getDepth() const {return depth;}
};
class ConstKronVector : public ConstVector
{
protected:
int m;
int n;
int depth;
public:
ConstKronVector(const KronVector& v);
ConstKronVector(const ConstKronVector& v);
ConstKronVector(const Vector& v, int mm, int nn, int dp);
ConstKronVector(const ConstVector& v, int mm, int nn, int dp);
ConstKronVector(const KronVector& v, int i);
ConstKronVector(const ConstKronVector& v, int i);
int getM() const {return m;}
int getN() const {return n;}
int getDepth() const {return depth;}
};
int power(int m, int depth);
#endif /* KRON_VECTOR */
// Local Variables:
// mode:C++
// End:

34
mex/sources/korderpert/Dyn_pp/sylv/cc/Makefile Normal file
View File

@ -0,0 +1,34 @@
# $Header: /var/lib/cvs/dynare_cpp/sylv/cc/Makefile,v 1.4 2005/01/18 21:28:26 kamenik Exp $
# Tag $Name: $
CC_FLAGS := -Wall -I../testing -I../cc \
$(CC_INCLUDE_PATH)
ifeq ($(DEBUG),yes)
CC_FLAGS := $(CC_FLAGS) -g
else
CC_FLAGS := $(CC_FLAGS) -O2
endif
ifeq ($(OS),Windows_NT)
CC_FLAGS := -mno-cygwin -mthreads $(CC_FLAGS)
endif
objects := $(patsubst %.cpp,%.o,$(wildcard *.cpp))
headers := $(wildcard *.h)
all: $(objects)
sylvester.a: $(objects)
ar cr sylvester.a $(objects)
ranlib sylvester.a
clear:
rm -f *.o
rm -f sylvester.a
%.o : %.cpp $(headers)
$(CC) $(CC_FLAGS) $(EXTERN_DEFS) -c $*.cpp

682
mex/sources/korderpert/Dyn_pp/sylv/cc/QuasiTriangular.cpp Normal file
View File

@ -0,0 +1,682 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/QuasiTriangular.cpp,v 1.1.1.1 2004/06/04 13:00:31 kamenik Exp $ */
/* Tag $Name: $ */
#include "QuasiTriangular.h"
#include "SylvException.h"
#include "SchurDecomp.h"
#include "cppblas.h"
#include <stdio.h>
#include <cmath>
using namespace std;
double DiagonalBlock::getDeterminant() const
{
return (*alpha)*(*alpha) + getSBeta();
}
double DiagonalBlock::getSBeta() const
{
return -(*beta1)*(*beta2);
}
double DiagonalBlock::getSize() const
{
if (real)
return abs(*alpha);
else
return sqrt(getDeterminant());
}
// this function makes Diagonal inconsistent, it should only be used
// on temorary matrices, which will not be used any more, e.g. in
// QuasiTriangular::solve (we need fast performance)
void DiagonalBlock::setReal()
{
*beta1 = 0;
*beta2 = 0;
real = true;
}
void DiagonalBlock::checkBlock(const double* d, int d_size)
{
const double* a1 = d + jbar*d_size+jbar;
const double* b1 = a1 + d_size;
const double* b2 = a1 + 1;
const double* a2 = b1 + 1;
if (a1 != alpha.a1)
throw SYLV_MES_EXCEPTION("Bad alpha1.");
if (!real && b1 != beta1)
throw SYLV_MES_EXCEPTION("Bad beta1.");
if (!real && b2 != beta2)
throw SYLV_MES_EXCEPTION("Bad beta2.");
if (!real && a2 != alpha.a2)
throw SYLV_MES_EXCEPTION("Bad alpha2.");
}
Diagonal::Diagonal(double* data, int d_size)
{
int nc = getNumComplex(data, d_size); // return nc <= d_size/2
num_all = d_size - nc;
num_real = d_size - 2*nc;
int jbar = 0;
int j = 0;
while (j < num_all) {
int id = jbar*d_size + jbar; // index of diagonal block in data
int ill = id + 1; // index of element below the diagonal
int iur = id + d_size; // index of element right to diagonal
int idd = id + d_size + 1; // index of element next on diagonal
if ((jbar < d_size-1) && !isZero(data[ill])) {
// it is not last column and we have nonzero below diagonal
DiagonalBlock b(jbar, false, &data[id], &data[idd],
&data[iur], &data[ill]);
blocks.push_back(b);
jbar++;
} else {
// it is last column or we have zero below diagonal
DiagonalBlock b(jbar, true, &data[id], &data[id], NULL, NULL);
blocks.push_back(b);
}
jbar++;
j++;
}
}
Diagonal::Diagonal(double* data, const Diagonal& d)
{
num_all = d.num_all;
num_real = d.num_real;
int d_size = d.getSize();
for (const_diag_iter it = d.begin(); it != d.end(); ++it) {
const DiagonalBlock& dit = *it;
double* beta1 = NULL;
double* beta2 = NULL;
int id = dit.getIndex()*(d_size+1);
int idd = id;
if (! dit.isReal()) {
beta1 = &data[id+d_size];
beta2 = &data[id+1];
idd = id + d_size + 1;
}
DiagonalBlock b(dit.getIndex(), dit.isReal(),
&data[id], &data[idd], beta1, beta2);
blocks.push_back(b);
}
}
void Diagonal::copy(const Diagonal& d)
{
num_all = d.num_all;
num_real = d.num_real;
blocks = d.blocks;
}
int Diagonal::getNumComplex(const double* data, int d_size)
{
int num_complex = 0;
int in = 1;
for (int i = 0; i < d_size-1; i++, in = in + d_size + 1) {
if (! isZero(data[in])) {
num_complex++;
if (in < d_size - 2 && ! isZero(data[in + d_size +1])) {
throw SYLV_MES_EXCEPTION("Matrix is not quasi-triangular");
}
}
}
return num_complex;
}
void Diagonal::changeBase(double* p)
{
int d_size = getSize();
for (diag_iter it = begin(); it != end(); ++it) {
const DiagonalBlock& b = *it;
int jbar = b.getIndex();
int base = d_size*jbar + jbar;
if (b.isReal()) {
DiagonalBlock bnew(jbar, true, &p[base], &p[base],
NULL, NULL);
*it = bnew;
} else {
DiagonalBlock bnew(jbar, false, &p[base], &p[base+d_size+1],
&p[base+d_size], &p[base+1]);
*it = bnew;
}
}
}
void Diagonal::getEigenValues(Vector& eig) const
{
int d_size = getSize();
if (eig.length() != 2*d_size) {
char mes[500];
sprintf(mes, "Wrong length of vector for eigenvalues len=%d, should be=%d.\n",
eig.length(), 2*d_size);
throw SYLV_MES_EXCEPTION(mes);
}
for (const_diag_iter it = begin(); it != end(); ++it) {
const DiagonalBlock& b = *it;
int ind = b.getIndex();
eig[2*ind] = *(b.getAlpha());
if (b.isReal()) {
eig[2*ind+1] = 0.0;
} else {
double beta = sqrt(b.getSBeta());
eig[2*ind+1] = beta;
eig[2*ind+2] = eig[2*ind];
eig[2*ind+3] = -beta;
}
}
}
/* swaps logically blocks 'it', and '++it'. remember to move also
* addresses, alpha, beta1, beta2. This is a dirty (but most
* effective) way how to do it. */
void Diagonal::swapLogically(diag_iter it)
{
diag_iter itp = it;
++itp;
if ((*it).isReal() && !(*itp).isReal()) {
// first is real, second is complex
double* d1 = (*it).alpha.a1;
double* d2 = (*itp).alpha.a1;
double* d3 = (*itp).alpha.a2;
// swap
DiagonalBlock new_it((*it).jbar, d1, d2);
*it = new_it;
DiagonalBlock new_itp((*itp).jbar+1, d3);
*itp = new_itp;
} else if (!(*it).isReal() && (*itp).isReal()) {
// first is complex, second is real
double* d1 = (*it).alpha.a1;
double* d2 = (*it).alpha.a2;
double* d3 = (*itp).alpha.a1;
// swap
DiagonalBlock new_it((*it).jbar, d1);
*it = new_it;
DiagonalBlock new_itp((*itp).jbar-1, d2, d3);
*itp = new_itp;
}
}
void Diagonal::checkConsistency(diag_iter it)
{
if (!(*it).isReal() && isZero((*it).getBeta2())) {
(*it).getBeta2() = 0.0; // put exact zero
int jbar = (*it).getIndex();
double* d2 = (*it).alpha.a2;
(*it).alpha.a2 = (*it).alpha.a1;
(*it).real = true;
(*it).beta1 = 0;
(*it).beta2 = 0;
DiagonalBlock b(jbar+1, d2);
blocks.insert((++it).iter(), b);
num_real += 2;
num_all++;
}
}
double Diagonal::getAverageSize(diag_iter start, diag_iter end)
{
double res = 0;
int num = 0;
for (diag_iter run = start; run != end; ++run) {
num++;
res += (*run).getSize();
}
if (num > 0)
res = res/num;
return res;
}
Diagonal::diag_iter Diagonal::findClosestBlock(diag_iter start, diag_iter end, double a)
{
diag_iter closest = start;
double minim = 1.0e100;
for (diag_iter run = start; run != end; ++run) {
double dist = abs(a - (*run).getSize());
if (dist < minim) {
minim = dist;
closest = run;
}
}
return closest;
}
Diagonal::diag_iter Diagonal::findNextLargerBlock(diag_iter start, diag_iter end, double a)
{
diag_iter closest = start;
double minim = 1.0e100;
for (diag_iter run = start; run != end; ++run) {
double dist = (*run).getSize() - a;
if ((0 <= dist) && (dist < minim)) {
minim = dist;
closest = run;
}
}
return closest;
}
void Diagonal::print() const
{
printf("Num real: %d, num complex: %d\n",getNumReal(), getNumComplex());
for (const_diag_iter it = begin(); it != end(); ++it) {
if ((*it).isReal()) {
printf("real: jbar=%d, alpha=%f\n", (*it).getIndex(), *((*it).getAlpha()));
}
else {
printf("complex: jbar=%d, alpha=%f, beta1=%f, beta2=%f\n",
(*it).getIndex(), *((*it).getAlpha()), (*it).getBeta1(), (*it).getBeta2());
}
}
}
double Diagonal::EPS = 1.0e-300;
bool Diagonal::isZero(double p)
{
return (abs(p)<EPS);
}
QuasiTriangular::const_col_iter
QuasiTriangular::col_begin(const DiagonalBlock& b) const
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return const_col_iter(&getData()[jbar*d_size], d_size, b.isReal(), 0);
}
QuasiTriangular::col_iter
QuasiTriangular::col_begin(const DiagonalBlock& b)
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return col_iter(&getData()[jbar*d_size], d_size, b.isReal(), 0);
}
QuasiTriangular::const_row_iter
QuasiTriangular::row_begin(const DiagonalBlock& b) const
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
int off = jbar*d_size+jbar+d_size;
int col = jbar+1;
if (!b.isReal()) {
off = off + d_size;
col++;
}
return const_row_iter(&getData()[off], d_size, b.isReal(), col);
}
QuasiTriangular::row_iter
QuasiTriangular::row_begin(const DiagonalBlock& b)
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
int off = jbar*d_size+jbar+d_size;
int col = jbar+1;
if (!b.isReal()) {
off = off + d_size;
col++;
}
return row_iter(&getData()[off], d_size, b.isReal(), col);
}
QuasiTriangular::const_col_iter
QuasiTriangular::col_end(const DiagonalBlock& b) const
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return const_col_iter(getData().base()+jbar*d_size+jbar, d_size, b.isReal(),
jbar);
}
QuasiTriangular::col_iter
QuasiTriangular::col_end(const DiagonalBlock& b)
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return col_iter(&getData()[jbar*d_size+jbar], d_size, b.isReal(), jbar);
}
QuasiTriangular::const_row_iter
QuasiTriangular::row_end(const DiagonalBlock& b) const
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return const_row_iter(&getData()[d_size*d_size+jbar], d_size, b.isReal(),
d_size);
}
QuasiTriangular::row_iter
QuasiTriangular::row_end(const DiagonalBlock& b)
{
int jbar = b.getIndex();
int d_size = diagonal.getSize();
return row_iter(&getData()[d_size*d_size+jbar], d_size, b.isReal(), d_size);
}
QuasiTriangular::QuasiTriangular(double r, const QuasiTriangular& t)
: SqSylvMatrix(t.numRows()), diagonal(getData().base(), t.diagonal)
{
setMatrix(r, t);
}
QuasiTriangular::QuasiTriangular(double r, const QuasiTriangular& t,
double rr, const QuasiTriangular& tt)
: SqSylvMatrix(t.numRows()), diagonal(getData().base(), t.diagonal)
{
setMatrix(r, t);
addMatrix(rr, tt);
}
QuasiTriangular::QuasiTriangular(const QuasiTriangular& t)
: SqSylvMatrix(t), diagonal(getData().base(), t.diagonal)
{
}
QuasiTriangular::QuasiTriangular(const double* d, int d_size)
: SqSylvMatrix(d, d_size), diagonal(getData().base(), d_size)
{}
QuasiTriangular::~QuasiTriangular()
{
}
QuasiTriangular::QuasiTriangular(int p, const QuasiTriangular& t)
: SqSylvMatrix(t.numRows()), diagonal(getData().base(), t.diagonal)
{
Vector aux(t.getData());
int d_size = diagonal.getSize();
double alpha = 1.0;
double beta = 0.0;
BLAS_dgemm("N", "N", &d_size, &d_size, &d_size, &alpha, aux.base(),
&d_size, t.getData().base(), &d_size, &beta, getData().base(), &d_size);
}
QuasiTriangular::QuasiTriangular(const SchurDecomp& decomp)
: SqSylvMatrix(decomp.getT()),
diagonal(getData().base(), decomp.getDim())
{
}
/* this pads matrix with intial columns with zeros */
QuasiTriangular::QuasiTriangular(const SchurDecompZero& decomp)
: SqSylvMatrix(decomp.getDim())
{
// nullify first decomp.getZeroCols() columns
int zeros = decomp.getZeroCols()*decomp.getDim();
Vector zv(getData(), 0, zeros);
zv.zeros();
// fill right upper part with decomp.getRU()
for (int i = 0; i < decomp.getRU().numRows(); i++) {
for (int j = 0; j < decomp.getRU().numCols(); j++) {
getData()[(j+decomp.getZeroCols())*decomp.getDim()+i] = decomp.getRU().get(i,j);
}
}
// fill right lower part with decomp.getT()
for (int i = 0; i < decomp.getT().numRows(); i++) {
for (int j = 0; j < decomp.getT().numCols(); j++) {
getData()[(j+decomp.getZeroCols())*decomp.getDim()+decomp.getZeroCols()+i] =
decomp.getT().get(i,j);
}
}
// construct diagonal
Diagonal* const d = new Diagonal(getData().base(), decomp.getDim());
diagonal = *d;
delete d;
}
void QuasiTriangular::setMatrix(double r, const QuasiTriangular& t)
{
getData().zeros();
getData().add(r, t.getData());
}
void QuasiTriangular::setMatrixViaIter(double r, const QuasiTriangular& t)
{
register double rr = r;
diag_iter dil = diag_begin();
const_diag_iter dir = t.diag_begin();
for ( ; dil != diag_end(); ++dil, ++dir) {
(*dil).getAlpha() = rr*(*(*dir).getAlpha());
if (! (*dil).isReal()) {
(*dil).getBeta1() = rr*(*dir).getBeta1();
(*dil).getBeta2() = rr*(*dir).getBeta2();
}
col_iter cil = col_begin(*dil);
const_col_iter cir = t.col_begin(*dir);
for ( ; cil != col_end(*dil); ++cil, ++cir) {
if ((*dil).isReal()) {
*cil = rr*(*cir);
} else {
cil.a() = rr*cir.a();
cil.b() = rr*cir.b();
}
}
}
}
void QuasiTriangular::addMatrix(double r, const QuasiTriangular& t)
{
getData().add(r, t.getData());
}
void QuasiTriangular::addMatrixViaIter(double r, const QuasiTriangular& t)
{
register double rr = r;
diag_iter dil = diag_begin();
const_diag_iter dir = t.diag_begin();
for ( ; dil != diag_end(); ++dil, ++dir) {
(*dil).getAlpha() = (*(*dil).getAlpha()) + rr*(*(*dir).getAlpha());
if (! (*dil).isReal()) {
(*dil).getBeta1() += rr*(*dir).getBeta1();
(*dil).getBeta2() += rr*(*dir).getBeta2();
}
col_iter cil = col_begin(*dil);
const_col_iter cir = t.col_begin(*dir);
for ( ; cil != col_end(*dil); ++cil, ++cir) {
if ((*dil).isReal()) {
*cil += rr*(*cir);
} else {
cil.a() += rr*cir.a();
cil.b() += rr*cir.b();
}
}
}
}
void QuasiTriangular::addUnit()
{
for (diag_iter di = diag_begin(); di != diag_end(); ++di) {
(*di).getAlpha() = *((*di).getAlpha()) + 1.0;
}
}
void QuasiTriangular::solve(Vector& x, const ConstVector& b, double& eig_min)
{
x = b;
solvePre(x, eig_min);
}
void QuasiTriangular::solveTrans(Vector& x, const ConstVector& b, double& eig_min)
{
x = b;
solvePreTrans(x, eig_min);
}
void QuasiTriangular::solvePre(Vector& x, double& eig_min)
{
addUnit();
for (diag_iter di = diag_begin(); di != diag_end(); ++di) {
double eig_size;
if (!(*di).isReal()) {
eig_size = (*di).getDeterminant();
eliminateLeft((*di).getIndex()+1, (*di).getIndex(), x);
} else {
eig_size = *(*di).getAlpha()*(*(*di).getAlpha());
}
if (eig_size < eig_min)
eig_min = eig_size;
}
int nn = diagonal.getSize();
int lda = diagonal.getSize();
int incx = x.skip();
BLAS_dtrsv("U", "N", "N", &nn, getData().base(), &lda, x.base(), &incx);
}
void QuasiTriangular::solvePreTrans(Vector& x, double& eig_min)
{
addUnit();
for (diag_iter di = diag_begin(); di != diag_end(); ++di) {
double eig_size;
if (!(*di).isReal()) {
eig_size = (*di).getDeterminant();
eliminateRight((*di).getIndex()+1, (*di).getIndex(), x);
} else {
eig_size = *(*di).getAlpha()*(*(*di).getAlpha());
}
if (eig_size < eig_min)
eig_min = eig_size;
}
int nn = diagonal.getSize();
int lda = diagonal.getSize();
int incx = x.skip();
BLAS_dtrsv("U", "T", "N", &nn, getData().base(), &lda, x.base(), &incx);
}
/* calculates x = Tb */
void QuasiTriangular::multVec(Vector& x, const ConstVector& b) const
{
x = b;
int nn = diagonal.getSize();
int lda = diagonal.getSize();
int incx = x.skip();
BLAS_dtrmv("U", "N", "N", &nn, getData().base(), &lda, x.base(), &incx);
for (const_diag_iter di = diag_begin(); di != diag_end(); ++di) {
if (!(*di).isReal()) {
int jbar = (*di).getIndex();
x[jbar+1] += (*di).getBeta2()*(b[jbar]);
}
}
}
void QuasiTriangular::multVecTrans(Vector& x, const ConstVector& b) const
{
x = b;
int nn = diagonal.getSize();
int lda = diagonal.getSize();
int incx = x.skip();
BLAS_dtrmv("U", "T", "N", &nn, getData().base(), &lda, x.base(), &incx);
for (const_diag_iter di = diag_begin(); di != diag_end(); ++di) {
if (!(*di).isReal()) {
int jbar = (*di).getIndex();
x[jbar] += (*di).getBeta2()*b[jbar+1];
}
}
}
void QuasiTriangular::multaVec(Vector& x, const ConstVector& b) const
{
Vector tmp((const Vector&) x); // new copy
multVec(x, b);
x.add(1.0, tmp);
}
void QuasiTriangular::multaVecTrans(Vector& x, const ConstVector& b) const
{
Vector tmp((const Vector&) x); // new copy
multVecTrans(x, b);
x.add(1.0, tmp);
}
/* calculates x=x+(T\otimes I)b, where size of I is given by b (KronVector) */
void QuasiTriangular::multaKron(KronVector& x, const ConstKronVector& b) const
{
int id = b.getN()*power(b.getM(), b.getDepth()-1);
ConstGeneralMatrix b_resh(b.base(), id, b.getM());
GeneralMatrix x_resh(x.base(), id, b.getM());
x_resh.multAndAdd(b_resh, ConstGeneralMatrix(*this), "trans");
}
/* calculates x=x+(T'\otimes I)b, where size of I is given by b (KronVector) */
void
QuasiTriangular::multaKronTrans(KronVector& x, const ConstKronVector& b) const
{
int id = b.getN()*power(b.getM(), b.getDepth()-1);
ConstGeneralMatrix b_resh(b.base(), id, b.getM());
GeneralMatrix x_resh(x.base(), id, b.getM());
x_resh.multAndAdd(b_resh, ConstGeneralMatrix(*this));
}
void QuasiTriangular::multKron(KronVector& x) const
{
KronVector b((const KronVector&)x); // make copy
x.zeros();
multaKron(x, b);
}
void
QuasiTriangular::multKronTrans(KronVector& x) const
{
KronVector b((const KronVector&)x); // make copy
x.zeros();
multaKronTrans(x, b);
}
void QuasiTriangular::multLeftOther(GeneralMatrix& a) const
{
a.multLeft(*this);
}
void QuasiTriangular::multLeftOtherTrans(GeneralMatrix& a) const
{
a.multLeftTrans(*this);
}
void QuasiTriangular::swapDiagLogically(diag_iter it)
{
diagonal.swapLogically(it);
}
void QuasiTriangular::checkDiagConsistency(diag_iter it)
{
diagonal.checkConsistency(it);
}
double QuasiTriangular::getAverageDiagSize(diag_iter start, diag_iter end)
{
return diagonal.getAverageSize(start, end);
}
QuasiTriangular::diag_iter
QuasiTriangular::findClosestDiagBlock(diag_iter start, diag_iter end, double a)
{
return diagonal.findClosestBlock(start, end, a);
}
QuasiTriangular::diag_iter
QuasiTriangular::findNextLargerBlock(diag_iter start, diag_iter end, double a)
{
return diagonal.findNextLargerBlock(start, end, a);
}
int QuasiTriangular::getNumOffdiagonal() const
{
return diagonal.getSize()*(diagonal.getSize()-1)/2 - diagonal.getNumComplex();
}

339
mex/sources/korderpert/Dyn_pp/sylv/cc/QuasiTriangular.h Normal file
View File

@ -0,0 +1,339 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/QuasiTriangular.h,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef QUASI_TRIANGULAR_H
#define QUASI_TRIANGULAR_H
#include "Vector.h"
#include "KronVector.h"
#include "SylvMatrix.h"
#include <list>
using namespace std;
class DiagonalBlock;
class Diagonal;
class DiagPair {
private:
double* a1;
double* a2;
public:
DiagPair() {}
DiagPair(double* aa1, double* aa2) {a1 = aa1; a2 = aa2;}
DiagPair(const DiagPair& p) {a1 = p.a1; a2 = p.a2;}
const DiagPair& operator=(const DiagPair& p) {a1 = p.a1; a2 = p.a2; return *this;}
const DiagPair& operator=(double v) {*a1 = v; *a2 = v; return *this;}
const double& operator*() const {return *a1;}
/** here we must not define double& operator*(), since it wouldn't
rewrite both values, we use operator= for this */
friend class Diagonal;
friend class DiagonalBlock;
};
class DiagonalBlock {
private:
int jbar;
bool real;
DiagPair alpha;
double* beta1;
double* beta2;
void copy(const DiagonalBlock& b) {
jbar = b.jbar;
real = b.real;
alpha = b.alpha;
beta1 = b.beta1;
beta2 = b.beta2;
}
public:
DiagonalBlock() {}
DiagonalBlock(int jb, bool r, double* a1, double* a2,
double* b1, double* b2)
: alpha(a1, a2)
{
jbar = jb;
real = r;
beta1 = b1;
beta2 = b2;
}
// construct complex block
DiagonalBlock(int jb, double* a1, double* a2)
: alpha(a1, a2)
{
jbar = jb;
real = false;
beta1 = a2 - 1;
beta2 = a1 + 1;
}
// construct real block
DiagonalBlock(int jb, double* a1)
: alpha(a1, a1)
{
jbar = jb;
real = true;
beta1 = 0;
beta2 = 0;
}
DiagonalBlock(const DiagonalBlock& b)
{copy(b);}
const DiagonalBlock& operator=(const DiagonalBlock& b)
{copy(b); return *this;}
int getIndex() const
{return jbar;}
bool isReal() const
{return real;}
const DiagPair& getAlpha() const
{return alpha;}
DiagPair& getAlpha()
{return alpha;}
double& getBeta1() const
{return *beta1;}
double& getBeta2() const
{return *beta2;}
double getDeterminant() const;
double getSBeta() const;
double getSize() const;
void setReal();
// for debugging
void checkBlock(const double* d, int d_size);
friend class Diagonal;
};
template <class _Tdiag, class _Tblock, class _Titer>
struct _diag_iter {
typedef _diag_iter<_Tdiag, _Tblock, _Titer> _Self;
_Tdiag diag;
_Titer it;
public:
_diag_iter(_Tdiag d, _Titer iter) : diag(d), it(iter) {}
_Tblock operator*() const {return *it;}
_Self& operator++() {++it; return *this;}
_Self& operator--() {--it; return *this;}
bool operator==(const _Self& x) const {return x.it == it;}
bool operator!=(const _Self& x) const {return x.it != it;}
const _Self& operator=(const _Self& x) {it = x.it; return *this;}
_Titer iter() const {return it;}
};
class Diagonal {
public:
typedef _diag_iter<const Diagonal&, const DiagonalBlock&, list<DiagonalBlock>::const_iterator> const_diag_iter;
typedef _diag_iter<Diagonal&, DiagonalBlock&, list<DiagonalBlock>::iterator> diag_iter;
private:
int num_all;
list<DiagonalBlock> blocks;
int num_real;
void copy(const Diagonal&);
public:
Diagonal() : num_all(0), num_real(0) {}
Diagonal(double* data, int d_size);
Diagonal(double* data, const Diagonal& d);
Diagonal(const Diagonal& d) {copy(d);}
const Diagonal& operator =(const Diagonal& d) {copy(d); return *this;}
virtual ~Diagonal() {}
int getNumComplex() const {return num_all - num_real;}
int getNumReal() const {return num_real;}
int getSize() const {return getNumReal() + 2*getNumComplex();}
int getNumBlocks() const {return num_all;}
void getEigenValues(Vector& eig) const;
void swapLogically(diag_iter it);
void checkConsistency(diag_iter it);
double getAverageSize(diag_iter start, diag_iter end);
diag_iter findClosestBlock(diag_iter start, diag_iter end, double a);
diag_iter findNextLargerBlock(diag_iter start, diag_iter end, double a);
void print() const;
diag_iter begin()
{return diag_iter(*this, blocks.begin());}
const_diag_iter begin() const
{return const_diag_iter(*this, blocks.begin());}
diag_iter end()
{return diag_iter(*this, blocks.end());}
const_diag_iter end() const
{return const_diag_iter(*this, blocks.end());}
/* redefine pointers as data start at p */
void changeBase(double* p);
private:
static double EPS;
static int getNumComplex(const double* data, int d_size);
static bool isZero(double p);
};
template <class _TRef, class _TPtr>
struct _matrix_iter {
typedef _matrix_iter<_TRef, _TPtr> _Self;
int d_size;
bool real;
_TPtr ptr;
public:
_matrix_iter(_TPtr base, int ds, bool r)
{ptr = base; d_size = ds; real = r;}
virtual ~_matrix_iter() {}
const _Self& operator=(const _Self& it)
{ptr = it.ptr; d_size = it.d_size; real = it.real; return *this;}
bool operator==(const _Self& it) const
{return ptr == it.ptr;}
bool operator!=(const _Self& it) const
{return ptr != it.ptr;}
_TRef operator*() const
{return *ptr;}
_TRef a() const
{return *ptr;}
virtual _Self& operator++() =0;
};
template <class _TRef, class _TPtr>
class _column_iter : public _matrix_iter<_TRef, _TPtr> {
typedef _matrix_iter<_TRef, _TPtr> _Tparent;
typedef _column_iter<_TRef, _TPtr> _Self;
int row;
public:
_column_iter(_TPtr base, int ds, bool r, int rw)
: _matrix_iter<_TRef, _TPtr>(base, ds, r), row(rw) {};
_Self& operator++()
{_Tparent::ptr++; row++; return *this;}
_TRef b() const
{
if (_Tparent::real) {
return *(_Tparent::ptr);
} else {
return *(_Tparent::ptr+_Tparent::d_size);
}
}
int getRow() const {return row;}
};
template <class _TRef, class _TPtr>
class _row_iter : public _matrix_iter<_TRef, _TPtr> {
typedef _matrix_iter<_TRef, _TPtr> _Tparent;
typedef _row_iter<_TRef, _TPtr> _Self;
int col;
public:
_row_iter(_TPtr base, int ds, bool r, int cl)
: _matrix_iter<_TRef, _TPtr>(base, ds, r), col(cl) {};
_Self& operator++()
{_Tparent::ptr += _Tparent::d_size; col++; return *this;}
virtual _TRef b() const
{
if (_Tparent::real) {
return *(_Tparent::ptr);
}else {
return *(_Tparent::ptr+1);
}
}
int getCol() const {return col;}
};
class SchurDecomp;
class SchurDecompZero;
class QuasiTriangular : public SqSylvMatrix {
public:
typedef _column_iter<const double&, const double*> const_col_iter;
typedef _column_iter<double&, double*> col_iter;
typedef _row_iter<const double&, const double*> const_row_iter;
typedef _row_iter<double&, double*> row_iter;
typedef Diagonal::const_diag_iter const_diag_iter;
typedef Diagonal::diag_iter diag_iter;
protected:
Diagonal diagonal;
public:
QuasiTriangular(const double* d, int d_size);
QuasiTriangular(double r, const QuasiTriangular& t);
QuasiTriangular(double r, const QuasiTriangular& t,
double rr, const QuasiTriangular& tt);
QuasiTriangular(int p, const QuasiTriangular& t);
QuasiTriangular(const SchurDecomp& decomp);
QuasiTriangular(const SchurDecompZero& decomp);
QuasiTriangular(const QuasiTriangular& t);
virtual ~QuasiTriangular();
const Diagonal& getDiagonal() const {return diagonal;}
int getNumOffdiagonal() const;
void swapDiagLogically(diag_iter it);
void checkDiagConsistency(diag_iter it);
double getAverageDiagSize(diag_iter start, diag_iter end);
diag_iter findClosestDiagBlock(diag_iter start, diag_iter end, double a);
diag_iter findNextLargerBlock(diag_iter start, diag_iter end, double a);
/* (I+T)y = x, y-->x */
virtual void solvePre(Vector& x, double& eig_min);
/* (I+T')y = x, y-->x */
virtual void solvePreTrans(Vector& x, double& eig_min);
/* (I+T)x = b */
virtual void solve(Vector& x, const ConstVector& b, double& eig_min);
/* (I+T')x = b */
virtual void solveTrans(Vector& x, const ConstVector& b, double& eig_min);
/* x = Tb */
virtual void multVec(Vector& x, const ConstVector& b) const;
/* x = T'b */
virtual void multVecTrans(Vector& x, const ConstVector& b) const;
/* x = x + Tb */
virtual void multaVec(Vector& x, const ConstVector& b) const;
/* x = x + T'b */
virtual void multaVecTrans(Vector& x, const ConstVector& b) const;
/* x = (T\otimes I)x */
virtual void multKron(KronVector& x) const;
/* x = (T'\otimes I)x */
virtual void multKronTrans(KronVector& x) const;
/* A = T*A */
virtual void multLeftOther(GeneralMatrix& a) const;
/* A = T'*A */
virtual void multLeftOtherTrans(GeneralMatrix& a) const;
const_diag_iter diag_begin() const
{return diagonal.begin();}
diag_iter diag_begin()
{return diagonal.begin();}
const_diag_iter diag_end() const
{return diagonal.end();}
diag_iter diag_end()
{return diagonal.end();}
/* iterators for off diagonal elements */
virtual const_col_iter col_begin(const DiagonalBlock& b) const;
virtual col_iter col_begin(const DiagonalBlock& b);
virtual const_row_iter row_begin(const DiagonalBlock& b) const;
virtual row_iter row_begin(const DiagonalBlock& b);
virtual const_col_iter col_end(const DiagonalBlock& b) const;
virtual col_iter col_end(const DiagonalBlock& b);
virtual const_row_iter row_end(const DiagonalBlock& b) const;
virtual row_iter row_end(const DiagonalBlock& b);
/* clone */
virtual QuasiTriangular* clone() const
{return new QuasiTriangular(*this);}
virtual QuasiTriangular* clone(int p, const QuasiTriangular& t) const
{return new QuasiTriangular(p, t);}
virtual QuasiTriangular* clone(double r) const
{return new QuasiTriangular(r, *this);}
virtual QuasiTriangular* clone(double r, double rr, const QuasiTriangular& tt) const
{return new QuasiTriangular(r, *this, rr, tt);}
protected:
void setMatrix(double r, const QuasiTriangular& t);
void addMatrix(double r, const QuasiTriangular& t);
private:
void addUnit();
/* x = x + (T\otimes I)b */
void multaKron(KronVector& x, const ConstKronVector& b) const;
/* x = x + (T'\otimes I)b */
void multaKronTrans(KronVector& x, const ConstKronVector& b) const;
/* implementation via iterators, useful for large matrices */
void setMatrixViaIter(double r, const QuasiTriangular& t);
void addMatrixViaIter(double r, const QuasiTriangular& t);
/* hide noneffective implementations of parents */
void multsVec(Vector& x, const ConstVector& d) const;
void multsVecTrans(Vector& x, const ConstVector& d) const;
};
#endif /* QUASI_TRIANGULAR_H */
// Local Variables:
// mode:C++
// End:

148
mex/sources/korderpert/Dyn_pp/sylv/cc/QuasiTriangularZero.cpp Normal file
View File

@ -0,0 +1,148 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/QuasiTriangularZero.cpp,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#include "QuasiTriangularZero.h"
#include "SchurDecomp.h"
#include "SylvMatrix.h"
#include "SylvException.h"
#include <stdio.h>
QuasiTriangularZero::QuasiTriangularZero(int num_zeros, const double* d,
int d_size)
: QuasiTriangular(SqSylvMatrix(GeneralMatrix(d, num_zeros+d_size, d_size),
num_zeros, 0, d_size).getData().base(),
d_size),
nz(num_zeros),
ru(GeneralMatrix(d, num_zeros+d_size, d_size), 0, 0, num_zeros, d_size)
{
}
QuasiTriangularZero::QuasiTriangularZero(double r,
const QuasiTriangularZero& t)
: QuasiTriangular(r, t),
nz(t.nz),
ru(t.ru)
{
ru.mult(r);
}
QuasiTriangularZero::QuasiTriangularZero(double r,
const QuasiTriangularZero& t,
double rr,
const QuasiTriangularZero& tt)
: QuasiTriangular(r, t, rr, tt),
nz(t.nz),
ru(t.ru)
{
ru.mult(r);
ru.add(rr, tt.ru);
}
QuasiTriangularZero::QuasiTriangularZero(int p, const QuasiTriangularZero& t)
: QuasiTriangular(p, t),
nz(t.nz),
ru(t.ru)
{
ru.multRight(t);
}
QuasiTriangularZero::QuasiTriangularZero(const SchurDecompZero& decomp)
: QuasiTriangular(decomp.getT().getData().base(),
decomp.getT().numRows()),
nz(decomp.getZeroCols()),
ru(decomp.getRU())
{
}
QuasiTriangularZero::QuasiTriangularZero(const QuasiTriangular& t)
: QuasiTriangular(t),
nz(0), ru(0, t.getDiagonal().getSize())
{
}
QuasiTriangularZero::~QuasiTriangularZero()
{
}
void QuasiTriangularZero::solvePre(Vector& x, double& eig_min)
{
Vector xu(x, 0, nz);
Vector xl(x, nz, x.length()-nz);
QuasiTriangular::solvePre(xl, eig_min);
ru.multsVec(xu, xl);
if (nz > 0)
eig_min = (eig_min > 1.0)? 1.0 : eig_min;
}
void QuasiTriangularZero::solvePreTrans(Vector& x, double& eig_min)
{
Vector xu(x, 0, nz);
Vector xl(x, nz, x.length()-nz);
ru.multsVecTrans(xl, xu);
QuasiTriangular::solvePreTrans(xl, eig_min);
if (nz > 0)
eig_min = (eig_min > 1.0)? 1.0 : eig_min;
}
void QuasiTriangularZero::multVec(Vector& x, const ConstVector& b) const
{
x.zeros();
multaVec(x, b);
}
void QuasiTriangularZero::multVecTrans(Vector& x, const ConstVector& b) const
{
x.zeros();
multaVecTrans(x, b);
}
void QuasiTriangularZero::multaVec(Vector& x, const ConstVector& b) const
{
ConstVector bl(b, nz, b.length()-nz);
Vector xu(x, 0, nz);
Vector xl(x, nz, x.length()-nz);
xu.zeros();
ru.multaVec(xu, bl);
QuasiTriangular::multVec(xl, bl);
}
void QuasiTriangularZero::multaVecTrans(Vector& x, const ConstVector& b) const
{
ConstVector bu(b, 0, b.length());
ConstVector bl(b, nz, b.length()-nz);
Vector xu(x, 0, nz);
Vector xl(x, nz, x.length()-nz);
xu.zeros();
QuasiTriangular::multVecTrans(xl, bl);
ru.multaVecTrans(xl, bu);
}
void QuasiTriangularZero::multLeftOther(GeneralMatrix& a) const
{
GeneralMatrix a1(a, 0, 0, nz, a.numCols());
GeneralMatrix a2(a, nz, 0, a.numRows()-nz, a.numCols());
a1.mult(ru, a2);
QuasiTriangular::multLeftOther(a2);
}
void QuasiTriangularZero::print() const
{
printf("super=\n");
QuasiTriangular::print();
printf("nz=%d\n",nz);
printf("ru=\n");
ru.print();
}
void QuasiTriangularZero::multKron(KronVector& x) const
{
throw SYLV_MES_EXCEPTION("Attempt to run QuasiTriangularZero::multKron.");
}
void QuasiTriangularZero::multKronTrans(KronVector& x) const
{
throw SYLV_MES_EXCEPTION("Attempt to run QuasiTriangularZero::multKronTrans.");
}

48
mex/sources/korderpert/Dyn_pp/sylv/cc/QuasiTriangularZero.h Normal file
View File

@ -0,0 +1,48 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/QuasiTriangularZero.h,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef QUASI_TRIANGULAR_ZERO_H
#define QUASI_TRIANGULAR_ZERO_H
#include "QuasiTriangular.h"
#include "GeneralMatrix.h"
class QuasiTriangularZero : public QuasiTriangular {
int nz; // number of zero columns
GeneralMatrix ru; // data in right upper part (nz,d_size)
public:
QuasiTriangularZero(int num_zeros, const double* d, int d_size);
QuasiTriangularZero(double r, const QuasiTriangularZero& t);
QuasiTriangularZero(double r, const QuasiTriangularZero& t,
double rr, const QuasiTriangularZero& tt);
QuasiTriangularZero(int p, const QuasiTriangularZero& t);
QuasiTriangularZero(const QuasiTriangular& t);
QuasiTriangularZero(const SchurDecompZero& decomp);
~QuasiTriangularZero();
void solvePre(Vector& x, double& eig_min);
void solvePreTrans(Vector& x, double& eig_min);
void multVec(Vector& x, const ConstVector& b) const;
void multVecTrans(Vector& x, const ConstVector& b) const;
void multaVec(Vector& x, const ConstVector& b) const;
void multaVecTrans(Vector& x, const ConstVector& b) const;
void multKron(KronVector& x) const;
void multKronTrans(KronVector& x) const;
void multLeftOther(GeneralMatrix& a) const;
/* clone */
virtual QuasiTriangular* clone() const
{return new QuasiTriangularZero(*this);}
virtual QuasiTriangular* clone(int p, const QuasiTriangular& t) const
{return new QuasiTriangularZero(p, (const QuasiTriangularZero&)t);}
virtual QuasiTriangular* clone(double r) const
{return new QuasiTriangularZero(r, *this);}
virtual QuasiTriangular* clone(double r, double rr, const QuasiTriangular& tt) const
{return new QuasiTriangularZero(r, *this, rr, (const QuasiTriangularZero&)tt);}
void print() const;
};
#endif /* QUASI_TRIANGULAR_ZERO_H */
// Local Variables:
// mode:C++
// End:

71
mex/sources/korderpert/Dyn_pp/sylv/cc/SchurDecomp.cpp Normal file
View File

@ -0,0 +1,71 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SchurDecomp.cpp,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#include "SchurDecomp.h"
#include "cpplapack.h"
SchurDecomp::SchurDecomp(const SqSylvMatrix& m)
: q_destroy(true), t_destroy(true)
{
int rows = m.numRows();
q = new SqSylvMatrix(rows);
SqSylvMatrix auxt(m);
int sdim;
double* const wr = new double[rows];
double* const wi = new double[rows];
int lwork = 6*rows;
double* const work = new double[lwork];
int info;
LAPACK_dgees("V", "N", 0, &rows, auxt.base(), &rows, &sdim,
wr, wi, q->base(), &rows,
work, &lwork, 0, &info);
delete [] work;
delete [] wi;
delete [] wr;
t = new QuasiTriangular(auxt.base(), rows);
}
SchurDecomp::SchurDecomp(const QuasiTriangular& tr)
: q_destroy(true), t_destroy(true)
{
q = new SqSylvMatrix(tr.numRows());
q->setUnit();
t = new QuasiTriangular(tr);
}
SchurDecomp::SchurDecomp(QuasiTriangular& tr)
: q_destroy(true), t_destroy(false)
{
q = new SqSylvMatrix(tr.numRows());
q->setUnit();
t = &tr;
}
SchurDecomp::~SchurDecomp()
{
if (t_destroy)
delete t;
if (q_destroy)
delete q;
}
int SchurDecomp::getDim() const
{
return t->numRows();
}
SchurDecompZero::SchurDecompZero(const GeneralMatrix& m)
: SchurDecomp(SqSylvMatrix(m, m.numRows()-m.numCols(), 0, m.numCols())),
ru(m, 0, 0, m.numRows()-m.numCols(), m.numCols())
{
ru.multRight(getQ());
}
int SchurDecompZero::getDim() const
{
return getT().numRows()+ru.numRows();
}

43
mex/sources/korderpert/Dyn_pp/sylv/cc/SchurDecomp.h Normal file
View File

@ -0,0 +1,43 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SchurDecomp.h,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef SCHUR_DECOMP_H
#define SCHUR_DECOMP_H
#include "SylvMatrix.h"
#include "QuasiTriangular.h"
class QuasiTriangular;
class SchurDecomp {
bool q_destroy;
SqSylvMatrix* q;
bool t_destroy;
QuasiTriangular* t;
public:
SchurDecomp(const SqSylvMatrix& m);
SchurDecomp(const QuasiTriangular& tr);
SchurDecomp(QuasiTriangular& tr);
const SqSylvMatrix& getQ() const {return *q;}
const QuasiTriangular& getT() const {return *t;}
SqSylvMatrix& getQ() {return *q;}
QuasiTriangular& getT() {return *t;}
virtual int getDim() const;
virtual ~SchurDecomp();
};
class SchurDecompZero : public SchurDecomp {
GeneralMatrix ru; /* right upper matrix */
public:
SchurDecompZero(const GeneralMatrix& m);
const GeneralMatrix& getRU() const {return ru;}
int getDim() const;
int getZeroCols() const {return ru.numRows();}
};
#endif /* SCHUR_DECOMP_H */
// Local Variables:
// mode:C++
// End:

91
mex/sources/korderpert/Dyn_pp/sylv/cc/SchurDecompEig.cpp Normal file
View File

@ -0,0 +1,91 @@
#include "SchurDecompEig.h"
#include "SylvException.h"
#include "cpplapack.h"
/* bubble diagonal 1-1, or 2-2 block from position 'from' to position
* 'to'. If an eigenvalue cannot be swapped with its neighbour, the
* neighbour is bubbled also in front. The method returns a new
* position 'to', where the original block pointed by 'to' happens to
* appear at the end. 'from' must be greater than 'to'.
*/
SchurDecompEig::diag_iter
SchurDecompEig::bubbleEigen(diag_iter from, diag_iter to)
{
diag_iter run = from;
while (run != to) {
diag_iter runm = run;
if (!tryToSwap(run, runm) && runm == to) {
++to;
} else {
// bubble all eigenvalues from runm(incl.) to run(excl.),
// this includes either bubbling generated eigenvalues due
// to split, or an eigenvalue which couldn't be swapped
while (runm != run) {
to = bubbleEigen(runm, to);
++runm;
}
}
}
return to;
}
/* this tries to swap two neighbouring eigenvalues, 'it' and '--it',
* and returns 'itadd'. If the blocks can be swapped, new eigenvalues
* can emerge due to possible 2-2 block splits. 'it' then points to
* the last eigenvalue coming from block pointed by 'it' at the
* begining, and 'itadd' points to the first. On swap failure, 'it' is
* not changed, and 'itadd' points to previous eignevalue (which must
* be moved backwards before). In either case, it is necessary to
* resolve eigenvalues from 'itadd' to 'it', before the 'it' can be
* resolved.
* The success is signaled by returned true.
*/
bool SchurDecompEig::tryToSwap(diag_iter& it, diag_iter& itadd)
{
itadd = it;
--itadd;
int n = getDim();
int ifst = (*it).getIndex() + 1;
int ilst = (*itadd).getIndex() + 1;
double* work = new double[n];
int info;
LAPACK_dtrexc("V", &n, getT().base(), &n, getQ().base(), &n, &ifst, &ilst, work,
&info);
delete [] work;
if (info < 0) {
throw SYLV_MES_EXCEPTION("Wrong argument to LAPACK_dtrexc.");
}
if (info == 0) {
// swap successful
getT().swapDiagLogically(itadd);
//check for 2-2 block splits
getT().checkDiagConsistency(it);
getT().checkDiagConsistency(itadd);
// and go back by 'it' in NEW eigenvalue set
--it;
return true;
}
return false;
}
void SchurDecompEig::orderEigen()
{
diag_iter run = getT().diag_begin();
diag_iter runp = run;
++runp;
double last_size = 0.0;
while (runp != getT().diag_end()) {
diag_iter least = getT().findNextLargerBlock(run, getT().diag_end(),
last_size);
last_size = (*least).getSize();
if (run == least)
++run;
else
run = bubbleEigen(least, run);
runp = run;
++runp;
}
}

31
mex/sources/korderpert/Dyn_pp/sylv/cc/SchurDecompEig.h Normal file
View File

@ -0,0 +1,31 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SchurDecompEig.h,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
// contains algorithms for eigenvalue reordering
#ifndef SCHUR_DECOMP_EIG_H
#define SCHUR_DECOMP_EIG_H
#include "SchurDecomp.h"
#include "QuasiTriangular.h"
class SchurDecompEig : public SchurDecomp {
public:
typedef QuasiTriangular::diag_iter diag_iter;
SchurDecompEig(const SqSylvMatrix& m) : SchurDecomp(m) {}
SchurDecompEig(const QuasiTriangular& tr) : SchurDecomp(tr) {};
SchurDecompEig(QuasiTriangular& tr) : SchurDecomp(tr) {}
diag_iter bubbleEigen(diag_iter from, diag_iter to);
void orderEigen();
protected:
bool tryToSwap(diag_iter& it, diag_iter& itadd);
};
#endif /* SCHUR_DECOMP_EIG_H */
// Local Variables:
// mode:C++
// End:

160
mex/sources/korderpert/Dyn_pp/sylv/cc/SimilarityDecomp.cpp Normal file
View File

@ -0,0 +1,160 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SimilarityDecomp.cpp,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#include "SimilarityDecomp.h"
#include "SchurDecomp.h"
#include "SchurDecompEig.h"
#include "SylvException.h"
#include "cpplapack.h"
#include <cmath>
SimilarityDecomp::SimilarityDecomp(const double* d, int d_size, double log10norm)
{
SchurDecomp sd(SqSylvMatrix(d, d_size));
q = new SqSylvMatrix(sd.getQ());
b = new BlockDiagonal(sd.getT());
invq = new SqSylvMatrix(d_size);
invq->setUnit();
invq->multLeftTrans(sd.getQ());
double norm = pow(10.0, log10norm);
diagonalize(norm);
}
SimilarityDecomp::~SimilarityDecomp()
{
delete invq;
delete b;
delete q;
}
void SimilarityDecomp::getXDim(diag_iter start, diag_iter end,
int &rows, int& cols) const
{
int si = (*start).getIndex();
int ei = (*end).getIndex();
cols = b->numRows() - ei;
rows = ei - si;
}
/* find solution of X for diagonal block given by start(incl.) and
* end(excl.). If the solution cannot be found, or it is greater than
* norm, X is not changed and flase is returned.
*/
bool SimilarityDecomp::solveX(diag_iter start, diag_iter end,
GeneralMatrix& X, double norm) const
{
int si = (*start).getIndex();
int ei = (*end).getIndex();
SqSylvMatrix A((const GeneralMatrix&)*b, si, si, X.numRows());
SqSylvMatrix B((const GeneralMatrix&)*b, ei, ei, X.numCols());
GeneralMatrix C((const GeneralMatrix&)*b, si, ei, X.numRows(), X.numCols());
int isgn = -1;
int m = A.numRows();
int n = B.numRows();
double scale;
int info;
LAPACK_dtrsyl("N", "N", &isgn, &m, &n, A.base(), &m, B.base(), &n,
C.base(), &m, &scale, &info);
if (info < -1)
throw SYLV_MES_EXCEPTION("Wrong parameter to LAPACK dtrsyl.");
if (info == 1 || scale < 1)
return false;
if (C.getData().getMax() > norm)
return false;
X = C;
return true;
}
/* multiply Q and invQ with (I -X; 0 I), and (I X; 0 I). This also sets X=-X. */
void SimilarityDecomp::updateTransform(diag_iter start, diag_iter end,
GeneralMatrix& X)
{
int si = (*start).getIndex();
int ei = (*end).getIndex();
SqSylvMatrix iX(q->numRows());
iX.setUnit();
iX.place(X, si, ei);
invq->GeneralMatrix::multLeft(iX);
iX.setUnit();
X.mult(-1.0);
iX.place(X, si, ei);
q->multRight(iX);
}
void SimilarityDecomp::bringGuiltyBlock(diag_iter start, diag_iter& end)
{
double av = b->getAverageDiagSize(start, end);
diag_iter guilty = b->findClosestDiagBlock(end, b->diag_end(), av);
SchurDecompEig sd((QuasiTriangular&)*b); // works on b including diagonal structure
end = sd.bubbleEigen(guilty, end); // iterators are valid
++end;
q->multRight(sd.getQ());
invq->multLeftTrans(sd.getQ());
}
void SimilarityDecomp::diagonalize(double norm)
{
diag_iter start = b->diag_begin();
diag_iter end = start;
++end;
while (end != b->diag_end()) {
int xrows;
int xcols;
getXDim(start, end, xrows, xcols);
GeneralMatrix X(xrows, xcols);
if (solveX(start, end, X, norm)) {
updateTransform(start, end, X);
b->setZeroBlockEdge(end);
start = end;
++end;
} else {
bringGuiltyBlock(start, end); // moves with end
}
}
}
void SimilarityDecomp::check(SylvParams& pars, const GeneralMatrix& m) const
{
// M - Q*B*inv(Q)
SqSylvMatrix c(getQ(), getB());
c.multRight(getInvQ());
c.add(-1.0, m);
pars.f_err1 = c.getNorm1();
pars.f_errI = c.getNormInf();
// I - Q*inv(Q)
c.setUnit();
c.mult(-1);
c.multAndAdd(getQ(), getInvQ());
pars.viv_err1 = c.getNorm1();
pars.viv_errI = c.getNormInf();
// I - inv(Q)*Q
c.setUnit();
c.mult(-1);
c.multAndAdd(getInvQ(), getQ());
pars.ivv_err1 = c.getNorm1();
pars.ivv_errI = c.getNormInf();
}
void SimilarityDecomp::infoToPars(SylvParams& pars) const
{
pars.f_blocks = getB().getNumBlocks();
pars.f_largest = getB().getLargestBlock();
pars.f_zeros = getB().getNumZeros();
pars.f_offdiag = getB().getNumOffdiagonal();
}
// Local Variables:
// mode:C++
// End:

41
mex/sources/korderpert/Dyn_pp/sylv/cc/SimilarityDecomp.h Normal file
View File

@ -0,0 +1,41 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SimilarityDecomp.h,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef SIMILARITY_DECOMP_H
#define SIMILARITY_DECOMP_H
#include "SylvMatrix.h"
#include "BlockDiagonal.h"
#include "SylvParams.h"
class SimilarityDecomp {
SqSylvMatrix* q;
BlockDiagonal* b;
SqSylvMatrix* invq;
typedef BlockDiagonal::diag_iter diag_iter;
public:
SimilarityDecomp(const double* d, int d_size, double log10norm = 3.0);
virtual ~SimilarityDecomp();
const SqSylvMatrix& getQ() const
{return *q;}
const SqSylvMatrix& getInvQ() const
{return *invq;}
const BlockDiagonal& getB() const
{return *b;}
void check(SylvParams& pars, const GeneralMatrix& m) const;
void infoToPars(SylvParams& pars) const;
protected:
void getXDim(diag_iter start, diag_iter end, int& rows, int& cols) const;
bool solveX(diag_iter start, diag_iter end, GeneralMatrix& X, double norm) const;
void updateTransform(diag_iter start, diag_iter end, GeneralMatrix& X);
void bringGuiltyBlock(diag_iter start, diag_iter& end);
void diagonalize(double norm);
};
#endif /* SIMILARITY_DECOMP_H */
// Local Variables:
// mode:C++
// End:

69
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvException.cpp Normal file
View File

@ -0,0 +1,69 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvException.cpp,v 1.2 2004/10/01 10:30:40 kamenik Exp $ */
/* Tag $Name: $ */
#include "SylvException.h"
#include <string.h>
#include <stdio.h>
SylvException::SylvException(const char* f, int l, const SylvException* s)
{
strcpy(file,f);
line = l;
source = s;
}
SylvException::~SylvException()
{
if (source != NULL) {
delete source;
}
}
void SylvException::printMessage() const
{
char mes[1500];
mes[0] = '\0';
printMessage(mes, 1499);
printf(mes);
}
int SylvException::printMessage(char* str, int maxlen) const
{
int remain = maxlen;
if (source != NULL) {
remain = source->printMessage(str, maxlen);
}
char aux[100];
sprintf(aux, "From %s:%d\n", file, line);
int newremain = remain - strlen(aux);
if (newremain < 0) {
aux[remain] = '\0';
newremain = 0;
}
strcat(str, aux);
return newremain;
}
SylvExceptionMessage::SylvExceptionMessage(const char* f, int i,
const char* mes)
: SylvException(f,i,NULL)
{
strcpy(message,mes);
}
int SylvExceptionMessage::printMessage(char* str, int maxlen) const
{
char aux[600];
sprintf(aux, "At %s:%d:%s\n", file, line, message);
int newremain = maxlen - strlen(aux);
if (newremain < 0) {
aux[maxlen] = '\0';
newremain = 0;
}
strcat(str, aux);
return newremain;
}

39
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvException.h Normal file
View File

@ -0,0 +1,39 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvException.h,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef SYLV_EXCEPTION_H
#define SYLV_EXCEPTION_H
#include "SylvMemory.h"
class SylvException : public MallocAllocator {
protected:
char file[50];
int line;
const SylvException* source;
public:
SylvException(const char* f, int l, const SylvException* s);
virtual ~SylvException();
virtual int printMessage(char* str, int maxlen) const;
void printMessage() const;
};
class SylvExceptionMessage : public SylvException {
char message[500];
public:
SylvExceptionMessage(const char* f, int l, const char* mes);
virtual int printMessage(char* str, int maxlen) const;
};
// define macros:
#define SYLV_EXCEPTION(exc) (SylvException(__FILE__, __LINE__, exc))
#define SYLV_MES_EXCEPTION(mes) (SylvExceptionMessage(__FILE__, __LINE__, mes))
#endif /* SYLV_EXCEPTION_H */
// Local Variables:
// mode:C++
// End:

251
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvMatrix.cpp Normal file
View File

@ -0,0 +1,251 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvMatrix.cpp,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#include "SylvException.h"
#include "SylvMatrix.h"
#include "cppblas.h"
#include "cpplapack.h"
#include <stdio.h>
#include <string.h>
#include <cmath>
void SylvMatrix::multLeftI(const SqSylvMatrix& m)
{
int off = rows - m.numRows();
if (off < 0) {
throw SYLV_MES_EXCEPTION("Wrong matrix dimensions for multLeftI.");
}
GeneralMatrix subtmp(*this, off, 0, m.numRows(), cols);
subtmp.multLeft(m);
}
void SylvMatrix::multLeftITrans(const SqSylvMatrix& m)
{
int off = rows - m.numRows();
if (off < 0) {
throw SYLV_MES_EXCEPTION("Wrong matrix dimensions for multLeftITrans.");
}
GeneralMatrix subtmp(*this, off, 0, m.numRows(), cols);
subtmp.multLeftTrans(m);
}
void SylvMatrix::multLeft(int zero_cols, const GeneralMatrix& a, const GeneralMatrix& b)
{
int off = a.numRows() - a.numCols();
if (off < 0 || a.numRows() != rows || off != zero_cols ||
rows != b.numRows() || cols != b.numCols()) {
throw SYLV_MES_EXCEPTION("Wrong matrix dimensions for multLeft.");
}
// here we cannot call SylvMatrix::gemm since it would require
// another copy of (usually big) b (we are not able to do inplace
// submatrix of const GeneralMatrix)
if (a.getLD() > 0 && ld > 0) {
int mm = a.numRows();
int nn = cols;
int kk = a.numCols();
double alpha = 1.0;
int lda = a.getLD();
int ldb = ld;
double beta = 0.0;
int ldc = ld;
BLAS_dgemm("N", "N", &mm, &nn, &kk, &alpha, a.getData().base(), &lda,
b.getData().base()+off, &ldb, &beta, data.base(), &ldc);
}
}
void SylvMatrix::multRightKron(const SqSylvMatrix& m, int order)
{
if (power(m.numRows(), order) != cols) {
throw SYLV_MES_EXCEPTION("Wrong number of cols for right kron multiply.");
}
KronVector auxrow(m.numRows(), m.numRows(), order-1);
for (int i = 0; i < rows; i++) {
Vector rowi(data.base()+i, rows, cols);
KronVector rowikron(rowi, m.numRows(), m.numRows(), order-1);
auxrow = rowi; // copy data
m.multVecKronTrans(rowikron, auxrow);
}
}
void SylvMatrix::multRightKronTrans(const SqSylvMatrix& m, int order)
{
if (power(m.numRows(), order) != cols) {
throw SYLV_MES_EXCEPTION("Wrong number of cols for right kron multiply.");
}
KronVector auxrow(m.numRows(), m.numRows(), order-1);
for (int i = 0; i < rows; i++) {
Vector rowi(data.base()+i, rows, cols);
KronVector rowikron(rowi, m.numRows(), m.numRows(), order-1);
auxrow = rowi; // copy data
m.multVecKron(rowikron, auxrow);
}
}
void SylvMatrix::eliminateLeft(int row, int col, Vector& x)
{
double d = get(col, col);
double e = get(row, col);
if (std::abs(d) > std::abs(e)) {
get(row, col) = 0.0;
double mult = e/d;
for (int i = col + 1; i < numCols(); i++) {
get(row, i) = get(row, i) - mult*get(col, i);
}
x[row] = x[row] - mult*x[col];
} else if (std::abs(e) > std::abs(d)) {
get(row, col) = 0.0;
get(col, col) = e;
double mult = d/e;
for (int i = col + 1; i < numCols(); i++) {
double tx = get(col, i);
double ty = get(row, i);
get(col, i) = ty;
get(row, i) = tx - mult*ty;
}
double tx = x[col];
double ty = x[row];
x[col] = ty;
x[row] = tx - mult*ty;
}
}
void SylvMatrix::eliminateRight(int row, int col, Vector& x)
{
double d = get(row, row);
double e = get(row, col);
if (std::abs(d) > std::abs(e)) {
get(row, col) = 0.0;
double mult = e/d;
for (int i = 0; i < row; i++) {
get(i, col) = get(i, col) - mult*get(i, row);
}
x[col] = x[col] - mult*x[row];
} else if (std::abs(e) > std::abs(d)) {
get(row, col) = 0.0;
get(row, row) = e;
double mult = d/e;
for (int i = 0; i < row; i++) {
double tx = get(i, row);
double ty = get(i, col);
get(i, row) = ty;
get(i, col) = tx - mult*ty;
}
double tx = x[row];
double ty = x[col];
x[row] = ty;
x[col] = tx - mult*ty;
}
}
SqSylvMatrix::SqSylvMatrix(const GeneralMatrix& a, const GeneralMatrix& b)
: SylvMatrix(a,b)
{
if (rows != cols)
throw SYLV_MES_EXCEPTION("Wrong matrix dimensions in multiplication constructor of square matrix.");
}
void SqSylvMatrix::multVecKron(KronVector& x, const KronVector& d) const
{
x.zeros();
if (d.getDepth() == 0) {
multaVec(x, d);
} else {
KronVector aux(x.getM(), x.getN(), x.getDepth());
for (int i = 0; i < x.getM(); i++) {
KronVector auxi(aux, i);
ConstKronVector di(d, i);
multVecKron(auxi, di);
}
for (int i = 0; i < rows; i++) {
KronVector xi(x, i);
for (int j = 0; j < cols; j++) {
KronVector auxj(aux, j);
xi.add(get(i,j),auxj);
}
}
}
}
void SqSylvMatrix::multVecKronTrans(KronVector& x, const KronVector& d) const
{
x.zeros();
if (d.getDepth() == 0) {
multaVecTrans(x, d);
} else {
KronVector aux(x.getM(), x.getN(), x.getDepth());
for (int i = 0; i < x.getM(); i++) {
KronVector auxi(aux, i);
ConstKronVector di(d, i);
multVecKronTrans(auxi, di);
}
for (int i = 0; i < rows; i++) {
KronVector xi(x, i);
for (int j = 0; j < cols; j++) {
KronVector auxj(aux, j);
xi.add(get(j,i), auxj);
}
}
}
}
void SqSylvMatrix::multInvLeft2(GeneralMatrix& a, GeneralMatrix& b,
double& rcond1, double& rcondinf) const
{
if (rows != a.numRows() || rows != b.numRows()) {
throw SYLV_MES_EXCEPTION("Wrong dimensions for multInvLeft2.");
}
// PLU factorization
Vector inv(data);
int * const ipiv = new int[rows];
int info;
LAPACK_dgetrf(&rows, &rows, inv.base(), &rows, ipiv, &info);
// solve a
int acols = a.numCols();
double* abase = a.base();
LAPACK_dgetrs("N", &rows, &acols, inv.base(), &rows, ipiv,
abase, &rows, &info);
// solve b
int bcols = b.numCols();
double* bbase = b.base();
LAPACK_dgetrs("N", &rows, &bcols, inv.base(), &rows, ipiv,
bbase, &rows, &info);
delete [] ipiv;
// condition numbers
double* const work = new double[4*rows];
int* const iwork = new int[rows];
double norm1 = getNorm1();
LAPACK_dgecon("1", &rows, inv.base(), &rows, &norm1, &rcond1,
work, iwork, &info);
double norminf = getNormInf();
LAPACK_dgecon("I", &rows, inv.base(), &rows, &norminf, &rcondinf,
work, iwork, &info);
delete [] iwork;
delete [] work;
}
void SqSylvMatrix::setUnit()
{
for (int i = 0; i < rows; i++) {
for (int j = 0; j < cols; j++) {
if (i==j)
get(i,j) = 1.0;
else
get(i,j) = 0.0;
}
}
}
// Local Variables:
// mode:C++
// End:

81
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvMatrix.h Normal file
View File

@ -0,0 +1,81 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvMatrix.h,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef SYLV_MATRIX_H
#define SYLV_MATRIX_H
#include "GeneralMatrix.h"
#include "KronVector.h"
class SqSylvMatrix;
class SylvMatrix : public GeneralMatrix {
public:
SylvMatrix(int m, int n)
: GeneralMatrix(m,n) {}
SylvMatrix(const double* d, int m, int n)
: GeneralMatrix(d, m, n) {}
SylvMatrix(double* d, int m, int n)
: GeneralMatrix(d, m, n) {}
SylvMatrix(const GeneralMatrix& m)
: GeneralMatrix(m) {}
SylvMatrix(const GeneralMatrix& m, int i, int j, int nrows, int ncols)
: GeneralMatrix(m, i, j, nrows, ncols) {}
SylvMatrix(GeneralMatrix& m, int i, int j, int nrows, int ncols)
: GeneralMatrix(m, i, j, nrows, ncols) {}
SylvMatrix(const GeneralMatrix& a, const GeneralMatrix& b)
: GeneralMatrix(a, b) {}
/* this = |I 0|* this
|0 m| */
void multLeftI(const SqSylvMatrix& m);
/* this = |I 0|* this
|0 m'| */
void multLeftITrans(const SqSylvMatrix& m);
/* this = |0 a|*b, so that |0 a| is square */
void multLeft(int zero_cols, const GeneralMatrix& a, const GeneralMatrix& b);
/* this = this * (m\otimes m..\otimes m) */
void multRightKron(const SqSylvMatrix& m, int order);
/* this = this * (m'\otimes m'..\otimes m') */
void multRightKronTrans(const SqSylvMatrix& m, int order);
/* this = P*this, x = P*x, where P is gauss transformation setting
* a given element to zero */
void eliminateLeft(int row, int col, Vector& x);
/* this = this*P, x = P'*x, where P is gauss transformation setting
* a given element to zero */
void eliminateRight(int row, int col, Vector& x);
};
class SqSylvMatrix : public SylvMatrix {
public:
SqSylvMatrix(int m) : SylvMatrix(m, m) {}
SqSylvMatrix(const double* d, int m) : SylvMatrix(d, m, m) {}
SqSylvMatrix(double* d, int m) : SylvMatrix(d, m, m) {}
SqSylvMatrix(const SqSylvMatrix& m) : SylvMatrix(m) {}
SqSylvMatrix(const GeneralMatrix& m, int i, int j, int nrows)
: SylvMatrix(m, i, j, nrows, nrows) {}
SqSylvMatrix(GeneralMatrix& m, int i, int j, int nrows)
: SylvMatrix(m, i, j, nrows, nrows) {}
SqSylvMatrix(const GeneralMatrix& a, const GeneralMatrix& b);
const SqSylvMatrix& operator=(const SqSylvMatrix& m)
{GeneralMatrix::operator=(m); return *this;}
/* x = (this \otimes this..\otimes this)*d */
void multVecKron(KronVector& x, const KronVector& d) const;
/* x = (this' \otimes this'..\otimes this')*d */
void multVecKronTrans(KronVector& x, const KronVector& d) const;
/* a = inv(this)*a, b=inv(this)*b */
void multInvLeft2(GeneralMatrix& a, GeneralMatrix& b,
double& rcond1, double& rcondinf) const;
/* this = I */
void setUnit();
};
#endif /* SYLV_MATRIX_H */
// Local Variables:
// mode:C++
// End:

221
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvMemory.cpp Normal file
View File

@ -0,0 +1,221 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvMemory.cpp,v 1.1.1.1 2004/06/04 13:00:49 kamenik Exp $ */
/* Tag $Name: $ */
#include "SylvMemory.h"
#include "SylvException.h"
#include "KronVector.h"
#ifdef MATLAB
#include "mex.h"
#endif
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
/**********************************************************/
/* SylvMemoryPool */
/**********************************************************/
SylvMemoryPool memory_pool;
SylvMemoryPool::SylvMemoryPool()
: base(0), length(0), allocated(0), stack_mode(false)
{
}
void SylvMemoryPool::init(size_t size)
{
#ifdef USE_MEMORY_POOL
length = size;
#ifdef MATLAB
if (base)
throw SYLV_MES_EXCEPTION("Attempt to use matlab memory pool twice.");
base = (char*) mxMalloc(length);
#else
base = (char*) malloc(length);
#endif
#else
throw SYLV_MES_EXCEPTION("SylvMemoryPool::init() called for non memory pool code.");
#endif
}
void* SylvMemoryPool::allocate(size_t size)
{
#ifdef USE_MEMORY_POOL
if (allocated + size < length) {
char* res = base + allocated;
allocated += size;
return res;
} else {
throw SYLV_MES_EXCEPTION("Run out of memory space");
}
#else
throw SYLV_MES_EXCEPTION("SylvMemoryPool::allocate() called for non memory pool code.");
#endif
}
void SylvMemoryPool::free(void* p)
{
#ifdef USE_MEMORY_POOL
int offset = ((char*)p) - base;
#ifdef DEBUG
if (offset < 0)
throw SYLV_MES_EXCEPTION("SylvMemoryPool::free() frees wrong address < begin.");
if (offset >= (int)length)
throw SYLV_MES_EXCEPTION("SylvMemoryPool::free() frees wrong address > end.");
#endif
if (stack_mode && offset >= 0 && offset < (int)allocated)
allocated = offset;
#else
throw SYLV_MES_EXCEPTION("SylvMemoryPool::free() called for non memory pool code.");
#endif
}
void SylvMemoryPool::setStackMode(bool mode)
{
stack_mode = mode;
}
SylvMemoryPool::~SylvMemoryPool()
{
reset();
}
void SylvMemoryPool::reset()
{
#ifndef MATLAB
delete [] base;
base = 0;
allocated = 0;
length = 0;
stack_mode = false;
#endif
}
/**********************************************************/
/* global new and delete */
/**********************************************************/
#ifdef USE_MEMORY_POOL
void* operator new(size_t size)
{
return memory_pool.allocate(size);
}
void* operator new[](size_t size)
{
return memory_pool.allocate(size);
}
void operator delete(void* p)
{
memory_pool.free(p);
}
void operator delete[](void* p)
{
memory_pool.free(p);
}
#endif
/**********************************************************/
/* saved version of global new and delete */
/**********************************************************/
#ifdef USE_MEMORY_POOL
void* MallocAllocator::operator new(size_t size)
{
#ifdef MATLAB
throw SYLV_MES_EXCEPTION("Attempt to call wrong memory allocator.");
#else
void* res = malloc(size);
if (!res)
throw SYLV_MES_EXCEPTION("Malloc unable to allocate memory.");
return res;
#endif
}
void* MallocAllocator::operator new[](size_t size)
{
#ifdef MATLAB
throw SYLV_MES_EXCEPTION("Attempt to call wrong memory allocator.");
#else
void* res = malloc(size);
if (!res)
throw SYLV_MES_EXCEPTION("Malloc unable allocate memory.");
return res;
#endif
}
void MallocAllocator::operator delete(void* p)
{
#ifdef MATLAB
throw SYLV_MES_EXCEPTION("Attempt to call wrong memory destructor.");
#else
free(p);
#endif
}
void MallocAllocator::operator delete[](void* p)
{
#ifdef MATLAB
throw SYLV_MES_EXCEPTION("Attempt to call wrong memory destructor.");
#else
free(p);
#endif
}
#endif
/**********************************************************/
/* SylvMemoryDriver */
/**********************************************************/
void SylvMemoryDriver::allocate(int num_d, int m, int n, int order)
{
#ifdef USE_MEMORY_POOL
int x_cols = power(m,order);
int total = num_d*x_cols*n; // storage for big matrices
total += x_cols; // storage for one extra row of a big matrix
int dig_vectors = (int)ceil(((double)(power(m,order)-1))/(m-1));
total += 8*n*dig_vectors; // storage for kron vectors instantiated during solv
total += 50*(m*m+n*n); // some storage for small square matrices
total *= sizeof(double); // everything in doubles
memory_pool.init(total);
#endif
}
SylvMemoryDriver::SylvMemoryDriver(int num_d, int m, int n, int order)
{
allocate(num_d, m, n, order);
}
SylvMemoryDriver::SylvMemoryDriver(const SylvParams& pars, int num_d,
int m, int n, int order)
{
if (*(pars.method) == SylvParams::iter)
num_d++;
if (*(pars.want_check))
num_d++;
allocate(num_d, m, n, order);
}
SylvMemoryDriver::~SylvMemoryDriver()
{
memory_pool.reset();
}
void SylvMemoryDriver::setStackMode(bool mode) {
memory_pool.setStackMode(mode);
}

63
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvMemory.h Normal file
View File

@ -0,0 +1,63 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvMemory.h,v 1.1.1.1 2004/06/04 13:00:49 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef SYLV_MEMORY_H
#define SYLV_MEMORY_H
#include "SylvParams.h"
#include <new>
class MallocAllocator {
#ifdef USE_MEMORY_POOL
public:
void* operator new(size_t size);
void* operator new[](size_t size);
void operator delete(void* p);
void operator delete[](void* p);
#endif
};
#ifdef USE_MEMORY_POOL
void* operator new(size_t size);
void* operator new[](size_t size);
void operator delete(void* p);
void operator delete[](void* p);
#endif
class SylvMemoryPool {
char* base;
size_t length;
size_t allocated;
bool stack_mode;
SylvMemoryPool(const SylvMemoryPool&);
const SylvMemoryPool& operator=(const SylvMemoryPool&);
public:
SylvMemoryPool();
~SylvMemoryPool();
void init(size_t size);
void* allocate(size_t size);
void free(void* p);
void reset();
void setStackMode(bool);
};
class SylvMemoryDriver {
SylvMemoryDriver(const SylvMemoryDriver&);
const SylvMemoryDriver& operator=(const SylvMemoryDriver&);
public:
SylvMemoryDriver(int num_d, int m, int n, int order);
SylvMemoryDriver(const SylvParams& pars, int num_d, int m, int n, int order);
static void setStackMode(bool);
~SylvMemoryDriver();
protected:
void allocate(int num_d, int m, int n, int order);
};
#endif /* SYLV_MEMORY_H */
// Local Variables:
// mode:C++
// End:

230
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvParams.cpp Normal file
View File

@ -0,0 +1,230 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvParams.cpp,v 1.1.1.1 2004/06/04 13:00:52 kamenik Exp $ */
/* Tag $Name: $ */
#include "SylvParams.h"
void SylvParams::print(const char* prefix) const
{
print(stdout, prefix);
}
void SylvParams::print(FILE* fdesc, const char* prefix) const
{
rcondA1.print(fdesc, prefix, "reci. cond1 A ", "%8.4g");
rcondAI.print(fdesc, prefix, "reci. condInf A ", "%8.4g");
bs_norm.print(fdesc, prefix, "log10 diag norm ", "%8.4g");
f_err1.print(fdesc, prefix, "abs. err 1 F diag ", "%8.4g");
f_errI.print(fdesc, prefix, "abs. err I F diag ", "%8.4g");
viv_err1.print(fdesc, prefix, "abs. err 1 V*invV ", "%8.4g");
viv_errI.print(fdesc, prefix, "abs. err I V*invV ", "%8.4g");
ivv_err1.print(fdesc, prefix, "abs. err 1 invV*V ", "%8.4g");
ivv_errI.print(fdesc, prefix, "abs. err I invV*V ", "%8.4g");
f_blocks.print(fdesc, prefix, "num blocks in F ", "%d");
f_largest.print(fdesc, prefix,"largest block in F ", "%d");
f_zeros.print(fdesc, prefix, "num zeros in F ", "%d");
f_offdiag.print(fdesc, prefix,"num offdiag in F ", "%d");
if (*method == iter) {
converged.print(fdesc, prefix, "converged ", "%d");
convergence_tol.print(fdesc, prefix, "convergence tol. ", "%8.4g");
iter_last_norm.print(fdesc, prefix, "last norm ", "%8.4g");
max_num_iter.print(fdesc, prefix, "max num iter ", "%d");
num_iter.print(fdesc, prefix, "num iter ", "%d");
} else {
eig_min.print(fdesc, prefix, "minimum eigenvalue ", "%8.4g");
}
mat_err1.print(fdesc, prefix, "rel. matrix norm1 ", "%8.4g");
mat_errI.print(fdesc, prefix, "rel. matrix normInf", "%8.4g");
mat_errF.print(fdesc, prefix, "rel. matrix normFro", "%8.4g");
vec_err1.print(fdesc, prefix, "rel. vector norm1 ", "%8.4g");
vec_errI.print(fdesc, prefix, "rel. vector normInf", "%8.4g");
cpu_time.print(fdesc, prefix, "time (CPU secs) ", "%8.4g");
}
void SylvParams::copy(const SylvParams& p)
{
method = p.method;
convergence_tol = p.convergence_tol;
max_num_iter = p.max_num_iter;
bs_norm = p.bs_norm;
want_check = p.want_check;
converged = p.converged;
iter_last_norm = p.iter_last_norm;
num_iter = p.num_iter;
f_err1 = p.f_err1;
f_errI = p.f_errI;
viv_err1 = p.viv_err1;
viv_errI = p.viv_errI;
ivv_err1 = p.ivv_err1;
ivv_errI = p.ivv_errI;
f_blocks = p.f_blocks;
f_largest = p.f_largest;
f_zeros = p.f_zeros;
f_offdiag = p.f_offdiag;
rcondA1 = p.rcondA1;
rcondAI = p.rcondAI;
eig_min = p.eig_min;
mat_err1 = p.mat_err1;
mat_errI = p.mat_errI;
mat_errF = p.mat_errF;
vec_err1 = p.vec_err1;
vec_errI = p.vec_errI;
cpu_time = p.cpu_time;
}
void SylvParams::setArrayNames(int& num, const char** names) const
{
num = 0;
if (method.getStatus() != undef)
names[num++] = "method";
if (convergence_tol.getStatus() != undef)
names[num++] = "convergence_tol";
if (max_num_iter.getStatus() != undef)
names[num++] = "max_num_iter";
if (bs_norm.getStatus() != undef)
names[num++] = "bs_norm";
if (converged.getStatus() != undef)
names[num++] = "converged";
if (iter_last_norm.getStatus() != undef)
names[num++] = "iter_last_norm";
if (num_iter.getStatus() != undef)
names[num++] = "num_iter";
if (f_err1.getStatus() != undef)
names[num++] = "f_err1";
if (f_errI.getStatus() != undef)
names[num++] = "f_errI";
if (viv_err1.getStatus() != undef)
names[num++] = "viv_err1";
if (viv_errI.getStatus() != undef)
names[num++] = "viv_errI";
if (ivv_err1.getStatus() != undef)
names[num++] = "ivv_err1";
if (ivv_errI.getStatus() != undef)
names[num++] = "ivv_errI";
if (f_blocks.getStatus() != undef)
names[num++] = "f_blocks";
if (f_largest.getStatus() != undef)
names[num++] = "f_largest";
if (f_zeros.getStatus() != undef)
names[num++] = "f_zeros";
if (f_offdiag.getStatus() != undef)
names[num++] = "f_offdiag";
if (rcondA1.getStatus() != undef)
names[num++] = "rcondA1";
if (rcondAI.getStatus() != undef)
names[num++] = "rcondAI";
if (eig_min.getStatus() != undef)
names[num++] = "eig_min";
if (mat_err1.getStatus() != undef)
names[num++] = "mat_err1";
if (mat_errI.getStatus() != undef)
names[num++] = "mat_errI";
if (mat_errF.getStatus() != undef)
names[num++] = "mat_errF";
if (vec_err1.getStatus() != undef)
names[num++] = "vec_err1";
if (vec_errI.getStatus() != undef)
names[num++] = "vec_errI";
if (cpu_time.getStatus() != undef)
names[num++] = "cpu_time";
}
#ifdef MATLAB
mxArray* SylvParams::DoubleParamItem::createMatlabArray() const
{
return mxCreateScalarDouble(value);
}
mxArray* SylvParams::IntParamItem::createMatlabArray() const
{
mxArray* res = mxCreateNumericMatrix(1, 1, mxINT32_CLASS, mxREAL);
*((int*)mxGetData(res)) = value;
return res;
}
mxArray* SylvParams::BoolParamItem::createMatlabArray() const
{
if (value)
return mxCreateString("true");
else
return mxCreateString("false");
}
mxArray* SylvParams::MethodParamItem::createMatlabArray() const
{
if (value == iter)
return mxCreateString("iterative");
else
return mxCreateString("recursive");
}
mxArray* SylvParams::createStructArray() const
{
const char* names[50];
int num;
setArrayNames(num, names);
const int dims[] = {1, 1};
mxArray* const res = mxCreateStructArray(2, dims, num, names);
int i = 0;
if (method.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, method.createMatlabArray());
if (convergence_tol.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, convergence_tol.createMatlabArray());
if (max_num_iter.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, max_num_iter.createMatlabArray());
if (bs_norm.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, bs_norm.createMatlabArray());
if (converged.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, converged.createMatlabArray());
if (iter_last_norm.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, iter_last_norm.createMatlabArray());
if (num_iter.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, num_iter.createMatlabArray());
if (f_err1.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, f_err1.createMatlabArray());
if (f_errI.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, f_errI.createMatlabArray());
if (viv_err1.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, viv_err1.createMatlabArray());
if (viv_errI.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, viv_errI.createMatlabArray());
if (ivv_err1.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, ivv_err1.createMatlabArray());
if (ivv_errI.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, ivv_errI.createMatlabArray());
if (f_blocks.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, f_blocks.createMatlabArray());
if (f_largest.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, f_largest.createMatlabArray());
if (f_zeros.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, f_zeros.createMatlabArray());
if (f_offdiag.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, f_offdiag.createMatlabArray());
if (rcondA1.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, rcondA1.createMatlabArray());
if (rcondAI.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, rcondAI.createMatlabArray());
if (eig_min.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, eig_min.createMatlabArray());
if (mat_err1.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, mat_err1.createMatlabArray());
if (mat_errI.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, mat_errI.createMatlabArray());
if (mat_errF.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, mat_errF.createMatlabArray());
if (vec_err1.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, vec_err1.createMatlabArray());
if (vec_errI.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, vec_errI.createMatlabArray());
if (cpu_time.getStatus() != undef)
mxSetFieldByNumber(res, 0, i++, cpu_time.createMatlabArray());
return res;
}
#endif
// Local Variables:
// mode:C++
// End:

162
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvParams.h Normal file
View File

@ -0,0 +1,162 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvParams.h,v 1.1.1.1 2004/06/04 13:00:54 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef SYLV_PARAMS_H
#define SYLV_PARAMS_H
#include <stdio.h>
#include <string.h>
#ifdef MATLAB
#include "mex.h"
#endif
typedef enum {def, changed, undef} status;
template <class _Type>
struct ParamItem {
protected:
typedef ParamItem<_Type> _Self;
status s;
_Type value;
public:
ParamItem()
{s = undef;}
ParamItem(_Type val)
{value = val; s = def;}
ParamItem(const _Self& item)
{value = item.value; s = item.s;}
const _Self& operator=(const _Self& item)
{value = item.value; s = item.s; return *this;}
const _Self& operator=(const _Type& val)
{value = val; s = changed; return *this;}
_Type operator*() const
{return value;}
status getStatus() const
{return s;}
void print(FILE* f, const char* prefix, const char* str, const char* fmt) const
{
if (s == undef)
return;
char out[1000];
strcpy(out, prefix);
strcat(out, str);
strcat(out, "= ");
strcat(out, fmt);
if (s == def)
strcat(out, " <default>");
strcat(out,"\n");
fprintf(f, out, value);
}
};
class SylvParams {
public:
typedef enum {iter, recurse} solve_method;
protected:
class DoubleParamItem : public ParamItem<double> {
public:
DoubleParamItem() : ParamItem<double>() {}
DoubleParamItem(double val) : ParamItem<double>(val) {}
DoubleParamItem(const DoubleParamItem& item) : ParamItem<double>(item) {}
const DoubleParamItem& operator=(const double& val)
{ParamItem<double>::operator=(val); return *this;}
#ifdef MATLAB
mxArray* createMatlabArray() const;
#endif
};
class IntParamItem : public ParamItem<int> {
public:
IntParamItem() : ParamItem<int>() {}
IntParamItem(int val) : ParamItem<int>(val) {}
IntParamItem(const IntParamItem& item) : ParamItem<int>(item) {}
const IntParamItem& operator=(const int& val)
{ParamItem<int>::operator=(val); return *this;}
#ifdef MATLAB
mxArray* createMatlabArray() const;
#endif
};
class BoolParamItem : public ParamItem<bool> {
public:
BoolParamItem() : ParamItem<bool>() {}
BoolParamItem(bool val) : ParamItem<bool>(val) {}
BoolParamItem(const BoolParamItem& item) : ParamItem<bool>(item) {}
const BoolParamItem& operator=(const bool& val)
{ParamItem<bool>::operator=(val); return *this;}
#ifdef MATLAB
mxArray* createMatlabArray() const;
#endif
};
class MethodParamItem : public ParamItem<solve_method> {
public:
MethodParamItem() : ParamItem<solve_method>() {}
MethodParamItem(solve_method val) : ParamItem<solve_method>(val) {}
MethodParamItem(const MethodParamItem& item) : ParamItem<solve_method>(item) {}
const MethodParamItem operator=(const solve_method& val)
{ParamItem<solve_method>::operator=(val); return *this;}
#ifdef MATLAB
mxArray* createMatlabArray() const;
#endif
};
public:
// input parameters
MethodParamItem method; // method of solution: iter/recurse
DoubleParamItem convergence_tol; // norm for what we consider converged
IntParamItem max_num_iter; // max number of iterations
DoubleParamItem bs_norm; // Bavely Stewart log10 of norm for diagonalization
BoolParamItem want_check; // true => allocate extra space for checks
// output parameters
BoolParamItem converged; // true if converged
DoubleParamItem iter_last_norm; // norm of the last iteration
IntParamItem num_iter; // number of iterations
DoubleParamItem f_err1; // norm 1 of diagonalization abs. error C-V*F*inv(V)
DoubleParamItem f_errI; // norm Inf of diagonalization abs. error C-V*F*inv(V)
DoubleParamItem viv_err1; // norm 1 of error I-V*inv(V)
DoubleParamItem viv_errI; // norm Inf of error I-V*inv(V)
DoubleParamItem ivv_err1; // norm 1 of error I-inv(V)*V
DoubleParamItem ivv_errI; // norm Inf of error I-inv(V)*V
IntParamItem f_blocks; // number of diagonal blocks of F
IntParamItem f_largest; // size of largest diagonal block in F
IntParamItem f_zeros; // number of off diagonal zeros in F
IntParamItem f_offdiag; // number of all off diagonal elements in F
DoubleParamItem rcondA1; // reciprocal cond 1 number of A
DoubleParamItem rcondAI; // reciprocal cond Inf number of A
DoubleParamItem eig_min; // minimum eigenvalue of the solved system
DoubleParamItem mat_err1; // rel. matrix 1 norm of A*X-B*X*kron(C,..,C)-D
DoubleParamItem mat_errI; // rel. matrix Inf norm of A*X-B*X*kron(C,..,C)-D
DoubleParamItem mat_errF; // rel. matrix Frob. norm of A*X-B*X*kron(C,..,C)-D
DoubleParamItem vec_err1; // rel. vector 1 norm of A*X-B*X*kron(C,..,C)-D
DoubleParamItem vec_errI; // rel. vector Inf norm of A*X-B*X*kron(C,..,C)-D
DoubleParamItem cpu_time; // time of the job in CPU seconds
// note: remember to change copy() if adding/removing member
SylvParams(bool wc = false)
: method(recurse), convergence_tol(1.e-30), max_num_iter(15),
bs_norm(1.3), want_check(wc) {}
SylvParams(const SylvParams& p)
{copy(p);}
const SylvParams& operator=(const SylvParams& p)
{copy(p); return *this;}
~SylvParams() {}
void print(const char* prefix) const;
void print(FILE* fdesc, const char* prefix) const;
void setArrayNames(int& num, const char** names) const;
#ifdef MATLAB
mxArray* createStructArray() const;
#endif
private:
void copy(const SylvParams& p);
};
#endif /* SYLV_PARAMS_H */
// Local Variables:
// mode:C++
// End:

51
mex/sources/korderpert/Dyn_pp/sylv/cc/SylvesterSolver.h Normal file
View File

@ -0,0 +1,51 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SylvesterSolver.h,v 1.1.1.1 2004/06/04 13:00:54 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef SYLVESTER_SOLVER_H
#define SYLVESTER_SOLVER_H
#include "KronVector.h"
#include "QuasiTriangular.h"
#include "QuasiTriangularZero.h"
#include "SimilarityDecomp.h"
#include "SylvParams.h"
#include "SchurDecomp.h"
class SylvesterSolver {
protected:
const QuasiTriangular* const matrixK;
const QuasiTriangular* const matrixF;
private:
/* return true when it is more efficient to use QuasiTriangular
* than QuasiTriangularZero */
static bool zeroPad(const SchurDecompZero& kdecomp) {
return ((kdecomp.getZeroCols()*3 < kdecomp.getDim()*2) ||
(kdecomp.getZeroCols() < 10));
}
public:
SylvesterSolver(const QuasiTriangular& k, const QuasiTriangular& f)
: matrixK(new QuasiTriangular(k)),
matrixF(new QuasiTriangular(f))
{}
SylvesterSolver(const SchurDecompZero& kdecomp, const SchurDecomp& fdecomp)
: matrixK((zeroPad(kdecomp)) ?
new QuasiTriangular(kdecomp) : new QuasiTriangularZero(kdecomp)),
matrixF(new QuasiTriangular(fdecomp))
{}
SylvesterSolver(const SchurDecompZero& kdecomp, const SimilarityDecomp& fdecomp)
: matrixK((zeroPad(kdecomp)) ?
new QuasiTriangular(kdecomp) : new QuasiTriangularZero(kdecomp)),
matrixF(new BlockDiagonal(fdecomp.getB()))
{}
virtual ~SylvesterSolver()
{delete matrixK; delete matrixF;}
virtual void solve(SylvParams& pars, KronVector& x) const = 0;
};
#endif /* SYLVESTER_SOLVER_H */
// Local Variables:
// mode:C++
// End:

101
mex/sources/korderpert/Dyn_pp/sylv/cc/SymSchurDecomp.cpp Normal file
View File

@ -0,0 +1,101 @@
/* $Header$ */
/* Tag $Name$ */
#include "SymSchurDecomp.h"
#include "SylvException.h"
#include "cpplapack.h"
#include <algorithm>
#include <cmath>
SymSchurDecomp::SymSchurDecomp(const GeneralMatrix& mata)
: lambda(mata.numRows()), q(mata.numRows())
{
// check mata is square
if (mata.numRows() != mata.numCols())
throw SYLV_MES_EXCEPTION("Matrix is not square in SymSchurDecomp constructor");
// prepare for dsyevr
const char* jobz = "V";
const char* range = "A";
const char* uplo = "U";
int n = mata.numRows();
GeneralMatrix tmpa(mata);
double* a = tmpa.base();
int lda = tmpa.getLD();
double dum;
double* vl = &dum;
double* vu = &dum;
int idum;
int* il = &idum;
int* iu = &idum;
double abstol = 0.0;
int m = n;
double* w = lambda.base();
double* z = q.base();
int ldz = q.getLD();
int* isuppz = new int[2*std::max(1,m)];
double tmpwork;
int lwork = -1;
int tmpiwork;
int liwork = -1;
int info;
// query for lwork and liwork
LAPACK_dsyevr(jobz, range, uplo, &n, a, &lda, vl, vu, il, iu, &abstol,
&m, w, z, &ldz, isuppz, &tmpwork, &lwork, &tmpiwork, &liwork, &info);
lwork = (int)tmpwork;
liwork = tmpiwork;
// allocate work arrays
double* work = new double[lwork];
int* iwork = new int[liwork];
// do the calculation
LAPACK_dsyevr(jobz, range, uplo, &n, a, &lda, vl, vu, il, iu, &abstol,
&m, w, z, &ldz, isuppz, work, &lwork, iwork, &liwork, &info);
if (info < 0)
throw SYLV_MES_EXCEPTION("Internal error in SymSchurDecomp constructor");
if (info > 0)
throw SYLV_MES_EXCEPTION("Internal LAPACK error in DSYEVR");
delete [] work;
delete [] iwork;
delete [] isuppz;
}
void SymSchurDecomp::getFactor(GeneralMatrix& f) const
{
if (f.numRows() != q.numRows())
throw SYLV_MES_EXCEPTION("Wrong dimension of factor matrix in SymSchurDecomp::getFactor");
if (f.numRows() != f.numCols())
throw SYLV_MES_EXCEPTION("Factor matrix is not square in SymSchurDecomp::getFactor");
if (! isPositiveSemidefinite())
throw SYLV_MES_EXCEPTION("Symmetric decomposition not positive semidefinite in SymSchurDecomp::getFactor");
f = q;
for (int i = 0; i < f.numCols(); i++) {
Vector fi(f, i);
fi.mult(std::sqrt(lambda[i]));
}
}
// LAPACK says that eigenvalues are ordered in ascending order, but we
// do not rely her on it
bool SymSchurDecomp::isPositiveSemidefinite() const
{
for (int i = 0; i < lambda.length(); i++)
if (lambda[i] < 0)
return false;
return true;
}
void SymSchurDecomp::correctDefinitness(double tol)
{
for (int i = 0; i < lambda.length(); i++)
if (lambda[i] < 0 && lambda[i] > - tol)
lambda[i] = 0.0;
}

41
mex/sources/korderpert/Dyn_pp/sylv/cc/SymSchurDecomp.h Normal file
View File

@ -0,0 +1,41 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/SchurDecomp.h,v 1.1.1.1 2004/06/04 13:00:44 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef SYM_SCHUR_DECOMP_H
#define SYM_SCHUR_DECOMP_H
#include "SylvMatrix.h"
class SymSchurDecomp {
protected:
Vector lambda;
SqSylvMatrix q;
public:
/** Calculates A = Q*Lambda*Q^T, where A is assummed to be
* symmetric and Lambda real diagonal, hence a vector. */
SymSchurDecomp(const GeneralMatrix& a);
SymSchurDecomp(const SymSchurDecomp& ssd)
: lambda(ssd.lambda), q(ssd.q) {}
virtual ~SymSchurDecomp() {}
const Vector& getLambda() const
{return lambda;}
const SqSylvMatrix& getQ() const
{return q;}
/** Return factor F*F^T = A, raises and exception if A is not
* positive semidefinite, F must be square. */
void getFactor(GeneralMatrix& f) const;
/** Returns true if A is positive semidefinite. */
bool isPositiveSemidefinite() const;
/** Correct definitness. This sets all eigenvalues between minus
* tolerance and zero to zero. */
void correctDefinitness(double tol);
};
#endif
// Local Variables:
// mode:C++
// End:

392
mex/sources/korderpert/Dyn_pp/sylv/cc/TriangularSylvester.cpp Normal file
View File

@ -0,0 +1,392 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/TriangularSylvester.cpp,v 1.1.1.1 2004/06/04 13:00:59 kamenik Exp $ */
/* Tag $Name: $ */
#include "TriangularSylvester.h"
#include "QuasiTriangularZero.h"
#include "KronUtils.h"
#include "BlockDiagonal.h"
#include <stdio.h>
#include <cmath>
double TriangularSylvester::diag_zero = 1.e-15;
double TriangularSylvester::diag_zero_sq = 1.e-30;
TriangularSylvester::TriangularSylvester(const QuasiTriangular& k,
const QuasiTriangular& f)
: SylvesterSolver(k, f),
matrixKK(matrixK->clone(2, *matrixK)),
matrixFF(new QuasiTriangular(2, *matrixF))
{
}
TriangularSylvester::TriangularSylvester(const SchurDecompZero& kdecomp,
const SchurDecomp& fdecomp)
: SylvesterSolver(kdecomp, fdecomp),
matrixKK(matrixK->clone(2, *matrixK)),
matrixFF(new QuasiTriangular(2, *matrixF))
{
}
TriangularSylvester::TriangularSylvester(const SchurDecompZero& kdecomp,
const SimilarityDecomp& fdecomp)
: SylvesterSolver(kdecomp, fdecomp),
matrixKK(matrixK->clone(2, *matrixK)),
matrixFF(new BlockDiagonal(2, *matrixF))
{
}
TriangularSylvester::~TriangularSylvester()
{
delete matrixKK;
delete matrixFF;
}
void TriangularSylvester::print() const
{
printf("matrix K (%d):\n",matrixK->getDiagonal().getSize());
matrixK->print();
printf("matrix F (%d):\n",matrixF->getDiagonal().getSize());
matrixF->print();
}
void TriangularSylvester::solve(SylvParams& pars, KronVector& d) const
{
double eig_min = 1e30;
solvi(1., d, eig_min);
pars.eig_min = sqrt(eig_min);
}
void TriangularSylvester::solvi(double r, KronVector& d, double& eig_min) const
{
if (d.getDepth() == 0) {
QuasiTriangular* t = matrixK->clone(r);
t->solvePre(d, eig_min);
delete t;
} else {
for (const_diag_iter di = matrixF->diag_begin();
di != matrixF->diag_end();
++di) {
if ((*di).isReal()) {
solviRealAndEliminate(r, di, d, eig_min);
} else {
solviComplexAndEliminate(r, di, d, eig_min);
}
}
}
}
void TriangularSylvester::solvii(double alpha, double beta1, double beta2,
KronVector& d1, KronVector& d2,
double& eig_min) const
{
KronVector d1tmp(d1);
KronVector d2tmp(d2);
linEval(alpha, beta1, beta2, d1, d2, d1tmp, d2tmp);
solviip(alpha, beta1*beta2, d1, eig_min);
solviip(alpha, beta1*beta2, d2, eig_min);
}
void TriangularSylvester::solviip(double alpha, double betas,
KronVector& d, double& eig_min) const
{
// quick exit to solvi if betas is small
if (betas < diag_zero_sq) {
solvi(alpha, d, eig_min);
solvi(alpha, d, eig_min);
return;
}
if (d.getDepth() == 0) {
double aspbs = alpha*alpha+betas;
QuasiTriangular* t= matrixK->clone(2*alpha, aspbs, *matrixKK);
t->solvePre(d, eig_min);
delete t;
} else {
const_diag_iter di = matrixF->diag_begin();
const_diag_iter dsi = matrixFF->diag_begin();
for (; di != matrixF->diag_end(); ++di, ++dsi) {
if ((*di).isReal()) {
solviipRealAndEliminate(alpha, betas, di, dsi, d, eig_min);
} else {
solviipComplexAndEliminate(alpha, betas, di, dsi, d, eig_min);
}
}
}
}
void TriangularSylvester::solviRealAndEliminate(double r, const_diag_iter di,
KronVector& d, double& eig_min) const
{
// di is real
int jbar = (*di).getIndex();
double f = *((*di).getAlpha());
KronVector dj(d, jbar);
// solve system
if (abs(r*f) > diag_zero) {
solvi(r*f, dj, eig_min);
}
// calculate y
KronVector y((const KronVector&)dj);
KronUtils::multKron(*matrixF, *matrixK, y);
y.mult(r);
double divisor = 1.0;
solviEliminateReal(di, d, y, divisor);
}
void TriangularSylvester::solviEliminateReal(const_diag_iter di, KronVector& d,
const KronVector& y, double divisor) const
{
for (const_row_iter ri = matrixF->row_begin(*di);
ri != matrixF->row_end(*di);
++ri) {
KronVector dk(d, ri.getCol());
dk.add(-(*ri)/divisor, y);
}
}
void TriangularSylvester::solviComplexAndEliminate(double r, const_diag_iter di,
KronVector& d, double& eig_min) const
{
// di is complex
int jbar = (*di).getIndex();
// pick data
double alpha = *(*di).getAlpha();
double beta1 = (*di).getBeta2();
double beta2 = -(*di).getBeta1();
double aspbs = (*di).getDeterminant();
KronVector dj(d, jbar);
KronVector djj(d, jbar+1);
// solve
if (r*r*aspbs > diag_zero_sq) {
solvii(r*alpha, r*beta1, r*beta2, dj, djj, eig_min);
}
KronVector y1(dj);
KronVector y2(djj);
KronUtils::multKron(*matrixF, *matrixK, y1);
KronUtils::multKron(*matrixF, *matrixK, y2);
y1.mult(r);
y2.mult(r);
double divisor = 1.0;
solviEliminateComplex(di, d, y1, y2, divisor);
}
void TriangularSylvester::solviEliminateComplex(const_diag_iter di, KronVector& d,
const KronVector& y1, const KronVector& y2,
double divisor) const
{
for (const_row_iter ri = matrixF->row_begin(*di);
ri != matrixF->row_end(*di);
++ri) {
KronVector dk(d, ri.getCol());
dk.add(-ri.a()/divisor, y1);
dk.add(-ri.b()/divisor, y2);
}
}
void TriangularSylvester::solviipRealAndEliminate(double alpha, double betas,
const_diag_iter di, const_diag_iter dsi,
KronVector& d, double& eig_min) const
{
// di, and dsi are real
int jbar = (*di).getIndex();
double aspbs = alpha*alpha+betas;
// pick data
double f = *((*di).getAlpha());
double fs = f*f;
KronVector dj(d, jbar);
// solve
if (fs*aspbs > diag_zero_sq) {
solviip(f*alpha, fs*betas, dj, eig_min);
}
KronVector y1((const KronVector&)dj);
KronVector y2((const KronVector&)dj);
KronUtils::multKron(*matrixF, *matrixK, y1);
y1.mult(2*alpha);
KronUtils::multKron(*matrixFF, *matrixKK, y2);
y2.mult(aspbs);
double divisor = 1.0;
double divisor2 = 1.0;
solviipEliminateReal(di, dsi, d, y1, y2, divisor, divisor2);
}
void TriangularSylvester::solviipEliminateReal(const_diag_iter di, const_diag_iter dsi,
KronVector& d,
const KronVector& y1, const KronVector& y2,
double divisor, double divisor2) const
{
const_row_iter ri = matrixF->row_begin(*di);
const_row_iter rsi = matrixFF->row_begin(*dsi);
for (; ri != matrixF->row_end(*di); ++ri, ++rsi) {
KronVector dk(d, ri.getCol());
dk.add(-(*ri)/divisor, y1);
dk.add(-(*rsi)/divisor2, y2);
}
}
void TriangularSylvester::solviipComplexAndEliminate(double alpha, double betas,
const_diag_iter di, const_diag_iter dsi,
KronVector& d, double& eig_min) const
{
// di, and dsi are complex
int jbar = (*di).getIndex();
double aspbs = alpha*alpha+betas;
// pick data
double gamma = *((*di).getAlpha());
double delta1 = (*di).getBeta2(); // swap because of transpose
double delta2 = -(*di).getBeta1();
double gspds = (*di).getDeterminant();
KronVector dj(d, jbar);
KronVector djj(d, jbar+1);
if (gspds*aspbs > diag_zero_sq) {
solviipComplex(alpha, betas, gamma, delta1, delta2, dj, djj, eig_min);
}
// here dj, djj is solution, set y1, y2, y11, y22
// y1
KronVector y1((const KronVector&) dj);
KronUtils::multKron(*matrixF, *matrixK, y1);
y1.mult(2*alpha);
// y11
KronVector y11((const KronVector&) djj);
KronUtils::multKron(*matrixF, *matrixK, y11);
y11.mult(2*alpha);
// y2
KronVector y2((const KronVector&) dj);
KronUtils::multKron(*matrixFF, *matrixKK, y2);
y2.mult(aspbs);
// y22
KronVector y22((const KronVector&) djj);
KronUtils::multKron(*matrixFF, *matrixKK, y22);
y22.mult(aspbs);
double divisor = 1.0;
solviipEliminateComplex(di, dsi, d, y1, y11, y2, y22, divisor);
}
void TriangularSylvester::solviipComplex(double alpha, double betas, double gamma,
double delta1, double delta2,
KronVector& d1, KronVector& d2,
double& eig_min) const
{
KronVector d1tmp(d1);
KronVector d2tmp(d2);
quaEval(alpha, betas, gamma, delta1, delta2,
d1, d2, d1tmp, d2tmp);
double delta = sqrt(delta1*delta2);
double beta = sqrt(betas);
double a1 = alpha*gamma - beta*delta;
double b1 = alpha*delta + gamma*beta;
double a2 = alpha*gamma + beta*delta;
double b2 = alpha*delta - gamma*beta;
solviip(a2, b2*b2, d1, eig_min);
solviip(a1, b1*b1, d1, eig_min);
solviip(a2, b2*b2, d2, eig_min);
solviip(a1, b1*b1, d2, eig_min);
}
void TriangularSylvester::solviipEliminateComplex(const_diag_iter di, const_diag_iter dsi,
KronVector& d,
const KronVector& y1, const KronVector& y11,
const KronVector& y2, const KronVector& y22,
double divisor) const
{
const_row_iter ri = matrixF->row_begin(*di);
const_row_iter rsi = matrixFF->row_begin(*dsi);
for (; ri != matrixF->row_end(*di); ++ri, ++rsi) {
KronVector dk(d, ri.getCol());
dk.add(-ri.a()/divisor, y1);
dk.add(-ri.b()/divisor, y11);
dk.add(-rsi.a()/divisor, y2);
dk.add(-rsi.b()/divisor, y22);
}
}
void TriangularSylvester::linEval(double alpha, double beta1, double beta2,
KronVector& x1, KronVector& x2,
const ConstKronVector& d1, const ConstKronVector& d2) const
{
KronVector d1tmp(d1); // make copy
KronVector d2tmp(d2); // make copy
KronUtils::multKron(*matrixF, *matrixK, d1tmp);
KronUtils::multKron(*matrixF, *matrixK, d2tmp);
x1 = d1;
x2 = d2;
Vector::mult2a(alpha, beta1, -beta2, x1, x2, d1tmp, d2tmp);
}
void TriangularSylvester::quaEval(double alpha, double betas,
double gamma, double delta1, double delta2,
KronVector& x1, KronVector& x2,
const ConstKronVector& d1, const ConstKronVector& d2) const
{
KronVector d1tmp(d1); // make copy
KronVector d2tmp(d2); // make copy
KronUtils::multKron(*matrixF, *matrixK, d1tmp);
KronUtils::multKron(*matrixF, *matrixK, d2tmp);
x1 = d1;
x2 = d2;
Vector::mult2a(2*alpha*gamma, 2*alpha*delta1, -2*alpha*delta2,
x1, x2, d1tmp, d2tmp);
d1tmp = d1; // restore to d1
d2tmp = d2; // restore to d2
KronUtils::multKron(*matrixFF, *matrixKK, d1tmp);
KronUtils::multKron(*matrixFF, *matrixKK, d2tmp);
double aspbs = alpha*alpha + betas;
double gspds = gamma*gamma - delta1*delta2;
Vector::mult2a(aspbs*gspds, 2*aspbs*gamma*delta1, -2*aspbs*gamma*delta2,
x1, x2, d1tmp, d2tmp);
}
double TriangularSylvester::getEigSep(int depth) const
{
int f_size = matrixF->getDiagonal().getSize();
Vector feig(2*f_size);
matrixF->getDiagonal().getEigenValues(feig);
int k_size = matrixK->getDiagonal().getSize();
Vector keig(2*k_size);
matrixK->getDiagonal().getEigenValues(keig);
KronVector eig(f_size, 2*k_size, depth);
multEigVector(eig, feig, keig);
double min = 1.0e20;
for (int i = 0; i < eig.length()/2; i++) {
double alpha = eig[2*i];
double beta = eig[2*i+1];
double ss = (alpha+1)*(alpha+1)+beta*beta;
if (min > ss)
min = ss;
}
return min;
}
void TriangularSylvester::multEigVector(KronVector& eig, const Vector& feig,
const Vector& keig)
{
int depth = eig.getDepth();
int m = eig.getM();
int n = eig.getN();
if (depth == 0) {
eig = keig;
} else {
KronVector aux(m, n, depth-1);
multEigVector(aux, feig, keig);
for (int i = 0; i < m; i++) {
KronVector eigi(eig, i);
eigi.zeros();
eigi.add(&feig[2*i], aux);
}
}
}
// Local Variables:
// mode:C++
// End:

115
mex/sources/korderpert/Dyn_pp/sylv/cc/TriangularSylvester.h Normal file
View File

@ -0,0 +1,115 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/TriangularSylvester.h,v 1.1.1.1 2004/06/04 13:01:03 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef TRIANGULAR_SYLVESTER_H
#define TRIANGULAR_SYLVESTER_H
#include "SylvesterSolver.h"
#include "KronVector.h"
#include "QuasiTriangular.h"
#include "QuasiTriangularZero.h"
#include "SimilarityDecomp.h"
class TriangularSylvester : public SylvesterSolver {
const QuasiTriangular* const matrixKK;
const QuasiTriangular* const matrixFF;
public:
TriangularSylvester(const QuasiTriangular& k, const QuasiTriangular& f);
TriangularSylvester(const SchurDecompZero& kdecomp, const SchurDecomp& fdecomp);
TriangularSylvester(const SchurDecompZero& kdecomp, const SimilarityDecomp& fdecomp);
virtual ~TriangularSylvester();
void print() const;
void solve(SylvParams& pars, KronVector& d) const;
void solvi(double r, KronVector& d, double& eig_min) const;
void solvii(double alpha, double beta1, double beta2,
KronVector& d1, KronVector& d2,
double& eig_min) const;
void solviip(double alpha, double betas,
KronVector& d, double& eig_min) const;
/* evaluates:
|x1| |d1| |alpha -beta1| |d1|
| | = | |+| |\otimes F'...\otimes K | |
|x2| |d2| |beta2 alpha| |d2|
*/
void linEval(double alpha, double beta1, double beta2,
KronVector& x1, KronVector& x2,
const ConstKronVector& d1, const ConstKronVector& d2) const;
void linEval(double alpha, double beta1, double beta2,
KronVector& x1, KronVector& x2,
const KronVector& d1, const KronVector& d2) const
{linEval(alpha, beta1, beta2, x1, x2,
ConstKronVector(d1), ConstKronVector(d2));}
/* evaluates:
|x1| |d1| |gamma -delta1| |d1|
| | = | | + 2alpha*| |\otimes F'...\otimes K | | +
|x2| |d2| |delta2 gamma| |d2|
|gamma -delta1|^2 |d1|
+ (alpha^2+betas)*| |\otimes F'2...\otimes K2 | |
|delta2 gamma| |d2|
*/
void quaEval(double alpha, double betas,
double gamma, double delta1, double delta2,
KronVector& x1, KronVector& x2,
const ConstKronVector& d1, const ConstKronVector& d2) const;
void quaEval(double alpha, double betas,
double gamma, double delta1, double delta2,
KronVector& x1, KronVector& x2,
const KronVector& d1, const KronVector& d2) const
{quaEval(alpha, betas, gamma, delta1, delta2, x1, x2,
ConstKronVector(d1), ConstKronVector(d2));}
private:
/* returns square of size of minimal eigenvalue of the system solved,
now obsolete */
double getEigSep(int depth) const;
/* recursivelly calculates kronecker product of complex vectors (used in getEigSep) */
static void multEigVector(KronVector& eig, const Vector& feig, const Vector& keig);
/* auxiliary typedefs */
typedef QuasiTriangular::const_diag_iter const_diag_iter;
typedef QuasiTriangular::const_row_iter const_row_iter;
/* called from solvi */
void solviRealAndEliminate(double r, const_diag_iter di,
KronVector& d, double& eig_min) const;
void solviComplexAndEliminate(double r, const_diag_iter di,
KronVector& d, double& eig_min) const;
/* called from solviip */
void solviipRealAndEliminate(double alpha, double betas,
const_diag_iter di, const_diag_iter dsi,
KronVector& d, double& eig_min) const;
void solviipComplexAndEliminate(double alpha, double betas,
const_diag_iter di, const_diag_iter dsi,
KronVector& d, double& eig_min) const;
/* eliminations */
void solviEliminateReal(const_diag_iter di, KronVector& d,
const KronVector& y, double divisor) const;
void solviEliminateComplex(const_diag_iter di, KronVector& d,
const KronVector& y1, const KronVector& y2,
double divisor) const;
void solviipEliminateReal(const_diag_iter di, const_diag_iter dsi,
KronVector& d,
const KronVector& y1, const KronVector& y2,
double divisor, double divisor2) const;
void solviipEliminateComplex(const_diag_iter di, const_diag_iter dsi,
KronVector& d,
const KronVector& y1, const KronVector& y11,
const KronVector& y2, const KronVector& y22,
double divisor) const;
/* Lemma 2 */
void solviipComplex(double alpha, double betas, double gamma,
double delta1, double delta2,
KronVector& d1, KronVector& d2,
double& eig_min) const;
/* norms for what we consider zero on diagonal of F */
static double diag_zero;
static double diag_zero_sq; // square of diag_zero
};
#endif /* TRIANGULAR_SYLVESTER_H */
// Local Variables:
// mode:C++
// End:

366
mex/sources/korderpert/Dyn_pp/sylv/cc/Vector.cpp Normal file
View File

@ -0,0 +1,366 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/Vector.cpp,v 1.1.1.1 2004/06/04 13:01:13 kamenik Exp $ */
/* Tag $Name: $ */
#include "Vector.h"
#include "GeneralMatrix.h"
#include "SylvException.h"
#include "cppblas.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <cmath>
#include <algorithm>
#include <limits>
using namespace std;
ZeroPad zero_pad;
Vector::Vector(const ConstVector& v)
: len(v.length()), s(1), data(new double[len]), destroy(true)
{
copy(v.base(), v.skip());
}
const Vector& Vector::operator=(const Vector& v)
{
if (this == &v)
return *this;
if (v.length() != length()) {
throw SYLV_MES_EXCEPTION("Attempt to assign vectors with different lengths.");
}
if (s == v.s &&
(data <= v.data && v.data < data+len*s ||
v.data <= data && data < v.data+v.len*v.s) &&
(data-v.data) % s == 0) {
printf("this destroy=%d, v destroy=%d, data-v.data=%d, len=%d\n", destroy, v.destroy, data-v.data, len);
throw SYLV_MES_EXCEPTION("Attempt to assign overlapping vectors.");
}
copy(v.base(), v.skip());
return *this;
}
const Vector& Vector::operator=(const ConstVector& v)
{
if (v.length() != length()) {
throw SYLV_MES_EXCEPTION("Attempt to assign vectors with different lengths.");
}
if (v.skip() == 1 && skip() == 1 && (
(base() < v.base() + v.length() && base() >= v.base()) ||
(base() + length() < v.base() + v.length() &&
base() + length() > v.base()))) {
throw SYLV_MES_EXCEPTION("Attempt to assign overlapping vectors.");
}
copy(v.base(), v.skip());
return *this;
}
void Vector::copy(const double* d, int inc)
{
int n = length();
int incy = skip();
BLAS_dcopy(&n, d, &inc, base(), &incy);
}
Vector::Vector(Vector& v, int off, int l)
: len(l), s(v.skip()), data(v.base()+off*v.skip()), destroy(false)
{
if (off < 0 || off + length() > v.length())
throw SYLV_MES_EXCEPTION("Subvector not contained in supvector.");
}
Vector::Vector(const Vector& v, int off, int l)
: len(l), s(1), data(new double[len]), destroy(true)
{
if (off < 0 || off + length() > v.length())
throw SYLV_MES_EXCEPTION("Subvector not contained in supvector.");
copy(v.base()+off*v.skip(), v.skip());
}
Vector::Vector(GeneralMatrix& m, int col)
: len(m.numRows()), s(1), data(&(m.get(0, col))), destroy(false)
{
}
Vector::Vector(int row, GeneralMatrix& m)
: len(m.numCols()), s(m.getLD()), data(&(m.get(row, 0))), destroy(false)
{
}
bool Vector::operator==(const Vector& y) const
{
return ConstVector(*this) == y;
}
bool Vector::operator!=(const Vector& y) const
{
return ConstVector(*this) != y;
}
bool Vector::operator<(const Vector& y) const
{
return ConstVector(*this) < y;
}
bool Vector::operator<=(const Vector& y) const
{
return ConstVector(*this) <= y;
}
bool Vector::operator>(const Vector& y) const
{
return ConstVector(*this) > y;
}
bool Vector::operator>=(const Vector& y) const
{
return ConstVector(*this) >= y;
}
void Vector::zeros()
{
if (skip() == 1) {
double* p = base();
for (int i = 0; i < length()/ZeroPad::length;
i++, p += ZeroPad::length)
memcpy(p, zero_pad.getBase(), sizeof(double)*ZeroPad::length);
for ( ; p < base()+length(); p++)
*p = 0.0;
} else {
for (int i = 0; i < length(); i++)
operator[](i) = 0.0;
}
}
void Vector::nans()
{
for (int i = 0; i < length(); i++)
operator[](i) = std::numeric_limits<double>::quiet_NaN();
}
void Vector::infs()
{
for (int i = 0; i < length(); i++)
operator[](i) = std::numeric_limits<double>::infinity();
}
Vector::~Vector()
{
if (destroy) {
delete [] data;
}
}
void Vector::rotatePair(double alpha, double beta1, double beta2, int i)
{
double tmp = alpha*operator[](i) - beta1*operator[](i+1);
operator[](i+1) = alpha*operator[](i+1) - beta2*operator[](i);
operator[](i) = tmp;
}
void Vector::add(double r, const Vector& v)
{
add(r, ConstVector(v));
}
void Vector::add(double r, const ConstVector& v)
{
int n = length();
int incx = v.skip();
int incy = skip();
BLAS_daxpy(&n, &r, v.base(), &incx, base(), &incy);
}
void Vector::add(const double* z, const Vector& v)
{
add(z, ConstVector(v));
}
void Vector::add(const double* z, const ConstVector& v)
{
int n = length()/2;
int incx = v.skip();
int incy = skip();
BLAS_zaxpy(&n, z, v.base(), &incx, base(), &incy);
}
void Vector::mult(double r)
{
int n = length();
int incx = skip();
BLAS_dscal(&n, &r, base(), &incx);
}
void Vector::mult2(double alpha, double beta1, double beta2,
Vector& x1, Vector& x2,
const Vector& b1, const Vector& b2)
{
x1.zeros();
x2.zeros();
mult2a(alpha, beta1, beta2, x1, x2, b1, b2);
}
void Vector::mult2a(double alpha, double beta1, double beta2,
Vector& x1, Vector& x2,
const Vector& b1, const Vector& b2)
{
x1.add(alpha, b1);
x1.add(-beta1, b2);
x2.add(alpha, b2);
x2.add(-beta2, b1);
}
double Vector::getNorm() const
{
ConstVector v(*this);
return v.getNorm();
}
double Vector::getMax() const
{
ConstVector v(*this);
return v.getMax();
}
double Vector::getNorm1() const
{
ConstVector v(*this);
return v.getNorm1();
}
double Vector::dot(const Vector& y) const
{
return ConstVector(*this).dot(ConstVector(y));
}
bool Vector::isFinite() const
{
return (ConstVector(*this)).isFinite();
}
void Vector::print() const
{
for (int i = 0; i < length(); i++) {
printf("%d\t%8.4g\n", i, operator[](i));
}
}
ConstVector::ConstVector(const Vector& v, int off, int l)
: BaseConstVector(l, v.skip(), v.base() + v.skip()*off)
{
if (off < 0 || off + length() > v.length()) {
throw SYLV_MES_EXCEPTION("Subvector not contained in supvector.");
}
}
ConstVector::ConstVector(const ConstVector& v, int off, int l)
: BaseConstVector(l, v.skip(), v.base() + v.skip()*off)
{
if (off < 0 || off + length() > v.length()) {
throw SYLV_MES_EXCEPTION("Subvector not contained in supvector.");
}
}
ConstVector::ConstVector(const double* d, int skip, int l)
: BaseConstVector(l, skip, d)
{
}
ConstVector::ConstVector(const ConstGeneralMatrix& m, int col)
: BaseConstVector(m.numRows(), 1, &(m.get(0, col)))
{
}
ConstVector::ConstVector(int row, const ConstGeneralMatrix& m)
: BaseConstVector(m.numCols(), m.getLD(), &(m.get(row, 0)))
{
}
bool ConstVector::operator==(const ConstVector& y) const
{
if (length() != y.length())
return false;
if (length() == 0)
return true;
int i = 0;
while (i < length() && operator[](i) == y[i])
i++;
return i == length();
}
bool ConstVector::operator<(const ConstVector& y) const
{
int i = std::min(length(), y.length());
int ii = 0;
while (ii < i && operator[](ii) == y[ii])
ii++;
if (ii < i)
return operator[](ii) < y[ii];
else
return length() < y.length();
}
double ConstVector::getNorm() const
{
double s = 0;
for (int i = 0; i < length(); i++) {
s+=operator[](i)*operator[](i);
}
return sqrt(s);
}
double ConstVector::getMax() const
{
double r = 0;
for (int i = 0; i < length(); i++) {
if (abs(operator[](i))>r)
r = abs(operator[](i));
}
return r;
}
double ConstVector::getNorm1() const
{
double norm = 0.0;
for (int i = 0; i < length(); i++) {
norm += abs(operator[](i));
}
return norm;
}
double ConstVector::dot(const ConstVector& y) const
{
if (length() != y.length())
throw SYLV_MES_EXCEPTION("Vector has different length in ConstVector::dot.");
int n = length();
int incx = skip();
int incy = y.skip();
return BLAS_ddot(&n, base(), &incx, y.base(), &incy);
}
bool ConstVector::isFinite() const
{
int i = 0;
while (i < length() && isfinite(operator[](i)))
i++;
return i == length();
}
void ConstVector::print() const
{
for (int i = 0; i < length(); i++) {
printf("%d\t%8.4g\n", i, operator[](i));
}
}
ZeroPad::ZeroPad()
{
for (int i = 0; i < length; i++)
pad[i] = 0.0;
}

178
mex/sources/korderpert/Dyn_pp/sylv/cc/Vector.h Normal file
View File

@ -0,0 +1,178 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/Vector.h,v 1.1.1.1 2004/06/04 13:01:13 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef VECTOR_H
#define VECTOR_H
/* NOTE! Vector and ConstVector have not common super class in order
* to avoid running virtual method invokation mechanism. Some
* members, and methods are thus duplicated */
#include <stdio.h>
class GeneralMatrix;
class ConstVector;
class Vector {
protected:
int len;
int s;
double* data;
bool destroy;
public:
Vector() : len(0), s(1), data(0), destroy(false) {}
Vector(int l) : len(l), s(1), data(new double[l]), destroy(true) {}
Vector(Vector& v) : len(v.length()), s(v.skip()), data(v.base()), destroy(false) {}
Vector(const Vector& v)
: len(v.length()), s(1), data(new double[len]), destroy(true)
{copy(v.base(), v.skip());}
Vector(const ConstVector& v);
Vector(const double* d, int l)
: len(l), s(1), data(new double[len]), destroy(true)
{copy(d, 1);}
Vector(double* d, int l)
: len(l), s(1), data(d), destroy(false) {}
Vector(double* d, int skip, int l)
: len(l), s(skip), data(d), destroy(false) {}
Vector(Vector& v, int off, int l);
Vector(const Vector& v, int off, int l);
Vector(GeneralMatrix& m, int col);
Vector(int row, GeneralMatrix& m);
const Vector& operator=(const Vector& v);
const Vector& operator=(const ConstVector& v);
double& operator[](int i)
{return data[s*i];}
const double& operator[](int i) const
{return data[s*i];}
const double* base() const
{return data;}
double* base()
{return data;}
int length() const
{return len;}
int skip() const
{return s;}
/** Exact equality. */
bool operator==(const Vector& y) const;
bool operator!=(const Vector& y) const;
/** Lexicographic ordering. */
bool operator<(const Vector& y) const;
bool operator<=(const Vector& y) const;
bool operator>(const Vector& y) const;
bool operator>=(const Vector& y) const;
virtual ~Vector();
void zeros();
void nans();
void infs();
bool toBeDestroyed() const {return destroy;}
void rotatePair(double alpha, double beta1, double beta2, int i);
void add(double r, const Vector& v);
void add(double r, const ConstVector& v);
void add(const double* z, const Vector& v);
void add(const double* z, const ConstVector& v);
void mult(double r);
double getNorm() const;
double getMax() const;
double getNorm1() const;
double dot(const Vector& y) const;
bool isFinite() const;
void print() const;
/* multiplies | alpha -beta1| |b1| |x1|
| |\otimes I .| | = | |
| -beta2 alpha| |b2| |x2|
*/
static void mult2(double alpha, double beta1, double beta2,
Vector& x1, Vector& x2,
const Vector& b1, const Vector& b2);
/* same, but adds instead of set */
static void mult2a(double alpha, double beta1, double beta2,
Vector& x1, Vector& x2,
const Vector& b1, const Vector& b2);
/* same, but subtracts instead of add */
static void mult2s(double alpha, double beta1, double beta2,
Vector& x1, Vector& x2,
const Vector& b1, const Vector& b2)
{mult2a(-alpha, -beta1, -beta2, x1, x2, b1, b2);}
private:
void copy(const double* d, int inc);
const Vector& operator=(int); // must not be used (not implemented)
const Vector& operator=(double); // must not be used (not implemented)
};
class BaseConstVector {
protected:
int len;
int s;
const double* data;
public:
BaseConstVector(int l, int si, const double* d) : len(l), s(si), data(d) {}
BaseConstVector(const BaseConstVector& v) : len(v.len), s(v.s), data(v.data) {}
const BaseConstVector& operator=(const BaseConstVector& v)
{len = v.len; s = v.s; data = v.data; return *this;}
const double& operator[](int i) const
{return data[s*i];}
const double* base() const
{return data;}
int length() const
{return len;}
int skip() const
{return s;}
};
class ConstGeneralMatrix;
class ConstVector : public BaseConstVector {
public:
ConstVector(const Vector& v) : BaseConstVector(v.length(), v.skip(), v.base()) {}
ConstVector(const ConstVector& v) : BaseConstVector(v) {}
ConstVector(const double* d, int l) : BaseConstVector(l, 1, d) {}
ConstVector(const Vector& v, int off, int l);
ConstVector(const ConstVector& v, int off, int l);
ConstVector(const double* d, int skip, int l);
ConstVector(const ConstGeneralMatrix& m, int col);
ConstVector(int row, const ConstGeneralMatrix& m);
virtual ~ConstVector() {}
/** Exact equality. */
bool operator==(const ConstVector& y) const;
bool operator!=(const ConstVector& y) const
{return ! operator==(y);}
/** Lexicographic ordering. */
bool operator<(const ConstVector& y) const;
bool operator<=(const ConstVector& y) const
{return operator<(y) || operator==(y);}
bool operator>(const ConstVector& y) const
{return ! operator<=(y);}
bool operator>=(const ConstVector& y) const
{return ! operator<(y);}
double getNorm() const;
double getMax() const;
double getNorm1() const;
double dot(const ConstVector& y) const;
bool isFinite() const;
void print() const;
};
class ZeroPad {
public:
//static const int length = 16;
enum { length = 16};
private:
double pad[16];
public:
ZeroPad();
const double* getBase() const {return pad;}
};
#endif /* VECTOR_H */
// Local Variables:
// mode:C++
// End:

68
mex/sources/korderpert/Dyn_pp/sylv/cc/cppblas.h Normal file
View File

@ -0,0 +1,68 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/cppblas.h,v 1.2 2004/11/24 20:42:52 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef CPPBLAS_H
#define CPPBLAS_H
#if defined(MATLAB) && !defined(__linux__)
#define BLAS_dgemm dgemm
#define BLAS_dgemv dgemv
#define BLAS_dtrsv dtrsv
#define BLAS_dtrmv dtrmv
#define BLAS_daxpy daxpy
#define BLAS_dcopy dcopy
#define BLAS_zaxpy zaxpy
#define BLAS_dscal dscal
#define BLAS_dtrsm dtrsm
#define BLAS_ddot ddot
#else /* defined(MATLAB) && !defined(__linux__) */
#define BLAS_dgemm dgemm_
#define BLAS_dgemv dgemv_
#define BLAS_dtrsv dtrsv_
#define BLAS_dtrmv dtrmv_
#define BLAS_daxpy daxpy_
#define BLAS_dcopy dcopy_
#define BLAS_zaxpy zaxpy_
#define BLAS_dscal dscal_
#define BLAS_dtrsm dtrsm_
#define BLAS_ddot ddot_
#endif /* defined(MATLAB) && !defined(__linux__) */
#define BLCHAR const char*
#define CONST_BLINT const int*
#define CONST_BLDOU const double*
#define BLDOU double*
extern "C" {
void BLAS_dgemm(BLCHAR transa, BLCHAR transb, CONST_BLINT m, CONST_BLINT n,
CONST_BLINT k, CONST_BLDOU alpha, CONST_BLDOU a, CONST_BLINT lda,
CONST_BLDOU b, CONST_BLINT ldb, CONST_BLDOU beta,
BLDOU c, CONST_BLINT ldc);
void BLAS_dgemv(BLCHAR trans, CONST_BLINT m, CONST_BLINT n, CONST_BLDOU alpha,
CONST_BLDOU a, CONST_BLINT lda, CONST_BLDOU x, CONST_BLINT incx,
CONST_BLDOU beta, BLDOU y, CONST_BLINT incy);
void BLAS_dtrsv(BLCHAR uplo, BLCHAR trans, BLCHAR diag, CONST_BLINT n,
CONST_BLDOU a, CONST_BLINT lda, BLDOU x, CONST_BLINT incx);
void BLAS_dtrmv(BLCHAR uplo, BLCHAR trans, BLCHAR diag, CONST_BLINT n,
CONST_BLDOU a, CONST_BLINT lda, BLDOU x, CONST_BLINT incx);
void BLAS_daxpy(CONST_BLINT n, CONST_BLDOU a, CONST_BLDOU x, CONST_BLINT incx,
BLDOU y, CONST_BLINT incy);
void BLAS_dcopy(CONST_BLINT n, CONST_BLDOU x, CONST_BLINT incx,
BLDOU y, CONST_BLINT incy);
void BLAS_zaxpy(CONST_BLINT n, CONST_BLDOU a, CONST_BLDOU x, CONST_BLINT incx,
BLDOU y, CONST_BLINT incy);
void BLAS_dscal(CONST_BLINT n, CONST_BLDOU a, BLDOU x, CONST_BLINT incx);
void BLAS_dtrsm(BLCHAR side, BLCHAR uplo, BLCHAR transa, BLCHAR diag, CONST_BLINT m,
CONST_BLINT n, CONST_BLDOU alpha, CONST_BLDOU a, CONST_BLINT lda,
BLDOU b, CONST_BLINT ldb);
double BLAS_ddot(CONST_BLINT n, CONST_BLDOU x, CONST_BLINT incx, CONST_BLDOU y,
CONST_BLINT incy);
};
#endif /* CPPBLAS_H */
// Local Variables:
// mode:C++
// End:

82
mex/sources/korderpert/Dyn_pp/sylv/cc/cpplapack.h Normal file
View File

@ -0,0 +1,82 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/cc/cpplapack.h,v 1.3 2004/11/24 20:43:10 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef CPPLAPACK_H
#define CPPLAPACK_H
#if defined(MATLAB) && !defined(__linux__)
#define LAPACK_dgetrs dgetrs
#define LAPACK_dgetrf dgetrf
#define LAPACK_dgees dgees
#define LAPACK_dgecon dgecon
#define LAPACK_dtrexc dtrexc
#define LAPACK_dtrsyl dtrsyl
#define LAPACK_dpotrf dpotrf
#define LAPACK_dgges dgges
#define LAPACK_dsyev dsyev
#define LAPACK_dsyevr dsyevr
#else /* MATLAB */
#define LAPACK_dgetrs dgetrs_
#define LAPACK_dgetrf dgetrf_
#define LAPACK_dgees dgees_
#define LAPACK_dgecon dgecon_
#define LAPACK_dtrexc dtrexc_
#define LAPACK_dtrsyl dtrsyl_
#define LAPACK_dpotrf dpotrf_
#define LAPACK_dgges dgges_
#define LAPACK_dsyev dsyev_
#define LAPACK_dsyevr dsyevr_
#endif /* MATLAB */
#define LACHAR const char*
#define CONST_LAINT const int*
#define LAINT int*
#define CONST_LADOU const double*
#define LADOU double*
typedef int (*DGGESCRIT)(const double*, const double*, const double*);
extern "C" {
void LAPACK_dgetrs(LACHAR trans, CONST_LAINT n, CONST_LAINT nrhs,
CONST_LADOU a, CONST_LAINT lda, CONST_LAINT ipiv,
LADOU b, CONST_LAINT ldb, LAINT info);
void LAPACK_dgetrf(CONST_LAINT m, CONST_LAINT n, LADOU a,
CONST_LAINT lda, LAINT ipiv, LAINT info);
void LAPACK_dgees(LACHAR jobvs, LACHAR sort, const void* select,
CONST_LAINT n, LADOU a, CONST_LAINT lda, LAINT sdim,
LADOU wr, LADOU wi, LADOU vs, CONST_LAINT ldvs,
LADOU work, CONST_LAINT lwork, const void* bwork, LAINT info);
void LAPACK_dgecon(LACHAR norm, CONST_LAINT n, CONST_LADOU a, CONST_LAINT lda,
CONST_LADOU anorm, LADOU rnorm, LADOU work, LAINT iwork,
LAINT info);
void LAPACK_dtrexc(LACHAR compq, CONST_LAINT n, LADOU t, CONST_LAINT ldt,
LADOU q, CONST_LAINT ldq, LAINT ifst, LAINT ilst, LADOU work,
LAINT info);
void LAPACK_dtrsyl(LACHAR trana, LACHAR tranb, CONST_LAINT isgn, CONST_LAINT m,
CONST_LAINT n, CONST_LADOU a, CONST_LAINT lda, CONST_LADOU b,
CONST_LAINT ldb, LADOU c, CONST_LAINT ldc, LADOU scale,
LAINT info);
void LAPACK_dpotrf(LACHAR uplo, CONST_LAINT n, LADOU a, CONST_LAINT lda,
LAINT info);
void LAPACK_dgges(LACHAR jobvsl, LACHAR jobvsr, LACHAR sort, DGGESCRIT delztg,
CONST_LAINT n, LADOU a, CONST_LAINT lda, LADOU b, CONST_LAINT ldb,
LAINT sdim, LADOU alphar, LADOU alphai, LADOU beta,
LADOU vsl, CONST_LAINT ldvsl, LADOU vsr, CONST_LAINT ldvsr,
LADOU work, CONST_LAINT lwork, LAINT bwork, LAINT info);
void LAPACK_dsyev(LACHAR jobz, LACHAR uplo, CONST_LAINT n, LADOU a, CONST_LAINT lda,
LADOU w, LADOU work, CONST_LAINT lwork, LAINT info);
void LAPACK_dsyevr(LACHAR jobz, LACHAR range, LACHAR uplo, CONST_LAINT n, LADOU a,
CONST_LAINT lda, LADOU lv, LADOU vu, CONST_LAINT il, CONST_LAINT iu,
CONST_LADOU abstol, LAINT m, LADOU w, LADOU z, CONST_LAINT ldz,
LAINT isuppz, LADOU work, CONST_LAINT lwork, LAINT iwork, CONST_LAINT liwork,
LAINT info);
};
#endif /* CPPLAPACK_H */
// Local Variables:
// mode:C++
// End:

140
mex/sources/korderpert/Dyn_pp/sylv/change_log.html Normal file
View File

@ -0,0 +1,140 @@
<HTML>
<!-- $Header: /var/lib/cvs/dynare_cpp/sylv/change_log.html,v 1.1.1.1 2004/06/04 13:00:05 kamenik Exp $ -->
<!-- Tag $Name: $ -->
<TITLE>
Sylvester Solver Change Log
</TITLE>
<BODY>
<TABLE CELLSPACING=2 ALIGN="CENTER" BORDER=1>
<TR>
<TD BGCOLOR="#d0d0d0" WIDTH="85"> Tag </TD>
<TD BGCOLOR="#d0d0d0" WIDTH="80"> Date </TD>
<TD BGCOLOR="#d0d0d0" WIDTH="600"> Description/Changes</TD>
</TR>
<TR>
<TD></TD>
<TD>2003/09/10</TD>
<TD>Initial version solving triangular system put to repository</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Implemented solution of general case.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Implemented a memory pool (Paris).</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Implemented MEX interface to the routine (Paris).</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Implemented QuasiTriangularZero (Paris) (not fully used yet).</TD>
</TR>
<TR>
<TD>rel-1</TD>
<TD>2003/10-02</TD>
<TD>Version sent to Michel.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Inheritance streamlined, QuasiTriangular inherits from GeneralMatrix.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Implemented block diagonalization algorithm.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Solution routines rewritten so that the output rewrites input,
considerable memory improvement.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>MEX interface now links with LAPACK library from Matlab.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Added a hack to MEX library loading in order to avoid Matlab crash in Wins.</TD>
</TR>
<TR>
<TD>rel-2</TD>
<TD>2003/10/15</TD>
<TD>Version sent to Michel.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>KronUtils now rewrite input by output using less memory.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Added iterative solution algorithm (doubling).</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Introduced abstraction for set of parameters (SylvParams).</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Algorithm enabled to solve problems with singular C.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Implemented a class chooser chossing between QuasiTriangularZero,
and QuasiTriangular (padded with zero) depending on size of the
problem. Full use of QuasiTriangularZero.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Reimplemented QuasiTriangular::solve, offdiagonal elements are
eleiminated by gauss with partial pivoting, not by transformation of
complex eigenvalues. More stable for ill conditioned eigenvalues.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Reimplemented calculation of eliminating vectors, much more
numerically stable now.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>Implemented algorithm for ordering of eigenvalues (not used now,
no numerical improvements).</TD>
</TR>
<TR>
<TD>rel-3</TD>
<TD>2003/12/4</TD>
<TD>Version sent to Michel.</TD>
</TR>
<TR>
<TD></TD>
<TD></TD>
<TD>GeneralMatrix separated for use outside, in sylv module we use
its subclass SylvMatrix. Implemented ConstGeneralMatrix (useful outside).
</TD>
</TR>
<TR>
<TD>rel-4</TD>
<TD>2004/6/4</TD>
<TD>Version, which was moved to pythie.cepremap.cnrs.fr repository.</TD>
</TR>
</TABLE>
</BODY>
</HTML>

35
mex/sources/korderpert/Dyn_pp/sylv/matlab/Makefile Normal file
View File

@ -0,0 +1,35 @@
# $Header: /var/lib/cvs/dynare_cpp/sylv/matlab/Makefile,v 1.1.1.1 2004/06/04 13:01:13 kamenik Exp $
# Tag $Name: $
# set directory to sylvester code
sylv=../cc
LD_LIBS := -llapack -lcblas -lblas -latlas
CC_FLAGS := -Wall -I../cc
CC_DEFS := -I/usr/local/matlab73/extern/include -DMATLAB #-DUSE_MEMORY_POOL
MEX := mex.bat
objects := $(patsubst %.cpp,%.o,$(wildcard ../cc/*.cpp))
headers := $(wildcard ../cc/*.h)
# set mex file suffix
mex_suffix=dll
ifeq ($(OSTYPE),linux-gnu)
mex_suffix=mexglx
endif
aa_gensylv.$(mex_suffix): gensylv.cpp ../cc/sylvester.a
$(MEX) -I../cc -DMATLAB gensylv.cpp ../cc/sylvester.a c:/matlab6p5/extern/lib/win32/microsoft/msvc60/libmwlapack.lib
mv gensylv.$(mex_suffix) aa_gensylv.$(mex_suffix)
../cc/sylvester.a : $(objects)
make -C ../cc sylvester.a
../cc/%.o: ../cc/%.cpp $(headers)
make EXTERN_DEFS="$(CC_DEFS)" -C ../cc $*.o
clear:
make -C ../cc clear
rm -f *.dll
rm -f *.mexglx

3
mex/sources/korderpert/Dyn_pp/sylv/matlab/dummy.h Normal file
View File

@ -0,0 +1,3 @@
/* this is only dummy header file to be able to loadlibrary to MATLAB */
void mexFunction(int nhls, mxArray* plhs[],
int nhrs, const mxArray* prhs[]);

100
mex/sources/korderpert/Dyn_pp/sylv/matlab/gensylv.cpp Normal file
View File

@ -0,0 +1,100 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/matlab/gensylv.cpp,v 1.1.1.1 2004/06/04 13:01:13 kamenik Exp $ */
/* Tag $Name: $ */
#include "mex.h"
#include "GeneralSylvester.h"
#include "SylvException.h"
void gen_sylv_solve(int order, int n, int m, int zero_cols,
const double* A, const double* B,
const double* C, double* X)
{
try {
GeneralSylvester s(order, n, m, zero_cols, A, B, C, X, false);
s.solve();
} catch (const SylvException& e) {
char mes[1000];
e.printMessage(mes, 999);
mexErrMsgTxt(mes);
}
}
void gen_sylv_solve_and_check(int order, int n, int m, int zero_cols,
const double* A, const double* B,
const double* C, const double* D,
double* X, mxArray*& p)
{
try {
GeneralSylvester s(order, n, m, zero_cols, A, B, C, X, true);
s.solve();
s.check(D);
p = s.getParams().createStructArray();
} catch (const SylvException& e) {
char mes[1000];
e.printMessage(mes, 999);
mexErrMsgTxt(mes);
}
}
void checkDimensions(const mwSize* const Adims, const mwSize* const Bdims,
const mwSize* const Cdims, const mwSize* const Ddims,
int order)
{
if (Adims[0] != Adims[1])
mexErrMsgTxt("Matrix A must be a square matrix.");
if (Adims[0] != Bdims[0])
mexErrMsgTxt("Matrix A and matrix B must have the same number of rows.");
if (Adims[0] != Ddims[0])
mexErrMsgTxt("Matrix A and matrix B must have the same number of rows.");
if (Cdims[0] != Cdims[1])
mexErrMsgTxt("Matrix C must be square.");
if (Bdims[0] < Bdims[1])
mexErrMsgTxt("Matrix B must not have more columns than rows.");
if (Ddims[1] != power(Cdims[0], order))
mexErrMsgTxt("Matrix D has wrong number of columns.");
}
extern "C" {
void mexFunction(int nhls, mxArray* plhs[],
int nhrs, const mxArray* prhs[])
{
if (nhrs != 5)
mexErrMsgTxt("Must have exactly 5 input args.");
if (nhls !=1 && nhls != 2)
mexErrMsgTxt("Must have 1 or 2 output args.");
int order = (int)mxGetScalar(prhs[0]);
const mxArray* const A = prhs[1];
const mxArray* const B = prhs[2];
const mxArray* const C = prhs[3];
const mxArray* const D = prhs[4];
const mwSize* const Adims = mxGetDimensions(A);
const mwSize* const Bdims = mxGetDimensions(B);
const mwSize* const Cdims = mxGetDimensions(C);
const mwSize* const Ddims = mxGetDimensions(D);
checkDimensions(Adims, Bdims, Cdims, Ddims, order);
int n = Adims[0];
int m = Cdims[0];
int zero_cols = Bdims[0] - Bdims[1];
mxArray* X = mxCreateDoubleMatrix(Ddims[0], Ddims[1], mxREAL);
// copy D to X
Vector Xvec((double*)mxGetPr(X), power(m, order)*n);
ConstVector Dvec((double*)mxGetPr(D), power(m, order)*n);
Xvec = Dvec;
// solve (or solve and check)
if (nhls == 1) {
gen_sylv_solve(order, n, m, zero_cols,
mxGetPr(A), mxGetPr(B), mxGetPr(C),
mxGetPr(X));
} else if (nhls == 2) {
gen_sylv_solve_and_check(order, n, m, zero_cols,
mxGetPr(A), mxGetPr(B), mxGetPr(C),
mxGetPr(D), mxGetPr(X), plhs[1]);
}
plhs[0] = X;
}
};

74
mex/sources/korderpert/Dyn_pp/sylv/matlab/gensylv.m Normal file
View File

@ -0,0 +1,74 @@
%
% GENSYLV solves the following matrix equation:
% A*X + [0 B]*X*kron(C,..,C) = D,
% where
% A ...... regular (n,n) matrix,
% [0 B] .. (n,n) matrix with a few first
% columns equal to zeros
% B ...... rectangular (n, nz) matrix with nz<=n
% C ...... regular (m,m) matrix, whose spectrum is
% within (-1, 1)
% kron(C,..,C)
% ...... Kronecker power of C of order 'order'
% D ..... rectangular (n, m^order) matrix.
%
% X = gensylv(order, A, B, C, D)
% returns X as the solution, doesn't perform any checks
%
% [X, par] = gensylv(order, A, B, C, D)
% solves the system, and performs checks. 'par' is struct
% containing information about solution and error norms
% returned by the check. This is a list of the struct
% members, some of them may be missing in actual returned
% value:
% method = method used for solution recursive/iterative
% convergence_tol = convergence tolerance for iter. method
% max_num_iter = max number of steps for iter. method
% bs_norm = Bavely Stewart log10 norm for diagonalization
% converged = convergence status for iterative method
% iter_last_norm = residual norm of the last step of iterations
% num_iter = number of iterations performed
% f_err1 = norm 1 of abs. error C-V*F*inv(V)
% f_errI = norm Inf of abs. error C-V*F*inv(V)
% viv_err1 = norm 1 of abs. error I-V*inv(V)
% viv_errI = norm Inf of abs. error I-V*inv(V)
% ivv_err1 = norm 1 of abs. error I-inv(V)*V
% ivv_errI = norm Inf of abs. error I-inv(V)*V
% f_blocks = number of diagonal blocks of F
% f_largest = size of largest diagonal block in F
% f_zeros = number of off diagonal zeros in F
% f_offdiag = number of all offdiagonal elements in F
% rcondA1 = reciprocal cond 1 number of A
% rcondAI = reciprocal cond Inf number of A
% eig_min = minimum eigenvalue of vectorized system
% mat_err1 = rel. matrix 1 norm of A*X-[0 B]*X*kron(C,..,C)-D
% mat_errI = rel. matrix Inf norm of --"--
% mat_errF = rel. matrix Frobenius norm of --"--
% vec_err1 = rel. vector 1 norm of --"--
% vec_errI = rel. vector Inf norm of --"--
% cpu_time = CPU time needed for solution in CPU seconds
%
% $Header: /var/lib/cvs/dynare_cpp/sylv/matlab/gensylv.m,v 1.1.1.1 2004/06/04 13:01:13 kamenik Exp $
% Tag $Name: $
function [X, varargout] = gensylv(order, A, B, C, D)
% in Windows, ensure that aa_gensylv.dll is loaded, this prevents
% clearing the function and a successive Matlab crash
if strcmp('PCWIN', computer)
if ~ libisloaded('aa_gensylv')
loadlibrary('aa_gensylv', 'dummy');
end
end
% launch aa_gensylv
if nargout == 1
X = aa_gensylv(order, A, B, C, D);
elseif nargout == 2
[X, par] = aa_gensylv(order, A, B, C, D);
varargout(1) = {par};
else
error('Must have 1 or 2 output arguments.');
end

59
mex/sources/korderpert/Dyn_pp/sylv/matlab/mexopts.bat Normal file
View File

@ -0,0 +1,59 @@
@echo off
rem $Header: /var/lib/cvs/dynare_cpp/sylv/matlab/mexopts.bat,v 1.1.1.1 2004/06/04 13:01:13 kamenik Exp $
rem Tag $Name: $
rem c:\ondra\wk\sylv\matlab\mexopts.bat
rem Generated by gnumex.m script in c:\fs\gnumex
rem gnumex version: 1.08
rem Compile and link options used for building MEX etc files with
rem the Mingw/Cygwin tools. Options here are:
rem Cygwin (cygwin*.dll) linking
rem Mex file creation
rem Standard (safe) linking to temporary libraries
rem Language C / C++
rem Matlab version 6.5
rem
set MATLAB=C:\MATLAB~2
set GM_PERLPATH=C:\MATLAB~2\sys\perl\win32\bin\perl.exe
set GM_UTIL_PATH=c:\fs\gnumex
set PATH=C:\fs\cygwin\bin;%PATH%
rem
rem Added libraries for linking
set GM_ADD_LIBS=
rem
rem Type of file to compile (mex or engine)
set GM_MEXTYPE=mex
rem
rem Language for compilation
set GM_MEXLANG=c
rem
rem def files to be converted to libs
set GM_DEFS2LINK=libmx.def;libmex.def;libmat.def;_libmatlbmx.def;
rem
rem dlltool command line
set GM_DLLTOOL=c:\fs\gnumex\mexdlltool -E --as C:\fs\cygwin\bin\as.exe
rem
rem compiler options; add compiler flags to compflags as desired
set NAME_OBJECT=-o
set COMPILER=gcc
set COMPFLAGS=-c -DMATLAB_MEX_FILE
set OPTIMFLAGS=-O3 -mcpu=pentium -malign-double
set DEBUGFLAGS=-g
set CPPCOMPFLAGS=%COMPFLAGS% -x c++
set CPPOPTIMFLAGS=%OPTIMFLAGS%
set CPPDEBUGFLAGS=%DEBUGFLAGS%
rem
rem NB Library creation commands occur in linker scripts
rem
rem Linker parameters
set LINKER=%GM_PERLPATH% %GM_UTIL_PATH%\linkmex.pl
set LINKFLAGS=
set CPPLINKFLAGS= --driver-name c++
set LINKOPTIMFLAGS=-s
set LINKDEBUGFLAGS=-g
set LINK_FILE=
set LINK_LIB=
set NAME_OUTPUT=-o %OUTDIR%%MEX_NAME%.dll
rem
rem Resource compiler parameters
set RC_COMPILER=%GM_PERLPATH% %GM_UTIL_PATH%\rccompile.pl --unix -o %OUTDIR%mexversion.res
set RC_LINKER=

541
mex/sources/korderpert/Dyn_pp/sylv/sylvester.tex Normal file
View File

@ -0,0 +1,541 @@
\input amstex
\documentstyle{amsppt}
\def\vec{\mathop{\hbox{vec}}}
\def\otimesi{\mathop{\overset{\ssize i}\to{\otimes}}}
\def\iF{\,^i\!F}
\def\imF{\,^{i-1}\!F}
\def\solvi{\bold{solv1}}
\def\solvii{\bold{solv2}}
\def\solviip{\bold{solv2p}}
\topmatter
\title Solution of Specialized Sylvester Equation\endtitle
\author Ondra Kamenik\endauthor
\email ondrej.kamenik@cnb.cz\endemail
\endtopmatter
\document
Given the following matrix equation
$$AX+BX\left(\otimesi C\right)=D,$$ where $A$ is regular $n\times n$
matrix, $X$ is $n\times m^i$ matrix of unknowns, $B$ is singular
$n\times n$ matrix, $C$ is $m\times m$ regular matrix with
$|\beta(C)|<1$ (i.e. modulus of largest eigenvalue is less than one),
$i$ is an order of Kronecker product, and finally $D$ is $n\times m^i$
matrix.
First we multiply the equation from the left by $A^{-1}$ to obtain:
$$X+A^{-1}BX\left(\otimesi C\right)=A^{-1}D$$
Then we find real Schur decomposition $K=UA^{-1}BU^T$, and
$F=VCV^T$. The equation can be written as
$$UX\left(\otimesi V^T\right) +
KUX\left(\otimesi V^T\right)\left(\otimesi F\right) =
UA^{-1}D\left(\otimesi V^T\right)$$
This can be rewritten as
$$Y + KY\left(\otimesi F\right)=\widehat{D},$$
and vectorized
$$\left(I+\otimesi F^T\otimes K\right)\vec(Y)=\vec(\widehat{D})$$
Let $\iF$ denote $\otimesi F^T$ for the rest of the text.
\proclaim{Lemma 1}
For any $n\times n$ matrix $A$ and $\beta_1\beta_2>0$, if there is
exactly one solution of
$$\left(I_2\otimes I_n +
\pmatrix\alpha&\beta_1\cr-\beta_2&\alpha\endpmatrix
\otimes A\right)\pmatrix x_1\cr x_2\endpmatrix =
\pmatrix d_1\cr d_2\endpmatrix,$$
then it can be obtained as solution of
$$\align
\left(I_n + 2\alpha A+(\alpha^2+\beta^2)A^2\right)x_1 & =
\widehat{d_1}\\
\left(I_n + 2\alpha A+(\alpha^2+\beta^2)A^2\right)x_2 & =
\widehat{d_2}
\endalign$$
where $\beta=\sqrt{\beta1\beta2}$, and
$$
\pmatrix \widehat{d_1}\cr\widehat{d_2}\endpmatrix =
\left(I_2\otimes I_n +
\pmatrix\alpha&-\beta_1\cr\beta_2&\alpha\endpmatrix
\otimes A\right)\pmatrix d_1\cr d_2\endpmatrix$$
\endproclaim
\demo{Proof} Since
$$
\pmatrix \alpha&\beta_1\cr-\beta_2&\alpha\endpmatrix
\pmatrix \alpha&-\beta_1\cr\beta_2&\alpha\endpmatrix
=
\pmatrix \alpha&-\beta_1\cr\beta_2&\alpha\endpmatrix
\pmatrix \alpha&\beta_1\cr-\beta_2&\alpha\endpmatrix
=
\pmatrix \alpha^2+\beta^2&0\cr 0&\alpha^2+\beta^2\endpmatrix,
$$
it is easy to see that if the equation is multiplied by
$$I_2\otimes I_n +
\pmatrix\alpha&-\beta_1\cr\beta_2&\alpha\endpmatrix
\otimes A$$
we obtain the result. We only need to prove that the matrix is
regular. But this is clear because matrix
$$\pmatrix \alpha&-\beta_1\cr\beta_2&\alpha\endpmatrix$$
collapses an eigenvalue of $A$ to $-1$ iff the matrix
$$\pmatrix \alpha&\beta_1\cr-\beta_2&\alpha\endpmatrix$$
does.\qed
\enddemo
\proclaim{Lemma 2}
For any $n\times n$ matrix $A$ and $\delta_1\delta_2>0$, if there is
exactly one solution of
$$\left(I_2\otimes I_n +
2\alpha\pmatrix\gamma&\delta_1\cr-\delta_2&\gamma\endpmatrix\otimes A
+(\alpha^2+\beta^2)
\pmatrix\gamma&\delta_1\cr-\delta_2&\gamma\endpmatrix^2\otimes A^2\right)
\pmatrix x_1\cr x_2\endpmatrix=
\pmatrix d_1\cr d_2\endpmatrix
$$
it can be obtained as
$$
\align
\left(I_n+2a_1A+(a_1^2+b_1^2)A^2\right)\left(I_n+2a_2A+(a_2^2+b_2^2)A^2\right)
x_1 & =\widehat{d_1}\\
\left(I_n+2a_1A+(a_1^2+b_1^2)A^2\right)\left(I_n+2a_2A+(a_2^2+b_2^2)A^2\right)
x_2 & =\widehat{d_2}
\endalign$$
where
$$
\pmatrix \widehat{d_1}\cr\widehat{d_2}\endpmatrix =
\left(I_2\otimes I_n +
2\alpha\pmatrix\gamma&-\delta_1\cr\delta_2&\gamma\endpmatrix\otimes A
+(\alpha^2+\beta^2)
\pmatrix\gamma&-\delta_1\cr\delta_2&\gamma\endpmatrix^2\otimes A^2\right)
\pmatrix d_1\cr d_2\endpmatrix
$$
and
$$
\align
a_1 & = \alpha\gamma - \beta\delta\\
b_1 & = \alpha\delta + \gamma\beta\\
a_2 & = \alpha\gamma + \beta\delta\\
b_2 & = \alpha\delta - \gamma\beta\\
\delta & = \sqrt{\delta_1\delta_2}
\endalign$$
\endproclaim
\demo{Proof}
The matrix can be written as
$$\left(I_2\otimes I_n+(\alpha+\roman i\beta)
\pmatrix\gamma&\delta_1\cr-\delta_2&\gamma\endpmatrix\otimes A\right)
\left(I_2\otimes I_n +(\alpha-\roman i\beta)
\pmatrix\gamma&\delta_1\cr-\delta_2&\gamma\endpmatrix\otimes A\right).
$$
Note that the both matrices are regular since their product is
regular. For the same reason as in the previous proof, the following
matrix is also regular
$$\left(I_2\otimes I_n+(\alpha+\roman i\beta)
\pmatrix\gamma&-\delta_1\cr\delta_2&\gamma\endpmatrix\otimes A\right)
\left(I_2\otimes I_n +(\alpha-\roman i\beta)
\pmatrix\gamma&-\delta_1\cr\delta_2&\gamma\endpmatrix\otimes A\right),
$$
and we may multiply the equation by this matrix obtaining
$\widehat{d_1}$ and $\widehat{d_2}$. Note that the four matrices
commute, that is why we can write the whole product as
$$
\align
\left(I_2\otimes I_n + (\alpha+\roman i\beta)
\pmatrix\gamma&\delta_1\cr-\delta_2&\gamma\endpmatrix\otimes A\right)\cdot
\left(I_2\otimes I_n + (\alpha+\roman i\beta)
\pmatrix\gamma&-\delta_1\cr\delta_2&\gamma\endpmatrix\otimes A\right)&\cdot\\
\left(I_2\otimes I_n + (\alpha-\roman i\beta)
\pmatrix\gamma&\delta_1\cr-\delta_2&\gamma\endpmatrix\otimes A\right)\cdot
\left(I_2\otimes I_n + (\alpha-\roman i\beta)
\pmatrix\gamma&-\delta_1\cr\delta_2&\gamma\endpmatrix\otimes A\right)&=\\
\left(I_2\otimes I_n + 2(\alpha + \roman i\beta)
\pmatrix\gamma&0\cr 0&\gamma\endpmatrix\otimes A +
(\alpha + \roman i\beta)^2
\pmatrix\gamma^2+\delta^2&0\cr 0&\gamma^2+\delta^2\endpmatrix\otimes A^2
\right)&\cdot\\
\left(I_2\otimes I_n + 2(\alpha - \roman i\beta)
\pmatrix\gamma&0\cr 0&\gamma\endpmatrix\otimes A +
(\alpha - \roman i\beta)^2
\pmatrix\gamma^2+\delta^2&0\cr 0&\gamma^2+\delta^2\endpmatrix\otimes A^2
\right)&
\endalign
$$
The product is a diagonal consiting of two $n\times n$ blocks, which are the
same. The block can be rewritten as product:
$$
\align
(I_n+(\alpha+\roman i\beta)(\gamma+\roman i\delta)A)\cdot
(I_n+(\alpha+\roman i\beta)(\gamma-\roman i\delta)A)&\cdot\\
(I_n+(\alpha-\roman i\beta)(\gamma+\roman i\delta)A)\cdot
(I_n+(\alpha-\roman i\beta)(\gamma-\roman i\delta)A)&
\endalign
$$
and after reordering
$$
\align
(I_n+(\alpha+\roman i\beta)(\gamma+\roman i\delta)A)\cdot
(I_n+(\alpha-\roman i\beta)(\gamma-\roman i\delta)A)&\cdot\\
(I_n+(\alpha+\roman i\beta)(\gamma-\roman i\delta)A)\cdot
(I_n+(\alpha-\roman i\beta)(\gamma+\roman i\delta)A)&=\\
(I_n+2(\alpha\gamma-\beta\delta)A+
(\alpha^2+\beta^2)(\gamma^2+\delta^2)A^2)&\cdot\\
(I_n+2(\alpha\gamma+\beta\delta)A+
(\alpha^2+\beta^2)(\gamma^2+\delta^2)A^2)&
\endalign
$$
Now it suffices to compare $a_1=\alpha\gamma-\beta\delta$ and verify
that
$$
\align
b_1^2 & = (\alpha^2+\beta^2)(\gamma^2+\delta^2)-a_1^2 =\cr
& = \alpha^2\gamma^2+\beta^2\gamma^2+\alpha^2\beta^2+\beta^2\delta^2-
(\alpha\gamma)^2+2\alpha\beta\gamma\delta-(\beta\delta)^2=\cr
& = (\beta\gamma)^2 + (\alpha\beta)^2 + 2\alpha\beta\gamma\delta=\cr
& = (\beta\gamma +\alpha\beta)^2
\endalign
$$
For $b_2$ it is done in the same way.
\qed
\enddemo
\head The Algorithm\endhead
Below we define three functions of which
$\vec(Y)=\solvi(1,\vec(\widehat{D}),i)$ provides the solution $Y$. $X$
is then obtained as $X=U^TY\left(\otimesi V\right)$.
\subhead Synopsis\endsubhead
$F^T$ is $m\times m$ lower quasi-triangular matrix. Let $m_r$ be a
number of real eigenvalues, $m_c$ number of complex pairs. Thus
$m=m_r+2m_c$. Let $F_j$ denote
$j$-th diagonal block of $F^T$ ($1\times 1$ or $2\times 2$ matrix) for
$j=1,\ldots, m_r+m_c$. For a fixed $j$, let $\bar j$ denote index of the
first column of $F_j$ in $F^T$. Whenever we write something like
$(I_{m^i}\otimes I_n+r\iF\otimes K)x = d$, $x$ and $d$ denote column
vectors of appropriate dimensions, and $x_{\bar j}$ is $\bar j$-th
partition of $x$, and $x_j=(x_{\bar j}\quad x_{\bar j+1})^T$ if $j$-th
eigenvalue is complex, and $x_j=x_{\bar j}$ if $j$-th eigenvalue is real.
\subhead Function $\solvi$\endsubhead
The function $x=\solvi(r,d,i)$ solves equation
$$\left(I_{m^i}\otimes I_n+r\iF\otimes K\right)x = d.$$
The function proceedes as follows:
If $i=0$, the equation is solved directly, $K$ is upper
quasi-triangular matrix, so this is easy.
If $i>0$, then we go through diagonal blocks $F_j$ for
$j=1,\ldots, m_r+m_c$ and perform:
\roster
\item if $F_j=(f_{\bar j\bar j}) = (f)$, then we return
$x_j=\solvi(rf,d_{\bar j}, i-1)$. Then precalculate $y=d_j-x_j$, and
eliminate guys below $F_j$. This is, for each $k=\bar j+1,\ldots, m$, we
put
$$d_k = d_k-rf_{\bar jk}\left(\imF\otimes K\right)x_{\bar j}=
d_k - \frac{f_{\bar jk}}{f}y$$
\item if $F_j=\pmatrix\alpha&\beta_1\cr -\beta_2&\alpha\endpmatrix$,
we return $x_j=\solvii(r\alpha, r\beta_1, r\beta_2, d_j, i-1)$. Then
we precalculate
$$y=\left(\pmatrix\alpha&-\beta_1\cr \beta_2&\alpha\endpmatrix
\otimes I_{m^{i-1}}\otimes I_n\right)
\pmatrix d_{\bar j} - x_{\bar j}\cr
d_{\bar j+1} - x_{\bar j+1}
\endpmatrix$$
and eliminate guys below $F_j$. This is, for each $k=\bar j+2,\ldots, n$
we put
$$
\align
d_k &= d_k - r(f_{{\bar j}k}\quad f_{{\bar j}+1 k})
\otimes\left(\imF\otimes K\right)x_j\\
&= d_k - \frac{1}{\alpha^2+\beta_1\beta_2}
\left((f_{{\bar j}k}\quad f_{{\bar j}+1 k})
\otimes I_{m^{i-1}}\otimes I_n\right)y
\endalign
$$
\endroster
\subhead Function $\solvii$\endsubhead
The function $x=\solvii(\alpha, \beta_1, \beta_2, d, i)$ solves
equation
$$
\left(I_2\otimes I_{m^i}\otimes I_n +
\pmatrix\alpha&\beta_1\cr-\beta_2&\alpha\endpmatrix
\otimes\iF\otimes K\right)x=d
$$
According to {\bf Lemma 1} the function returns
$$
x=\pmatrix\solviip(\alpha,\beta_1\beta_2,\widehat{d_1},i)\cr
\solviip(\alpha,\beta_1\beta_2,\widehat{d_2},i)\endpmatrix,
$$
where $\widehat{d_1}$, and $\widehat{d_2}$ are partitions of
$\widehat{d}$ from the lemma.
\subhead Function $\solviip$\endsubhead
The function $x=\solviip(\alpha,\beta^2,d,i)$ solves equation
$$
\left(I_{m^i}\otimes I_n + 2\alpha\iF\otimes K +
(\alpha^2+\beta^2)\iF^2\otimes K^2\right)x = d
$$
The function proceedes as follows:
If $i=0$, the matrix $I_n+2\alpha K+(\alpha^2+\beta^2)K^2$ is
calculated and the solution is obtained directly.
Now note that diagonal blocks of $F^{2T}$ are of the form $F_j^2$,
since if the $F^T$ is block partitioned according to diagonal blocks,
then it is lower triangular.
If $i>0$, then we go through diagonal blocks $F_j$ for $j=1,\ldots, m_r+m_c$
and perform:
\roster
\item if $F_j=(f_{\bar j\bar j})=(f)$ then $j$-th diagonal block of
$$
I_{m^i}\otimes I_n + 2\alpha\iF\otimes K +
(\alpha^2+\beta^2)\iF^2\otimes K^2
$$
takes the form
$$
I_{m^{i-1}}\otimes I_n +2\alpha f\imF\otimes K +
(\alpha^2+\beta^2)f^2\imF^2\otimes K^2
$$
and we can put $x_j = \solviip(f\alpha,f^2\beta^2,d_j,i-1)$.
Then we need to eliminate guys below $F_j$. Note that $|f^2|<|f|$,
therefore we precalculate $y_2=(\alpha^2+\beta^2)f^2(\imF^2\otimes K^2)x_j$,
and then precalculate
$$y_1 = 2\alpha f(\imF\otimes K)x_j = d_j-x_j-y_2.$$
Let $g_{pq}$ denote element of $F^{2T}$ at position $(q,p)$.
The elimination is done by going through $k=\bar j+1,\ldots, m$ and
putting
$$
\align
d_k &= d_k - \left(2\alpha f_{\bar j k}\imF\otimes K +
(\alpha^2+\beta^2)g_{\bar j k}\imF^2\otimes K^2\right)x_j\\
&= d_k - \frac{f_{\bar j k}}{f}y_1 -
\frac{g_{\bar j k}}{f^2}y_2
\endalign
$$
\item if $F_j=\pmatrix\gamma&\delta_1\cr -\delta_2&\gamma\endpmatrix$,
then $j$-th diagonal block of
$$
I_{m^i}\otimes I_n + 2\alpha\iF\otimes K +
(\alpha^2+\beta^2)\iF^2\otimes K^2
$$
takes the form
$$
I_{m^{i-1}}\otimes I_n +2\alpha
\pmatrix\gamma&\delta_1\cr -\delta_2&\gamma\endpmatrix\imF\otimes K
+(\alpha^2+\beta^2)
\pmatrix\gamma&\delta_1\cr -\delta_2&\gamma\endpmatrix^2\imF^2\otimes K^2
$$
According to {\bf Lemma 2}, we need to calculate
$\widehat{d}_{\bar j}$, and $\widehat{d}_{\bar j+1}$, and $a_1$,
$b_1$, $a_2$, $b_2$. Then we obtain
$$
\align
x_{\bar j}&=
\solviip(a_1,b_1^2,\solviip(a_2,b_2^2,\widehat{d}_{\bar j},i-1),i-1)\\
x_{\bar j+1}&=
\solviip(a_1,b_1^2,\solviip(a_2,b_2^2,\widehat{d}_{\bar j+1},i-1),i-1)
\endalign
$$
Now we need to eliminate guys below $F_j$. Since $\Vert F^2_j\Vert <
\Vert F_j\Vert$, we precalculate
$$
\align
y_2&=(\alpha^2+\beta^2)(\gamma^2+\delta^2)
\left(I_2\otimes\imF^2\otimes K^2\right)x_j\\
y_1&=2\alpha(\gamma^2+\delta^2)\left(I_2\otimes\imF\otimes
K\right)x_j\\
&=(\gamma^2+\delta^2)
\left(F_j^{-1}
\otimes I_{m^{i-1}n}\right)
\left(d_j-x_j-\frac{1}{(\gamma^2+\delta^2)}
\left(
F_j^2
\otimes I_{m^{i-1}n}\right)y_2\right)\\
&=\left(\pmatrix\gamma&-\delta_1\cr\delta_2&\gamma\endpmatrix
\otimes I_{m^{i-1}n}\right)(d_j-x_j)
-\left(\pmatrix\gamma&\delta_1\cr-\delta_2&\gamma\endpmatrix
\otimes I_{m^{i-1}n}\right)y_2
\endalign
$$
Then we go through all $k=\bar j+2,\ldots, m$. For clearer formulas, let
$\bold f_k$ denote pair of $F^T$ elements in $k$-th line below $F_j$,
this is $\bold f_k=(f_{\bar jk}\quad f_{\bar j+1k})$. And let $\bold g_k$
denote the same for $F^{2T}$, this is $\bold g_k=(g_{\bar jk}\quad
g_{\bar j+1k})$. For each $k$ we put
$$
\align
d_k &= d_k - \left(2\alpha\bold f_k\otimes
\imF\otimes K +
(\alpha^2+\beta^2)\bold g_k\otimes
\imF^2\otimes K^2\right)x_j\\
&= d_k - \frac{1}{\gamma^2+\delta^2}
\left(\bold f_k\otimes
I_{m^{i-1}n}\right)y_1
- \frac{1}{\gamma^2+\delta^2}
\left(\bold g_k\otimes
I_{m^{i-1}n}\right)y_2
\endalign
$$
\endroster
\head Final Notes\endhead
\subhead Numerical Issues of $A^{-1}B$\endsubhead
We began the solution of the Sylvester equation with multiplication by
$A^{-1}$. This can introduce numerical errors, and we need more
numerically stable supplement. Its aim is to make $A$ and $B$
commutative, this is we need to find a regular matrix $P$, such that
$(PA)(PB)=(PB)(PA)$. Recall that this is neccessary in solution of
$$
(I_2\otimes I_{m^i}\otimes (PA)+(D+C)\otimes\,\iF\otimes (PB))x=d,
$$
since this equation is
multiplied by $I_2\otimes I_{m^i}\otimes (PA)+(D-C)\otimes\,\iF\otimes PB$,
and the diagonal
result
$$
I_2\otimes I_{m^i}\otimes (PAPA) + 2D\otimes\,\iF\otimes (PAPB) +
(D^2-C^2)\otimes\,\iF^2\otimes (PBPB)
$$
is obtained only if
$(PA)(PB)=(PB)(PA)$.
Finding regular solution of $(PA)(PB)=(PB)(PA)$ is equivalent to
finding regular solution of $APB-BPA=0$. Numerical error of the former
equation is $P$-times greater than the numerical error of the latter
equation. And the numerical error of the latter equation also grows
with the size of $P$. On the other hand, truncation error in $P$
multiplication decreases with growing the size of $P$. By intuition,
stability analysis will show that the best choice is some orthonormal
$P$.
Obviously, since $A$ is regular, the equation $APB-BPA=0$ has solution
of the form $P=\alpha A^{-1}$, where $\alpha\neq 0$. There is a vector
space of all solutions $P$ (including singular ones). In precise
arithmetics, its dimension is $\sum n^2_i$, where $n_i$ is number of
repetitions of $i$-th eigenvalue of $A^{-1}B$ which is similar to
$BA^{-1}$. In floating point arithmetics, without any further
knowledge about $A$, and $B$, we are only sure about dimension $n$
which is implied by similarity of $A^{-1}B$ and $BA^{-1}$. Now we try
to find the base of the vector space of solutions.
Let $L$ denote the following linear operator:
$$L(X)=(AXB-BXA)^T.$$
Let $\vec(X)$ denote a vector made by stacking all the
columns of $X$. Let $T_n$ denote $n^2\times n^2$ matrix representing
operator $\vec(X)\mapsto \vec(X^T)$. And
finally let $M$ denote $n^2\times n^2$ matrix represening the operator
$L$. It is not difficult to verify that:
$$M=T_n(B^T\otimes A - A^T\otimes B)$$
Now we show that $M$ is skew symmetric. Recall that $T_n(X\otimes
Y)=(Y\otimes X)T_n$, we have:
$$M^T=(B^T\otimes A - A^T\otimes B)^TT_n=(B\otimes A^T - A\otimes B^T)T_n=
T_n(A^T\otimes B - B^T\otimes A) = -M$$
We try to solve $M\vec(X) = T_n(0) = 0$. Since $M$ is
skew symmetric, there is real orthonormal matrix $Q$, such that
$M=Q\widehat{M}Q^T$, and $\widehat{M}$ is block diagonal matrix
consisting of $2\times 2$ blocks of the form
$$\left(\matrix 0&\alpha_i\cr-\alpha_i&0\endmatrix\right),$$
and of additional zero, if $n^2$ is odd.
Now we solve equation $\widehat{M}y=0$, where $y=Q^T\vec(X)$. Now
there are $n$ zero rows in $\widehat{M}$ coming from similarity of
$A^{-1}B$ and $BA^{-1}$ (structural zeros). Note that the additional
zero for odd $n^2$ is already included in that number, since for odd
$n^2$ is $n^2-n$ even. Besides those, there are also zeros (esp. in
floating point arithmetics), coming from repetitive (or close)
eigenvalues of $A^{-1}B$. If we are able to select the rows with the
structural zeros, a solution is obtained by picking arbitrary numbers
for the same positions in $y$, and put $\vec(X)=Qy$.
The following questions need to be answered:
\roster
\item How to recognize the structural rows?
\item Is $A^{-1}$ generated by a $y$, which has non-zero elements only
on structural rows? Note that $A$ can have repetitive eigenvalues. The
positive answer to the question implies that in each $n$-partition of
$y$ there is exactly one structural row.
\item And very difficult one: How to pick $y$ so that $X$ would be
regular, or even close to orthonormal (pure orthonormality
overdeterminates $y$)?
\endroster
\subhead Making Zeros in $F$\endsubhead
It is clear that the numerical complexity of the proposed algorithm
strongly depends on a number of non-zero elements in the Schur factor
$F$. If we were able to find $P$, such that $PFP^{-1}$ has
substantially less zeros than $F$, then the computation would be
substantially faster. However, it seems that we have to pay price for
any additional zero in terms of less numerical stability of $PFP^{-1}$
multiplication. Consider $P$, and $F$ in form
$$P=\pmatrix I &X\cr 0&I\endpmatrix,
\qquad F=\pmatrix A&C\cr 0&B\endpmatrix$$
we obtain
$$PFP^{-1}=\pmatrix A& C + XB - AX\cr 0&B \endpmatrix$$
Thus, we need to solve $C = AX - XB$. Its clear that numerical
stability of operator $Y\mapsto PYP^{-1}$ and its inverse $Y\mapsto
P^{-1}YP$ is worse with growing norm $\Vert X\Vert$. The norm can be
as large as $\Vert F\Vert/\delta$, where $\delta$ is a distance of
eigenspectra of $A$ and $B$. Also, a numerical error of the solution is
proportional to $\Vert C\Vert/\delta$.
Although, these difficulties cannot be overcome completely, we may
introduce an algorithm, which works on $F$ with ordered eigenvalues on
diagonal, and seeks such partitioning to maximize $\delta$ and
minimize $C$. If the partitioning is found, the algorithm finds $P$
and then is run for $A$ and $B$ blocks. It stops when further
partitioning is not possible without breaking some user given limit
for numerical errors. We have to keep in mind that the numerical
errors are accumulated in product of all $P$'s of every step.
\subhead Exploiting constant rows in $F$\endsubhead
If some of $F$'s rows consists of the same numbers, or a number of
distict values within a row is small, then this structure can be
easily exploited in the algorithm. Recall, that in both functions
$\solvi$, and $\solviip$, we eliminate guys below diagonal element (or
block) (of $F^T$), by multiplying solution of the diagonal and
cancelling it from right side. If the elements below the diagonal
block are the same, we save one vector multiplication. Note that in
$\solviip$ we still need to multiply by elements below diagonal of the
matrix $F^{T2}$, which obviously has not the property. However, the
heaviest elimination is done at the very top level, in the first call
to $\solvi$.
Another way of exploitation the property is to proceed all
calculations in complex numbers. In that case, only $\solvi$ is run.
How the structure can be introduced into the matrix? Following the
same notation as in previous section, we solve $C = AX - XB$ in order
to obtain zeros at place of $C$. If it is not possible, we may relax
the equation by solving $C - R = AX - XB$, where $R$ is suitable
matrix with constant rows. The matrix $R$ minimizes $\Vert C-R\Vert$
in order to minimize $\Vert X\Vert$ if $A$, and $B$ are given. Now, in
the next step we need to introduce zeros (or constant rows) to matrix
$A$, so we seek for regular matrix $P$, doing the
job. If found, the product looks like:
$$\pmatrix P&0\cr 0&I\endpmatrix\pmatrix A&R\cr 0&B\endpmatrix
\pmatrix P^{-1}&0\cr 0&I\endpmatrix=
\pmatrix PAP^{-1}&PR\cr 0&B\endpmatrix$$
Now note, that matrix $PR$ has also constant rows. Thus,
preconditioning of the matrix in upper left corner doesn't affect the
property. However, a preconditioning of the matrix in lower right
corner breaks the property, since we would obtain $RP^{-1}$.
\enddocument

71
mex/sources/korderpert/Dyn_pp/sylv/testing/MMMatrix.cpp Normal file
View File

@ -0,0 +1,71 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/testing/MMMatrix.cpp,v 1.1.1.1 2004/06/04 13:01:13 kamenik Exp $ */
/* Tag $Name: $ */
#include "MMMatrix.h"
#include <stdio.h>
#include <string.h>
MMMatrixIn::MMMatrixIn(const char* fname)
{
FILE* fd;
if (NULL==(fd = fopen(fname,"r")))
throw MMException(string("Cannot open file ")+fname+" for reading\n");
char buffer[1000];
// jump over initial comments
while (fgets(buffer, 1000, fd) && strncmp(buffer, "%%", 2)) {}
// read in number of rows and cols
if (!fgets(buffer, 1000, fd))
throw MMException(string("Cannot read rows and cols while reading ")+fname+"\n");
if (2 != sscanf(buffer, "%d %d", &rows, &cols))
throw MMException("Couldn't parse rows and cols\n");
// read in data
data = (double*) operator new[](rows*cols*sizeof(double));
int len = rows*cols;
int i = 0;
while (fgets(buffer, 1000, fd) && i < len) {
if (1 != sscanf(buffer, "%lf", &data[i]))
throw MMException(string("Couldn't parse float number ")+buffer+"\n");
i++;
}
if (i < len) {
char mes[1000];
sprintf(mes,"Couldn't read all %d lines, read %d so far\n",len,i);
throw MMException(mes);
}
fclose(fd);
}
MMMatrixIn::~MMMatrixIn()
{
operator delete [](data);
}
void MMMatrixOut::write(const char* fname, int rows, int cols, const double* data)
{
FILE* fd;
if (NULL==(fd = fopen(fname,"w")))
throw MMException(string("Cannot open file ")+fname+" for writing\n");
if (0 > fprintf(fd, "%%%%MatrixMarket matrix array real general\n"))
throw MMException(string("Output error when writing file ")+fname);
if (0 > fprintf(fd, "%d %d\n", rows, cols))
throw MMException(string("Output error when writing file ")+fname);
int running = 0;
for (int i = 0; i < cols; i++) {
for (int j = 0 ; j < rows; j++) {
if (0 > fprintf(fd, "%40.35g\n", data[running]))
throw MMException(string("Output error when writing file ")+fname);
running++;
}
}
fclose(fd);
}
void MMMatrixOut::write(const char* fname, const GeneralMatrix& m)
{
write(fname, m.numRows(), m.numCols(), m.base());
}

46
mex/sources/korderpert/Dyn_pp/sylv/testing/MMMatrix.h Normal file
View File

@ -0,0 +1,46 @@
/* $Header: /var/lib/cvs/dynare_cpp/sylv/testing/MMMatrix.h,v 1.1.1.1 2004/06/04 13:01:13 kamenik Exp $ */
/* Tag $Name: $ */
#ifndef MM_MATRIX_H
#define MM_MATRIX_H
#include "GeneralMatrix.h"
#include "SylvMemory.h"
#include <string>
using namespace std;
class MMException : public MallocAllocator {
string message;
public:
MMException(string mes) : message(mes) {}
MMException(const char* mes) : message(mes) {}
const char* getMessage() const {return message.data();}
};
class MMMatrixIn : public MallocAllocator {
double* data;
int rows;
int cols;
public:
MMMatrixIn(const char* fname);
~MMMatrixIn();
const double* getData() const {return data;}
int size() const {return rows*cols;}
int row() const {return rows;}
int col() const {return cols;}
};
class MMMatrixOut : public MallocAllocator {
public:
static void write(const char* fname, int rows, int cols, const double* data);
static void write(const char* fname, const GeneralMatrix& m);
};
#endif /* MM_MATRIX_H */
// Local Variables:
// mode:C++
// End:

36
mex/sources/korderpert/Dyn_pp/sylv/testing/Makefile Normal file
View File

@ -0,0 +1,36 @@
# $Header: /var/lib/cvs/dynare_cpp/sylv/testing/Makefile,v 1.2 2004/09/28 16:16:43 kamenik Exp $
# Tag $Name: $
LD_LIBS := -llapack -lcblas -lf77blas -latlas -lg2c
CC_FLAGS := -Wall -I../cc $(CC_INCLUDE_PATH)
CC_DEFS := #-DUSE_MEMORY_POOL
ifeq ($(DEBUG),yes)
CC_FLAGS := $(CC_FLAGS) -g
CC_DEFS := $(CC_DEFS) -DDEBUG
else
CC_FLAGS := $(CC_FLAGS) -O2
endif
objects := $(patsubst %.cpp,%.o,$(wildcard ../cc/*.cpp))
headers := $(wildcard ../cc/*.h)
clear:
make -C ../cc clear
rm -f tests.exe
rm -f tests
rm -f *.o
../cc/%.o : ../cc/%.cpp $(headers)
make EXTERN_DEFS="$(CC_DEFS)" -C ../cc $*.o
%.o : %.cpp $(headers)
$(CC) $(CC_FLAGS) $(CC_DEFS) -c $*.cpp
# untar testing data
tdata.done : tdata.tgz
tar -xzf tdata.tgz
touch tdata.done
test: $(objects) tests.o MMMatrix.o tdata.done
$(CC) $(CC_FLAGS) -o test $(objects) tests.o MMMatrix.o $(LD_LIBS)

BIN
mex/sources/korderpert/Dyn_pp/sylv/testing/tdata.tgz Normal file
View File

Binary file not shown.

1022
mex/sources/korderpert/Dyn_pp/sylv/testing/tests.cpp Normal file
View File

File diff suppressed because it is too large Load Diff

59
mex/sources/korderpert/Dyn_pp/tl/cc/Makefile Normal file
View File

@ -0,0 +1,59 @@
# $Id: Makefile 886 2006-09-01 11:56:07Z kamenik $
# Copyright 2004, Ondra Kamenik
LD_LIBS := -llapack -lcblas -lf77blas -latlas -lg2c
CC_FLAGS := -Wall -I../../sylv/cc \
$(CC_INCLUDE_PATH)
ifeq ($(DEBUG),yes)
CC_FLAGS := $(CC_FLAGS) -g -DTL_DEBUG=2
else
CC_FLAGS := $(CC_FLAGS) -O2 -DPOSIX_THREADS
endif
ifeq ($(OS),Windows_NT)
CC_FLAGS := -mno-cygwin -mthreads $(CC_FLAGS)
LD_LIBS := -mno-cygwin -mthreads $(LD_LIBS) -lpthreadGC1
else
LD_LIBS := $(LD_LIBS) -lpthread
endif
matrix_interface := GeneralMatrix Vector SylvException
matobjs := $(patsubst %, ../../sylv/cc/%.o, $(matrix_interface))
cwebsource := $(wildcard *.cweb)
cppsource := $(patsubst %.cweb,%.cpp,$(cwebsource))
objects := $(patsubst %.cweb,%.o,$(cwebsource))
hwebsource := $(wildcard *.hweb)
hsource := $(patsubst %.hweb,%.h,$(hwebsource))
dummy.ch:
touch dummy.ch
%.cpp: %.cweb dummy.ch
ctangle -bhp $*.cweb dummy.ch $*.cpp
%.h: %.hweb dummy.ch
ctangle -bhp $*.hweb dummy.ch $*.h
%.o : %.cpp $(hsource)
$(CC) $(CC_FLAGS) $(EXTERN_DEFS) -c $*.cpp
all: $(objects) $(cppsource) $(hsource)
tl.pdf: doc
doc: main.web $(hwebsource) $(cwebsource)
cweave -bhp main.web
pdftex main
mv main.pdf tl.pdf
clear:
rm -f $(cppsource)
rm -f $(hsource)
rm -f *.o
rm -f main.{dvi,idx,log,pdf,scn,tex,toc}
rm -f dummy.ch
rm -f *~

513
mex/sources/korderpert/Dyn_pp/tl/cc/equivalence.cpp Normal file
View File

@ -0,0 +1,513 @@
/*1:*/
#line 6 "./equivalence.cweb"
#include "equivalence.h"
#include "permutation.h"
#include "tl_exception.h"
#include <string.h>
/*2:*/
#line 19 "./equivalence.cweb"
/*6:*/
#line 57 "./equivalence.cweb"
int OrdSequence::operator[](int i)const
{
TL_RAISE_IF((i<0||i>=length()),
"Index out of range in OrdSequence::operator[]");
return data[i];
}
/*:6*/
#line 20 "./equivalence.cweb"
;
/*7:*/
#line 69 "./equivalence.cweb"
bool OrdSequence::operator<(const OrdSequence&s)const
{
double ta= average();
double sa= s.average();
return(ta<sa||((ta==sa)&&(operator[](0)> s[0])));
}
/*:7*/
#line 21 "./equivalence.cweb"
;
/*8:*/
#line 78 "./equivalence.cweb"
bool OrdSequence::operator==(const OrdSequence&s)const
{
if(length()!=s.length())
return false;
int i= 0;
while(i<length()&&operator[](i)==s[i])
i++;
return(i==length());
}
/*:8*/
#line 22 "./equivalence.cweb"
;
/*9:*/
#line 96 "./equivalence.cweb"
void OrdSequence::add(int i)
{
vector<int> ::iterator vit= data.begin();
while(vit!=data.end()&&*vit<i)
++vit;
if(vit!=data.end()&&*vit==i)
return;
data.insert(vit,i);
}
void OrdSequence::add(const OrdSequence&s)
{
vector<int> ::const_iterator vit= s.data.begin();
while(vit!=s.data.end()){
add(*vit);
++vit;
}
}
/*:9*/
#line 23 "./equivalence.cweb"
;
/*10:*/
#line 117 "./equivalence.cweb"
bool OrdSequence::has(int i)const
{
vector<int> ::const_iterator vit= data.begin();
while(vit!=data.end()){
if(*vit==i)
return true;
++vit;
}
return false;
}
/*:10*/
#line 24 "./equivalence.cweb"
;
/*11:*/
#line 130 "./equivalence.cweb"
double OrdSequence::average()const
{
double res= 0;
for(unsigned int i= 0;i<data.size();i++)
res+= data[i];
TL_RAISE_IF(data.size()==0,
"Attempt to take average of empty class in OrdSequence::average");
return res/data.size();
}
/*:11*/
#line 25 "./equivalence.cweb"
;
/*12:*/
#line 142 "./equivalence.cweb"
void OrdSequence::print(const char*prefix)const
{
printf("%s",prefix);
for(unsigned int i= 0;i<data.size();i++)
printf("%d ",data[i]);
printf("\n");
}
/*:12*/
#line 26 "./equivalence.cweb"
;
/*:2*/
#line 13 "./equivalence.cweb"
;
/*3:*/
#line 29 "./equivalence.cweb"
/*13:*/
#line 152 "./equivalence.cweb"
Equivalence::Equivalence(int num)
:n(num)
{
for(int i= 0;i<num;i++){
OrdSequence s;
s.add(i);
classes.push_back(s);
}
}
Equivalence::Equivalence(int num,const char*dummy)
:n(num)
{
OrdSequence s;
for(int i= 0;i<num;i++)
s.add(i);
classes.push_back(s);
}
/*:13*/
#line 30 "./equivalence.cweb"
;
/*14:*/
#line 173 "./equivalence.cweb"
Equivalence::Equivalence(const Equivalence&e)
:n(e.n),
classes(e.classes)
{
}
Equivalence::Equivalence(const Equivalence&e,int i1,int i2)
:n(e.n),
classes(e.classes)
{
seqit s1= find(i1);
seqit s2= find(i2);
if(s1!=s2){
OrdSequence ns(*s1);
ns.add(*s2);
classes.erase(s1);
classes.erase(s2);
insert(ns);
}
}
/*:14*/
#line 31 "./equivalence.cweb"
;
/*17:*/
#line 220 "./equivalence.cweb"
Equivalence::const_seqit Equivalence::findHaving(int i)const
{
const_seqit si= classes.begin();
while(si!=classes.end()){
if((*si).has(i))
return si;
++si;
}
TL_RAISE_IF(si==classes.end(),
"Couldn't find equivalence class in Equivalence::findHaving");
return si;
}
Equivalence::seqit Equivalence::findHaving(int i)
{
seqit si= classes.begin();
while(si!=classes.end()){
if((*si).has(i))
return si;
++si;
}
TL_RAISE_IF(si==classes.end(),
"Couldn't find equivalence class in Equivalence::findHaving");
return si;
}
/*:17*/
#line 32 "./equivalence.cweb"
;
/*18:*/
#line 249 "./equivalence.cweb"
Equivalence::const_seqit Equivalence::find(int j)const
{
const_seqit si= classes.begin();
int i= 0;
while(si!=classes.end()&&i<j){
++si;
i++;
}
TL_RAISE_IF(si==classes.end(),
"Couldn't find equivalence class in Equivalence::find");
return si;
}
Equivalence::seqit Equivalence::find(int j)
{
seqit si= classes.begin();
int i= 0;
while(si!=classes.end()&&i<j){
++si;
i++;
}
TL_RAISE_IF(si==classes.end(),
"Couldn't find equivalence class in Equivalence::find");
return si;
}
/*:18*/
#line 33 "./equivalence.cweb"
;
/*19:*/
#line 278 "./equivalence.cweb"
void Equivalence::insert(const OrdSequence&s)
{
seqit si= classes.begin();
while(si!=classes.end()&&*si<s)
++si;
classes.insert(si,s);
}
/*:19*/
#line 34 "./equivalence.cweb"
;
/*15:*/
#line 196 "./equivalence.cweb"
const Equivalence&Equivalence::operator= (const Equivalence&e)
{
classes.clear();
n= e.n;
classes= e.classes;
return*this;
}
/*:15*/
#line 35 "./equivalence.cweb"
;
/*16:*/
#line 206 "./equivalence.cweb"
bool Equivalence::operator==(const Equivalence&e)const
{
if(!std::operator==(classes,e.classes))
return false;
if(n!=e.n)
return false;
return true;
}
/*:16*/
#line 36 "./equivalence.cweb"
;
/*20:*/
#line 293 "./equivalence.cweb"
void Equivalence::trace(IntSequence&out,int num)const
{
int i= 0;
int nc= 0;
for(const_seqit it= begin();it!=end()&&nc<num;++it,++nc)
for(int j= 0;j<(*it).length();j++,i++){
TL_RAISE_IF(i>=out.size(),
"Wrong size of output sequence in Equivalence::trace");
out[i]= (*it)[j];
}
}
/*:20*/
#line 37 "./equivalence.cweb"
;
/*21:*/
#line 307 "./equivalence.cweb"
void Equivalence::trace(IntSequence&out,const Permutation&per)const
{
TL_RAISE_IF(out.size()!=n,
"Wrong size of output sequence in Equivalence::trace");
TL_RAISE_IF(per.size()!=numClasses(),
"Wrong permutation for permuted Equivalence::trace");
int i= 0;
for(int iclass= 0;iclass<numClasses();iclass++){
const_seqit itper= find(per.getMap()[iclass]);
for(int j= 0;j<(*itper).length();j++,i++)
out[i]= (*itper)[j];
}
}
/*:21*/
#line 38 "./equivalence.cweb"
;
/*22:*/
#line 324 "./equivalence.cweb"
void Equivalence::print(const char*prefix)const
{
int i= 0;
for(const_seqit it= classes.begin();
it!=classes.end();
++it,i++){
printf("%sclass %d: ",prefix,i);
(*it).print("");
}
}
/*:22*/
#line 39 "./equivalence.cweb"
;
/*:3*/
#line 14 "./equivalence.cweb"
;
/*4:*/
#line 42 "./equivalence.cweb"
/*23:*/
#line 357 "./equivalence.cweb"
EquivalenceSet::EquivalenceSet(int num)
:n(num),
equis()
{
list<Equivalence> added;
Equivalence first(n);
equis.push_back(first);
addParents(first,added);
while(!added.empty()){
addParents(added.front(),added);
added.pop_front();
}
if(n> 1){
Equivalence last(n,"");
equis.push_back(last);
}
}
/*:23*/
#line 43 "./equivalence.cweb"
;
/*24:*/
#line 386 "./equivalence.cweb"
bool EquivalenceSet::has(const Equivalence&e)const
{
list<Equivalence> ::const_reverse_iterator rit= equis.rbegin();
while(rit!=equis.rend()&&*rit!=e)
++rit;
if(rit!=equis.rend())
return true;
return false;
}
/*:24*/
#line 44 "./equivalence.cweb"
;
/*25:*/
#line 404 "./equivalence.cweb"
void EquivalenceSet::addParents(const Equivalence&e,
list<Equivalence> &added)
{
if(e.numClasses()==2||e.numClasses()==1)
return;
for(int i1= 0;i1<e.numClasses();i1++)
for(int i2= i1+1;i2<e.numClasses();i2++){
Equivalence ns(e,i1,i2);
if(!has(ns)){
added.push_back(ns);
equis.push_back(ns);
}
}
}
/*:25*/
#line 45 "./equivalence.cweb"
;
/*26:*/
#line 422 "./equivalence.cweb"
void EquivalenceSet::print(const char*prefix)const
{
char tmp[100];
strcpy(tmp,prefix);
strcat(tmp," ");
int i= 0;
for(list<Equivalence> ::const_iterator it= equis.begin();
it!=equis.end();
++it,i++){
printf("%sequivalence %d:(classes %d)\n",prefix,i,(*it).numClasses());
(*it).print(tmp);
}
}
/*:26*/
#line 46 "./equivalence.cweb"
;
/*:4*/
#line 15 "./equivalence.cweb"
;
/*5:*/
#line 49 "./equivalence.cweb"
/*27:*/
#line 438 "./equivalence.cweb"
EquivalenceBundle::EquivalenceBundle(int nmax)
{
nmax= max(nmax,1);
generateUpTo(nmax);
}
/*:27*/
#line 50 "./equivalence.cweb"
;
/*28:*/
#line 446 "./equivalence.cweb"
EquivalenceBundle::~EquivalenceBundle()
{
for(unsigned int i= 0;i<bundle.size();i++)
delete bundle[i];
}
/*:28*/
#line 51 "./equivalence.cweb"
;
/*29:*/
#line 454 "./equivalence.cweb"
const EquivalenceSet&EquivalenceBundle::get(int n)const
{
if(n> (int)(bundle.size())||n<1){
TL_RAISE("Equivalence set not found in EquivalenceBundle::get");
return*(bundle[0]);
}else{
return*(bundle[n-1]);
}
}
/*:29*/
#line 52 "./equivalence.cweb"
;
/*30:*/
#line 468 "./equivalence.cweb"
void EquivalenceBundle::generateUpTo(int nmax)
{
int curmax= bundle.size();
for(int i= curmax+1;i<=nmax;i++)
bundle.push_back(new EquivalenceSet(i));
}
/*:30*/
#line 53 "./equivalence.cweb"
;
/*:5*/
#line 16 "./equivalence.cweb"
;
/*:1*/

146
mex/sources/korderpert/Dyn_pp/tl/cc/equivalence.h Normal file
View File

@ -0,0 +1,146 @@
/*1:*/
#line 46 "./equivalence.hweb"
#ifndef EQUIVALENCE_H
#define EQUIVALENCE_H
#include "int_sequence.h"
#include <vector>
#include <list>
using namespace std;
/*2:*/
#line 72 "./equivalence.hweb"
class OrdSequence{
vector<int> data;
public:
OrdSequence():data(){}
OrdSequence(const OrdSequence&s):data(s.data){}
const OrdSequence&operator= (const OrdSequence&s)
{data= s.data;return*this;}
bool operator==(const OrdSequence&s)const;
int operator[](int i)const;
bool operator<(const OrdSequence&s)const;
const vector<int> &getData()const
{return data;}
int length()const{return data.size();}
void add(int i);
void add(const OrdSequence&s);
bool has(int i)const;
void print(const char*prefix)const;
private:
double average()const;
};
/*:2*/
#line 57 "./equivalence.hweb"
;
/*3:*/
#line 101 "./equivalence.hweb"
class Permutation;
class Equivalence{
private:
int n;
list<OrdSequence> classes;
public:
typedef list<OrdSequence> ::const_iterator const_seqit;
typedef list<OrdSequence> ::iterator seqit;
/*6:*/
#line 178 "./equivalence.hweb"
Equivalence(int num);
Equivalence(int num,const char*dummy);
Equivalence(const Equivalence&e);
Equivalence(const Equivalence&e,int i1,int i2);
/*:6*/
#line 111 "./equivalence.hweb"
;
const Equivalence&operator= (const Equivalence&e);
bool operator==(const Equivalence&e)const;
bool operator!=(const Equivalence&e)const
{return!operator==(e);}
int getN()const{return n;}
int numClasses()const{return classes.size();}
void trace(IntSequence&out,int n)const;
void trace(IntSequence&out)const
{trace(out,numClasses());}
void trace(IntSequence&out,const Permutation&per)const;
void print(const char*prefix)const;
/*7:*/
#line 185 "./equivalence.hweb"
seqit begin(){return classes.begin();}
const_seqit begin()const{return classes.begin();}
seqit end(){return classes.end();}
const_seqit end()const{return classes.end();}
/*:7*/
#line 123 "./equivalence.hweb"
;
const_seqit find(int i)const;
seqit find(int i);
protected:
/*8:*/
#line 198 "./equivalence.hweb"
const_seqit findHaving(int i)const;
seqit findHaving(int i);
void insert(const OrdSequence&s);
/*:8*/
#line 127 "./equivalence.hweb"
;
};
/*:3*/
#line 58 "./equivalence.hweb"
;
/*4:*/
#line 137 "./equivalence.hweb"
class EquivalenceSet{
int n;
list<Equivalence> equis;
public:
typedef list<Equivalence> ::const_iterator const_iterator;
EquivalenceSet(int num);
void print(const char*prefix)const;
const_iterator begin()const
{return equis.begin();}
const_iterator end()const
{return equis.end();}
private:
bool has(const Equivalence&e)const;
void addParents(const Equivalence&e,list<Equivalence> &added);
};
/*:4*/
#line 59 "./equivalence.hweb"
;
/*5:*/
#line 161 "./equivalence.hweb"
class EquivalenceBundle{
vector<EquivalenceSet*> bundle;
public:
EquivalenceBundle(int nmax);
~EquivalenceBundle();
const EquivalenceSet&get(int n)const;
void generateUpTo(int nmax);
};
/*:5*/
#line 60 "./equivalence.hweb"
;
#endif
/*:1*/

39
mex/sources/korderpert/Dyn_pp/tl/cc/fine_container.cpp Normal file
View File

@ -0,0 +1,39 @@
/*1:*/
#line 6 "./fine_container.cweb"
#include "fine_container.h"
#include <math.h>
/*2:*/
#line 16 "./fine_container.cweb"
SizeRefinement::SizeRefinement(const IntSequence&s,int nc,int max)
{
new_nc= 0;
for(int i= 0;i<nc;i++){
int nr= s[i]/max;
if(s[i]%max!=0)
nr++;
int ss= (nr> 0)?(int)round(((double)s[i])/nr):0;
for(int j= 0;j<nr-1;j++){
rsizes.push_back(ss);
ind_map.push_back(i);
new_nc++;
}
rsizes.push_back(s[i]-(nr-1)*ss);
ind_map.push_back(i);
new_nc++;
}
for(int i= nc;i<s.size();i++){
rsizes.push_back(s[i]);
ind_map.push_back(i);
}
}
/*:2*/
#line 11 "./fine_container.cweb"
;
/*:1*/

130
mex/sources/korderpert/Dyn_pp/tl/cc/fine_container.h Normal file
View File

@ -0,0 +1,130 @@
/*1:*/
#line 33 "./fine_container.hweb"
#ifndef FINE_CONTAINER_H
#define FINE_CONTAINER_H
#include "stack_container.h"
#include <vector>
/*2:*/
#line 54 "./fine_container.hweb"
class SizeRefinement{
vector<int> rsizes;
vector<int> ind_map;
int new_nc;
public:
SizeRefinement(const IntSequence&s,int nc,int max);
int getRefSize(int i)const
{return rsizes[i];}
int numRefinements()const
{return rsizes.size();}
int getOldIndex(int i)const
{return ind_map[i];}
int getNC()const
{return new_nc;}
};
/*:2*/
#line 41 "./fine_container.hweb"
;
/*3:*/
#line 77 "./fine_container.hweb"
template<class _Ttype>
class FineContainer:public SizeRefinement,public StackContainer<_Ttype> {
protected:
typedef StackContainer<_Ttype> _Stype;
typedef typename StackContainerInterface<_Ttype> ::_Ctype _Ctype;
typedef typename StackContainerInterface<_Ttype> ::itype itype;
_Ctype**const ref_conts;
const _Stype&stack_cont;
public:
/*4:*/
#line 109 "./fine_container.hweb"
FineContainer(const _Stype&sc,int max)
:SizeRefinement(sc.getStackSizes(),sc.numConts(),max),
StackContainer<_Ttype> (numRefinements(),getNC()),
ref_conts(new _Ctype*[getNC()]),
stack_cont(sc)
{
for(int i= 0;i<numRefinements();i++)
_Stype::stack_sizes[i]= getRefSize(i);
_Stype::calculateOffsets();
int last_cont= -1;
int last_row= 0;
for(int i= 0;i<getNC();i++){
if(getOldIndex(i)!=last_cont){
last_cont= getOldIndex(i);
last_row= 0;
}
union{const _Ctype*c;_Ctype*n;}convert;
convert.c= stack_cont.getCont(last_cont);
ref_conts[i]= new _Ctype(last_row,_Stype::stack_sizes[i],
*(convert.n));
_Stype::conts[i]= ref_conts[i];
last_row+= _Stype::stack_sizes[i];
}
}
/*:4*/
#line 87 "./fine_container.hweb"
;
/*5:*/
#line 137 "./fine_container.hweb"
virtual~FineContainer()
{
for(int i= 0;i<_Stype::numConts();i++)
delete ref_conts[i];
delete[]ref_conts;
}
/*:5*/
#line 88 "./fine_container.hweb"
;
itype getType(int i,const Symmetry&s)const
{return stack_cont.getType(getOldIndex(i),s);}
};
/*:3*/
#line 42 "./fine_container.hweb"
;
/*6:*/
#line 148 "./fine_container.hweb"
class FoldedFineContainer:public FineContainer<FGSTensor> ,public FoldedStackContainer{
public:
FoldedFineContainer(const StackContainer<FGSTensor> &sc,int max)
:FineContainer<FGSTensor> (sc,max){}
};
/*:6*/
#line 43 "./fine_container.hweb"
;
/*7:*/
#line 156 "./fine_container.hweb"
class UnfoldedFineContainer:public FineContainer<UGSTensor> ,public UnfoldedStackContainer{
public:
UnfoldedFineContainer(const StackContainer<UGSTensor> &sc,int max)
:FineContainer<UGSTensor> (sc,max){}
};
/*:7*/
#line 44 "./fine_container.hweb"
;
#endif
/*:1*/

Some files were not shown because too many files have changed in this diff Show More