#-------------------------------------------------------------------------------
# globals.s CODA library v0.40bs1
#
# Description: The globals.s library provides a set of functions for managing
#    the dizzying number of global variables in the CODA program.  Changes in
#    S-PLUS v5.0 broke the CODA v0.40 progam due to the way it handled global
#    variables.  Versions of CODA based on the globals.s library will function
#    properly under all present and future versions of S-PLUS.  All global
#    variables used in CODA should be defined in this library.  Adding a global
#    variable is as simple as adding a variable to one of the lists in the
#    'globals.create()' function.  As easy and tempting as this may be, you
#    should only add global variables as a last resort.  They are harder to
#    keep track of than local variables and not in the general spirit of object
#    oriented programming.
#
# Functions:
#    globals.create()
#    globals.init()
#    globals.load()
#    globals.remove()
#    globals.save()
#    globals()
#    changes()
#    data.defaults()
#    func.defaults()
#
# Usage:
#
# Step 1 - Creating the Global Variables
#    The global variables are stored internally in the following data
#    structures:
#       .coda.globals
#       .coda.changes
#       .coda.data.defaults
#       .coda.func.defaults
#    These must be created and initialized before the global variables can be
#    used.  This is accomplished by including the following commands in your
#    program:
#       globals.create()
#       globals.init()
#    OR
#       globals.create()
#       globals.load()
#
# Step 2 - Assigning Values to Variables
#    Do NOT try to assign values to the global variables directly.  In
#    particular, do NOT use the '<<-' to assign values.  Not only is this poor
#    programming style, but the behavior of this operator is subject to change
#    without prior notification in subsequent versions of S-PLUS.  Instead, use
#    the funcions
#       globals()
#       changes()
#       data.defaults()
#       func.defaults()
#    to set the values of the variables in the respective internal data
#    structures.  For example, global variables stored in the '.coda.globals'
#    object should be assigned values by typing
#       globals(<variable 1> = <value 1>, ..., <variable n> = <value n>)
#    This can be done at any point in the program, and repeated as often as
#    necessary.
# 
# Step 3 - Extracting Variable Values
#    Do NOT try to extract values directly from the global variables.  Instead,
#    use the functions
#       globals()
#       changes()
#       data.defaults()
#       func.defaults()
#    to extract the values from the variables in the respective internal data
#    structures.  For example, global variables stored in the '.coda.globals'
#    object should be extracted by typing
#       globals()$<variable>
#    This can be done at any point in the program, and repeated as often as
#    necessary.
# 
# Step 4 - Saving the Variables
#    To permanently save the current state of the global variables in the
#    current S-PLUS working database, type
#       globals.save("<prefix>")
#    The resulting objects will be named
#       <prefix>.globals
#       <prefix>.changes
#       <prefix>.data.defaults
#       <prefix>.func.defaults
#    These saved variables can be loaded by typing
#       globals.load("<prefix>")
#    Note that the current global variables will be overwritten by the saved
#    data.  Loading data is an alternative way to initialize the global
#    variables (see Step 1).
# 
# Step 5 - Clean Up after Yourself
#    Always, always, always have your program execute
#       globals.remove()
#    before exiting.  Failure to do so may result in memory leaks or lingering
#    or lost data.
# 
# This is an abbreviated list of the features provided by these functions.  Have
# a look at each individual function for all the details.  If you have any
# questions, comments, suggestions, money for me, job offers, or stock tips I
# would love to hear from you. 
#
# Memory Issues: If CODA seems to be eating up all of your system's physical
#    memory, you might try changing all the occurances of 'frame=0' in this
#    library to 'where=1'.  
#
# Author: Brian Smith <brian-j-smith@uiowa.edu>
#         The University of Iowa, Iowa City, US
#
# Modified: February 15, 1999
#-------------------------------------------------------------------------------


