info                MACRO
) This file contains MacAnova macros, including most of the pre-
) defined macros available when MacAnova is launched
)
) Many use features available only in MacAnova4.11 or later
)
) There is help for some of the macros in this file in file MacAnova.hlp
) but not all macros currently have help available.
)
) The following macros.macros are in this file
)   & = may be pre-defined and need not be read in
)   * Not meaningful for all versions of MacAnova
) Linear model related macros
)        makefactor &   model & (others moved to Regress.mac)
) Graph related macros
)        (all moved to Regress.mac)
) Clipboard related macros
)        clipreaddata & clipwritedat & fromclip &     toclip & 
) Macros related to input or output of data and macros
)        addmacrofile & getmacros &    getdata &      readcols &
)        gettsmacros    getdesignmac   console &      enter &
)        enterchars &   readdata &     writedata &    restorenames
) Macros related to help and help files
)        addhelpfile &  help &         usage &
) Miscellaneous other macros
)        haslabels &    hasnotes &     printoptions
) Miscellaneous data analysis macros
)        boxcox &       standardize    rsample        bartlett
)        ttest          descriptive    ztest          proptest
)        tinterval      zinterval      propinterval
) Probability related macros
)        pbin           ppoi           twotailt &     twotailF
) Miscellaneous computational macros
)        (all moved to Math.mac)
) Help related macros
)        arimahelp &    designhelp &   tserhelp &     userfunhelp &
)        _gethelp &
) Macros for use on Minnesota Statistics Network (may not be in file)
)        hdcpy *        psprint *      usa
) Terminal control macros
)        tek *&         tekx *&        vt *&          vtx *&
)        tekclear *     xtekclear *
) Other miscellaneous macros
)        cutmissing     formatpval     makecols &
)        ls             ll             rm             mv
)        dir            erase          ren
)        setformat      equal          head           tail
)        breakif &      more *&        edit *&        editpc *&
)        editunix *& 
) File version 030321
)) All macros are in the "new" format (no line count, macro body
)) terminated by %macroname%)
)) "ERROR: " removed from all arguments to error() and 'macroname:F'
)) added where appropriate
)) argvalue() and keyvalue() are used in most cases to retrieve macro
)) arguments and decode keyword phrases.
)) 000518 made many changes including improvements to readcols, makecols
)) bartlet and hist.
)) Synchronized with pre-defined macros in iniMacro.mac
)) Removed the following multivariate related macros
))    backstep compf      covar     discrim distcomp forstep
))    goodfit  groupcovar jackknife stepgls stepml   stepuls
)) Removed obsolete fcolplot and fcolplot, anytrue and alltrue
)) Add macro matsqrt
)) Reworked readcols to recognized 'realorchar:T'
)) 000616 makefactor now has keyword phrase 'labels:F'
)) 000904 Many graphics related and mathematical macros moved to
))        macro files Graphics.mac, Regress.mac and Math.mac.
))        Multivariate analysis macros have been moved to macro file
))        Mulvar.mac
))        Others will be moved to macro files catdat.mac and
))        nonpar.mac which are under construction.
)) 000914 Put back makefactor which had been accidentally removed
)) 000922 Added readdata which somehow had not been added
)) 001003 added macro userfunhelp
)) 001110 Added clipreaddata which uses readdata to read from CLIPBOARD
)) 001130 Fixed bug occurring when readdata encountered empty lines
)) 010316 Fixed bug in readdata when reading blank but not null lines
)) 010324 Updated getmacros to use new keyword 'printname' and to
))        use getfilename(last:T) (in 4.11 release 4)
)) 010207 fixed bug in readdata
)) 010324 Updated getmacros to use new keyword 'printname' and to
))        use getfilename(last:T)
)) 010327 Minor bugfix to getmacros
)) 010617 Add macros addhelpfile and gethelp
)) 010619 Changed name of gethelp to help and added macro usage
))        modified arimahelp, graphicshelp, ... to use gethelp(), the
))        new name for function help()
)) 010620 Tweaking of help
)) 010703 addhelpfile updates HELPINDICES as well as HELPFILES
))        help(index:helpfilename) prints annotated index of helpfile
)) 010806 fixed bug in readcols() so it prints file name at most once
)) 011029 added writedata(), clipwritedat() and modified makefactor()
)) 020111 readdata() (and hence clipreaddata()) print number of
))        MISSING values found in a variable when there are any
)) 020806 Amended some uses of cumstu() and cumF() to use 'upper:T'
)) 020827 Added macro formatpval()
)) 021015 Enhanced bartlett() and makecols()
)) 021211 addmacrofile(), addhelpfile() and adddatapath() now correctly
))        handle "" file or path names
)) 030113 readdata() (and clipreaddata()) now recognize sort:F, which
))        results in non-numeric columns being read as factors coded
))        in order of values encountered
)) 030114 removed standardize() and put it in mulvar.mac
)) 030321 added restorenames() and printoptions()
)) 050705 added descriptive() and ttest()
)) 072105 added ztest(), proptest(), zinterval(), tinterval(), 
))        propinterval(), and iscarapace()
%info%

====> bartlett <====
bartlett        MACRO DOLLARS
) Compute Bartlett's test for homogeneity of variances or
) homogeneity of covariance matrices
)
) Usage:
)  result <- bartlett(x, a [,df:T] [,silent:T])
)   x                REAL vector or matrix
)   a                factor or vector of positive integers defining
)                    groups, with length(a) = nrows(x)
)   result           REAL scalar chisq (without df:T)
)                    structure(chisq, df) (with df:T)
) 
) chisq is the univariate (x a vector) or multivariate Bartlett statistic
)
) silent:T suppresses warning message when cases with MISSING values are
) omitted
)
) Let p = ncols(x) and g = number of groups with size > 1.  Then df =
) (g-1)*(p*(p+1)/2.
)
) When the data are independent random samples from univariate (p = 1) or
) multivariate (p > 1) normal distributions all with identical variances
) (p = 1) or covariance matrices (p > 1), the statistic computed is
) aproximately distributed as chisquared on df degrees of freedom.
))000218 stripped $$
))000520 generalized to handle multivariate data
))021015 recognizes 'df:T' and 'silent:T'
# usage: $S(x,A), x a real vector, A a factor
if ($v != 2){
	error("usage is $S(x, groupfactor)", macroname:F)
}
@x <- matrix(argvalue($1,"argument 1","real matrix"))
@a <- argvalue($2,"argument 2","positive integer vector")
@keepdf <- keyvalue($K,"df","TF",default:F)
@silent <- keyvalue($K,"silent","TF",default:F)
@n <- nrows(@x)
@p <- ncols(@x)
if (nrows(@a) != @n){
	error("arguments to $S are of different lengths", macroname:F)
}

@J <- if (@p == 1){
	!ismissing(@x)
}else{
	vector(sum(ismissing(@x')) == 0)
}

@n1 <- sum(@J)
if (@n1 == 0){
	error("all rows of $2 have MISSING values")
}
if (@n1 < @n){
	@x <- @x[@J,]
	@a <- @a[@J]
	
	if (!@silent){
		print(paste("WARNING:",@n-@n1,"cases with missing values omitted"),\
			macroname:T)
	}
}
@df <- tabs(,@a,count:T) - 1
if (max(@df) < 1 || sum(@df > 0) <= 1){
	error("you need at least 2 groups with 2 or more observations")
}
@J <- @df > 0
@g <- sum(@J)
if (@p == 1){
	@vars <- tabs(@x,@a,var:T)
	@s <- sum(@df[@J]*@vars[@J])/sum(@df[@J])
}else{
	@s <- matrix(rep(0,@p^2),@p)
	@vars <- rep(0,sum(@J))
	@k <- 0
	for (@i,1,max(@a)){
		if (@J[@i]){
			@ss <- @x[@a == @i,]
			@ss <-- sum(@ss)/nrows(@ss)
			@ss <- @ss %c% @ss
			@s <-+ @ss
			@k <-+ 1
			@vars[@k] <- det(@ss/@df[@k])
		}
	}
	delete(@ss,@k,@i)
	@s <- det(@s/sum(@df))
}
@df <- @df[@J]
@vars <- @vars[@J]
delete(@a,@J,@x)
@chisq <- sum(@df)*log(@s) - sum(@df*log(@vars))
@chisq <-/ 1 + (2*@p^2+3*@p-1)*(sum(1/@df) - 1/sum(@df))/\
	(6*(@p+1)*(@g-1))
if (delete(@keepdf,return:T)){
	@chisq <- structure(chisq:@chisq,df:(@g-1)*@p*(@p+1)/2)
}
delete(@df, @vars, @p, @s, @g)
delete(@chisq,return:T)
%bartlett%

====> twotailt <====
twotailt           MACRO DOLLARS
) Macro to compute two-tailed P-value for Student's t
) Usage:
)  pvalues <- twotailt(tval, df)
)   tval        REAL scalar, vector, matrix or array
)   df          positive REAL scalar vector, matrix or array
)   pvalues     REAL variable the same dimensions as the larger
)               of tval or df
)   If tval and df are both not scalars they must have identical
)   dimensions
) Version of 000306
)) 020806 use 'upper:T' on cumstu()
# $S(tval,df)
@tval <- argvalue($1,"argument 1","real nonmissing")
@df <- argvalue($2,"degrees of freedom","positive")
if(!isscalar(@tval) && !isscalar(@df)){
	@ok <- if(ndims(@tval) != ndims(@df)){
		F
	}else{
		sum(dim(@tval) != dim(@df)) == 0
	}
	if(!delete(@ok,return:T)){
		error("t-value and df not scalars and not identical shapes")
	}
}
2*cumstu(abs(delete(@tval,return:T)),delete(@df,return:T),upper:T)
%twotailt%

====> twotailF <====
twotailF        MACRO DOLLARS
) macro to compute two-tailed F P-value
) Usage:
)  pvals <- twotailF(f, df1, df2)
)   f      Nonnegative REAL scalar or vector
)   df1    Positive REAL scalar or vector
)   df2    Positive REAL scalar or vector
)   pvals  REAL scalar or vector
)
) Any arguments are not scalars must have the same length.  length(pvals)
) = max(length(f),length(df1), length(df2))
)
)) Version of 000306, stripped $$
)) 020806 use 'upper:T' on cumF()
# usage: $S(f, df1, df2), any non-scalar arguments vectors of same length
@f <- argvalue($1,"F value","nonnegative vector")
@df1 <- argvalue($2,"numerator df","positive vector")
@df2 <- argvalue($3,"denominator df","positive vector")
@length <- max(length(@f),length(@df1),length(@df2))
if(!isscalar(@f) && length(@f) != @length ||\
	!isscalar(@df1) && length(@df1) != @length ||\
	!isscalar(@df2) && length(@df2) != @length){
		error("lengths of arguments to $S do not match", macroname:F)
}
@out <- 2*vector(min(hconcat(vector(cumF(@f,@df1,@df2)),\
	vector(cumF(@f,@df1,@df2,upper:T)))'))
delete(@length,@f,@df1,@df2)
delete(@out, return:T)
%twotailF%

====> pbin <====
pbin MACRO DOLLARS
) Macro to compute p(x) for binomial n, p
) Usage:
)   pbin(x,n,p)
)     x a scalar integer or vector, matrix or array of integers
)     n a scalar integer > 0 or vector, matrix or array of integers > 0
)     p a REAL scalar or vector, matrix or array, all values between 0 and 1
)     All arguments that are not scalars must have matching dimensions
)) Version of 990901
# usage: $S(x,n,p)
@x <- argvalue($1,"x","integer")
@n <- argvalue($2,"n","positive integer")
@p <- argvalue($3,"p","nonnegative")
if (max(vector(@p)) > 1){
	error("Value > 1 for p")
}

 #coerce to vector or matrix if appropriate
@x <- if (isvector(@x)){
	vector(@x)
}elseif (ismatrix(@x)){
	matrix(@x)
}else{
	@x
}
@n <- if (isvector(@n)){
	vector(@n)
}elseif (ismatrix(@n)){
	matrix(@n)
}else{
	@n
}
@p <- if (isvector(@p)){
	vector(@p)
}elseif (ismatrix(@p)){
	matrix(@p)
}else{
	@p
}

if (!isscalar(@x) && !isscalar(@n)){
	@ok <- if(ndims(@x) != ndims(@n)){
		F
	}else{
		sum(dim(@x) != dim(@n)) == 0
	}
	if (!@ok){
		error("dimension mismatch of x and n")
	}
}
if (!isscalar(@x) && !isscalar(@p)){
	@ok <- if(ndims(@x) != ndims(@p)){
		F
	}else{
		sum(dim(@x) != dim(@p)) == 0
	}
	if(@ok){
		@ok <- sum(dim(@x) != dim(@p)) == 0
	}
	if (!@ok){
		error("dimension mismatch of x and p")
	}
}
if (!isscalar(@n) && !isscalar(@p)){
	@ok <- if(ndims(@n) != ndims(@p)){
		F
	}else{
		sum(dim(@n) != dim(@p)) == 0
	}
	if(@ok){
		@ok <- sum(dim(@n) != dim(@p)) == 0
	}
	if (!@ok){
		error("dimension mismatch of n and p")
	}
}
delete(@ok, silent:T)
cumbin(@x,@n,@p) - cumbin(delete(@x,return:T)-1,delete(@n,return:T),\
	delete(@p,return:T))
%pbin%

====> ppoi <====
ppoi MACRO DOLLARS
) Macro to compute p(x) for poisson with mean lambda
) Usage:
)   ppoi(x,lambda)
)     x a scalar integer or vector, matrix or array of integers
)     lambda a scalar > 0 or vector, matrix or array of REALs > 0
)     If both arguments are not scalars they must have matching dimensions
)) Version of 990901
# usage: $S(x,lambda)
@x <- argvalue($1,"x","integer")
@lambda <- argvalue($2,"lambda","positive")
 #coerce to vector or matrix if appropriate
@x <- if (isvector(@x)){
	vector(@x)
}elseif (ismatrix(@x)){
	matrix(@x)
}else{
	@x
}
@lambda <- if (isvector(@lambda)){
	vector(@lambda)
}elseif (ismatrix(@lambda)){
	matrix(@lambda)
}else{
	@lambda
}

if (!isscalar(@x) && !isscalar(@lambda)){
	if (!alltrue(ndims(@x) == ndims(@lambda),\
		sum(dim(@x) != dim(@lambda)) == 0)){
		error("dimension mismatch of x and lambda")
	}
}
cumpoi(@x,@lambda) - cumpoi(delete(@x,return:T)-1,delete(@lambda,return:T))
%ppoi%

====> rsample <====
rsample      MACRO DOLLARS
) macro to sample from the rows of a matrix with or without replacement
) usage: sample <- rsample(x,n)  sample with replacement
)        sample <- rsample(x,n,F) sample without replacement
)) 000518 stripped $$, delete temporaries
#usage: sample <- $S(x,n)    sample with replacement
#       sample <- $S(x,n,F)  sample without replacement
if ($v < 2 || $v > 3){
	error("usage is  $S(x,n) or $S(x,n,F), F means no replacement",\
		macroname:F)
}	
@x <- argvalue($1, "argument 1", "real")
@n <- argvalue($2, "sample size", "positive integer scalar")
@replace <- if ($v > 2){
	argvalue($3, "argument 3", "TF")
}else{
	T
}

if(ismatrix(@x)){
	@x<-matrix(@x,nrows(@x))
}
@dims <- dim(@x)
@N <- @dims[1] # population size

if(!@replace && @N < @n){
	error("Without replacement sample size > population size")
}

@I <- if(delete(@replace, return:T)){
	ceiling(@N*runi(@n))
}else{
	rank(runi(@N),ties:"i")[run(@n)]
}
@dims <- if(isvector(@x)){
	@n
}else{
	vector(@n,@dims[-1])
}
delete(@n)
array(matrix(delete(@x, return:T),\
	delete(@N, return:T))[delete(@I, return:T),], delete(@dims, return:T))
