Nothing
library(urca)
#
# ADF-test
#
urcadf <- function(){
if (!checkActiveDataSet()) return()
if (!checkNumeric(n=1)) return()
initializeDialog(title="ADF Test")
xBox <- variableListBox(top, Numeric(), title="Variable (pick one)")
onOK <- function(){
x <- getSelection(xBox)
var <- paste(.activeDataSet, "$", x, sep="")
ttype <- tclvalue(testtypeVariable)
lags <- tclvalue(lagsVariable)
if (length(x) == 0){
errorCondition(recall=urcadf, message="You must select a variable.")
return()
}
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(ur.df(y= ", var, ", type = ", ttype, ", lags = ", lags, "))", sep=""))
tkdestroy(top)
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ur.df")
radioButtons(name="testtype", buttons=c("none", "drift", "trend"), values=c("'none'", "'drift'", "'trend'" ), labels=c("no deterministic regressor", "drift only", "drift and trend"), title="Type of test")
rightFrame <- tkframe(top)
lagsFrame <- tkframe(rightFrame)
lagsVariable <- tclVar("4")
lagsField <- tkentry(lagsFrame, width="2", textvariable=lagsVariable)
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(tklabel(rightFrame, text=""))
tkgrid(tklabel(lagsFrame, text="Maximum number of lags = ", fg="blue"), lagsField, sticky="w")
tkgrid(lagsFrame, sticky="w")
tkgrid(testtypeFrame, rightFrame, sticky="nw")
tkgrid(buttonsFrame, columnspan=2, sticky="w")
tkgrid.configure(lagsField, sticky="e")
dialogSuffix(rows=4, columns=2)
}
#
# ERS-test
#
urcaers <- function(){
if (!checkActiveDataSet()) return()
if (!checkNumeric(n=1)) return()
initializeDialog(title="ERS Test")
xBox <- variableListBox(top, Numeric(), title="Variable (pick one)")
onOK <- function(){
x <- getSelection(xBox)
var <- paste(.activeDataSet, "$", x, sep="")
ttype <- tclvalue(testtypeVariable)
modtype <- tclvalue(modelVariable)
lags <- tclvalue(lagsVariable)
if (length(x) == 0){
errorCondition(recall=urcaers, message="You must select a variable.")
return()
}
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(ur.ers(y= ", var, ", type = ", ttype, ", model = ", modtype, ", lag.max = ", lags, "))", sep=""))
tkdestroy(top)
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ur.ers")
radioButtons(name="testtype", buttons=c("DFGLS", "Ptest"), values=c("'DF-GLS'", "'P-test'"),
labels=c("DF-GLS statistic", "P-test statistic"), title="Type of test")
radioButtons(name="model", buttons=c("const", "trend"), values=c("'constant'", "'trend'"),
labels=c("Include constant", "Include constant + trend"), title="Model type")
rightFrame <- tkframe(top)
lagsFrame <- tkframe(rightFrame)
lagsVariable <- tclVar("4")
lagsField <- tkentry(lagsFrame, width="2", textvariable=lagsVariable)
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(tklabel(rightFrame, text=""))
tkgrid(tklabel(lagsFrame, text="Maximum number of lags = ", fg="blue"), lagsField, sticky="w")
tkgrid(lagsFrame, sticky="w")
tkgrid(testtypeFrame, rightFrame, sticky="nw")
tkgrid(modelFrame, rightFrame, sticky="nw")
tkgrid(buttonsFrame, columnspan=2, sticky="w")
tkgrid.configure(lagsField, sticky="e")
dialogSuffix(rows=4, columns=2)
}
#
# KPSS-test
#
urcakpss <- function(){
if (!checkActiveDataSet()) return()
if (!checkNumeric(n=1)) return()
initializeDialog(title="KPSS Test")
xBox <- variableListBox(top, Numeric(), title="Variable (pick one)")
radioButtons(name="testtype", buttons=c("constant", "trend"),
values=c("'mu'", "'tau'"), initialValue="'mu'",
labels=c("Include constant", "Include trend"), title="Deterministic Part")
radioButtons(name="lags", buttons=c("short", "long", "nil"),
values=c("'short'", "'long'", "'nil'"), initialValue="'short'", labels=c("use short lags", "use long lags", "use no lags"), title="Lag Selection")
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcakpss, message="You must select a variable.")
return()
}
var <- paste(.activeDataSet, "$", x, sep="")
ttype <- tclvalue(testtypeVariable)
ltype <- tclvalue(lagsVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
command <- paste("summary(ur.kpss(", var, ", type = ", ttype, ", lags = ", ltype, "))", sep="")
doItAndPrint(command)
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ur.kpss")
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(testtypeFrame, lagsFrame, sticky="w")
tkgrid(buttonsFrame, columnspan=2, sticky="w")
dialogSuffix(rows=3, columns=2)
}
#
# Schmidt-Phillips test
#
urcasp <- function(){
if (!checkActiveDataSet()) return()
if (!checkNumeric(n=1)) return()
initializeDialog(title="SP Test")
xBox <- variableListBox(top, Numeric(), title="Variable (pick one)")
onOK <- function(){
x <- getSelection(xBox)
var <- paste(.activeDataSet, "$", x, sep="")
ttype <- tclvalue(testtypeVariable)
pdtype <- tclvalue(poldegVariable)
sltype <- tclvalue(signifVariable)
if (length(x) == 0){
errorCondition(recall=urcasp, message="You must select a variable.")
return()
}
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(ur.sp(y= ", var, ", type = ", ttype, ", pol.deg = ", pdtype, ", signif = ", sltype, "))", sep=""))
tkdestroy(top)
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ur.sp")
radioButtons(name="testtype", buttons=c("tau", "rho"), values=c("'tau'", "'rho'"),
labels=c("tau statistic", "rho statistic"), title="Type of test")
radioButtons(name="poldeg", buttons=c("pb1", "pb2", "pb3", "pb4"), values=c("1", "2", "3", "4"),
labels=c("1st", "2nd", "3rd", "4th"), title="Select pol. degree")
radioButtons(name="signif", buttons=c("sb1", "sb5", "sb10"), values=c("0.01", "0.05", "0.1"),
labels=c("alpha=1%", "alpha=5%", "alpha=10%"), title="Sig. Level")
tkgrid(getFrame(xBox), testtypeFrame, sticky="nw")
tkgrid(poldegFrame, signifFrame, sticky="nw")
tkgrid(buttonsFrame, columnspan=2, sticky="w")
dialogSuffix(rows=4, columns=2)
}
#
# Phillips-Perron test
#
urcapp <- function(){
if (!checkActiveDataSet()) return()
if (!checkNumeric(n=1)) return()
initializeDialog(title="PP Test")
xBox <- variableListBox(top, Numeric(), title="Variable (pick one)")
onOK <- function(){
x <- getSelection(xBox)
var <- paste(.activeDataSet, "$", x, sep="")
ttype <- tclvalue(testtypeVariable)
modtype <- tclvalue(modelVariable)
lagtype <- tclvalue(lagsVariable)
if (length(x) == 0){
errorCondition(recall=urcapp, message="You must select a variable.")
return()
}
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(ur.pp(x= ", var, ", type = ", ttype, ", model = ", modtype, ", lags = ", lagtype, "))", sep=""))
tkdestroy(top)
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ur.pp")
radioButtons(name="testtype", buttons=c("Zalpha", "Ztau"), values=c("'Z-alpha'", "'Z-tau'"),
labels=c("Z-alpha statistic", "Z-tau statistic"), title="Type of test")
radioButtons(name="model", buttons=c("const", "trend"), values=c("'constant'", "'trend'"),
labels=c("Include constant", "include constant + trend"), title="Model type")
radioButtons(name="lags", buttons=c("short", "long"), values=c("'short'", "'long'"),
labels=c("short lags", "long lags"), title="Lags for error correction")
tkgrid(getFrame(xBox), testtypeFrame, sticky="nw")
tkgrid(modelFrame, lagsFrame, sticky="nw")
tkgrid(buttonsFrame, columnspan=2, sticky="w")
dialogSuffix(rows=4, columns=2)
}
#
# Zivot-Andrews test
#
urcaza <- function(){
if (!checkActiveDataSet()) return()
if (!checkNumeric(n=1)) return()
initializeDialog(title="Zivot & Andrews Test")
xBox <- variableListBox(top, Numeric(), title="Variable (pick one)")
onOK <- function(){
x <- getSelection(xBox)
var <- paste(.activeDataSet, "$", x, sep="")
modtype <- tclvalue(modelVariable)
lags <- tclvalue(lagsVariable)
ptype <- if(tclvalue(plotVariable) == 0) "FALSE" else "TRUE"
if (length(x) == 0){
errorCondition(recall=urcaza, message="You must select a variable.")
return()
}
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
command <- paste("ur.za(y= ", var, ", model = ", modtype, ", lag = ", lags, ")", sep="")
logger(paste("ZAstat <- ", command, sep=""))
assign("ZAstat", justDoIt(command), envir=.GlobalEnv)
doItAndPrint("summary(ZAstat)")
if(ptype==TRUE) {
justDoIt("x11()")
justDoIt("plot(ZAstat)")
}
logger("remove(ZAstat)")
remove(ZAstat, envir=.GlobalEnv)
tkdestroy(top)
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ur.za")
radioButtons(name="model", buttons=c("const", "trend", "both"), values=c("'intercept'", "'trend'", "'both'"),
labels=c("Include constant", "Include trend", "Include both"), title="Model type")
checkBoxes(frame="plotFrame", boxes="plot", initialValues="0", labels="Plot path of Zivot & Andrews Statistic?")
rightFrame <- tkframe(top)
lagsFrame <- tkframe(rightFrame)
lagsVariable <- tclVar("4")
lagsField <- tkentry(lagsFrame, width="2", textvariable=lagsVariable)
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(tklabel(rightFrame, text=""))
tkgrid(tklabel(lagsFrame, text="Maximum number of lags = ", fg="blue"), lagsField, sticky="w")
tkgrid(lagsFrame, sticky="w")
tkgrid(modelFrame, rightFrame, sticky="nw")
tkgrid(plotFrame, sticky="nw")
tkgrid(buttonsFrame, columnspan=2, sticky="w")
tkgrid.configure(lagsField, sticky="e")
dialogSuffix(rows=3, columns=2)
}
#
# Phillips-Ouliaris test
#
urcacapo <- function(){
dataSets <- listDataSets()
if (length(dataSets) == 0){
tkmessageBox(message="There are no data sets from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="Phillips & Ouliaris Test")
xBox <- variableListBox(top, dataSets, title="Data Sets (pick one)")
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcacapo, message="You must select a data set.")
return()
}
meantype <- tclvalue(demeanVariable)
lags <- tclvalue(lagsVariable)
ttype <- tclvalue(typeVariable)
tolvar <- tclvalue(tolVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(ca.po(z = ", x, ", demean = ", meantype, ", lag = ", lags, ", type = ", ttype, ", tol = ", tolvar, "))", sep=""))
tkdestroy(top)
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ca.po")
radioButtons(name="demean", buttons=c("none", "constant", "trend"), values=c("'none'", "'constant'", "'trend'"),
labels=c("None", "Include constant", "Include trend"), title="Demean?")
radioButtons(name="lags", buttons=c("short", "long"), values=c("'short'", "'long'"),
labels=c("short lags", "long lags"), title="Lags for error correction")
radioButtons(name="type", buttons=c("Pu", "Pz"), values=c("'Pu'", "'Pz'"),
labels=c("Pu statistic", "Pz statistic"), title="Type of test")
rightFrame <- tkframe(top)
tolFrame <- tkframe(rightFrame)
tolVariable <- tclVar("NULL")
tolField <- tkentry(tolFrame, width="8", textvariable=tolVariable)
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(tklabel(rightFrame, text=""))
tkgrid(tklabel(tolFrame, text="Tolerance level = ", fg="blue"), tolField, sticky="w")
tkgrid(tolFrame, sticky="w")
tkgrid(demeanFrame, rightFrame, sticky="nw")
tkgrid(lagsFrame, typeFrame, sticky="nw")
tkgrid(buttonsFrame, columnspan=2, sticky="w")
tkgrid.configure(tolField, sticky="e")
dialogSuffix(rows=5, columns=2)
}
#
# Johansen-Procedure
#
urcacajo <- function(){
dataSets <- listDataSets()
if (length(dataSets) == 0){
tkmessageBox(message="There are no data sets from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="Johansen's Procedure")
xBox <- variableListBox(top, dataSets, title="Data Sets (pick one)")
assign("UpdateModelNumber", UpdateModelNumber() + 1, envir=.GlobalEnv)
modelName <- tclVar(paste("VECMmodel.", UpdateModelNumber, sep=""))
modelFrame <- tkframe(top)
model <- tkentry(modelFrame, width="20", textvariable=modelName)
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcacajo, message="You must select a data set.")
return()
}
ttype <- tclvalue(typeVariable)
spect <- tclvalue(specVariable)
ctype <- tclvalue(ecdetVariable)
lags <- tclvalue(lagVariable)
seas <- tclvalue(seasonVariable)
dummy <- tclvalue(dumVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
modelValue <- tclvalue(modelName)
if (!is.valid.name(modelValue)){
assign("UpdateModelNumber", UpdateModelNumber() - 1, envir=.GlobalEnv)
errorCondition(recall=urcacajo, message=paste('"', modelValue, '" is not a valid name.', sep=""))
return()
}
if (is.element(modelValue, listVECMmodels())) {
if ("no" == tclvalue(checkReplace(modelValue, type="Model"))){
assign("UpdateModelNumber", UpdateModelNumber() - 1, envir=.GlobalEnv)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
urcacajo()
return()
}
}
command <- paste("ca.jo(x = ", x, ", type = ", ttype, ", ecdet = ", ctype, ", K = ",
lags, ", spec = ", spect, ", season = ", seas, ", dumvar = ", dummy , ")", sep="")
logger(paste(modelValue, " <- ", command, sep=""))
assign(modelValue, justDoIt(command), envir=.GlobalEnv)
doItAndPrint(paste("summary(", modelValue, ")", sep=""))
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ca.jo")
radioButtons(name="type", buttons=c("eigen", "trace"), values=c("'eigen'", "'trace'"),
labels=c("Eigenvalue statistic", "Trace statistic"), title="Type of statistic")
radioButtons(name="spec", buttons=c("long", "trans"), values=c("'longrun'", "'transitory'"),
labels=c("longrun specification", "transitory specification"), title="VECM specification")
radioButtons(name="season", buttons=c("none", "monthly", "quarterly"), values=c("NULL", "12", "4"),
labels=c("None", "Monthly seasonality", "Quarterly seasonality"), title="Seasonality")
radioButtons(name="ecdet", buttons=c("none", "const", "trend"), values=c("'none'", "'const'", "'trend'"),
labels=c("none", "constant", "trend"), title="Deterministic Variable in Cointegration")
rightFrame <- tkframe(top)
lagFrame <- tkframe(rightFrame)
lagVariable <- tclVar("2")
lagField <- tkentry(lagFrame, width="2", textvariable=lagVariable)
dumFrame <- tkframe(rightFrame)
dumVariable <- tclVar("NULL")
dumField <- tkentry(dumFrame, width="8", textvariable=dumVariable)
tkgrid(tklabel(modelFrame, text="Enter name for model:"), model, sticky="w")
tkgrid(modelFrame, sticky="w")
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(tklabel(rightFrame, text=""), sticky="w")
tkgrid(tklabel(lagFrame, text="Lag order = ", fg="blue"), lagField, sticky="w")
tkgrid(lagFrame, sticky="w")
tkgrid(tklabel(dumFrame, text="Matrix of dummy variables = ", fg="blue"), dumField, sticky="w")
tkgrid(dumFrame, sticky="w")
tkgrid(typeFrame, rightFrame, sticky="nw")
tkgrid(specFrame, seasonFrame, sticky="nw")
tkgrid(ecdetFrame, rightFrame, sticky="w")
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(lagField, sticky="e")
tkgrid.configure(dumField, sticky="e")
dialogSuffix(rows=8, columns=2)
}
#
# Linear Trend test
#
urcalttest <- function(){
VECMmodels <- listVECMmodels()
if (length(VECMmodels) == 0){
tkmessageBox(message="There are no VECM models from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="Linear Trend Test")
xBox <- variableListBox(top, VECMmodels, title="VECM models (pick one)")
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcalttest, message="You must select a VECM model.")
return()
}
rint <- tclvalue(rankVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("lttest(z = ", x, ", r = ", rint, ")", sep=""))
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="lttest")
rankFrame <- tkframe(top)
rankVariable <- tclVar("1")
rankField <- tkentry(rankFrame, width="2", textvariable=rankVariable)
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(rankFrame, sticky="w")
tkgrid(tklabel(rankFrame, text="Number of cointegrating relationships = ", fg="blue"), rankField, sticky="w")
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(rankField, sticky="e")
dialogSuffix(rows=3, columns=2)
}
#
# Restrictions on Loading matrix
#
urcaalrtest <- function(){
VECMmodels <- listVECMmodels()
matrices <- listMatrix()
if (length(VECMmodels) == 0){
tkmessageBox(message="There are no VECM models from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
if (length(matrices) == 0){
tkmessageBox(message="There are no restriction matrices defined from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="Test Restrictions on Loading Vectors")
xBox <- variableListBox(top, VECMmodels, title="VECM models (pick one)")
yBox <- variableListBox(top, matrices, title="Restriction matrices (pick one)")
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcaalrtest, message="You must select a VECM model.")
return()
}
y <- getSelection(yBox)
if (length(y) == 0){
errorCondition(recall=urcaalrtest, message="You must select a restriction matrix.")
return()
}
rint <- tclvalue(rankVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(alrtest(z = ", x, ", A = ", y , ", r = ", rint, "))", sep=""))
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="alrtest")
rankFrame <- tkframe(top)
rankVariable <- tclVar("1")
rankField <- tkentry(rankFrame, width="2", textvariable=rankVariable)
tkgrid(getFrame(xBox), getFrame(yBox), sticky="nw")
tkgrid(rankFrame, sticky="w")
tkgrid(tklabel(rankFrame, text="Number of cointegrating relationships = ", fg="blue"), rankField, sticky="w")
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(rankField, sticky="e")
dialogSuffix(rows=3, columns=1)
}
#
# Restrictions on cointegration matrix
#
urcablrtest <- function(){
VECMmodels <- listVECMmodels()
matrices <- listMatrix()
if (length(VECMmodels) == 0){
tkmessageBox(message="There are no VECM models from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
if (length(matrices) == 0){
tkmessageBox(message="There are no restriction matrices defined from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="Test Restrictions on Cointegration Vectors")
xBox <- variableListBox(top, VECMmodels, title="VECM models (pick one)")
yBox <- variableListBox(top, matrices, title="Restriction matrices (pick one)")
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcaablrtest, message="You must select a VECM model.")
return()
}
y <- getSelection(yBox)
if (length(y) == 0){
errorCondition(recall=urcaalrtest, message="You must select a restriction matrix.")
return()
}
rint <- tclvalue(rankVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(blrtest(z = ", x, ", H = ", y , ", r = ", rint, "))", sep=""))
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="blrtest")
rankFrame <- tkframe(top)
rankVariable <- tclVar("1")
rankField <- tkentry(rankFrame, width="2", textvariable=rankVariable)
tkgrid(getFrame(xBox), getFrame(yBox), sticky="nw")
tkgrid(rankFrame, sticky="w")
tkgrid(tklabel(rankFrame, text="Number of cointegrating relationships = ", fg="blue"), rankField, sticky="w")
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(rankField, sticky="e")
dialogSuffix(rows=3, columns=1)
}
#
# Restrictions for partly known cointegrating vectors
#
urcabh5lrtest <- function(){
VECMmodels <- listVECMmodels()
matrices <- listMatrix()
numerics <- listNumeric()
elements <- c(matrices, numerics)
if (length(VECMmodels) == 0){
tkmessageBox(message="There are no VECM models from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
if (length(matrices) == 0){
tkmessageBox(message="There are no restriction matrices defined from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="Test validity of partly known cointegrating Vectors")
xBox <- variableListBox(top, VECMmodels, title="VECM models (pick one)")
yBox <- variableListBox(top, elements, title="Restriction matrices (pick one)")
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcabh5lrtest, message="You must select a VECM model.")
return()
}
y <- getSelection(yBox)
if (length(y) == 0){
errorCondition(recall=urcabh5lrtest, message="You must select a restriction matrix.")
return()
}
rint <- tclvalue(rankVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(bh5lrtest(z = ", x, ", H = ", y , ", r = ", rint, "))", sep=""))
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="bh5lrtest")
rankFrame <- tkframe(top)
rankVariable <- tclVar("2")
rankField <- tkentry(rankFrame, width="2", textvariable=rankVariable)
tkgrid(getFrame(xBox), getFrame(yBox), sticky="nw")
tkgrid(rankFrame, sticky="w")
tkgrid(tklabel(rankFrame, text="Number of cointegrating relationships = ", fg="blue"), rankField, sticky="w")
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(rankField, sticky="e")
dialogSuffix(rows=3, columns=1)
}
#
# Restrictions for partly known cointegrating vectors
#
urcabh6lrtest <- function(){
VECMmodels <- listVECMmodels()
matrices <- listMatrix()
numerics <- listNumeric()
elements <- c(matrices, numerics)
if (length(VECMmodels) == 0){
tkmessageBox(message="There are no VECM models from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
if (length(matrices) == 0){
tkmessageBox(message="There are no restriction matrices defined from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="Test restrictions of partly known cointegrating Vectors")
xBox <- variableListBox(top, VECMmodels, title="VECM models (pick one)")
yBox <- variableListBox(top, elements, title="Restriction matrices (pick one)")
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcabh6lrtest, message="You must select a VECM model.")
return()
}
y <- getSelection(yBox)
if (length(y) == 0){
errorCondition(recall=urcaalrtest, message="You must select a restriction matrix.")
return()
}
rint <- tclvalue(rankVariable)
r1int <- tclvalue(r1Variable)
maxiter <- tclvalue(maxiterVariable)
conv <- tclvalue(conVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(bh6lrtest(z = ", x, ", H = ", y , ", r = ", rint, ", r1 =", r1int, ", conv.val =", conv, ", max.iter =", maxiter, "))", sep=""))
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="bh6lrtest")
rankFrame <- tkframe(top)
r1Frame <- tkframe(top)
rankVariable <- tclVar("2")
r1Variable <- tclVar("1")
rightFrame <- tkframe(top)
maxiterFrame <- tkframe(rightFrame)
maxiterVariable <- tclVar("50")
maxiterField <- tkentry(maxiterFrame, width="4", textvariable=maxiterVariable)
conFrame <- tkframe(rightFrame)
conVariable <- tclVar("0.0001")
conField <- tkentry(conFrame, width="8", textvariable=conVariable)
tkgrid(tklabel(rightFrame, text=""))
rankField <- tkentry(rankFrame, width="2", textvariable=rankVariable)
r1Field <- tkentry(r1Frame, width="2", textvariable=r1Variable)
tkgrid(getFrame(xBox), getFrame(yBox), sticky="nw")
tkgrid(rankFrame, rightFrame, sticky="w")
tkgrid(tklabel(rankFrame, text="Number of cointegrating relationships = ", fg="blue"), rankField, sticky="w")
tkgrid(r1Frame, rightFrame, sticky="w")
tkgrid(tklabel(r1Frame, text="Number of restricted ci relationships = ", fg="blue"), r1Field, sticky="w")
tkgrid(maxiterFrame, sticky="w")
tkgrid(tklabel(maxiterFrame, text="Maximum number of iterations = ", fg="blue"), maxiterField, sticky="w")
tkgrid(conFrame, sticky="w")
tkgrid(tklabel(conFrame, text="Convergence criteria = ", fg="blue"), conField, sticky="w")
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(rankField, sticky="e")
tkgrid.configure(r1Field, sticky="e")
tkgrid.configure(maxiterField, sticky="e")
tkgrid.configure(conField, sticky="e")
dialogSuffix(rows=4, columns=2)
}
#
# Restrictions for loading and cointegration matrix
#
urcaablrtest <- function(){
VECMmodels <- listVECMmodels()
matrices <- listMatrix()
if (length(VECMmodels) == 0){
tkmessageBox(message="There are no VECM models from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
if (length(matrices) == 0){
tkmessageBox(message="There are no restriction matrices defined from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="Test Restrictions on Loading & Cointegration vectors")
xBox <- variableListBox(top, VECMmodels, title="VECM models (pick one)")
yBox <- variableListBox(top, matrices, title="Restriction matrices for cointegration vectors (pick one)")
lBox <- variableListBox(top, matrices, title="Restriction matrices for loading vectors (pick one)")
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcaablrtest, message="You must select a VECM model.")
return()
}
y <- getSelection(yBox)
if (length(y) == 0){
errorCondition(recall=urcaablrtest, message="You must select a cointegration restriction matrix.")
return()
}
l <- getSelection(lBox)
if (length(l) == 0){
errorCondition(recall=urcaablrtest, message="You must select a loading restriction matrix.")
return()
}
rint <- tclvalue(rankVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
doItAndPrint(paste("summary(ablrtest(z = ", x, ", H = ", y, ", A = ", l, ", r = ", rint, "))", sep=""))
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="ablrtest")
rankFrame <- tkframe(top)
rankVariable <- tclVar("1")
rankField <- tkentry(rankFrame, width="2", textvariable=rankVariable)
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(getFrame(yBox), getFrame(lBox), sticky="nw")
tkgrid(rankFrame, sticky="w")
tkgrid(tklabel(rankFrame, text="Number of cointegrating relationships = ", fg="blue"), rankField, sticky="w")
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(rankField, sticky="e")
dialogSuffix(rows=3, columns=2)
}
#
# VECM with a structural shift
#
urcacajolst <- function(){
dataSets <- listDataSets()
if (length(dataSets) == 0){
tkmessageBox(message="There are no data sets from which to choose.", icon="error", type="ok")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title="VECM with level shift")
xBox <- variableListBox(top, dataSets, title="Data Sets (pick one)")
assign("UpdateModelNumber", UpdateModelNumber + 1, envir=.GlobalEnv)
modelName <- tclVar(paste("VECMmodel.", UpdateModelNumber, sep=""))
modelFrame <- tkframe(top)
model <- tkentry(modelFrame, width="20", textvariable=modelName)
onOK <- function(){
x <- getSelection(xBox)
if (length(x) == 0){
errorCondition(recall=urcacajo, message="You must select a data set.")
return()
}
ttype <- if(tclvalue(trendVariable) == 0) "FALSE" else "TRUE"
lags <- tclvalue(lagVariable)
seas <- tclvalue(seasonVariable)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
modelValue <- tclvalue(modelName)
if (!is.valid.name(modelValue)){
assign("UpdateModelNumber", UpdateModelNumber - 1, envir=.GlobalEnv)
errorCondition(recall=urcacajolst, message=paste('"', modelValue, '" is not a valid name.', sep=""))
return()
}
if (is.element(modelValue, listVECMmodels())) {
if ("no" == tclvalue(checkReplace(modelValue, type="Model"))){
assign("UpdateModelNumber", UpdateModelNumber - 1, envir=.GlobalEnv)
if (GrabFocus()) tkgrab.release(top)
tkdestroy(top)
urcacajolst()
return()
}
}
command <- paste("cajolst(x = ", x, ", trend = ", ttype, ", K = ", lags, ", season = ", seas, ")", sep="")
logger(paste(modelValue, " <- ", command, sep=""))
assign(modelValue, justDoIt(command), envir=.GlobalEnv)
doItAndPrint(paste("summary(", modelValue, ")", sep=""))
tkfocus(CommanderWindow())
}
OKCancelHelp(helpSubject="cajolst")
radioButtons(name="season", buttons=c("none", "monthly", "quarterly"), values=c("NULL", "12", "4"),
labels=c("None", "Monthly seasonality", "Quarterly seasonality"), title="Seasonality")
checkBoxes(frame="trendFrame", boxes="trend", initialValues="1", labels="Include linear trend in the auxiliary regressions?")
lagFrame <- tkframe(top)
lagVariable <- tclVar("2")
lagField <- tkentry(lagFrame, width="2", textvariable=lagVariable)
tkgrid(tklabel(modelFrame, text="Enter name for model:"), model, sticky="w")
tkgrid(modelFrame, sticky="w")
tkgrid(getFrame(xBox), sticky="nw")
tkgrid(tklabel(lagFrame, text="Lag order = ", fg="blue"), lagField, sticky="w")
tkgrid(lagFrame, sticky="w")
tkgrid(trendFrame, sticky="w")
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(lagField, sticky="e")
dialogSuffix(rows=5, columns=1)
}
#
# Utility Functions
#
listVECMmodels <- function(envir=.GlobalEnv, ...) {
objects <- ls(envir=envir, ...)
if (length(objects) == 0) NULL
else objects[sapply(objects, function(.x) "ca.jo" == (class(eval(parse(text=.x), envir=envir))[1]))]
}
listMatrix <- function(envir=.GlobalEnv, ...) {
objects <- ls(envir=envir, ...)
if (length(objects) == 0) NULL
else objects[sapply(objects, function(.x) "matrix" == (class(eval(parse(text=.x), envir=envir))[1]))]
}
listNumeric <- function(envir=.GlobalEnv, ...) {
objects <- ls(envir=envir, ...)
if (length(objects) == 0) NULL
else objects[sapply(objects, function(.x) "numeric" == (class(eval(parse(text=.x), envir=envir))[1]))]
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.