# File to test commands in Chapter 9 of MacAnova Users' Guide
# Version of 000911
# Set default configuration
startTime <- gettime(quiet:T,keep:T)
setoptions(default:T)
DEGPERRAD <- 180/PI; E <- exp(1)
PLATFORM <- vecread(string:VERSION,bywords:T)[5]
MACINTOSH <- PLATFORM == "(Mac" || PLATFORM == "(Macintosh" ||\
	PLATFORM == "(Power"
DOS <- PLATFORM == "(DOS" || PLATFORM == "(Win32s"
if (MACINTOSH || DOS){DATAPATH <- DATAPATHS <- HOME;;}
PATHSEP <- if (MACINTOSH){":"}else{"/"}
DATAFILE <- "macanova.dat"; MACROFILE <-  "macanova.mac"
MACROFILES <- vector("graphics.mac","regress.mac","design.mac",\
	"tser.mac", "arima.mac", "mulvar.mac", "math.mac", "macanova.mac")
setoptions(errors:20,dumbplot:T,height:25,width:80)
#9. Programming MacAnova
#9.1 Working with structures
#9.1.1 Creating structures - structure(), strconcat() and split()
trees <- structure(info:"Made up data on 6 trees",\
  varnames:vector("Species","DBH"),\
  data:matrix(vector(1,1,1,2,2,2, 5.6,4.5,8.9,7.3,9.9,11.3),6))
trees
@x <- 3;structure(run(5),sqrt_pi:sqrt(PI), @x)
hills <- structure(vector(2,3),vector(7,4),compnames:"hill")
hills
hills2 <- structure(vector(2,3),vector(7,4),\
	compnames:"hill",labels:"Minnesota Hill "); hills2
getlabels(hills2)
compnames(hills2) # component names as before (see Sec. 9.1.2)
hills <- strconcat(hills,hill3:vector(9,5,11),hill3:12)
hills
hills[4] # component 4, second hill3
structure(sin,cos)
structure(sin,cos,silent:T)
treatment <- factor(vector(1,1,1,2,2,2,2,3,3))
z <- vector(7.7,10.7,10.2, 11.5,6.6,10.9,8.7, 8.7,9.2)
split(z,treatment)
split(run(10),vector(F,T,T,F,F,T,T,T,F,T))
split(matrix(run(6),3)) # or split(matrix(run(6),3),bycols:T)
split(matrix(run(6),3),byrows:T)
describe(split(z,treatment,compnames:vector("K","P","N")),\
	mean:T,var:T)
#9.1.2 Getting information about a structure - ncomps() and compnames()
ncomps(trees)
compnames(trees)
#9.1.3 Changing a structure - changestr()
changestr(trees,info:"New value for component info")
changestr(trees, date:"March 5, 1977")
changestr(trees,"info","New value for component info")
changestr(trees,"date","March 5, 1977")
changestr(trees,3,newdata:vector(7.1,5.1,3.7,2.8))
changestr(trees,-3) # delete component 3
#9.2 Compound commands, conditional commands, and looping commands
#9.2.1 Compound commands
{@tmp <- 3*log(640320)/sqrt(163)
	@tmp + 2
	@tmp - PI}
diff <- { # example on Windowed version
@tmp <- 3*log(640320)/sqrt(163)
@tmp; @tmp - PI
}; diff
{{x <- 3+4; y <- 7};{x <- 3*x; x+y}}# contains 2 compnd cmds.
{{x <- 3+4; y<-7};{x <- 3*x};;} # value is NULL
#9.2.2 Conditional commands - if, elseif and else
x <- 3; y <- 4
if(x <= y){print("x <= y")}#Logical expression is True
if(x > y){print("x > y")}#Logical expression is False; no print
b1 <- if(x < y){ #compound command on two lines
		2*x + 10} # value assigned is non-NULL