%rsample%

====> boxcox <====
boxcox             MACRO DOLLARS
) Macro to compute Box-Cox transformation
) Usage:
)  y <- boxcox(x, pow)
)   x     REAL vector, matrix or array with no 0 or negative elements
)   pow   non-MISSING REAL scalar
)   y     REAL variable the same size and shapes as x, containing the
)         Box-Cox transformation of x, normalized by dividing by
)         GM^(pow - 1), where GM is the geometric mean averaging
)         over the first dimension, for all combinations of other
)         dimensions.
) Version of 990308 handles arrays, suppresses warnings on MISSING
))000508 stripped $$
# usage: $S(x,power), x a vector or matrix, power a scalar
@x <- argvalue($1,"argument 1", "real")
@power <- argvalue($2,"power argument","number")
@dims <- dim(@x)

if (min(vector(sum(!ismissing(@x)))) == 0){
	error("argument 1 is all MISSING or has an all MISSING column")
}
if (min(@x[vector(!ismissing(@x))]) <= 0){
	error("argument 1 has zero or negative values")
}
if (ndims(@x) > 2){
	@x <- matrix(vector(@x),@dims[1])
}
@w <- getoptions(warnings:T)
setoptions(warnings:F)
@gm <- exp(describe(log(@x),mean:T))'
@x <- if ( @power == 0 ) {
	@gm * log(@x)
} else {
	(@x^@power - 1)/(@power*@gm^(@power-1))
}
setoptions(warnings:delete(@w,return:T))
delete(@gm, @power)
array(delete(@x,return:T),delete(@dims,return:T))
%boxcox%

====> readcols <====
readcols        MACRO DOLLARS
) Macro to create named vector variables from columns of data in a file
) Usage is either
)  readcols(filename,name1,...,namek [,keyword phrases]), filename
)   a CHARACTER scalar or quoted string, name1,... names, legal
)   variable names, with or without quotes
)  readcols(filename,vector("name1",...,"namek")[,keyword phrases])
) or
)  readcols(filename [,keyword phrases]), with no names; names are taken
)    from first non blank line of the file; an informative message printed
)    unless 'quiet:T' or 'silent:T' is an argument
)
) filename can be replaced by 'string:CharVector' or 'file:CharScalar'
)
) With bywords:T and bychar:T, variables created are CHARACTER vectors.
) bylines:T makes no sense and is not legal
)
) With 'realorchar:T', each column is initially as CHARACTER data using
) bywords:T.  If the first element of a column represents a number
) the column is translated to numbers and saved as a REAL variable
) Otherwise it is saved as a CHARACTER vector.  You can't use keywords
) 'bywords', 'bylines', 'bychars' or 'byfields' with 'realorchar:T'
)
) Recognizes most other vecread() keywords including 'stop', 'skip',
) 'skipthru', 'go', 'bypass', 'quiet', 'echo', and 'n', but not
) 'startline'
)
) All usages are different from MacAnova 2.4x readcols
) 
)) 000508 stripped dollars; added validity checks of names
)) 000518 can get variable names from first line of file
)) 000601 modified to work with vecread() keyword 'bypass'
)) 000614 added new keyword phrase realorchar:T, enabling non-numerical
))        columns saved as CHARACTER vectors
)) Requires MacAnova later than 6/14/00
)) 000806 added 'silent:T' to vecread() calls searching for first non
))        blank line
# $S(filename,name1,...,namek [,echo:T or F]), only filename quoted
if(isscalar(VERSION,char:T)){
	if(vecread(string:VERSION,byfields:T,silent:T)[2] < 4.11){
		error("$S requires MacAnova 4.11 or later",macroname:F)
	}
}
@nv <- $v - 1
@string <- keyvalue($K,"string","character vector")
@filename <- keyvalue($K,"file","string")
if (!isnull(@string) || !isnull(@filename)){
	if (!isnull(@string) && !isnull(@filename)){
		error("illegal to use both 'file' and 'string'")
	}
	@nv <-+ 1
}else{
	#just check argument (file name)
	@filename <- argvalue($01,"$1","string")
}

if (!isnull(keyvalue($K, "startline", "positive integer scalar"))){
	error("'startline:M' illegal on $S",macroname:F)
}

if (keyvalue($K, "byline*","TF",default:F)){
	error("'bylines:T illegal on $S",macroname:F)
}
@bypass <- keyvalue($K, "bypass","count",default:0)
@badvalue <- keyvalue($K, "badval*","real scalar", default:?)
@quiet <- keyvalue($K, "quiet","TF", default:F)
@echo <- keyvalue($K, "echo","TF", default:F)
@silent <- keyvalue($K, "silent","TF", default:F)
if (@silent && (@echo || !@quiet)){
	error("silent:T is incompatible with echo:T and quiet:F")
}
@silent <- !@echo && @quiet

@startline <- 1

@realorch <- keyvalue($K, "realorch*", "TF", default:F)
if (@realorch){
	@illegal <- vector("byword","bychar","byline","byfield")
	for (@i,1,4){
		@what <- paste(@illegal[@i],"*",sep:"")
		if (!isnull(keyvalue($K, @what, "TF"))){
		@what <- paste(@illegal[@i],"s",sep:"")
			error(paste("'",@what,"' can't be used with 'realorchar:T'",\
				sep:""))
		}
	}
	delete(@illegal,@what)
}

  #determine names of variables to be created
@names <- if (@nv == 0){
	# look for first non blank line (very inefficient, esp if bypass>1)
	for(@startline,1,200){
		@nameline <- if(!isnull(@filename)){
			vecread(@filename,n:1,bylines:T,startline:@startline,\
				bypass:@bypass,silent:T)
		}else{
			vecread(string:@string, n:1, bylines:T,startline:@startline,\
				bypass:@bypass,silent:T)
		}
		if (isnull(@nameline)){
			break
		}
		if (@nameline != ""){
			@tmp <- vecread(string:delete(@nameline, return:T), bywords:T)
			if (anytrue(isnull(@tmp), length(@tmp) > 1, @tmp[1] == "")){
				break;
			}
		}
	}
	if (anytrue(!isdefined(@tmp), isnull(@tmp), @startline == 200)){
		error("no data found")
	}
	@startline <-+ 1
	delete(@tmp, return:T)
}elseif(@nv == 1){
	if(ischar($02)){
		$2
	}else{
		"$2"
	}
}else{
	$A[1+run(@nv)]
}
delete(@filename,@string,@bypass)

  #strip off any quotes and check that names are legal
@n <- length(@names)

for(@i,1,@n){
	@NAME <- @names[@i]
	if (match("\"*\"", @NAME, 0, exact:F) != 0){
		@names[@i] <- @NAME <- <<@NAME>>
	}
	if (!isname(@NAME)){
		error(paste(@NAME,"is not a legal variable name"))
	}
	if (isfunction(<<@NAME>>)){
		error(paste(@NAME, "is a function name and can't be used for data"))
	}
	if (ismacro(<<@NAME>>)){
		print(paste("WARNING: macro",@NAME,\
			"has been replaced by data vector"), macroname:T)
	}
}
delete(@NAME)

  # read data into vector, always CHARACTER with realorchar:T
@data <- if (@realorch){
	if(@nv == $v){
		vecread($K,bywords:T,startline:@startline,silent:@silent,\
			badkeyok:T)
	}elseif($k > 0){
		vecread($01,$K,bywords:T,startline:@startline,silent:@silent,\
			badkeyok:T)
	}else{
		vecread($01,bywords:T,startline:@startline,silent:@silent,\
			badkeyok:T)
	}
}elseif(@nv==$v){
	vecread($K,startline:@startline,silent:@silent,badkeyok:T)
}elseif($k>0){
	vecread($01,$K,startline:@startline,silent:@silent,badkeyok:T)
}else{
	vecread($01,startline:@startline,silent:@silent,badkeyok:T)
}
if (!@quiet && @nv == 0){
	print(paste("Creating vectors",@names))
}
delete(@silent,@echo,@quiet,@startline,@nv)

  #matrix will complain if n does not divide length(data)
@data <- matrix(@data,@n)
@bad <- 8.3109081054232958e-203 #arbitrary
for(@i,1,@n){
	<<@names[@i]>> <- if (@realorch){
		if (vecread(string:@data[@i,1],byfields:T,badvalue:@bad) == @bad){
			# CHARACTER variable
			vector(@data[@i,])
		} else {
			# REAL variable
			vecread(string:@data[@i,]',byfields:T,badvalue:@badvalue, silent:T)
		}
	}else{
		vector(@data[@i,])
	}
}
delete(@data,@names,@i,@n,@realorch,@badvalue,@bad)
%readcols%

====> readdata <====
readdata        MACRO DOLLARS
) Macro to create named vector variables from columns of data in a file
) This is a modification of readcols that has the following enhancements:
) 1. It automatically decides if a column is to be saved as a REAL vector
)    by seeing if the first element in the column is readable as a number
)    If it is not a number, the column is saved as a a factor with
)    the actual CHARACTER values used as row labels or, when factors:F
)    is an argument, as a CHARACTER vector
) 2. If no names are provided, the first line of the file is assumed to
)    contain them, with data starting on the next line.
) 3. '#' is the default 'skip' character, allowing easy internal
)    documentation of files.
) 4. The default value of 'quiet' is F so that skipped lines are echoed
)    and a summary of variables created is printed
)
) Usage is either
)  readdata(filename,name1,...,namek [,keyword phrases]),
)   filename a CHARACTER scalar or quoted string, name1,... names, legal
)   variable names, with or without quotes
)  readdata(filename,vector("name1",...,"namek") [,keyword phrases])
) or
)  readdata(filename [,keyword phrases]), with no names; names are taken
)    from first non blank line of the file; an informative message printed
)    unless 'quiet:T' or 'silent:T' is an argument
)
) filename can be replaced by 'string:CharVector' or 'file:CharScalar'
)
) Each column is initially read as CHARACTER data using bywords:T.
)
) When the first element of a column represents a number or MISSING, the
) column is translated to numbers and saved as a REAL variable.
)
) When the first element is not a number, the column converted to a
) factor as if it were processed by makefactor vector.  The original
) riginal CHARACTER data items are used as case labels.
)
) readdata(filename [,names ...], sort:F [,keyword phrases])
) does the same, except the translation of a non-numerical column
) to a factor is similar to makefactor(x,sort:F), that is, factor
) levels are assigned in the order new values are encountered, and
) not maintaining the alphabetical order of the original column.
)
) readdata(filename [,names ...], factors:F [,keyword phrases])
) does the same, a column whose first items is not a number is saved
) as a CHARACTER vector
)
) Recognizes some other vecread() keywords including 'stop', 'skip',
) 'skipthru', 'go', 'quiet', 'echo', and 'n'
) 
) vecread() keywords 'bywords', 'bylines', 'bychars' or 'byfields' are illegal
)
)) Reworking of new readcols macro so that it doesn't use 'startline' or
)) 'bypass', with only the behavior enabled by realorchar:T enabled.
)) C. Bingham, kb@stat.umn.edu
)) 001130 problem with empty lines fixed
)) 001126 keyword 'n' is is now illegal on 'readdata'
)) 010206 fixed bug; line too long error
)) 010316 Fixed bug: blank but not null lines were counted as data items
)) 020111 Without quiet:T, when a REAL variable has any MISSING values,
))        the number of MISSING values is printed 
)) 030113 Added keyword 'sort'
# $S(filename,name1,...,namek [,echo:T or F]), only filename quoted
@nv <- $v - 1
@string <- keyvalue($K,"string","character vector")
@filename <- keyvalue($K,"file","string")
if (!isnull(@string) || !isnull(@filename)){
	if (!isnull(@string) && !isnull(@filename)){
		error("illegal to use both 'file' and 'string'")
	}
	@nv <-+ 1
}else{
	#just check argument (file name)
	@filename <- argvalue($01,"$1","string")
}

@factors <- keyvalue($K,"factor*","TF",default:T)
@sort <- keyvalue($K, "sort","TF",default:T)
@badvalue <- keyvalue($K, "badval*","real scalar", default:?)
@quiet <- keyvalue($K, "quiet","TF", default:F)
@echo <- keyvalue($K, "echo","TF", default:F)
@silent <- keyvalue($K, "silent","TF", default:F)
@stop <- keyvalue($K, "stop","string", default:"!")
@skip <- keyvalue($K, "skip","string", default:"#")

if (@silent && (@echo || !@quiet)){
	error("silent:T is incompatible with echo:T and quiet:F")
}
@silent <- !@echo && @quiet

@illegal <- vector("byword","char","bychar","byline","byfield","bypas","n")
for (@i,1,4){
	@what <- paste(@illegal[@i],"*",sep:"")
	if (!isnull(keyvalue($K, @what, "TF"))){
	@what <- paste(@illegal[@i],"s",sep:"")
		error(paste("'",@what,"' is not a legal keyword", sep:""))
	}
}
delete(@illegal)
@what <- vector(if (@factors){
	if (@sort){
		"factor"
	} else {
		"unsorted factor"
	}
}else{
	"CHARACTER vector"
}, "REAL vector")

@contents <- if (!isnull(@filename)){
	vecread(@filename,bylines:T,stop:@stop,skip:@skip,echo:@echo,\
		silent:@silent,quiet:@quiet)
} else {
	vecread(string:@string,bylines:T,stop:@stop,skip:@skip,echo:@echo,\
		silent:@silent,quiet:@quiet)
}

if (isnull(@contents)){
	error("no data read")
}
@nlines <- length(@contents)
if (@contents[@nlines] == "\032"){ #remove trailing ^Z if any
	@contents <- @contents[-@nlines]
	@nlines <-- 1
}

if (@nlines == 0){
	error("no data read")
}
  #determine names of variables to be created
@names <- if (@nv == 0){
	if (@nlines < 2){
		error("no data read")
	}

	@names <- vecread(string:@contents[1],bywords:T)
	if (paste(vector(@names,"")) == ""){
		error("variable names not in line 1")
	}
	@contents <- @contents[-1]
	@nlines <-- 1
	@names
}elseif(@nv == 1){
	if(ischar($02)){
		$2
	}else{
		"$2"
	}
}else{
	$A[1+run(@nv)]
}
delete(@filename,@string)

  #strip off any quotes and check that names are legal
@n <- length(@names)

for(@i,1,@n){
	@NAME <- @names[@i]
	if (match("\"*\"", @NAME, 0, exact:F) != 0){
		@names[@i] <- @NAME <- <<@NAME>>
	}
	if (!isname(@NAME)){
		error(paste(@NAME,"is not a legal variable name"))
	}
	if (isfunction(<<@NAME>>)){
		error(paste(@NAME, "is a function name and can't be used for data"))
	}
	if (ismacro(<<@NAME>>)){
		print(paste("WARNING: data vector replacing macro",@NAME),\
			 macroname:T)
	}
}
delete(@NAME)

  # read data into CHARACTER vector

@data <- vecread(string:delete(@contents,return:T),bywords:T)

if (anymissing(@data)){
	# at least one ""
	@data <- @data[!ismissing(@data)]
}	
if (isnull(@data)){
	error("no data read")
}
	
if (length(@data) %% @n != 0){
	error(paste("number of variables",@n,\
		"does not divide number of data items",length(@data)))
}
@data <- matrix(@data,@n)

@bad <- 8.3109081054232958e-203 #arbitrary

@type <- 1 + (vecread(string:vector(@data[,1]),\
			byfields:T,badvalue:@bad) != @bad)

delete(@bad,@silent,@echo)