globals.create <- function()
#-------------------------------------------------------------------------------
# Creates the internal data structures used to store the global variables.
# Either this function or the 'globals.load()' function must be called first
# when using this library.  To keep this function general, the variables are
# originally assigned NULL values.  This is not the place to assign anything
# other than NULL values to these variables.  To initalize the global
# variables, 'globals.init()' or 'globals.load()' should be called after this
# function.
#-------------------------------------------------------------------------------
{
   assign(".coda.globals",
          list(filenames = NULL,
               files.list = NULL, 
               first.time = NULL,
               graph.open = NULL,
               Home = NULL,
               Labels = NULL,
               labels.list = NULL,
               mtitle = NULL,
               Nchains = NULL,
               nfiles = NULL,
               Niters = NULL,
               Nparms = NULL,
               nparms = NULL,
               outfile = NULL,
               out = NULL,
               parmnames = NULL,
               parmnames2 = NULL,
               parmsmat = NULL,
               parmsmat.iter = NULL,
               pick = NULL,
               pick1 = NULL,
               pick2 = NULL,
               pick3 = NULL,
               quit.CODA = NULL,
               short.labels = NULL,
               which.dev = NULL), frame=0)

   #----------------------------------------------------------------------------
   # The '.coda.changes' data structure indicates which defaults have been
   # changed - this is used to speed up the display of current defaults by
   # avoiding the need to re-tabulate unchanged defaults
   #----------------------------------------------------------------------------
   assign(".coda.changes",
          list(chains = NULL,
               iter = NULL,
               parms = NULL,
               pos.parms = NULL,
               thin = NULL), frame=0)

   assign(".coda.data.defaults",
          list(all.trace = NULL,
               chains = NULL,
               chainsC = NULL,
               end = NULL,
               parms = NULL,
               parmsC = NULL,
               start = NULL,
               thin = NULL), frame=0)

   assign(".coda.func.defaults",
          list(bandwidth = NULL,
               batch.size = NULL,
               combine.corr = NULL,
               combine.stats = NULL,
               densplot = NULL,
               digits = NULL,
               frac1 = NULL,
               frac2 = NULL,
               geweke.bin = NULL,
               geweke.max = NULL,
               gr.bin = NULL,
               gr.max = NULL,
               halfwidth = NULL,
               lowess = NULL,
               mcols = NULL,
               mrows = NULL,
               onepage = NULL,
               pos.parms = NULL,
               pos.parmsmat = NULL,
               prop.parms = NULL,
               prop.parmsmat = NULL,
               ps.plot = NULL,
               q = NULL,
               quantiles = NULL,
               r = NULL,
               s = NULL,
               scientific = NULL,
               sepplot = NULL,
               trace = NULL,
               user.layout = NULL), frame=0)
   return()
}


globals.init <- function()
#-------------------------------------------------------------------------------
# Assigns initial values to the global variables.  The initial values here
# should evaluate to a constant, independent of any other data.  If used, this
# function usually appears immediately after 'globals.create()'.
#
# PRECONDITION:
#    Requires that the global variables have already been created via
#    'globals.create()'
#-------------------------------------------------------------------------------
{
    globals(graph.open = F,
            quit.CODA = F)
    changes(parms = T,
            chains = T,
            iter = T,
            thin = T,
            pos.parms = T)
    data.defaults(all.trace = F,
                  chainsC = numeric(),
                  parmsC = numeric(),
                  start = 1,
                  thin = 1)
    func.defaults(bandwidth = function(y){(max(y)-min(y))/4},
                  batch.size = 25,
                  combine.corr = F,
                  combine.stats = F,
                  densplot = T,
                  digits = 3,
                  frac1 = 0.1,
                  frac2 = 0.5,
                  geweke.bin = 10,
                  geweke.max = 50,
                  gr.bin = 10,
                  gr.max = 50,
                  halfwidth = 0.1,
                  lowess = F,
                  mcols = 1,
                  mrows = 1,
                  onepage = F,
                  pos.parms = 0,
                  pos.parmsmat = 0,
                  prop.parms = 0,
                  prop.parmsmat = 0,
                  ps.plot = 1,
                  q = 0.025,
                  quantiles = c(0.025, 0.5, 0.975),
                  r = 0.005,
                  s = 0.95,
                  scientific = 6,
                  sepplot = F,
                  trace = T,
                  user.layout = F)
   return()
}