b2 <- if(x > y){2*x + 10} # value assigned is NULL
print(b1, b2)
x <- 3; y <- 4
if (x < y){print("x < y")}else{print("x >= y")}
signdiff <- if (x < y){-1}else{1};signdiff # assigned value
x <- 4; y <- 4
if (x < y){print("x < y")}else{print("x >= y")}
signdiff <- if (x < y){-1}else{1};signdiff # assigned value
x <- 1; y <- 7
if(x < y){tmp <- y - x;;} else {tmp <- x - y;;}; tmp
tmp <- if(x < y){y-x}else{x-y} ; tmp # Assignment to tmp
x <- 3; if(x > 0) {1} elseif (x < 0) {-1} else {0}
x <- -3;if(x > 0) {1} elseif (x < 0) {-1} else {0}
x <- 0; if(x > 0) {1} elseif (x < 0) {-1} else {0}
#9.2.3 Looping - for and while
s <- 0; n <- 10; while(n > 0) { s <- s + n; n <- n-1;;}; s
s <- 0; n <- 10; while(n > 0) {
	s <-s  + n;; # Note that n is not decremented
}
setoptions(maxwhile:50) # only 50 trips through loop allowed
i <- 0; while(i >= 0){i <- i+1;;} # i incremented on every trip
i
s <- 0; for(i,run(5)){s <- s + i;;}; s # s <- 1+2+3+4+5
s <- 0; for(i,3,10){s <- s + i;;}; s #3+4+5+6+7+8+9+10
s <- 0; for(i,1,3,1/3){s <- s + i;;};s #1+4/3+5/3+2+7/3+8/3+3
#9.2.4 Escaping from loops - break and breakall
x <- .57 # small enough to converge rapidly
s <- 1; for(i,run(30)){
	term <- x^i; s <- s + term
	ratio <- abs(term/s)
	if(ratio < .000001){break}
}
vector(i, ratio, s, 1/(1-x)) #converged in 24 trips around loop
x <- .8 # larger value of x; slower convergence
s <- 1; for(i,run(30)){
	term <- x^i; s <- s + term
	ratio <- abs(term/s)
	if(ratio < .000001){break}
}
vector(i, ratio, s, 1/(1-x))
a <- matrix(vector(1,3,4,2,5,0,6,7),2); a # has 1 zero
foundzero <- F
for(i,run(nrows(a))){
		for(j,run(ncols(a))){
			if(a[i,j] == 0){foundzero <- T; break 2}
		}
	}
if(foundzero){
		print(paste("a[",i,",",j,"] == 0",sep:""))
	} else {
		print("No element of a is 0")
	}