for(@i,1,@n){
	@var_i <- vector(@data[@i,])
	<<@names[@i]>> <- if (@type[@i] == 1){
		if (!@factors){
			# CHARACTER variable
			@var_i
		} elseif (@sort) {
			# make a factor labelled with values
			factor(vector(match(@var_i, unique(sort(@var_i))),\
				labels:paste(@var_i,multiline:T)))
		} else {
			# make a factor labelled with values
			factor(vector(match(@var_i, unique(@var_i)),\
				labels:paste(@var_i,multiline:T)))
		}
	} else {
		# REAL variable
		vecread(string:@var_i, byfields:T,badvalue:@badvalue,silent:T)
	}
	if (!@quiet){
		@nmiss <- if (isreal(<<@names[@i]>>)) {
			sum(ismissing(<<@names[@i]>>))
		} else {
			0
		}
		@missmsg <- if (@nmiss > 0) {
			paste("with",@nmiss,"missing value(s)")
		} else {
			""
		}
		print(paste("Column",@i,"saved as", @what[@type[@i]],@names[@i],\
					@missmsg))
		delete(@nmiss,@missmsg)
	}
}
delete(@data,@var_i,@names,@i,@n,@badvalue,@quiet,@factors,@sort,@nv,@what)
%readdata%

====> writedata <====
writedata        MACRO   DOLLARS   OUTLINE
) Macro to write one or more vectors of the same length as columns
) in a file
)
) 1.  Variable names are written in a header line (suppressed by putnames:F)
) 2.  A REAL non-factor or factor with no labels is written as numbers
) 3.  For a factor with row labels, the row labels are written instead
)     of the factor levels.
) 4.  CHARACTER vectors are written as such, without quotes.
) 5.  LOGICAL vectors are written as T or F, without quotes
)
) Optionally a CHARACTER scalar is returned instead of writing a file.
)
) Usage to write a file
)   writedata(fileName,x1,x2,a,b,... [,missing:M] [, putnames:F] \
)        [,fieldwidth:w  or  format:fmt])
) Usage to return a CHARACTER scalar
)   writedata(x1,x2,a,b,..., keep:T [,missing:M] [, putnames:F] \
)        [,fieldwidth:w  or  format:fmt])
)   fileName           CHARACTER scalar or CONSOLE (not with keep:T)
)   x1, x2, a, b       vectors or factors all of same length;  they can
)                      have names specified by keyword. e.g. x1:X[,3]
)   M                  CHARACTER scalar, default "?"
)   w                  positive integer
)   fmt                CHARACTER scalar, legal output format
)
)   With keep:T, nothing is written to a file; instead, what would be
)   written is returned as a CHARACTER scalar which can be assigned
)   to a variable or to CLIPBOARD
)
)   With putnames:F, no line with variable names is written
)
)   With missing:M, M is written for any MISSING values
)
)   Only one of fieldwidth:w and format:fmt is permitted
)   Without either fieldwidth:w and format:fmt, the default format is
)   getoptions(format:T) and w is derived from it
)   With fieldwidth:w, fmt is "w.w-7g" (e.g., "20.13g" when w = 20)
)   Without fieldwidth:w, w is derived from the format
)
)) Written by C. Bingham, kb@stat.umn.edu, 011028
# $S(filename,x1,x2,a,b,... [,missing:M] [, putnames:F] \
#        [,fieldwidth:w  or  format:fmt])
if ($N < 2) {
	error("$S must have at least two arguments")
}

@args <- structure($0)
@argnames <- compnames(@args)
@keep <- if ($k > 0) {
	keyvalue($K,"keep","TF")
} else {
	NULL
}
@j <- if (!isnull(@keep)) {
	if (!@keep) {
		error("value for 'keep' must be T")
	}
	match("keep",@argnames)
} else {
	@keep <- F
	1
}

@args <- @args[-@j]
@argnames <- @argnames[-@j]
@arglist <- $A[-@j]
@nvars <- $N-1

@keys <- if ($k > 0) {
	structure($K)
} else {
	structure(NoTaKeY:NULL)
}
@new <- keyvalue(@keys, "new", "TF")
if (isnull(@new) ) {
	@new <- T
} else {
	if (@keep){
		error("illegal to use 'keep' and 'new' together")
	}
	@j <- match("new",@argnames)
	@args <- @args[-@j]
	@argnames <- @argnames[-@j]
	@arglist <- @arglist[-@j]
	@nvars <-- 1
}

@putnames <- keyvalue(@keys, "putnames", "TF")
if (isnull(@putnames) ) {
	@putnames <- T
} else {
	@j <- match("putnames",@argnames)
	@args <- @args[-@j]
	@argnames <- @argnames[-@j]
	@arglist <- @arglist[-@j]
	@nvars <-- 1
}
@missing <- keyvalue(@keys, "missing", "string")
if (isnull(@missing)) {
	@missing <- "?"
} else {
	@j <- match("missing",@argnames)
	@args <- @args[-@j]
	@argnames <- @argnames[-@j]
	@arglist <- @arglist[-@j]
	@nvars <-- 1
}

@format <- keyvalue(@keys, "format", "string")
@fieldwid <- keyvalue(@keys, "fieldwidth", "positive count")
if (!isnull(@format) && !isnull(@fieldwid)) {
	error("'format' and 'fieldwidth' can't be used together")
}
if (isnull(@format) && isnull(@fieldwid)) {
	@format <- getoptions(format:T)
} elseif (!isnull(@format) ) {
	@j <- match("format",@argnames)
	@args <- @args[-@j]
	@argnames <- @argnames[-@j]
	@arglist <- @arglist[-@j]
	@nvars <-- 1
}
if (isnull(@fieldwid) ) {
	@fieldwid <- vecread(string:@format,silent:T)
	@fieldwid <- if (@fieldwid < 1) {
		@intwidth <- @charwidth <- 1
		@fieldwid <- round(10*@fieldwid + 7)
	} else {
		@intwidth <- @charwidth <- floor(@fieldwid)
	}
} else {
	if (isnull(@format)) {
		@format <- paste(@fieldwid,".",max(@fieldwid - 7,0),"g",sep:"")
	}
	@intwidth <- @charwidth <- @fieldwid
	@j <- match("fieldwidth",@argnames)
	@args <- @args[-@j]
	@argnames <- @argnames[-@j]
	@arglist <- @arglist[-@j]
	@nvars <-- 1
}

if (@nvars < 1) {
	error("no data provided to write")
}
delete(@keys)

if (!@keep) {
	@filename <- "$1"
	if (match("\"*\"", @filename, 0, exact:F) != 0) {
		@filename <- <<@filename>>
	} elseif (alltrue(@filename != "CONSOLE", isname(@filename),\
					  isscalar(<<@filename>>, char:T))) {
		@filename <- <<@filename>>
	}
	if (!isscalar(@filename, char:T)) {
		error("'$1' not a CHARACTER scalar")
	}
}

@n <- 0

for (@i, 1, @nvars) {
	if (!isvector(@args[@i])) {
		error(paste(@arglist[@i], "is not a vector"))
	}
	@argi <- @args[@i]
	if (@n == 0) {
		@n <- length(@argi)
	} elseif (length(@argi) != @n) {
		error("not all data vectors have the same length")
	}
}
delete(@argi)

@chars <- rep(F,@nvars)
for(@i,1,@nvars) {
	if (isfactor(@args[@i]) && haslabels(@args[@i])) {
		# check factor levels are constant for each distinct label
		@labels <- getlabels(@args[@i], 1)
		@labels1 <- unique(@labels)
		if (length(@labels1) == length(unique(@args[@i]))) {
			for(@j,1,length(@labels1)) {
				if (describe(@args[@i][@labels == @labels1[@j]],var:T) > 0) {
					@j <- -1
					break
				}
			}
			if (@j > 0) {
				@args[@i] <- @labels
				@chars[@i] <- T
			}
		}
		delete(@labels)
	} else {
		@chars[@i] <- ischar(@args[@i])
	}
}

for (@j, 1, @nvars) {
	@x <- @args[@j]
	@cx <- rep("", @n)
	if (!@chars[@j]) {
		for (@i, 1, @n) {
			@cx[@i] <- if (isscalar(@x[@i],integer:T)) {
				paste(@x[@i],intwidth:@intwidth)
			} elseif (ismissing(@x[@i])) {
				paste(@missing,charwidth:@charwidth,justify:"R")
			} else {
				paste(@x[@i],format:@format)
			}
		}
	} else {
		for (@i, 1, @n) {
			@cx[@i] <- paste(@x[@i], charwidth:@charwidth,justify:"R")
		}
	}
	@args[@j] <- @cx
}
delete(@x,@cx,@i,@j,@format,@fieldwid,@intwidth)
@output <- paste(matrix(vector(@args),delete(@n,return:T)), multiline:T)
if (delete(@putnames,return:T)) {
	@output <- vector(paste(@argnames, charwidth:@charwidth,justify:"R"),\
		@output)
}
delete(@args,@argnames,@charwidth)
if (@keep) {
	delete(@output,return:T)
} else {
	print(file:delete(@filename,return:T),paste(delete(@output,return:T),\
	   multiline:T,linesep:"\n"), new:delete(@new,return:T))
}
%writedata%

====> makecols <====
makecols           MACRO DOLLARS
) Macro to create vectors from columns of a matrix
) usage:
)   makecols(y,name1,name2,...,namek [,nomissing:T] [,quiet:T or silent:T] \
)            [,factors:colNos or factors:TorFvec])
)   y           REAL matrix or CHARACTER vector or scalar
)   name1,...   quoted or unquoted MacAnova variable names
)   
)   TorFvec     LOGICAL vector whose length matches the number of names
)               When TorFvec[i] is True, the i-th variable will
)               be turned into a factor
)   colNos      vector of positive integers containing columns numbers
)               of data matrix to be turned into factors
) or
)    makecols(y,vector("name1","name2",...,"namek") [,nomissing:T]
)               [,factors:TorFvec  or  factors:colNos]\
)               [,quiet:T or silent:T])
)
) Both create vectors name1, ..., namek
)
) With nomissing:T, any MISSING values are stripped out of each variable
) With quiet:T, no report of vectors created is made
) With silent:T, nothing is printed, not even warning messages
)
) When y is CHARACTER, it is assumed to be readable by
)   vecread(string:y) to yield real data.
)   The intended usage with CHARACTER y is
)      makecols(CLIPBOARD,name1,name2,...)
)
) makecols(y [,nomissing:T] [factors:TorFvec  or  variates:intVec]),
) with no variable names is also acceptable 
)   When y is REAL, y must have labels and the column labels are taken
)   as the names
)   When y is CHARACTER, the first line is assumed to contain column
)   labels to be used as names and data is read from the remaining
)   lines
)
)) 000219 stripped $$; makes use of argvalue, allows quoted names
))        uses column labels if any when there are no names,
))        and checks that names are acceptable variable names
))        requires MacAnova later than 5/18/00
)) 021011 added argument factors:TorFvec
)) 021015 added arguments quiet:T and silent:T
)) 021111 integer value for factors allowed
)) 021128 fixed bug when factors:vec not an argument
# $S(y,name1,name2,...,namek [,nomissing:T] [,factors:TorFvec)
#  y a matrix, name1,... quoted or unquoted names, TorFvec LOGICAL vec
@data <- matrix(argvalue($1, "$1", "matrix"))
if ($v == 2){
	@names <- if(ischar($2)){
		$2
	}else{
		"$2"
	}
}elseif($v > 2){
	@names <- $A[run(2,$v)]
}
@strip <- keyvalue($K,"nomissing","TF", default:F)
@factors <- keyvalue($K,"factor*","nonmissing vector")
@silent <- keyvalue($K,"silent","TF",default:F)
@quiet <- keyvalue($K,"quiet","TF",default:F) || @silent

if (ischar(@data)){
	if (!isvector(@data)){
		error("CHARACTER argument 1 must be a scalar or vector")
	}
	@line1 <- vecread(string:@data,bylines:T,n:1) # first line
	@line1 <- vecread(string:@line1, bywords:T)#split it up
	@startline <- 1
	if ($v == 1){
		@names <- @line1
		@line1 <- vecread(string:@data,bylines:T,n:1,startline:2)
		@havedata <- !isnull(@line1)
		if (@havedata){
			@line1 <- vecread(string:@line1, bywords:T)
			@havedata <- @line1[1] != ""
		}
		if (!@havedata){
			error("No data in CHARACTER argument 1")
		}
		delete(@havedata)
		@startline <- 2
	}
	@nvars <- length(@line1)
		
	@badvalue <- -9.8696044731e301
	@data <- vecread(string:@data,byfields:T,badvalue:@badvalue,\
					startline:@startline)
	if (isnull(@data)){
		error("No data in CHARACTER argument 1")
	}
	if (length(@data) %% @nvars != 0){
		error("data in CHARACTER argument 1 not a matrix")
	}
	if (match(@badvalue,vector(@data),0) != 0){
		if (!@silent){
			print("WARNING: unreadable items in CHARACTER argument set to MISSING",\
				macroname:T)
		}
		@data[vector(@data) == @badvalue] <- ?
	}
	@data <- matrix(@data,@nvars)'

	delete(@badvalue, @line1, @nvars)
}elseif (!isreal(@data)){
	error("argument 1 not REAL or CHARACTER matrix")
}elseif ($v == 1){
	@names <- getlabels(@data,2,silent:T)
	if (isnull(@names)){
		error("no variable names provided and argument 1 has no labels")
	}
}

@n <- length(@names)
if (!isnull(@data)){
	@n <- min(@n, ncols(@data))
}
if (!isnull(@factors)){
	if (islogic(@factors)){
		if (length(@factors) != @n){
			error("Length of value of 'factors' != number of variables")
		}
	} elseif (!isvector(@factors,integer:T,positive:T)){
		error("non-LOGICAL value for 'factors' not a vector of positive integers")
	} elseif (max(@factors) > @n ||\
			  length(unique(@factors)) != length(@factors)){
		error("duplicate or out of range values for 'factors'")
	} else {
		@factors <- match(run(@n),@factors,0) != 0
	}
} else {
	@factors <- rep(F,@n)
}

for(@i,run(@n)){
	@NAME <- @names[@i]
	if (match("\"*\"",@NAME,0,exact:F) != 0){
		@names[@i] <- @NAME <- <<@NAME>> # strip quotes
	}
	if (!isname(@NAME)){
		error(paste("'",@NAME,"' is not a valid variable name",sep:""))
	}
	if (isfunction(<<@NAME>>)){
		error(paste(@NAME, "is a function name and can't be used for data"))
	}
}
for(@i,run(@n)){
	@NAME <- @names[@i]
	if (ismacro(<<@NAME>>) && !@silent){
		print(paste("WARNING: macro",@NAME,\
			"has been replaced by data vector"), macroname:T)
	}
	<<@NAME>> <- vector(@data[,@i])
	if(@strip){
		if (anymissing(<<@NAME>>)){
			@I <- !ismissing(<<@NAME>>)
			<<@NAME>> <- if (sum(@I) == 0){
				if (!@silent){
					print(paste("WARNING:",@NAME,\
						"is all MISSING; set to NULL"))
				}
				NULL
			}else{
				<<@NAME>>[@I]
			}
		}
	}
	@what <- if (@factors[@i]){
		<<@NAME>> <- makefactor(<<@NAME>>)
		paste("factor",@NAME," with",max(<<@NAME>>,silent:T),"levels")
	} else {
		paste("vector",@NAME)
	}
	if (!@quiet){
		print(paste("Column",@i,"saved as",@what))
	}
}
delete(@data,@names,@i,@n,@strip,@factors,@what,@quiet,@silent)
%makecols%