globals.load <- function(prefix, where=1)
#-------------------------------------------------------------------------------
# Loads a previously saved set of global variables into the internal data
# structures used by this library.  Note that this function will overwrite the 
# global variables that are currently in use.  CODA v0.40 does not use this
# function.  It is provided for completeness' sake.
#
# REQUIRED ARGUMENTS:
#    prefix: A character expression giving the root name of the data to be
#            loaded.  In particular, the function will look for the following
#            objects:
#               <prefix>.globals
#               <prefix>.changes
#               <prefix>.data.defaults
#               <prefix>.func.defaults
#
# OPTIONAL ARGUMENTS:
#    where: The position of the database that contains the objects to be loaded.
#           Defaults to the current working database.
#
# PRECONDITION:
#    Requires that the global variables have already been created via
#    'globals.create()'
#-------------------------------------------------------------------------------
{
   name.globals <- paste(prefix, ".globals", sep="")
   name.changes <- paste(prefix, ".changes", sep="")
   name.data.defaults <- paste(prefix, ".data.defaults", sep="")
   name.func.defaults <- paste(prefix, ".func.defaults", sep="")

   loaded <- T

   if (exists(name.globals, where=where))
      new.globals <- get(name.globals, where=where)
   else {
      warning(paste("Object '", name.globals, "' not found", sep=""))
      loaded <- F
   }
   
   if (exists(name.changes, where=where))
      new.changes <- get(name.changes, where=where)
   else {
      warning(paste("Object '", name.changes, "' not found", sep=""))
      loaded <- F
   }

   if (exists(name.data.defaults, where=where))
      new.data.defaults <- get(name.data.defaults, where=where)
   else {
      warning(paste("Object '", name.data.defaults, "' not found", sep=""))
      loaded <- F
   }

   if (exists(name.func.defaults, where=where))
      new.func.defaults <- get(name.func.defaults, where=where)
   else {
      warning(paste("Object '", name.func.defaults, "' not found", sep=""))
      loaded <- F
   }

   if(loaded) {
      globals(new.globals)
      changes(new.changes)
      data.defaults(new.data.defaults)
      func.defaults(new.func.defaults)
   }
   loaded
}


globals.remove <- function()
#-------------------------------------------------------------------------------
# Removes the internal data structures used to store the global variables.  This
# function should always be called at the end of any session in which
# 'globals.create()' was called.  If you wish to save the global variables, use
# the 'globals.save()' function prior to executing this function.
#
# PRECONDITION:
#    Requires that the global variables have already been created via
#    'globals.create()'
#-------------------------------------------------------------------------------
{
   remove(".coda.globals", frame=0)
   remove(".coda.changes", frame=0)
   remove(".coda.data.defaults", frame=0)
   remove(".coda.func.defaults", frame=0)
}


globals.save <- function(prefix, where=1)
#-------------------------------------------------------------------------------
# Saves the current state of the global variables in the internal data
# structures used by this library.  CODA v0.40 does not use this function.  It
# is provided for completeness' sake.
#
# REQUIRED ARGUMENTS:
#    prefix: A character expression specifying the root name for the saved data.
#            In particular, the following objects will be saved:
#               <prefix>.globals
#               <prefix>.changes
#               <prefix>.data.defaults
#               <prefix>.func.defaults
#
# OPTIONAL ARGUMENTS:
#    where: The position of the database that contains the objects to be loaded.
#           Defaults to the current working database.
#
# PRECONDITION:
#    Requires that the global variables have already been created via
#    'globals.create()'
#-------------------------------------------------------------------------------
{
   saved <- T 
   if(prefix == ".coda") {
      warning("'.coda' is currently in use.  A different prefix must be specified")
      saved <- F
   } else {
      assign(paste(prefix, ".globals", sep=""), globals(), where=where)
      assign(paste(prefix, ".changes", sep=""), changes(), where=where)
      assign(paste(prefix, ".data.defaults", sep=""), data.defaults(),
             where=where)
      assign(paste(prefix, ".func.defaults", sep=""), func.defaults(),
             where=where)
   }
   saved
}


globals <- function(...)
#-------------------------------------------------------------------------------
# Extracts values from and assigns values to the global variables stored in the
# '.coda.globals' internal data structure.  You can use this function at any
# point in your program and as often as necessary.  'globals()' essentially
# mimics the behavior of the 'options()' function in S-PLUS.
#
# ASSIGNING VALUES:
#    One or more variables can be assigned values by typing
#       globals(<variable 1> = <value 1>, ..., <variable n> = <value n>)
#
# EXTRACTING VALUES:
#    A value can be extracted by typing 'globals()$<variable>'
#
# PRECONDITION:
#    Requires that the global variables have already been created via
#    'globals.create()'
#-------------------------------------------------------------------------------
{
   if(nargs() == 0)  return(get(".coda.globals", frame=0))
   current <- get(".coda.globals", frame=0)
   temp <- list(...)
   if(length(temp) == 1 && is.null(names(temp))) {
      arg <- temp[[1]]
      switch(mode(arg),
         list = temp <- arg,
         character = return(current[arg]),
         stop(paste("invalid argument:", arg))
      )
   }
   n <- names(temp)
   if(is.null(n))  stop("options must be given by name")
   changed <- current[n]
   names(changed) <- n
   current[n] <- temp
   assign(".coda.globals", current, frame=0)
   invisible(changed)
}