#9.2.5 Skipping to the end of a loop - next
x <- .57; s1 <- 0; s <- 1; for(i,run(100)){
	term <- x^i;
	ratio <- abs(term/s)
	s <-+ term
	if(ratio >= .000001){next}
	s1 <-+ term ;;# executed only when ratio < .000001;;
}
vector(s, s1) # converged value and remainder
x <- .80; s1 <- 0; s <- 1; for(i,run(100)){
	term <- x^i;
	ratio <- abs(term/s)
	s <-+ term
	if(ratio >= .000001){next}
	s1 <-+ term ;;# executed only when ratio < .000001;;
}
vector(s, s1) # converged value and remainder
a <- matrix(vector(1,3,4,2, 5,0,6,7, 9,10,0,8),3) #3 by 4
rowswithzero <- 0 # initialize count
for(i,run(nrows(a))){ # loop over rows
	for(j,run(ncols(a))){ # loop over columns within row
		if(a[i,j] == 0){rowswithzero <-+ 1; next 2}
	}
} # next 2 skipped to just before this '}'
rowswithzero # number of rows with zeros
#9.3 Macros
#9.3.1 Creating macros
mymac <- macro("$1 * $1 + $2") # create macro mymac
list(mymac) # it's a variable of type MACRO
mymac # print it 
#9.3.2 Argument substitution
mymac(4,5) # expands as {4 * 4 + 5}
mymac(4,run(3)) # expands as {4 * 4 + run(3)}
mymac(3+1,run(3)) # expands to {3+1 * 3+1 + run(3)}
mymac <- macro("($1) * ($1) + ($2)") # $1 & $2 in parentheses
mymac(3+1,run(3)) # expands as {(3+1) * (3+1) + (run(3))}
printmsgs <- macro("print(\"$1\")")
printmsgs # Macro to print its argument as string
printmsgs(MacAnova's great)
printmsgs("MacAnova's great")
printarg1 <- macro("print(\"Argument 1 is '$1'\")")
printarg1()
print2 <- macro("print($1,$2)") # requires two arguments
print2(PI) # one argument only
print2a <- macro("print($01,$02)") # expects two arguments
print2a(PI) # one argument;expands to {print(PI,NULL)}
#9.3.3 The use of temporary variables and $$
mymac(sum(log(run(2000)))/2000,exp(run(3)))
mymac <- macro("@x <- $1
	@x * @x + ($2)")
mymac
mymac(sum(log(run(2000)))/2000,exp(run(3)))
mymac2 <- macro("@x <- $1; @y <- $2;mymac(@y, @x)")
mymac2
mymac(4,run(3))
mymac2(run(3),4)
mymac<-macro("@x$$ <- $1
@x$$ * @x$$ + ($2)") # note the trailing "$$"'s
mymac2 <- macro("@x$$ <- $1; @y$$ <- $2
mymac(@y$$, @x$$)") # trailing "$$"'s used again
mymac2(run(3),4) # now it's correct
mymac <- macro("@x <- $1
@x * @x + ($2)",dollars:T)
mymac # "$$"'s were automatically added
#9.3.4 Other expanding macro symbols
dir <- macro("list($0)") # create 'alias' for command list()
dir(real:T)  # this expands to {list(real:T)}
mymac <- macro("@args$$ <- structure($0)
@args$$[1] * @args$$[1] + @args$$[2]")
mymac(4,run(3))
testN <- macro("paste(\"The number of arguments is\",$N)")
testN()
testN(1,"a",T,last:4)
testV <- macro("print(Dollarv:$v,DollarV:structure($V))")
testV(1,"a",tau:4,T) # 3 non-keyword arguments
testK <- macro("print(Dollark:$k,DollarK:structure($K))")
testK(1,"a",tau:4,T) # 1 keyword phrase argument
testA <- macro("@A <- $A # character version of arguments
@args <- structure($0) # ordinary version of arguments
for(@i,run($N)){
	print(paste(@A[@i],\"=\",@args[@i]))
}",dollars:T) # 5 line macro
testA(3+4, PI, sqrt(20))
testS <- macro("print(\"This is macro $S\")")
testS1 <- testS # copy testS to testS1
testS()
testS1() # identical to testS except for its name
#9.3.5 In-line and out-of-line macros
for (i, run(3)){
	printi <- macro(paste("print(i:",i,")",sep:""),inline:T)
	printi()
}
for (i, run(3)){ # note the use of inline:F
	printi <- macro(paste("print(i:",i,")",sep:""),inline:F)
	printi()
}
#9.3.6 Using delete(result,return:T)
#9.4 Functions useful in macros
#9.4.1 Functions unique() and match()
v <- vector(3.1,2.5,2.5,4.3,3.7,6.8,6.8,3.1);unique(v)
unique(v,index:T)
match(6.8,v,-1)
match(7.0,v,-1)
match(vector(6.8,7.0),v,-1) # 6.8 matches, 7.0 does not
a <- factor(match(v,sort(unique(v))));a # create factor from v
match(vector(6.8,7.0),v)
v1 <- vector("abc","ade","gfh")
match(vector("*c","*d*","g*","g*h", "a*b*c"), v1, exact:F)
v2 <- vector("aqbde","bb123", "allbdef")
match(vector("a*b???","a*b??"),v2,exact:F)
y <- matrix(10*run(2)+run(3)',2,labels:structure("R","C"))
y # note the row and column labels
y[match("R2",getlabels(y,1)),\
		match(vector("C1","C3"),getlabels(y,2))]
# This is equivalent to y[2,vector(1,3)]
#9.4.2 Checking the characteristics of variables - isxxxx() functions 
isreal(3,"MacAnova",run(3),?,3 < 4,structure(1,2))
islogic(3,"MacAnova",run(3),?,3 < 4,structure(1,2))
ischar(3,"MacAnova",run(3),?,3 < 4,structure(1,2))
isstruc(3,"MacAnova",run(3),?,3 < 4,structure(1,2))
ismacro(PI,boxcox)
a <- vector(1,1,2,2,3,3); b <- factor(a)
isfactor(a,b)
isdefined(PI,NULL,UnDef)
isscalar(UnDef,3,run(3),matrix(run(4),2),array(run(8),rep(2,3)))
isvector(UnDef,3,run(3),matrix(run(4),2),array(run(8),rep(2,3)))
ismatrix(UnDef,3,run(3),matrix(run(4),2),array(run(8),rep(2,3)))
isarray(UnDef,3,run(3),matrix(run(4),2),array(run(8),rep(2,3)),\
	boxcox,structure(PI))
isnull(NULL,print("Value of print() is NULL"),1,T,?)
realscalar <- PI;logicscalar <- T; charscalar <- "A"
isscalar(realscalar,logicscalar,charscalar,real:T)
isscalar(realscalar,logicscalar,charscalar,logic:T)
isscalar(realscalar,logicscalar,charscalar,character:T)
ismissing(matrix(vector(1,?, ?,4, 5,6),2))
#9.4.3 Other miscellaneous functions - anymissing(), nameof(), error() and gettime()
a <- matrix(vector(1,3,4,2,?,0,6,7),2) # note MISSING value
anymissing(a)
anymissing(structure(a, b:structure(b1:"",b2:run(5))))
nameof(x,cos,boxcox,run(5),"hello",F)
error("Test of error()") # message doesn't start with ERROR:
gettime() # prints time since start of run
gettime(interval:T) # prints time since last use of gettime()
gettime(quiet:T) #or gettime(interval:T,quiet:T)
gettime(interval:T)
time <- gettime(keep:T); time# return cumulative time as value
d <- gettime(interval:T,keep:T,quiet:F)
d
timeit <- macro("gettime(quiet:T);{$0};gettime(interval:T)")
setseeds(1422795195, 968974238) # make reproducible
timeit(x <- rnorm(6000);stuff<-describe(x))
delete(x,stuff)
#9.4.4 Keywords in macros - using $K, $k Macro symbols $K and $k
sortrows <- macro("sort(($1)',$K)'") # 1st try
data <- matrix(vector(28.4,21.6,23.1,22.1,\
	18.0,20.4,24.5,24.8),2) # small 2 by 4 matrix
data
sortrows(data,down:T)# works as we hope
sortrows(data) # no keywords; hope to sort rows "up"
sortrows<-macro("if($k!=0){sort(($1)',$K)'}else{sort(($1)')'}")
sortrows(data) # new version works without keyword
#9.4.5 Checking and evaluating keyword phrase arguments - keyvalue()
val <- keyvalue(a:10,b:20,"b","real");val# match w/correct type
val <- keyvalue(a:10,b:20,"a","real");val# match w/correct type
val <- keyvalue(a:10,b:20,"c","real");print(val)# no match
val <- keyvalue(a:10,b:20,"a","logic") # match with wrong type
val <- keyvalue(a:matrix(run(4),2),"a",vector("real","vector"))
val <- keyvalue(structure(a:10,b:20),"b","real"); val
#9.4.6 Checking and evaluating non-keyword arguments - argvalue()
gamma <- macro("if ($v != 1 || $k > 0){error(\"usage is gamma(x)\")}
@x$$ <- argvalue($1,\"$1\",vector(\"positive\",\"array\"))
exp(lgamma(@x$$))")
gamma(run(5)) 
gamma(run(0,2)) # illegal argument
gamma(vector(3.5,8,?,2))
#9.4.7 Properties checked by keyvalue() and argvalue()
#9.5 Indirect evaluation of commands
#9.5.1 evaluate()
evaluate("print(\"Hello!\");sqrt(2*PI)")
x <- run(5)
for(i,run(3)){evaluate(paste("x",i," <- x^",i,sep:""));;}
hconcat(x1,x2,x3)
evaluate("evaluate(\"sqrt(2)\")/evaluate(\"sqrt(PI)\")")
#9.5.2 Indirect references using <<...>>
<<"print(\"Hello!\");sqrt(2*PI)">>
<<"3.14159">>^.5 # or <<"3.14159^.5">>
print(<<"T">>,<<"-123.45">>,<<"NULL">>,<<"\"MacAnova\"">>)
vector(<<"cos">>(PI/6), cos(<<"PI">>/6))
x <- vector(9.53,5.59,9.27,7.19,10.98)
<<"print">>(<<"boxcox">>(x,.5))#indirect refs to print & boxcox
# Recreate structure temperatures from Sec. 2.8.16
temperatures <- structure(Saturday:vector(65,71,75,86,91,93,\
89,78,69,59),Sunday:vector(61,73,85,83,81),\
Monday:vector(51,65,71,78,83,84,85,84,81,75,69,64,59,49))
temperatures$<<"Sunday">> # same as temperatures$Sunday
#9.6 Analysis of macro regs
#9.7 User functions
#9.7.1 loadUser()
#9.7.2 User()
#9.7.3 User function arguments and value returned
#c <- 0; User("add1",3,sqrt(25),c) 
#c # c has a new value
#c <- 0; User("add1",3,5,result:c)
#c # c has a original value
#c <- 0; User("add1",a:3,b:5,result:c)
#User("innerprod",x:run(5),y:vector(3,1,10,2,4),n:asLong(5),s:0)
#User("add4",run(4),vector(3,1,0,2),result:rep(0,4))
#User("add4",run(4),vector(3,1,0,2),result:0)
#9.7.4 Passing integer arguments - aslong()
a <- asLong(run(-2,2))
list(a)
#s <- 0; n <- User("innerprod",x,y,n:asLong(5),s); list(n)
3 + asLong(5)
sum(asLong(run(5)))
print(asLong(run(-2,2)))#prints as if REAL
asciisave("chkpnt9.sav") # make sure all variables created are savable
restore("chkpnt9.sav")
print(paste("Total time =",gettime(quiet:T,keep:T) - startTime))