====> makefactor <====
makefactor      MACRO DOLLARS
) Macro to create a factor from a vector whose elements may not be
) positive integers
) Usage:
)  a <- makefactor(x)           or a <- makefactor(x, sort:F)
)  a <- makefactor(x, labels:F or T [, sort:F])
)   where x is a vector (REAL, CHARACTER, or LOGICAL).
)   a will be a factor with levels corresponding to the unique
)   elements in x.  Any MISSING values of a REAL or LOGICAL x remain
)   MISSING in a.
)   
)   By default, the assigned factor levels are in the same order
)   as the values in x.  With 'sort:F', the order matches the order
)   of the first occurrences of each value in x.
)
)   When labels:F is an argument, the result will have no row labels.
)   Otherwise, when x has labels, the output will have the same labels.
)   When x does not have labels and labels:T is an argument, a
)   CHARACTER representation of x will be attached to the output as
)   row labels
)
)) Version 960913 Added second argument
)) Version 990309 converted to use of argvalue()
)) Version 991208, allows keyword sort
)) 000220 stripped $$, use argvalue()
)) 000616 added keyword 'labels' and label x with 'labels:T'
)) 011029 if x is CHARACTER, it is attached as labels to the
))        result unless labels:F is an argument
# $S(values [,sort:F] [,labels:F or F]) where values is a vector
if($v < 1 || $v > 2 || $k > 2){
	error("usage: $S(vec [, sort:T] [, labels:F])",macroname:F)
}
@values <- argvalue($1, "argument 1", "vector")
@sort <- if($v == 1){
	T
}else{
	argvalue($02,"$2","TF")
}
@sort <- keyvalue($K,"sort","TF",default:@sort)
@labels <- getlabels(@values,1,silent:T)
@addlabels <- keyvalue($K,"label*","TF",\
	default:!isnull(@labels) || ischar(@values))

if (@addlabels && isnull(@labels)){
	@labels <- paste(@values,multiline:T,missing:"?")
}
if (alltrue(!ischar(@values), sum(ismissing(@values)) == nrows(@values))){
	error("all elements in argument are MISSING")
}
@warnings <- getoptions(warnings:T)
setoptions(warnings:F) # suppress warning messages with MISSING values
if (islogic(@values)){
	@values <- @values + 0 #convert to REAL
}

@values <- if(!delete(@sort, return:T)){
	match(@values,unique(@values))
}elseif(ischar(@values) || !anymissing(@values)){
	match(@values,unique(sort(@values)))
}else{
	@J <- ismissing(@values)
	match(@values,unique(sort(@values[!ismissing(@values)])))
}
setoptions(warnings:delete(@warnings,return:T))

if (delete(@addlabels, return:T)){
	factor(vector(delete(@values,return:T),labels:delete(@labels,return:T)))
} else {
	factor(delete(@values, return:T))
}
%makefactor%

====> model <====
model               MACRO DOLLARS
) model(y=a+b) and model("y=a+b"), say, set variable STRMODEL to "y=a+b"
) The argument must include '=' preceded and followed by at least 1
) character
))000219, stripped $$, added argument checking, allow quoted argument
# model(y=a+b) or model("y=a+b") sets STRMODEL to "y=a+b"
if ($v != 1){
	error("$S must have exactly 1 argument",macroname:F)
}
@model <- "$1"
if (match("\"*\"",@model,0,exact:F) != 0){
	@model <- <<@model>> # strip quotes
}
if (match("*?=?*",@model,0,exact:F) == 0){
	error(paste("'",@model,"' is not a GLM model",sep:""))
}
STRMODEL <- delete(@model,return:T)
NULL
%model%

====> addmacrofile <====
addmacrofile    MACRO DOLLARS
) Macro to add to or create vector MACROFILES of file names to be
) searched by macro getmacros.
) usages:
)  addmacrofile(fileName)  inserts fileName at start of MACROFILES
)  addmacrofile(fileName,T), appends fileName to end of MACROFILES
)   fileName       CHARACTER scalar or vector; if fileName[i] = "",
)                  the user selects the file in a dialog box
) In both cases if MACROFILES is not defined, it is created with fileName
) as its value
)) 000508. Use argvalue(), strip $$
)) 021211 Uses getfilename() with "" file name
# $S(fileName) or $S(fileName,atEnd), atEnd T or F
@newfiles <- argvalue($1,"macro file name(s)","character vector")
@atend <- if($v > 1){
	argvalue($2,"argument 2","TF")
}else{
	F
}
for (@i,1,length(@newfiles)){
	if (@newfiles[@i] == ""){
		if (ncomps(GRAPHWINDOWS) <= 1){
			error("null file name \"\" illegal in this version")
		}
		@newfiles[@i] <- getfilename(type:"text")
	}
}
MACROFILES <- if (!isdefined(MACROFILES)){
	@newfiles
}elseif(@atend){
	vector(MACROFILES,@newfiles)
}else{
	vector(@newfiles,MACROFILES)
}
delete(@newfiles,@atend)
%addmacrofile%

====> addhelpfile <====
addhelpfile MACRO OUTLINE DOLLARS
) Macro to add to or create vector HELPFILES of file names to be
) searched by macro gethelp.
) usages:  addhelpfile(names)     inserts names[1] at start of HELPFILES
)                                 and names[2] at start of HELPINDICES
)          addhelpfile(names, T)  appends names[1] at end of HELPFILES and
)                                 names[2] at end of HELPINDICES
) names      CHARACTER vector of length 2 or scalar
)            When a scalar, names[2] is assumed to be "index"
)            When names[1] = "", you get choose the file name in a
)            dialog box (windowed versions only)
)
) In both cases if HELPFILES is not defined, it is created with fileName
) as its value.
) 
)) 010616 New, modelled on addmacrofile
)) 010703 Argument 1 can be a length 2 vector
)) 021211 Correctly handles "" file name in windowed versions
# $S(fileName [,T]) or $S(vector(fileName,indexName) [,T])
@names <- argvalue($1,"help file name(s)","character vector")
@atend <- if($v > 1){
	argvalue($2,"argument 2","TF")
}else{
	F
}
if (length(@names) > 2){
	error("argument 1 not CHARACTER scalar or vector of length 2")
}
@newfile <- @names[1]
@newindex <- if (isscalar(@names)){
	"index"
} else {
	if (@names[2] == ""){
		error("null index name \"\"")
	} else {
		@names[2]
	}
}
delete(@names)
if (@newfile == ""){
	if (ncomps(GRAPHWINDOWS) <= 1){
		error("null file name \"\" not legal in this version")
	}
	@newfile <- getfilename(type:"text")
}
if (isdefined(HELPFILES) && !isdefined(HELPINDICES)) {
	HELPINDICES <- rep("index", length(HELPFILES))
}
HELPFILES <- if (!isdefined(HELPFILES)){
	@newfile
}elseif(@atend){
	vector(HELPFILES,@newfile)
}else{
	vector(@newfile,HELPFILES)
}
HELPINDICES <- if (!isdefined(HELPINDICES)){
	@newindex
}elseif(@atend) {
	vector(HELPINDICES,@newindex)
}else{
	vector(@newindex,HELPINDICES)
}
delete(@newfile,@newindex,@atend)
if (length(HELPINDICES) != length(HELPFILES)){
	print("WARNING: HELPINDICES and HELPFILES have different lengths",\
		macroname:T)
}
%addhelpfile%

====> adddatapath <====
adddatapath      MACRO DOLLARS
) Macro to add to or create vector DATAPATHS of names of directories or
) folders to be searched for files
) usages:  adddatapath(dirName)  inserts dirName at start of DATAPATHS
)          adddatapath(dirName,T), appends dirName to end of DATAPATHS
) In both cases if DATAPATHS is not defined, it is created with fileName
) as its value
)) 000508. Use argvalue(), strip $$
)) 021211  Correctly handles "" file name in Windowed versions
# $S(dirName) or $S(dirName,atEnd), atEnd T or F
@newpaths <- argvalue($1,"argument 1","character vector")
@atend <- if($v > 1){
	argvalue($02,"argument 2","TF")
}else{
	F
}
for (@i,1,length(@newpaths)){
	if (@newpaths[@i] == ""){
		if (ncomps(GRAPHWINDOWS) <= 1){
			error("null path name \"\" illegal in this version")
		}
		@newpaths[@i] <- getfilename(pathonly:T)
	}
}
DATAPATHS <- if (!isdefined(DATAPATHS)){
	@newpaths
}elseif(@atend){
	vector(DATAPATHS,@newpaths)
}else{
	vector(@newpaths,DATAPATHS)
}
delete(@newpaths,@atend)
%adddatapath%

====> restorenames <====
restorenames MACRO DOLLARS
) Macro to restore file- and folder-related variables saved by restore()
) in structure SAVEDNAMES.
)
) The contents of SAVEDNAMES are the values of variables HOME, DATAFILE
) DATAPATHS, MACROFILES, HELPFILES, HELPINDICES as saved in the restore
) file.  restore() does not overwrite the pre-existing values in the work-
) space.  Use restorenames() after restore() if you do want to overwrite
) pre-existing values
) Usage:
)  restorenames(name1, name2, ... [,quiet:T])
)   name1, name2, ...          quoted or non-quoted names from the list
)                              HOME, DATAFILE, DATAPATHS, MACROFILES,
)                              HELPFILES, HELPINDICES (or other names
)                              that might be in SAVEDNAMES.
)                              Example: restorenames(MACROFILES,"DATAPATHS")
)  restorenames([quiet:T])
)    restores all variables in SAVEDNAMES
)  Without quiet:T, warning messages will be printed if SAVEDNAMES is
)  not an existing structure or if any name provided is not a legal
)  variable name or does not match a component name of SAVEDNAMES
)) 030321 written by C. Bingham kb@umn.edu
# $S([quiet:T]) or $S(name1,name2,... [,quiet:T]) where
#  name1, name2, ... are component names of SAVEDNAMES
@quiet <- keyvalue($K,"quiet","TF",default:F)
if(isstruc(SAVEDNAMES)){
	@names <- compnames(SAVEDNAMES)
	if ($v == 0) {
		for(@i,1,ncomps(SAVEDNAMES)){
			<<compnames(SAVEDNAMES)[@i]>> <- SAVEDNAMES[@i];;
		}
	} else {
		@args <- $A
		for (@i,1,length(@args)){
			@argi <- @args[@i]
			if (match("\"*\"",@argi,0,exact:F) != 0){
				@argi <- <<@argi>>
			}
			@compno <- match(@argi, @names, 0)
			if (@compno > 0){
				<<@argi>> <- SAVEDNAMES[@compno]
			} elseif (!@quiet) {
				if (isname(@argi)){
					print(paste("WARNING: No component \"",@argi,\
						"\" in SAVEDNAMES", sep:""),macroname:T)
				} elseif (match("quiet:*F",@argi,0,exact:F) == 0) {
					print(paste("WARNING: \"",@argi,\
						"\" not legal variable name",sep:""),macroname:T)
				}
			}
		}
		delete(@args,@argi,@compno)
	}
	delete(@i)
} elseif (!@quiet) {
	print("structure SAVEDNAMES does not exist",macroname:T)
}
delete(@quiet)
%restorenames%

====> getmacros <====
getmacros MACRO OUTLINE DOLLARS
) getmacros(macro1,macro2,...[,quiet:T]), reads named
) macros from macro files named in MACROFILES, or if
) that's lacking, in MACROFILE
) Matrix names may be either quoted or unquoted, but must
) not be CHARACTER variables containing macro names.
) They must be legal macro names.
)) Written by C. Bingham, kb@stat.umn.edu
)) 010324 modified to mesh with new keyword phrase printname:F
)) 010327 minor bug fix relative to use of quiet:F without silent:F
)) Version of 010327
#$S(macro1,macro2,...[,quiet:T]) retrieves macros from MACROFILES
if($v==0){
	error("must specify at least one macro name")
}
if(!isdefined(MACROFILES) && (!isdefined(MACROFILE))){
	error("neither MACROFILES nor MACROFILE exists")
}
@files <- if(isdefined(MACROFILES)){
	MACROFILES
}else{
	MACROFILE
}
@silent <- keyvalue($K, "silent","TF",default:F)
@printname <- keyvalue($K, "printname","TF",default:!@silent)

@nf <- length(@files)
@args <- $A
for(@i,run($v)){
	@macname <- @args[@i]
	if (!isname(@macname)){
		# maybe the argument was "macroname"
		if(match("\"*\"",@macname,0,exact:F) != 0){
			@macname <- <<@macname>>
		}
		if (!isname(@macname)){
			error(paste("'",@macname, "' is not a legal macro name",sep:""))
		}
	}
	for (@j,run(@nf)){
		<<@macname>> <- if($k==0){
			macroread(@files[@j],@macname,\
				silent:F,printname:F,nofileok:T,notfoundok:T)
		}else{
			macroread(@files[@j],@macname,\
				printname:F,badkeyok:T,nofileok:T,notfoundok:T,\
					silent:@silent,$K)
		}
		if (!isnull(<<@macname>>)){
			if (@printname){
				print(paste(@macname," read from file \"",\
					getfilename(last:T),"\"",sep:""))
			}
			break
		}
	}
	if (isnull(<<@macname>>)){
		print(paste("WARNING:",@macname,"not found"))
		delete(<<@macname>>)
	}
}
delete(@macname,@files,@i,@j,@nf,@args,@silent,@printname)
%getmacros%

====> gettsmacros <====
gettsmacros      MACRO DOLLARS
) macro to read macros from file whose name is in CHARACTER scalar
) TSMACROS which much exist
) usage: gettsmacros(macro1, ... )
)) 000519 stripped $$
#$S(macro1,macro2,... [,quiet:T]) retrieves macros from TSMACROS
if($v==0){
	error("must specify at least one macro name")
}
if(!isscalar(TSMACROS, char:T)){
	error("CHARACTER scalar TSMACROS does not exist")
}
@args <- $A
for(@i,run($v)){
	@macname <- @args[@i]
	<<@macname>>  <-  if($k==0){
		macroread(TSMACROS,@macname)
	}else{
		macroread(TSMACROS,@macname,$K)
	}
}
delete(@args,@i,@macname)
%gettsmacros%

====> getdesignmac <====
getdesignmac      MACRO DOLLARS
) macro to read macros from file whose name is in CHARACTER scalar
) DESIGNMACROS which much exist
) usage: getdesignmac(macro1, ... )
)) 000519 stripped $$
#$S(macro1,macro2,... [,quiet:T]) retrieves macros from DESIGNMACROS
if($v==0){
	error("must specify at least one macro name")
}
if(!isscalar(DESIGNMACROS, char:T)){
	error("CHARACTER scalar DESIGNMACROS does not exist")
}
@args <- $A
for(@i,run($v)){
	@macname <- @args[@i]
	<<@macname>> <- if($k==0){
		macroread(DESIGNMACROS,@macname)
	}else{
		macroread(DESIGNMACROS,@macname,$K)
	}
}
delete(@args,@i,@macname)
%getdesignmac%

====> getdata <====
getdata      MACRO DOLLARS OUTLINE
) Macro to retrieve a named data set from file whose name is in
) CHARACTER scalar variable DATAFILE.
) usage:
)   y <- getdata(halddata [,quiet:T]), say,
) reads dataset halddata from file named by DATAFILE
)   y <- getdata([quiet:T]), with no set name, assumes the
) first non-blank line in the file is the start of the data set
) Without 'quiet:T', descriptive header lines are printed
))991108 data set name can now optionally be quoted
# y <- $S(datasetName [,quiet:T]) retrieves data set from DATAFILE
if($v > 1){
	error("usage: y <- $S(datasetName, [,quiet:T])",macroname:F)
}
if($v==1){
	@set <- if(match("\"*\"", "$1", 0, exact:F) != 0){
		$1
	}else{
		"$1"
	}
	@data <- if($k==0){
		matread(DATAFILE,@set)
	}else{
		matread(DATAFILE,@set,$K)
	}
	delete(@set)
}else{
	@data <- if($k==0){
		matread(DATAFILE)
	}else{
		matread(DATAFILE,$K)
	}
}
delete(@data,return:T)
%getdata%