changes <- function(...)
#-------------------------------------------------------------------------------
# Extracts values from and assigns values to the global variables stored in the
# '.coda.changes' internal data structure.  You can use this function at any
# point in your program and as often as necessary.  'changes()' essentially
# mimics the behavior of the 'options()' function in S-PLUS.
#
# ASSIGNING VALUES:
#    One or more variables can be assigned values by typing
#       changes(<variable 1> = <value 1>, ..., <variable n> = <value n>)
#
# EXTRACTING VALUES:
#    A value can be extracted by typing 'changes()$<variable>'
#
# PRECONDITION:
#    Requires that the global variables have already been created via
#    'globals.create()'
#-------------------------------------------------------------------------------
{
   if(nargs() == 0)  return(get(".coda.changes", frame=0))
   current <- get(".coda.changes", frame=0)
   temp <- list(...)
   if(length(temp) == 1 && is.null(names(temp))) {
      arg <- temp[[1]]
      switch(mode(arg),
         list = temp <- arg,
         character = return(current[arg]),
         stop(paste("invalid argument:", arg))
      )
   }
   n <- names(temp)
   if(is.null(n))  stop("options must be given by name")
   changed <- current[n]
   names(changed) <- n
   current[n] <- temp
   assign(".coda.changes", current, frame=0)
   invisible(changed)
}


data.defaults <- function(...)
#-------------------------------------------------------------------------------
# Extracts values from and assigns values to the global variables stored in the
# '.coda.data.defaults' internal data structure.  You can use this function at
# any point in your program and as often as necessary.  'data.defaults()'
# essentially mimics the behavior of the 'options()' function in S-PLUS.
#
# ASSIGNING VALUES:
#    One or more variables can be assigned values by typing
#       data.defaults(<variable 1> = <value 1>, ..., <variable n> = <value n>)
#
# EXTRACTING VALUES:
#    A value can be extracted by typing 'data.defaults()$<variable>'
#
# PRECONDITION:
#    Requires that the global variables have already been created via
#    'globals.create()'
#-------------------------------------------------------------------------------
{
   if(nargs() == 0)  return(get(".coda.data.defaults", frame=0))
   current <- get(".coda.data.defaults", frame=0)
   temp <- list(...)
   if(length(temp) == 1 && is.null(names(temp))) {
      arg <- temp[[1]]
      switch(mode(arg),
         list = temp <- arg,
         character = return(current[arg]),
         stop(paste("invalid argument:", arg))
      )
   }
   n <- names(temp)
   if(is.null(n))  stop("options must be given by name")
   changed <- current[n]
   names(changed) <- n
   current[n] <- temp
   assign(".coda.data.defaults", current, frame=0)
   invisible(changed)
}


func.defaults <- function(...)
#-------------------------------------------------------------------------------
# Extracts values from and assigns values to the global variables stored in the
# '.coda.func.defaults' internal data structure.  You can use this function at
# any point in your program and as often as necessary.  'func.defaults()'
# essentially mimics the behavior of the 'options()' function in S-PLUS.
#
# ASSIGNING VALUES:
#    One or more variables can be assigned values by typing
#       func.defaults(<variable 1> = <value 1>, ..., <variable n> = <value n>)
#
# EXTRACTING VALUES:
#    A value can be extracted by typing 'func.defaults()$<variable>'
#
# PRECONDITION:
#    Requires that the global variables have already been created via
#    'globals.create()'
#-------------------------------------------------------------------------------
{
   if(nargs() == 0)  return(get(".coda.func.defaults", frame=0))
   current <- get(".coda.func.defaults", frame=0)
   temp <- list(...)
   if(length(temp) == 1 && is.null(names(temp))) {
      arg <- temp[[1]]
      switch(mode(arg),
         list = temp <- arg,
         character = return(current[arg]),
         stop(paste("invalid argument:", arg))
      )
   }
   n <- names(temp)
   if(is.null(n))  stop("options must be given by name")
   changed <- current[n]
   names(changed) <- n
   current[n] <- temp
   assign(".coda.func.defaults", current, frame=0)
   invisible(changed)
}