1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
## $Id: dynareR.r 862 2006-08-04 17:34:56Z tamas $
## Copyright 2006, Tamas K Papp
dyn.load("dynareR.so") # FIXME: make it platform-independent
## FIXME hide auxiliary functions in a namespace
dynareR.indextensor <- function(ord, nume, nums) {
nume*((nums^ord-1)/(nums-1))
}
dynareR.extracttensor <- function(tensor, ord, nume, nums) {
aperm(array(tensor[dynareR.indextensor(ord,nume,nums)+(1:(nume*nums^ord))],
c(nume,rep(nums,ord))),(ord+1):1)
}
dynareR.errormessages <- c("Sylvester exception",
"Dynare exception",
"OGU exception",
"Tensor library exception",
"K-order expansion library exception",
"Error matching names")
calldynare <- function(modeleq, endo, exo, parameters, expandorder,
parval, vcovmatrix, initval=rep(1,length(endo)),
numsteps=0, jnlfile="/dev/null") {
## check type of parameters
local({
is.charvector <- function(cv) { is.character(cv) && is.vector(cv) }
stopifnot(is.charvector(modeleq) && is.charvector(endo) &&
is.charvector(exo) && is.charvector(parameters) &&
is.charvector(jnlfile))
})
stopifnot(is.numeric(expandorder) && is.vector(expandorder) &&
(length(expandorder) == 1) && (expandorder >= 0))
stopifnot(length(jnlfile) == 1)
local({ # variable names
checkvarname <- function(v) {
stopifnot(length(grep("[^a-zA-Z].*",v)) == 0) # look for strange chars
}
checkvarname(endo)
checkvarname(exo)
checkvarname(parameters)
})
stopifnot(is.vector(parval) && is.numeric(parval))
stopifnot(is.vector(initval) && is.numeric(initval))
stopifnot(is.matrix(vcovmatrix) && is.numeric(vcovmatrix))
stopifnot(is.numeric(numsteps) && is.vector(numsteps) &&
(length(numsteps)==1))
## append semicolons to model equations if necessary
modeleq <- sapply(modeleq, function(s) {
if (length(grep("^.*; *$",s))==1)
s
else
sprintf("%s;",s)
})
## then concatenate into a single string
modeleq <- paste(modeleq, collapse=" ")
## call dynareR
nume <- length(endo)
maxs <- length(endo)+length(exo)
dr <- .C("dynareR",
endo,as.integer(nume),
exo,as.integer(length(exo)),
parameters,as.integer(length(parameters)),
modeleq,as.integer(expandorder),jnlfile,
as.double(parval),as.double(vcovmatrix),
as.double(initval),
as.integer(numsteps),
tensorbuffer=double(dynareR.indextensor(expandorder+1,nume,maxs)),
numstate=integer(1), orderstate=integer(maxs),
orderendo=integer(nume),
orderexo=integer(length(exo)),
newinitval=double(nume),
error=integer(1),
errormessage=character(1),
kordcode=integer(1))
## check for errors
kordcode <- 0
if (dr$error == 0) {
if (dr$error == 5) {
list(kordcode=dr$kordcode - 251) # magic dynare++ constant
} else {
## return result
with(dr, {
nums <- numstate+length(exo)
list(ss=dynareR.extracttensor(dr$tensorbuffer,0,nume,nums), # ss
rule=sapply(1:expandorder,function (o) { # decision rule
dynareR.extracttensor(dr$tensorbuffer,o,nume,nums)
}),
orderstate=orderstate[1:numstate], # state ordering
orderendo=orderendo, # endog. ordering
orderexo=orderexo, # exog. ordering
newinitval=newinitval, # new init values
kordcode=0)
})
}
} else {
stop(sprintf("%s (\"%s\")",dynareR.errormessages[dr$error],
dr$errormessage))
}
}
|