====> help <====
help   MACRO   OUTLINE   DOLLARS
) Macro to search for help on a topic in files whose names are in
) CHARACTER vector HELPFILES.
) 
) Usage:
)   help(topicname [,allfiles:T]) or help("topicname" [,allfiles:T])
)
) help is used almost the same as gethelp().
) 
) If HELPFILES does not exist or if keywords 'file', 'orig', or 'alt'
) or 'key' are used, gethelp() is called with the same arguments.
) 
) Otherwise, help repeatedly uses gethelp() to attempt to find help on
) the help files in HELPFILES.  Unless 'allfiles:T' is an argument, as soon
) as any help has been found, it no further files are searched.
) For this reason, when you request help on more than one topic, you should
) normally use allfiles:T.
) 
) You can use keyword phrase 'subtopic"subtopic_name"' or arguments 
) of the form topic:"subtopic_name".
) 
) When help is found on any requested topic, the current help file
) becomes the file where help was found so that that subsequent
) use of gethelp() will search that file.  If no topic is found, the help
) file previously in use is reset.
)
)   help(topic, ..., reset:T)
) Directs that, before returning, the current help file should be
) reset to what it was before the search even when the search was
) successful
)
)) 010616 written by C. Bingham, kb@stat.umn.edu      
)) 010620 added all:T
)) 010621 with keyword 'news' always starts search with HELPFILES[1]
))        all:T is default; always searches current help file
)) 010622 Changed 'all' to 'allfiles'
)) 010703 Added keyword phrase 'index:"name"'
#$S(topic), $S(topic, subtopic:"?") or $S(topic, subtopic:"subtopic_name")
if ($N == 0){
	gethelp()
	return
}
if (!isdefined(HELPFILES)){
	print("WARNING: No variable HELPFILES; using gethelp()", macroname:T)
	gethelp($0)
	return
}
@what <- "$S"
@news <- match("news*",$A,0,exact:F) != 0
@ntopics <- $N
@reset <- @allfiles <- NULL
if ($k > 0){
	@keys <- structure($K)
	@index <- keyvalue(@keys, "index", "string")
	if (!isnull(@index) && $N > 1) {
		error("No other arguments allowed with keyword 'index'")
	}
	@file <- keyvalue(@keys, "file","string")
	@alt <- keyvalue(@keys, "alt","TF")
	@orig <- keyvalue(@keys, "orig","TF")
	@key <- keyvalue(@keys, "key","character vector")
	@k <- sum(vector(!isnull(@file), !isnull(@alt), !isnull(@orig),\
		!isnull(@key)))
	@nosearch <- @k > 0
	@ntopics <-- delete(@k, return:T)
	if (!@nosearch) {
		@allfiles <- keyvalue(@keys, "allf*", "TF")
		if (!isnull(@allfiles)){
			@ntopics <-- 1
		}
		@reset <- keyvalue(@keys, "reset", "TF")
		if (!isnull(@reset)){
			@ntopics <-- 1
		}
		@usage <- keyvalue(@keys, "usage", "TF")
		if (!isnull(@usage)){
			@ntopics <-- 1
			if (@usage) {
				@what <- "usage"
			}
		}
		if (!isnull(keyvalue(@keys, "scroll*","TF"))){
			@ntopics <-- 1
		}
		@silent <- keyvalue(@keys, "silent*","TF")
		if (!isnull(@silent)){
			@ntopics <-- 1
		} else {
			@silent <- F
		}
		if (!isnull(keyvalue(@keys, "printname*","TF"))){
			@ntopics <-- 1
		}
		if (!isnull(keyvalue(@keys, "news","positive integer vector"))){
			@ntopics <-- 1
		}
		if (!isnull(keyvalue(@keys, "subtopic*","character vector"))){
			@ntopics <-- 1
		}
	}
	delete(@keys,@file,@alt,@orig,@key)
} else {
	@index <- NULL
	@silent <- @nosearch <- F
}
			
if (delete(@nosearch, return:T)) {
	delete(@what,@news,@ntopics)
	gethelp($0)
} elseif (!isvector(HELPFILES, char:T)) {
	error("HELPFILES not a CHARACTER vector")
} elseif (sum(HELPFILES != "") == 0) {
		error("All elements of HELPFILES are \"\"")
} else {
	if (isnull(@allfiles)){
		@allfiles <- @ntopics > 1
	}
	@orighelp <- getfilename(help:T)
	@which <- match(@orighelp, HELPFILES, 0)
	if (!isnull(@index)){
		if (!isvector(HELPINDICES, char:T)){
			error("$S(index:\"name\") when HELPINDICES does not exist")
		}
		if (@index == ""){
			error("\"\" is not a legal value for 'index'")
		}
		@J <- match(@index,HELPFILES, 0, ignorecase:T)

		if (@J == 0) { # does it end in name?
			@J <- match(paste("*",@index,sep:""),HELPFILES,0,\
				exact:F, ignorecase:T)
		}
		if (@J == 0) { #does it end in name + extension?
			@J <- match(paste("*",@index,".???",sep:""),HELPFILES,0,\
				exact:F, ignorecase:T)
		}
		if (@J == 0) { #does it include name
			@J <- match(paste("*",@index,"*",sep:""),HELPFILES,0,\
				exact:F, ignorecase:T)
		}
		if (@J == 0){
			error(paste("\"",@index,\
				"\" does not match any help file name",sep:""))
		}
		@index <- HELPINDICES[@J]
		if (@J == @which){
			@result <- gethelp(HELPINDICES[@J], silent:T)
		} else {
			@result <- gethelp(file:HELPFILES[@J], HELPINDICES[@J], silent:T)
			gethelp(file:@orighelp)
		}
		if (!@result && !@silent){
			print(paste("WARNING: topic",HELPINDICES[@J], "in file",\
				HELPFILES[@J],"not found"), macroname:T)
		}
		delete(@index, @J)
	} else {
		@helpfiles <- HELPFILES
		if (@which > 0 && !delete(@news, return:T)){
			@helpfiles <- rotate(@helpfiles, -@which + 1)
		}
		@result <- F
		if (delete(@which,return:T) == 0) {
			@result <- gethelp(file:@orighelp,$0,silent:T,printname:@allfiles)
		}
		if (!@result || @allfiles) {
			for (@i, 1,length(@helpfiles)) {
				@result <- @result ||\
					gethelp(file:@helpfiles[@i],$0,silent:T,printname:@allfiles)
				if (!@allfiles && @result) {
					break
				}
			}
			delete(@i)
		}
		if (!@result){
			if (!@silent) {
				print(paste("WARNING: no",@what,"found"), macroname:T)
			}
			if (isnull(@reset)) {
				@reset <- T
			}
		} 
		if (isnull(@reset)){
			@reset <- @allfiles
		}
		if (delete(@reset, return:T)) {
			gethelp(file:@orighelp, silent:T)
		}
		delete(@helpfiles,@what, @orighelp, @silent, @allfiles)
	}
	delete(@result, return:T,invisible:T)
}
%help%

====> usage <====
usage               MACRO OUTLINE DOLLARS
) Macro to serve as a front end for getusage() and gethelp(), replacing a
) former function of the same name now called getusage().
) Usage:
)   usage(topic [, all:T])  or   usage("topic" [, all:T])
)   where topic is the name of a help topic in one of the standard help files
)   prints usage information for the topic.
)   
)   All the files named in CHARACTER vector HELPFILES are searched using
)   macro help.  Unless 'all:T' is an argument, as soon as any help has
)   been found, no further files are searched.
)   For this reason, when you request usage on more than one topic, you
)   should normally use all:T.
)) 010619 written by C. Bingham (kb@stat.umn.edu)
if ($N > 0) {
	if (!ismacro(help)){
		getmacros(help, silent:T)
	}
	@usagekey <- if ($k > 0){
		!isnull(keyvalue($K,"usage","TF"))
	} else {
		F
	}
	if (!delete(@usagekey, return:T)){
		help($0, usage:T)
	} else {
		help($0)
	}
} else {
	getusage()
}
%usage%

====> printoptions <====
printoptions    MACRO DOLLARS
) Macro to print options in more compact form than print(getoptions())
) Usage:
)  printoptions()
)  printoptions(optname1:T [,optname2:T, ... ])
)   optname1, optname2, ...      names of legal options
)
)  With no options specified, values all options are printed
)) 030320 written by C. Bingham, kb@umn.edu
)) 030321 translate tekset value to hex
# $S() or $S(option1:T [,option2:T, ...]), 
# where option1, option2, ... are legal option names
@options <- getoptions($K)
if (isstruc(@options)){
	# all or at least 2 options selected
	@names <- sort(compnames(@options))
	@len <- rep(0,length(@names))
	for(@i,1,length(@names)){
		@len[@i] <- length(vecread(string:@names[@i],bychar:T))
	}
	@len <- max(@len)
	for(@i,1,length(@names)){
		@value <- @options$<<@names[@i]>>
		if (isscalar(@value,char:T)){
			@value <- paste("\"",@value,"\"",sep:"")
		}
		@name <- @names[@i]
		if (@name == "tekset"){
			@hex <- vector("0","1","2","3","4","5","6","7",\
				"8","9","a","b","c","d","e","f")
			for(@j,1,2){
				@codes <- getascii(@value[@j])
				if (isnull(@codes)) {
					@value[@j] <- "\"\""
				} else {
					@codes <- matrix(@hex[1+vector(hconcat(floor(@codes/16),\
						@codes %% 16)')],2)
					for(@k,1,ncols(@codes)){
						@codes[1,@k] <- paste("\\x",@codes[,@k],sep:"")
					}
					@value[@j] <- paste("\"",@codes[1,],"\"",sep:"")
					delete(@k)
				}
			}
			delete(@codes,@j,@hex)
		}
		@name <- paste(cw:@len,@name,cw:1,"=")
		print(paste(@name,@value,format:".16g"))
	}
	delete(@names,@i,@len,@name)
} else {
	# one option selected
	@value <- if (isscalar(@options,char:T)){
		paste("\"",@options,"\"",sep:"")
	} else {
		@options
	}
	@keys <- structure($K)
	@name <- compnames(@keys)[vector(@keys)]
	if (@name == "tekset"){
		@hex <- vector("0","1","2","3","4","5","6","7",\
			"8","9","a","b","c","d","e","f")
		for(@j,1,2){
			@codes <- getascii(@value[@j])
			if (isnull(@codes)) {
				@value[@j] <- "\"\""
			} else {
				@codes <- matrix(@hex[1+vector(hconcat(floor(@codes/16),\
					@codes %% 16)')],2)
				for(@k,1,ncols(@codes)){
					@codes[1,@k] <- paste("\\x",@codes[,@k],sep:"")
				}
				@value[@j] <- paste("\"",@codes[1,],"\"",sep:"")
				delete(@k)
			}
		}
		delete(@codes,@j,@hex)
	}
	print(paste(@name,"=",@value,format:".16g"))
	delete(@keys,@name)
}
delete(@options,@value)
%printoptions%

====> tek <====
tek                 MACRO
) tek() switches some terminals to tektronix 4014 mode
putascii(getascii(getoptions(tekset:T)[1]))
%tek%

====> vt <====
vt                  MACRO
) vt() switches some terminals to vt100 mode
putascii(getascii(getoptions(tekset:T)[2]))
%vt%

====> tekx <====
tekx                MACRO
) tekx() switches xterm to tektronix 4014 mode
) should normally not be necessary
putascii(vector(27,91,63,51,56,104,27,56))
%tekx%

====> vtx <====
vtx                 MACRO
) vtx() switches xterm to vt100 mode
) should normally not be necessary
putascii(vector(27,3))
%vtx%

====> cutmissing <====
cutmissing         MACRO DOLLARS
) usage: x1 <- cutmissing(x)    Delete rows with missing values
))000219 stripped $$, use argvalue
#x1 <- $S(x) removes all rows containing MISSING values
@x <- matrix(argvalue($1,"argument","real matrix"))

@J <- vector(sum(ismissing(@x)'))  ==  0
if(sum(@J) == 0){
	print("WARNING: all rows of $1 have MISSING values; result is NULL",\
		macroname:T)
}
delete(@x, return:T)[delete(@J,return:T),]
%cutmissing%

====> edit <====
edit       MACRO
) In Unix, type
)   edit <- macroread("macanova.mac","editunix")
) In DOS or WINDOWS, type
)   edit <- macroread("macanova.mac","editpc")
print("This is the dummy version of $S
In Unix, type
  edit <- macroread(\"macanova.mac\",\"editunix\")
In DOS or WINDOWS, type
  edit <- macroread(\"macanova.mac\",\"editpc\")")
%edit%

====> editpc <====
editpc    MACRO DOLLARS
) This is DOS/Windows version, with edit as default editor and
) with scratch file of form \tmp\mvxxxxx
) Change 1st & 2nd executable line to customize
) Usage:
)   realVar<- edit(realVar), macroVar<-edit(macroVar [stripdol:,F]), 
)   macroVar<-edit([stripdol:F]), or realVar<-edit(0)
) or
)   edit(realVar,T), edit(macroVar,T [,stripdol:F])
) With stripdol:F, '$$' are included in file to be edited; otherwise
) they are stripped off
)) Version of 970227; takes advantage of macro end markers
)) Version of 970516; identical with unix version except for
)) first 3 executable lines
)) 000518 stripped $$, added strip:F
# $S(realVar), $S(macro [,stripdol:F]), $S(), or $S(0)
@editor <- "edit"     #change for different default editor
@tmpfile <- "\\tmp\\mv" #change for different temp name start
@delete <- "erase"   #change for different delete file command
if(isdefined(EDITOR) && ischar(EDITOR) && isscalar(EDITOR)){
	@editor <- EDITOR
}
@strip <- keyvalue($K,"strip*","TF",default:T)

@arg <- if($N == 0){
	macro("====> Replace this line with lines of your macro <====")
}else{
	$01
}
if($v > 2 || (!ismacro(@arg) && !isreal(@arg))){
	error("usage: $S(realVar), $S(macro [,stripdol:F]), $S(), or $S(0)")
}

@save <- if($v == 2){
	argvalue($02,"argument 2","TF")
}else{
	F
}
@tmpfile <- paste(@tmpfile,round(100000*runi(1)),sep:"")
if(ismacro(@arg)){
	macrowrite(@tmpfile,@arg,name:"macro_to_edit",stripdol:@strip,new:T)
}else{
	@vector <- isscalar(@arg) && @arg[1] == 0
	if(!@vector){
		matwrite(@tmpfile,edited:@arg,new:T)
	}
}
shell(paste(@editor,@tmpfile),interact:T)
if(ismacro(@arg)){
	@arg <- macroread(@tmpfile,quiet:T)
}else{
	if(!@vector){
		@arg <- matread(@tmpfile,quiet:T)
	}else{
		@arg <- vecread(@tmpfile,quiet:T)
	}
	delete(@vector)
}
shell(paste(@delete,@tmpfile),interact:T)
delete(@delete, @tmpfile, @editor)
if(delete(@save, return:T)){
	$01 <- delete(@arg, return:T)
}else{
	delete(@arg, return:T)
}
%editpc%

====> editunix <====
editunix        MACRO DOLLARS
) This is Unix version, with vi as default editor and
) with scratch file of form /tmp/macanova.xxxxx
) Change 1st & 2nd executable line to customize
) Usage:
)   realVar<- edit(realVar), macroVar<-edit(macroVar [stripdol:,F]), 
)   macroVar<-edit([stripdol:F]), or realVar<-edit(0)
) or
)   edit(realVar,T), edit(macroVar,T [,stripdol:F])
) With stripdol:F, '$$' are included in file to be edited; otherwise
) they are stripped off
)) Version of 970227; takes advantage of macro end markers
)) Version of 970516; minor changes
)) 000518 stripped $$, added strip:F
# $S(realVar), $S(macro [,stripdol:F]), $S(), or $S(0)
@editor <- "vi"     #change for different default editor
@tmpfile <- "/tmp/macanova." #change for different temp name start
@delete <- "rm"    #change for different delete file command
if(isdefined(EDITOR) && ischar(EDITOR) && isscalar(EDITOR)){
	@editor <- EDITOR
}
@strip <- keyvalue($K,"strip*","TF",default:T)

@arg <- if($N == 0){
	macro("====> Replace this line with lines of your macro <====")
}else{
	$01
}
if($v > 2 || (!ismacro(@arg) && !isreal(@arg))){
	error("usage: $S(realVar), $S(macro [,stripdol:F]), $S(), or $S(0)")
}

@save <- if($v == 2){
	argvalue($02,"argument 2","TF")
}else{
	F
}
@tmpfile <- paste(@tmpfile,round(100000*runi(1)),sep:"")
if(ismacro(@arg)){
	macrowrite(@tmpfile,@arg,name:"macro_to_edit",stripdol:@strip,new:T)
}else{
	@vector <- isscalar(@arg) && @arg[1] == 0
	if(!@vector){
		matwrite(@tmpfile,edited:@arg,new:T)
	}
}
shell(paste(@editor,@tmpfile),interact:T)
if(ismacro(@arg)){
	@arg <- macroread(@tmpfile,quiet:T)
}else{
	if(!@vector){
		@arg <- matread(@tmpfile,quiet:T)
	}else{
		@arg <- vecread(@tmpfile,quiet:T)
	}
	delete(@vector)
}
shell(paste(@delete,@tmpfile),interact:T)
delete(@delete, @tmpfile, @editor)
if(delete(@save, return:T)){
	$01 <- delete(@arg, return:T)
}else{
	delete(@arg, return:T)
}
%editunix%

====> more <====
more            MACRO DOLLARS
) Macro to invoke a pager on its argument
) usage: more(macro) or more(macro, macrowrite_keyword_phrases)
) or     more(var)   or more(var, print_keyword_phrases)
) It writes an external file and then uses shell() to invoke the pager
) If variable PAGER exists and is a CHARACTER scalar, it is the name
) of the pager.  Otherwise, "more" is used
# $S(var) or $S(macro [,stripdol:F])
if($v != 1){
	error("usage: $S(x [,keywords])", macroname:F)
}
@x <- $V
if(!ismacro(@x) && !isreal(@x) && !ischar(@x) && !islogic(@x)){
	error("$V is not a macro or a REAL, LOGICAL, or CHARACTER variable")
}
@strip <- keyvalue($K,"strip*","TF",default:T)
@tmpfile <- paste("/tmp/macanova.",round(100000*runi(1)),sep:"")
@pager <- if(isdefined(PAGER) && ischar(PAGER) && isscalar(PAGER)){
	PAGER
}else{
	"more"
}
if(ismacro(@x)){
	macrowrite(@tmpfile,name:"$1",@x,stripdol:@strip,new:T)
}elseif($k == 0){
	print(file:@tmpfile,name:"$V",@x,new:T)
}else{
	print(file:@tmpfile,name:"$V",@x,$K,new:T)
}
shell(paste(@pager,@tmpfile, "; rm", @tmpfile))
delete(@x, @tmpfile, @pager, @strip)
%more%


====> ls <====
ls                  MACRO
) Macro for Unix lovers
) alias for listbrief()
listbrief($0)
%ls%

====> ll <====
ll                  MACRO
) Macro for Unix lovers
) alias for list()
list($0)
%ll%

====> rm <====
rm                  MACRO
) Macro for Unix lovers
) alias for delete()
delete($0)
%rm%

====> mv <====
mv                  MACRO DOLLARS
) Macro for Unix lovers
) usage: newname <- mv(oldname)
)) 000907
@tmp <- argvalue($1,"argument")
delete($1)
delete(@tmp, return:T)
%mv%

====> dir <====
dir                  MACRO
) Macro for DOS lovers
) alias for list()
list($0)
%dir%

====> erase <====
erase                  MACRO
) Macro for DOS lovers
) alias for delete()
delete($0)
%erase%

====> ren <====
ren         MACRO DOLLARS
) Macro for DOS lovers
) usage: newname <- ren(oldname)
)) 000907
@tmp <- argvalue($1,"argument")
delete($1)
delete(@tmp, return:T)
%ren%

====> setformat <====
setformat           MACRO
) usage: setformat(f or g, m.n), e.g., setformat(f,10.4)
# $S(f, m.n)  or  $S(g, m.n)  set print format
setoptions(format:"$2$1")
%setformat%

====> formatpval <====
formatpval   MACRO DOLLARS
) Macro to format P-values similarly to the output of regress(),
) anova() and other MacAnova GLM commands
) Usage:
)  result <- formatpval(pvals [,minpval:minp] [,format:fmt])
)    pvals         Non-negative REAL scalar or vector
)    minp          Non-negative REAL scalar <= .001, default is
)                  the value of option 'minpval'
)    fmt           CHARACTER scalar specifying a legal value for
)                  option 'fmt'.  The default is the current value of
)                  opyion 'fmt'
)    result        CHARACTER vector the same length as pvals.  When
)                  pvals[i] < minp, result[i] is paste("<",minp), "< 1e-8"
)                  for example;  when pvals[i] >= minp, result[i] is
)                  paste(minp,format:fmt)
)) New 020827, C. Bingham, kb2stat.umn.edu
@pval <- argvalue($1,"P value","nonnegative vector")
@minpval <- keyvalue($K,"minp*","nonnegative number",\
	default:getoptions(minpval:T))
if (@minpval > .001){
	error("value for 'minpval' must be between 0 and .001")
}
@fmt <- keyvalue($K,"format","string",default:getoptions(format:T))
@result <- paste(@pval,multiline:T,format:@fmt)
if (min(@pval) < @minpval){
	@tmp <- vecread(string:@fmt,bychar:T)
	@tmp[@tmp == "f"] <- "g"
	if (@tmp[1] == "g") {
		@tmp <- vector(@tmp[-1],"g")
	}
	@j <- match(".",@tmp,0)
	if (@j > 1) {
		@tmp <- @tmp[-run(@j-1)]
	}
	@fmt1 <- paste(delete(@tmp,return:T),sep:"")
	@result[@pval < @minpval] <- paste("<",@minpval,format:@fmt1)
	delete(@fmt1,@j)
}
delete(@pval,@minpval,@fmt)
delete(@result,return:T)
%formatpval%

====> breakif <====
breakif     MACRO DOLLARS
) usage: breakif(logical [,n])
) breakif(logical) equivalent to if(logical){break}
) breakif(logical,n) equivalent to if(logical){break n} where n is REAL integer
if(argvalue($1,"argument 1","TF")){
	@depth <- if($N==1){
		1
	}else{
		argvalue($2, "argument 2","pos int scalar")
	}
	@break <- macro(paste("delete(",nameof(@depth),");break ",\
		@depth,";",sep:""), inline:T)
	@break()
}
%breakif%

====> clipreaddata <====
clipreaddata     MACRO DOLLARS
) Macro to create named vector variables from columns of data on the 
) clipboard.
) Usage is either
)  clipreaddata(name1,...,namek [,keyword phrases]),
)   name1,... names, legalvariable names, with or without quotes
)  clipreaddata(vector("name1",...,"namek") [,keyword phrases])
) or
)  clipreaddata([keyword phrases]), with no names; names are taken
)    from first non blank line if the clipboard; an informative message
)    printed unless 'quiet:T' or 'silent:T' is an argument
) clipreaddata uses readdata to read from the clipboard
)   clipreaddata() is readdata(string:CLIPBOARD)
)   clipreaddata(arg1 [,arg2,...]) is
)       readdata(string:CLIPBOARD, arg1 [,arg2,...])
)) written by C. Bingham (kb@stat.umn.edu)
)) 001110 New macro
# clipreaddata(name1,...,namek [,echo:T or F]), unquoted variable names
# clipreaddata([,echo:T or F]), names from 1st line of CLIPBOARD
if (!ismacro(readdata)){
	getmacros(readdata,quiet:T,printname:F)
}
if ($N > 0) {
	readdata(string:CLIPBOARD,$0)
} else {
	readdata(string:CLIPBOARD)
}
%clipreaddata%

====> clipwritedat <====
clipwritedat     MACRO   DOLLARS   OUTLINE
) Macro to put on the clipboard one or more vectors of the same
) length with a header line of variable names.  You can then
) paste the data into a spread sheet or other document.
)
) A REAL non-factor or factor with no labels is put as numbers
) For a factor with row the row labels are put instead
) of the factor levels.
) CHARACTER vectors are put as such
) LOGICAL vectors are put as "T" or "F"
) Optionally the header line can be suppressed.
)
) Usage
)   clipwritedat(x1,x2,a,b,... [,missing:M] [, putnames:F] \
)        [,fieldwidth:w  or  format:fmt])
)   x1, x2, a, b       vectors or factors all of same length;
)                      they can have the form x1:X[,3]
)   M                  CHARACTER scalar, default "?"
)   w                  positive integer
)   fmt                CHARACTER scalar, legal output format
)
)   With putnames:F, no line with variable names is written
)
)   With missing:M, M is written for any MISSING values
)
)   Only one of fieldwidth:w and format:fmt is permitted
)   Without either fieldwidth:w and format:fmt, the default format is
)   getoptions(format:T) and w is derived from it
)   With fieldwidth:w, fmt is "w.w-7g"
)   Without fieldwidth:w, w is derived from the format
)
)   Any CHARACTER arguments are written as such
)   Any LOGICAL variables are written as "T" or "F"
)   Any REAL non-factor or factor with no labels is written as
)   a number
)   For any factor with row labels, the row labels are written instead
)   of the factor labels.
)
) This is equivalent to
)   CLIPBOARD <- writedata(x1,x2,a,b,..., keep:T, [,missing:M] \
)        [, putnames:F] [,fieldwidth:w  or  format:fmt])
)) Written by C. Bingham, kb@stat.umn.edu, 011029
# $S(x1,x2,a,b,... [,missing:M] [, putnames:F] \
#        [,fieldwidth:w  or  format:fmt])
if (!ismacro(writedata)) {
	getmacros(writedata,silent:T)
}
CLIPBOARD <- writedata($0, keep:T);;
%clipwritedat%

====> fromclip <====
fromclip        MACRO DOLLARS
) Retrieve CHARACTER and numerical data from CLIPBOARD
) x <- fromclip()     retrieve REAL data as vector
) x <- fromclip(n)    retrieve REAL data as matrix, assuming n
)                     columns, read row-wise
) x <- fromclip(bywords:T) retrieve CHARACTER data  as vector, one "word"
)                     per element
) x <- fromclip(n, bywords:T) retrieve CHARACTER data as matrix, one word
)                     per element
) x <- fromclip(bylines:T), retrieve CHARACTER data as vector, one line
)                     per element
) Other vecread() keywords like 'stop', 'go', 'skip' and 'n' may be used.
)) 000508 stripped $$, use keyvalue()
# usage: x <- $S([bywords:T  or  bylines:T])
#    or  x <- $S(ncols [, bywords:T])
if($v==0){
	if ($k > 0){
		vecread(string:CLIPBOARD,$K)
	} else{
		vecread(string:CLIPBOARD)
	}
}else{
	@n <- argvalue($01,"number of columns","positive integer scalar")
	if ($k > 0){
		matrix(vecread(string:CLIPBOARD,$K),@n)
	}else{
		matrix(vecread(string:CLIPBOARD),@n)}'
}
%fromclip%

====> toclip <====
toclip           MACRO DOLLARS
) Macro to copy variables to the clipboard via special variable CLIPBOARD
) Usage:
)   toclip(x)
)   toclip(x,format:"6.3f",missing:"|NA",linesep:";")   (e.g.)
)) 000508 better handling of keywords
#usage: $S(x)  or (e.g.)  $S(x,format:"6.3f",missing:"NA",linesep:";")
if($v != 1){
	error("usage is $S(x [,keyword phrases])", macroname:F)
}
CLIPBOARD <- if($k == 0){
	$01
} else{
	@format <- keyvalue($K,"format","string",default:".17g")
	@missing <- keyvalue($K,"missing","string",default:"?")
	@sep <- keyvalue($K,"sep*","string",default:"\t")
	@linesep <- keyvalue($K,"linesep*","string",default:"\n")
	paste($01,multiline:T,sep:delete(@sep,return:T),\
		format:delete(@format,return:T),missing:delete(@missing,return:T),\
		linesep:delete(@linesep,return:T))
};;
%toclip%

====> console <====
console             MACRO
) usage: y <- console(), vector input direct from keyboard
) or     y <- console(echo:T)  or  y <- console(echo:F)
# usage: y <- $S() reads from keyboard or following lines in batch file
if($k==0){
	vecread(CONSOLE)
}else{
	vecread(CONSOLE,$K)
}
%console%

====> enter <====
enter               MACRO
) usage: x <- enter(x1 x2 x3 ...), x1, x2, ... numbers, no commas needed
# usage: x <- $S(3.1 2.75 3.12 4.5) (no commas needed)
vecread(string:"$0")
%enter%

====> enterchars <====
enterchars       MACRO
) usage: x <- enterchars(weight age height)  (no quotes or commas)
# usage: x <- $S(weight age) (use no quotes, commas)
vecread(string:"$0",char:T)
%enterchars%

====> haslabels <====
haslabels    MACRO
) Macro to test whether a variable has coordinate labels
) usage: labs <- if(haslabels(x)){getlabels(x)}else{""}
!isnull(getlabels($1,1,silent:T))
%haslabels%

====> hasnotes <====
hasnotes    MACRO
) Macro to test whether a variable has descriptive notes
) usage:
) notes <- if(hasnotes(x)){
)   getnotes(x)
) }else{
)   "no notes available"
) }
# notes <- if(hasnotes(x)){getnotes(x)}else{"no notes available"}
!isnull(getnotes($1,1,silent:T))
%hasnotes%

====> arimahelp <====
arimahelp     MACRO 
) Macro to obtain help on the macros in file arima.mac
) Usage:
)    arimahelp(topic1 [, topic2 ...] [,scrollback:T])
)      prints help on topics in file arima.mac
)    arimahelp(topic1 [, topic2 ...], usage:T [,scrollback:T])
)      prints usage information on topics in file arima.mac
)    arimahelp(index:T [,scrollback:T])
)      prints index of topics in the file arima.mac
)) Version 990929
# usage $S(topic1 [, topic2 ...] [help keywords])
#       $S(topic1 [, topic2 ...], usage:T) with no other keywords
#       $S(index:T)
if(!ismacro(_gethelp)){
	getmacros(_gethelp,quiet:T,printname:F)
}
___HELPFILE_ <- "arima.mac"
___INDEXTOP_ <- "arima_index"
___MACRO_ <- "$S"
_gethelp($0)
%arimahelp%

====> designhelp <====
designhelp     MACRO
) Macro to obtain help on the macros in file design.mac
) Usage:
)    designhelp(topic1 [, topic2 ...] [,scrollback:T])
)      prints help on topics in file design.hlp
)    designhelp(topic1 [, topic2 ...], usage:T [,scrollback:T])
)      prints usage information on topics in file design.hlp
)    designhelp(index:T [,scrollback:T])
)      prints index of topics in the file design.hlp
)) Version 990929
# usage $S(topic1 [, topic2 ...] [help keywords])
#       $S(topic1 [, topic2 ...], usage:T) with no other keywords
#       $S(index:T)
if(!ismacro(_gethelp)){
	getmacros(_gethelp,quiet:T,printname:F)
}
___HELPFILE_ <- "design.hlp"
___INDEXTOP_ <- "design_index"
___MACRO_ <- "$S"
_gethelp($0)
%designhelp%

====> tserhelp <====
tserhelp     MACRO
) Macro to obtain help on the macros in file tser.mac
) Usage:
)    tserhelp(topic1 [, topic2 ...] [,scrollback:T])
)      prints help on topics in file tser.hlp
)    tserhelp(topic1 [, topic2 ...], usage:T [,scrollback:T])
)      prints usage information on topics in file tser.hlp
)    tserhelp(index:T [,scrollback:T])
)      prints index of topics in the file tser.hlp
)) Version 990929
# usage $S(topic1 [, topic2 ...] [help keywords])
#       $S(topic1 [, topic2 ...], usage:T) with no other keywords
#       $S(index:T)
if(!ismacro(_gethelp)){
	getmacros(_gethelp,quiet:T,printname:F)
}
___HELPFILE_ <- "tser.hlp"
___INDEXTOP_ <- "tser_index"
___MACRO_ <- "$S"
_gethelp($0)
%tserhelp%

userfunhelp     MACRO
) Macro to obtain help on the macros in file userfun.hlp
) Usage:
)    userfunhelp(topic1 [, topic2 ...] [,scrollback:T])
)      prints help on topics in file userfun.hlp
)    userfunhelp(topic1 [, topic2 ...], usage:T [,scrollback:T])
)      prints usage information on topics in file userfun.hlp
)    userfunhelp(index:T [,scrollback:T])
)      prints index of topics in the file userfun.hlp
)) Version 001003
# usage $S(topic1 [, topic2 ...] [help keywords])
#       $S(topic1 [, topic2 ...], usage:T) with no other keywords
#       $S(index:T)
if(!ismacro(_gethelp)){
	getmacros(_gethelp,quiet:T,printname:F)
}
___HELPFILE_ <- "userfun.hlp"
___INDEXTOP_ <- "userfun_index"
___MACRO_ <- "$S"
_gethelp($0)
%userfunhelp%

====> _gethelp <====
_gethelp     MACRO DOLLARS
) Macro to obtain help on the macros in standard macrofiles
) This should be called only from a macro like designhelp that sets
) variables ___HELPFILE_ to the file name, variable ___INDEXTOP_ to
) the name of the topic with index information, and ___MACRO_ with the
) name of the macro itself.  These variables are deleted after the
) information is retrieved
)
) Usage:
)    _gethelp(topic1 [, topic2 ...] [,scrollback:T])
)      prints help on topics in file named in ___HELPFILE_
)    _gethelp(index:T) or simply _gethelp()
)      prints index of topics from topic named in ___INDEXTOP_ in the file
)    _gethelp(topic1 [, topic2 ...], usage:T) with no other keywords
)      prints usage information on topics in file
)    _gethelp(key:"keyword") lists topics associated with "keyword"
)    _gethelp(key:"?") lists lists all keys in the file
)
)) 000229 made _gethelp() equivalent to _gethelp(index:T)
)) 000927 implements key:key
)) 001213 implements subtopics
)) 010103 'news:dates' now allowed
@file <- delete(___HELPFILE_,return:T)
@indextop <- delete(___INDEXTOP_,return:T)
@macro <- delete(___MACRO_,return:T)
@keys <- if ($k > 0){
	structure($K)
} else {
	structure(notakey:NULL)
}
@usage <- keyvalue(@keys,"usage","TF")
@index <- keyvalue(@keys,"index","TF")
@scrollbk <- keyvalue(@keys,"scrollback","TF")
@key <- keyvalue(@keys,"key","string")
@subtopic <- keyvalue(@keys,"subtop*","character vector")
@news <- keyvalue(@keys,"news")
@badkeys <- vector("orig*","file","alt*")

@J <- unique(match(@badkeys,compnames(@keys),0,exact:F))
@J <- @J[@J > 0]
if (!isnull(@J)){
	error(paste("keyword '",compnames(@keys)[@J[1]],"' illegal on ",\
		@macro, sep:""), macroname:F)
}
delete(@badkeys,@J, @keys)

@speckeys <- (!isnull(@usage)) + (!isnull(@index)) +\
	(!isnull(@scrollbk)) + (!isnull(@key)) + (!isnull(@subtopic))

if ($k == $N && ($k > 0 && @speckeys == 0 ||\
	$k > 1 && @speckeys == 1 && !isnull(@scrollbk))){
	gethelp(file:@file,$K)
} else {	
	if (!isnull(@subtopic)) {
		if (!isnull(@usage) || !isnull(@index) || !isnull(@key) ||\
			!isnull(@news)){
			error("'subtopic' illegal with 'usage', 'index', 'key' and 'news'")
		}
		if ($v != 1){
			error("with keyword 'subtopic', exactly one topic must specified")
		}
	}
	if (!isnull(@usage) && (!isnull(@index) || !isnull(@key) || !isnull(@news))){
		error("'usage' illegal with 'index', 'key' or 'news'")
	}
	if (!isnull(@key) && (!isnull(@index) || !isnull(@news))){
		error("'key' illegal with 'index' or 'news'")
	}
	if (!isnull(@index) && !isnull(@news)){
		error("'index' illegal with 'news'")
	}
	if (isnull(@usage)){
		@usage <- F
	}
	if (isnull(@index)){
		@index <- $v == 0 && isnull(@key) && isnull(@subtopic)
	} elseif (!@index) {
		if ($v == 0 && $k == 1 && isnull(@key)) {
			error(paste("'index:F' but no topics specified for",@macro),\
				macroname:F)
		}
	} else {
		if ($v > 0 || $k > 2 || $k == 2 && isnull(@scrollbk)){
			error("scrollback:T only other argument allowed with 'index:T'")
		}
	}
	if (isnull(@scrollbk)){
		@scrollbk <- F
	}
	if (isnull(@key)){
		if (!@index){
			gethelp(file:@file,$0)
		} else {
			if (@scrollbk){
				gethelp(file:@file,paste(@indextop),scrollback:@scrollbk)
			}else{
				gethelp(file:@file,paste(@indextop))
			}
		}
	} else {
		# ignore @scrollback because of the trailing message which is needed
		# since gethelp() gives instructions on what to do
		gethelp(file:@file,key:@key)
		@what <- if (@key == "?"){
			"these headings"
		} else {
			"these topics"
		}
		print(paste("Use '",@macro,"' instead of 'help' for ",@what, sep:""))
	}
}
gethelp(orig:T) # reset help file to standard
delete(@usage,@file,@indextop,@macro,@key, @index)
%_gethelp%

====> tekclear <====
tekclear            MACRO
) usage: tekclear(), clear tektronix screen
putascii(vector(27,12))
%tekclear%

====> xtekclear <====
xtekclear           MACRO
) usage: xtekclear(), use instead of tekclear under xterm
XW(tekclear())
%xtekclear%

====> equal <====
equal           MACRO DOLLARS
) usage: equal(arg1,arg2), check identity of arg1 and arg2
) If arg1 is a structure, equal(arg1,arg2,F) suppresses comparison
) of component names
) Made obsolete by function equal()
)) Version of 951211
))000219 stripped $$
# $S(arg1,arg2 [,F]) returns T if arg1 and arg2 identical; otherwise F
@arg1 <- $1
@arg2 <- $2
@chknames <- if($N>2){
	$3
}else{
	T
}
@result <- isstruc(@arg1) == isstruc(@arg2)
@result <- if(@result && isstruc(@arg1)){
	ncomps(@arg1) == ncomps(@arg2)
}else{
	@result
}
@result <- if(@result && @chknames && isstruc(@arg1)){
	$S(compnames(@arg1),compnames(@arg2))
}else{
	@result
}
if(@result){
	if(isstruc(@arg1)){
		for(@i,run(ncomps(@arg1))){
			if(!(@result <- $S(@arg1[@i],@arg2[@i],@chknames))){
				break
			}
		}
	}else{
		if (isgraph(@arg1) || isgraph(@arg2)){
			error("cannot compare GRAPH variables")
		}
		if (ismacro(@arg1) || ismacro(@arg2)){
			@result <- ismacro(@arg1) && ismacro(@arg2)
			@result <- if(@result){
				paste(@arg1) == paste(@arg2)
			} else {
				F
			}
		} elseif (isnull(@arg1) || isnull(@arg2)){
			@result <- isnull(@arg1) && isnull(@arg2)
		} else{
			@result <- ndims(@arg1)==ndims(@arg2) &&\
				length(@arg1)==length(@arg2)
			@result <- if(@result){
				sum(dim(@arg1)!=dim(@arg2))==0
			}else{
				F
			}
			@result <- if(@result){
				sum(vector(@arg1!=@arg2))==0
			}else{
				F
			}
		}
	}
}
delete(@arg1, @arg2, @chknames)
delete(@result,return:T)
%equal%

====> head <====
head                MACRO DOLLARS
) usage: head(x [,nlines])  list first nlines (default 10) rows of matrix
)) stripped $$
#$S(x) or $S(x,nlines)
@y <- $1
if(!ischar(@y) && !isreal(@y) && !islogic(@y)){
	error("Argument to $S not REAL, CHARACTER or LOGICAL")
}
@n <- dim(@y)[1]
@nrows <- if($N > 1){
	argvalue($2,"argument 2","positive integer")
}else{
	10
}

@y <- @y[run(min(@nrows, @n)),,,,,,,,]
delete(@n, @nrows)
if(isvector(@y)){
	vector(@y)
}else{
	@y
}
%head%

====> tail <====
tail                MACRO DOLLARS
) usage: tail(x [,nlines])  list last nlines (default 10) rows of matrix
))000219 stripped $$
#$S(x) or $S(x,nlines)
@y <- $1
if(!ischar(@y) && !isreal(@y) && !islogic(@y)){
	error("Argument to $S not REAL, CHARACTER or LOGICAL")
}
@n <- dim(@y)[1]
@nrows <- if($N > 1){
	argvalue($2,"argument 2","positive integer")
}else{
	10
}

@y <- @y[run(@n - min(@nrows,@n) + 1,@n),,,,,,,,]
delete(@n, @nrows)
if(isvector(@y)){
	vector(delete(@y,return:T))
}else{
	delete(@y,return:T)
}
%tail%

====> hdcpy <====
hdcpy               MACRO DOLLARS
) hdcpy() prints Xterm Tektronix window
) hdcpy(fileName) saves PostScript in file fileName (CHAR variable or string)
) requires Unix script hdcpy which uses tek2ps
) Before using, you need to have shell script hdcpy and program
) tek2ps.  You also need to modify the creation of @script below
)) 000219 stripped $$
)) 030220 slight modification; updated location of script
#usage: $S() prints Xterm Tektronix window using Unix scrip hdcpy
#       $S(fileName) save PostScript of plot in file
@script <- paste("/HOME/faculty/kb/bin","hdcpy",sep:"/")
@cmd <- if($N==0){
	paste(@script," -lw",sep:"")
}else{
	paste(@script," -ps ",argvalue($1,"file name","string"),sep:"")
}
shell(@cmd)
%hdcpy%

====> psprint <====
psprint             MACRO DOLLARS
) usage: psprint()  or  psprint(graphVar)
) prints the graph in GRAPH variable LASTPLOT or graphVar on a Unix
) system for which the default printer for lpr is a PostScript
) printer
)) 000219 stripped $$
# usage: $S()  or  $S(graphVar) prints LASTPLOT or graphVar
@plotfile <- "/tmp/"
@lprcmd <- "lpr"
@plotfile <- paste(@plotfile, "plot.", floor(1000*runi(1)), "ps", sep:"")
showplot({
	if($N>0){
		$1
	}else{
		LASTPLOT
	}
}, file:@plotfile, new:T)
shell(paste(@lprcmd, @plotfile, "; rm", @plotfile))
%psprint%


ttest MACRO DOLLARS
) ttest(x[,y],null:nullval,[options]) where options are pooled:T or F
) for two-sample tests and possibly uppertail:T or lowertail:T
) (two tailed is default)
# usage: $S(x,y,null:value,[upper:T or lower:T][,pooled:T|F])
@nvars <- $v
if(@nvars != 1 && @nvars != 2) {
	error("$S takes either one or two non-keyword arguments")
}
@pool <- keyvalue($K,"pool*","logic scalar",default:T)
@null <- keyvalue($K,"null*","real scalar",default:0)
@upper <- keyvalue($K,"upper*","logic scalar",default:F)
@lower <- keyvalue($K,"lower*","logic scalar",default:F)
if(@upper+@lower > 1) {
	error("Exactly one of uppertail:, lowertail:, and twotail: must be true in $S")
}
if($v == 1) {
	@tout <- tval($1-@null,df:T)
} elseif (@pool) {
	@tout <- t2val($1-@null,$2,df:T)
} else {
	@tout <- t2val($1-@null,$2,pooled:F)
}
if (@lower) {
	@pv <- cumstu(@tout$t,@tout$df)
} elseif(@upper) {
	@pv <- 1-cumstu(@tout$t,@tout$df)
} else {
	@pv <- twotailt(@tout$t,@tout$df)
}
vector(@tout,@pv,labels:vector("t-value","df","p-value"))
%ttest%

descriptive MACRO DOLLARS
) descriptive() is a front-end to describe().  It's sole added
) functionality is that you can add a structure:F keyword 
) argument which will force the output to be a labelled vector
) or matrix rather than a structure.  descriptive() can only
) describe a single variable.
if($v != 1) {
	error("$S takes exactly one non-keyword argument")
}
if(!isreal($V)) {
	error("$S only takes a real argument")
}
@asstruct <- keyvalue($K,"structure","logic scalar",default:T)
@args <- $A
@cmd <- "@tmp$$ <- describe("
for(@i,run(length(@args))) {
	if(@args[@i] != "structure:F" && @args[@i] != "structure:T") {
		if(@i != 1) {
			@cmd <- paste(@cmd,",",sep:"")
		}
		@cmd <- paste(@cmd,@args[@i],sep:"")
	}
}
@cmd <- paste(@cmd,")",sep:"")
evaluate(@cmd)
if(isreal(@tmp)) {
	return(@tmp)
}
@labs <- compnames(@tmp)
@dims <- dim($V)
@out <- vector(@tmp)
if(length(@dims) > 1) {
	@out <- array(@out,vector(@dims[-1],length(@labs)))
	@out <- t(@out,vector(ndims(@out),run(ndims(@out)-1)))
} else {
	@out <- @out''
}
setlabels(@out,structure(@labs),silent:T)
@out
%descriptive%


ztest MACRO DOLLARS
) ztest(x[,y],null:nullval,var:value[options]) where options are
) either uppertail:T, lowertail:T, or twotailed:T   The value for
) the variance can be either a real scalar or a vector of length
) 2 for a two-sample test.
# usage: $S(x[,y],null:value,var:value[,upper:T,lower:T])
@nvars <- $v
if(@nvars != 1 && @nvars != 2) {
        error("$S takes either one or two non-keyword arguments")
}
@var <- keyvalue($K,"var*","real vector")
@null <- keyvalue($K,"null*","real scalar",default:0)
@upper <- keyvalue($K,"upper*","logic scalar",default:F)
@lower <- keyvalue($K,"lower*","logic scalar",default:F)
if(@lower+@upper > 1) {
        error("At most one of uppertail: and lowertail: can be true in $S")
}
if(length(@var) > @nvars) {
	error("Too many variances specified")
}
if(sum(@var <= 0) > 0) {
	error("Variances must be nonnegative")
}
@v1 <- @v2 <- @var[1]
if(length(@var) > 1) {
	@v2 <- @var[2]
}
if($v == 1) {
	@out <- describe($1,n:T,mean:T,silent:T)
	if(@out$n == 0) {
		error("No nonmissing data in first argument")
	}
	@z <- (@out$mean - @null)/sqrt(@v1/@out$n)
} else {
	@out1 <- describe($1,n:T,mean:T,silent:T)
	@out2 <- describe($2,n:T,mean:T,silent:T)
	if(@out1$n == 0) {
		error("No nonmissing data in first argument")
	}
	if(@out2$n == 0) {
		error("No nonmissing data in second argument")
	}
	@z <- (@out1$mean - @null - @out2$mean)/sqrt(@v1/@out1$n + @v2/@out2$n)
}
if (@lower) {
        @pv <- cumnor(@z)
} elseif(@upper) {
        @pv <- 1-cumnor(@z)
} else {
        @pv <- 2*cumnor(-abs(@z))
}
vector(@z,@pv,labels:vector("z-value","p-value"))
%ztest%


proptest MACRO DOLLARS
) proptest(x,null:nullval,[options]) 
) or proptest(success,trials,null:nullval,[options])
) or proptest(x,y,[options])
) or proptest(success1,trials1,success2,trials2,[options])
) Options include one of uppertail:T or lowertail:T
) contcor:T|F use a continuity correction 
) pool:T|F for whether a pooled estimate of variance on ztest
# usage: $S(x[,y],null:value,[,upper:T,lower:T,pool:T|F,contcor:T|F])
@nvars <- $v
if(@nvars == 1) {
	@onesamp <- T
	@x <- argvalue($1,"$1","nonnegative integer vector")
	if(sum(!ismissing(@x)) == 0) {
		error("Data all missing")
	}
	if(max(@x) > 1) {
		error("Must be 0/1 data")
	}
	@n1 <- sum(!ismissing(@x))
	@s1 <- sum(@x==1)
} elseif (@nvars == 2) {
	if(isscalar($1) && isscalar($2)) {
		@onesamp <- T
		@s1 <- argvalue($1,"$1","count")
		@n1 <- argvalue($2,"$2","positive integer")
		if(@s1 > @n1) {
			error("Number of trials less than number of successes")
		}
		@x <- NULL
	} else {
		@onesamp <- F
		@x <- argvalue($1,"$1","nonnegative integer vector")
		if(sum(!ismissing(@x)) == 0) {
			error("Data all missing in first argument")
		}
		if(max(@x) > 1) {
			error("First argument must be 0/1 data")
		}
		@n1 <- sum(!ismissing(@x))
		@s1 <- sum(@x==1)
		@y <- argvalue($2,"$2","nonnegative integer vector")
		if(sum(!ismissing(@y)) == 0) {
			error("Data all missing in second argument")
		}
		if(max(@y) > 1) {
			error("Second argument must be 0/1 data")
		}
		@n2 <- sum(!ismissing(@y))
		@s2 <- sum(@y==1)
	}
} elseif (@nvars == 4) {
		@onesamp <- F
		@s1 <- argvalue($1,"$1","count")
		@n1 <- argvalue($2,"$2","positive integer scalar")
		@s2 <- argvalue($3,"$3","count")
		@n2 <- argvalue($4,"$4","positive integer scalar")
		if(@s1 > @n1) {
			error("Number of trials less than number of successes")
		}
		if(@s2 > @n2) {
			error("Number of trials less than number of successes")
		}
		@x <- NULL
		@y <- NULL
} else {
	error("Wrong number of arguments")
}

@null <- keyvalue($K,"null*","real scalar",default:0)
if(!@onesamp && @null != 0) {
	error("Non-zero null only allowed for one-sample proptest")
}
if(@onesamp && (@null <=0  || @null >= 1)) {
	error("Null value must be between 0 and 1 for one-sample proptest")
}
@upper <- keyvalue($K,"upper*","logic scalar",default:F)
@lower <- keyvalue($K,"lower*","logic scalar",default:F)
if(@upper+@lower > 1) {
        error("At most one of uppertail: or lowertail: can be true in $S")
}
@pool <- keyvalue($K,"pool*","logic scalar",default:T)
@contcor <- keyvalue($K,"contcor","logic scalar",default:F)
@delta <- 0
if(@onesamp) {
	@v1 <- @null*(1-@null)
	if(@contcor) {
		@delta <- .5
	}
	if(@upper) {
		@p1 <- (@s1-@delta)/@n1
	} elseif (@lower) {
       		@p1 <- (@s1+@delta)/@n1
	} else {
		if(@s1/@n1 < @null) {
			@p1 <- (@s1+@delta)/@n1
		} else {
			@p1 <- (@s1-@delta)/@n1
		}
	}
	@z <- (@p1 - @null)/sqrt(@v1/@n1)
} else {
	@p1 <- @s1/@n1
	@p2 <- @s2/@n2
	if(@contcor) {
		@delta <- 1/2/max(@n1,@n2)
	}
	if(@pool) {
		@null <- (@n1*@p1 + @n2*@p2)/(@n1+@n2)
		@v2 <- @v1 <- @null*(1-@null)
	} else {
		@v1 <- @p1*(1-@p1)
		@v2 <- @p2*(1-@p2)
	}
	if(@upper) {
		@z <- (@p1 - @p2 - @delta)/sqrt(@v1/@n1 + @v2/@n2)
	} elseif (@lower) {
		@z <- (@p1 - @p2 + @delta)/sqrt(@v1/@n1 + @v2/@n2)
	} else {
	@junk <- paste(@p1,@p2) #why is this needed? bug? otherwise we get a warning
		if(@p1 < @p2) {
			@z <- (@p1 - @p2 + @delta)/sqrt(@v1/@n1 + @v2/@n2)
		} else {
			@z <- (@p1 - @p2 - @delta)/sqrt(@v1/@n1 + @v2/@n2)
		}
	}
}
if (@lower) {
       	@pv <- cumnor(@z)
} elseif(@upper) {
       	@pv <- 1-cumnor(@z)
} else {
       	@pv <- 2*cumnor(-abs(@z))
}
return(vector(@z,@pv,labels:vector("z-value","p-value")))
%proptest%

zinterval MACRO DOLLARS
) zinterval(x[,y],cover:fraction,var:value[,lowerb:T,upperb:T]) where 
) fraction is the coverage and var gives the variance (either a 
) scalar or a vector of length 2). Default is a two-sided interval,
) but lowerb:T or upperb:T will generate one-sided intervals with
) lower or upper bounds respectively.
# usage: $S(x[,y],cover:fraction,var:value)
@nvars <- $v
if(@nvars != 1 && @nvars != 2) {
        error("$S takes either one or two non-keyword arguments")
}
@var <- keyvalue($K,"var*","real vector")
if(isnull(@var)) {
	error("You must specify the variance(s)")
}
@cover <- keyvalue($K,"cover*","real scalar",default:.95)
if(length(@var) > @nvars) {
	error("Too many variances specified")
}
if(sum(@var <= 0) > 0) {
	error("Variances must be nonnegative")
}
@v1 <- @v2 <- @var[1]
if(length(@var) > 1) {
	@v2 <- @var[2]
}
if(@cover <=0 || @cover >= 1) {
	error("Coverage must be between 0 and 1")
}
@upperb <- keyvalue($K,"upper*","logic scalar",default:F)
@lowerb <- keyvalue($K,"lower*","logic scalar",default:F)
if(@upperb+@lowerb > 1) {
	error("At most one of upperb and lowerb can be selected")
}
if(@upperb) {
	@zval <- vector(0,invnor(@cover))
} elseif(@lowerb) {
	@zval <- vector(invnor(1-@cover),0)
} else {
	@zval <- invnor((1-@cover)/2)*vector(1,0,-1)
}
if($v == 1) {
	@out <- describe($1,n:T,mean:T,silent:T)
	if(@out$n == 0) {
		error("No nonmissing data in first argument")
	}
	@int <- @out$mean + sqrt(@v1/@out$n)*@zval
} else {
	@out1 <- describe($1,n:T,mean:T,silent:T)
	@out2 <- describe($2,n:T,mean:T,silent:T)
	if(@out1$n == 0) {
		error("No nonmissing data in first argument")
	}
	if(@out2$n == 0) {
		error("No nonmissing data in second argument")
	}
	@int <- (@out1$mean - @out2$mean) + @zval*\
		sqrt(@v1/@out1$n + @v2/@out2$n)
}
if(@upperb) {
	setlabels(@int,vector("estimate","upper limit"))
} elseif(@lowerb) {
	setlabels(@int,vector("lower limit","estimate"))
} else {
	setlabels(@int,vector("lower limit","estimate","upper limit"))
}
return(@int)
%zinterval%


tinterval MACRO DOLLARS
) tinterval(x[,y],cover:fraction,[pool:T|F,lowerb:T,upperb:T]) where 
) fraction is the coverage.  Default is a two-sided interval,
) but lowerb:T or upperb:T will generate one-sided intervals with
) lower or upper bounds respectively. Pooling of variance can be
) controlled via pool:T or pool:F.
# usage: $S(x,y,cover:fraction)
@nvars <- $v
if(@nvars != 1 && @nvars != 2) {
        error("$S takes either one or two non-keyword arguments")
}
@pool <- keyvalue($K,"pool*","logic scalar",default:F)
@cover <- keyvalue($K,"cover*","real scalar",default:.95)
if(@cover <=0 || @cover >= 1) {
	error("Coverage must be between 0 and 1")
}
@upperb <- keyvalue($K,"upper*","logic scalar",default:F)
@lowerb <- keyvalue($K,"lower*","logic scalar",default:F)
if(@upperb+@lowerb > 1) {
	error("At most one of upperb and lowerb can be selected")
}
if($v == 1) {
	@out <- describe($1,n:T,mean:T,var:T,silent:T)
	if(@out$n == 0) {
		error("No nonmissing data")
	}
	@df <- @out$n-1
	if(@upperb) {
		@tval <- vector(0,invstu(@cover,@df))
	} elseif(@lowerb) {
		@tval <- vector(invstu(1-@cover,@df),0)
	} else {
		@tval <- invstu((1-@cover)/2,@df)*vector(1,0,-1)
	}
	@int <- @out$mean + sqrt(@out$var/@out$n)*@tval
} else {
	@out1 <- describe($1,n:T,mean:T,var:T,silent:T)
	@out2 <- describe($2,n:T,mean:T,var:T,silent:T)
	if(@out1$n == 0) {
		error("No nonmissing data in first argument")
	}
	if(@out2$n == 0) {
		error("No nonmissing data in second argument")
	}
	if(@pool) {
		@df <- @out1$n+@out2$n-2
		@se <- (@out1$n-1)*@out1$var+(@out2$n-1)*@out2$var
		@se <- @se/(@df)
		@se <- sqrt(@se*(1/@out1$n+1/@out2$n))
	} else {
		@se <- sqrt(@out1$var/@out1$n+@out2$var/@out2$n)
		@df <- (@out1$var/@out1$n+@out2$var/@out2$n)^2
		@df <- @df/((@out1$var/@out1$n)^2/(@out1$n-1) + \
			(@out2$var/@out2$n)^2/(@out2$n-1))
	}
	if(@upperb) {
		@tval <- vector(0,invstu(@cover,@df))
	} elseif(@lowerb) {
		@tval <- vector(invstu(1-@cover,@df),0)
	} else {
		@tval <- invstu((1-@cover)/2,@df)*vector(1,0,-1)
	}
	@int <- (@out1$mean - @out2$mean) + @tval*@se
}
if(@upperb) {
	setlabels(@int,vector("estimate","upper limit"))
} elseif(@lowerb) {
	setlabels(@int,vector("lower limit","estimate"))
} else {
	setlabels(@int,vector("lower limit","estimate","upper limit"))
}
return(@int)
%tinterval%

propinterval MACRO DOLLARS
) propinterval(x,cover:frac,[options]) 
) or propinterval(success,trials,cover:frac,[options])
) or propinterval(x,y,cover:frac,[options])
) or propinterval(success1,trials1,success2,trials2,cover:frac,[options])
) Options include upperb:T, lowerb:T
) plus4:T|F for whether to use the Agresti "add 4"
# usage: $S(x,y,cover:frac,[,upper:T,lower:T,plus4:T])
@nvars <- $v
if(@nvars == 1) {
	@onesamp <- T
	@x <- argvalue($1,"$1","nonnegative integer vector")
	if(sum(!ismissing(@x)) == 0) {
		error("Data all missing")
	}
	if(max(@x) > 1) {
		error("Must be 0/1 data")
	}
	@n1 <- sum(!ismissing(@x))
	@s1 <- sum(@x==1)
} elseif (@nvars == 2) {
	if(isscalar($1) && isscalar($2)) {
		@onesamp <- T
		@s1 <- argvalue($1,"$1","count")
		@n1 <- argvalue($2,"$2","positive integer")
		if(@s1 > @n1) {
			error("Number of trials less than number of successes")
		}
		@x <- NULL
	} else {
		@onesamp <- F
		@x <- argvalue($1,"$1","nonnegative integer vector")
		if(sum(!ismissing(@x)) == 0) {
			error("Data all missing in first argument")
		}
		if(max(@x) > 1) {
			error("First argument must be 0/1 data")
		}
		@n1 <- sum(!ismissing(@x))
		@s1 <- sum(@x==1)
		@y <- argvalue($2,"$2","nonnegative integer vector")
		if(sum(!ismissing(@y)) == 0) {
			error("Data all missing in second argument")
		}
		if(max(@y) > 1) {
			error("Second argument must be 0/1 data")
		}
		@n2 <- sum(!ismissing(@y))
		@s2 <- sum(@y==1)
	}
} elseif (@nvars == 4) {
		@onesamp <- F
		@s1 <- argvalue($1,"$1","count")
		@n1 <- argvalue($2,"$2","positive integer scalar")
		@s2 <- argvalue($3,"$3","count")
		@n2 <- argvalue($4,"$4","positive integer scalar")
		if(@s1 > @n1) {
			error("Number of trials less than number of successes")
		}
		if(@s2 > @n2) {
			error("Number of trials less than number of successes")
		}
		@x <- NULL
		@y <- NULL
} else {
	error("Wrong number of arguments")
}

@cover <- keyvalue($K,"cover*","real scalar",default:.95)
if(@cover <=0 || @cover >= 1) {
	error("Coverage must be between 0 and 1")
}
@upperb <- keyvalue($K,"upper*","logic scalar",default:F)
@lowerb <- keyvalue($K,"lower*","logic scalar",default:F)
if(@upperb+@lowerb > 1) {
        error("At most one of upperb: or lowerb: can be true in $S")
}
@plus4 <- keyvalue($K,"plus4","logic scalar",default:F)
if(@plus4 && (@cover < .9 || @cover > .99)) {
	if(iscarapace()) {
		alert("Plus4 method used with coverage less than .9 or greater than .99")
	} else {
		print("WARNING: plus4 method used with coverage less than .9 or greater than .99")
	}
}
if(@upperb) {
	@zval <- vector(0,invnor(@cover))
} elseif(@lowerb) {
	@zval <- vector(invnor(1-@cover),0)
} else {
	@zval <- invnor((1-@cover)/2)*vector(1,0,-1)
}
if(@onesamp) {
	if(@plus4) {
		@s1 <- @s1 + 2
		@n1 <- @n1 + 4
	}
	@p1 <- @s1/@n1
	@v1 <- @p1*(1-@p1)
	@int <- @p1 + @zval*sqrt(@v1/@n1)
} else {
	if(@plus4) {
		@s1 <- @s1 + 1
		@n1 <- @n1 + 2
		@s2 <- @s2 + 1
		@n2 <- @n2 + 2
	}
	@p1 <- @s1/@n1
	@p2 <- @s2/@n2
	@v1 <- @p1*(1-@p1)
	@v2 <- @p2*(1-@p2)
	@int <- (@p1 - @p2) + @zval*sqrt(@v1/@n1 + @v2/@n2)
}
if(@upperb) {
	setlabels(@int,vector("estimate","upper limit"))
} elseif(@lowerb) {
	setlabels(@int,vector("lower limit","estimate"))
} else {
	setlabels(@int,vector("lower limit","estimate","upper limit"))
}
return(@int)
%propinterval%

iscarapace MACRO
match("*Cara*",vecread(string:VERSION,bywords:T),-1,exact:F) > 0
%iscarapace%
