-
Notifications
You must be signed in to change notification settings - Fork 9
/
ASF.R
144 lines (121 loc) · 4.79 KB
/
ASF.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
#### ASF model interface version 0.15.1
#### Includes the following functions:
####
#### FMD (TH)
####
#### List of optional function input variables:
## args list of options
## test if TRUE FMD() exists without doing calculations.
## This feature is only included for use .Rd files
## At some point a small default dataset should be included in
## the package.
ASF <- function(args=ASFoptions() ,test=FALSE ) {
if (test){
print("ASF: Just a test - didn't calculate anything! ;-)")
return(0)
}
if (class(args)=="list"){
argnames<-names(args)
for (i in 1:length(args)){
assign(argnames[i],args[[i]])
}
}
else
stop("args must be a list containing all required parameter values!")
if(verbose) cat("Assigned all options\n")
## Parsing textual parameters:
if (!is.expression(delayTimes))
delayTimes<-parse(text=delayTimes)
if (!is.expression(newInfFunctions))
newInfFunctions<-parse(text=newInfFunctions)
if (!is.expression(controlFunctions))
controlFunctions<-parse(text=controlFunctions)
if (!is.expression(interventionFunctions))
interventionFunctions<-parse(text=interventionFunctions)
if(verbose) cat("Parsed textual parameters\n")
## Prespecified seeds can be used
if (!is.null(seed))
if(seed<0)
set.seed(1) ## This is further handled when initializing each iteration
else
set.seed(seed)
## In order not to mess around in the global environment all functions
## that need access to internal variables need to be re-scoped.
## Re-scoping the internal functions:
environment(ASFEngine)<-environment()
environment(createASFvars)<-environment()
environment(initializeASFvars)<-environment()
environment(limitMovements)<-environment()
environment(updateHerds)<-environment()
environment(constructChronicle)<-environment()
environment(constructDist)<-environment()
environment(ConstpMat)<-environment()
environment(constructAInfHerd)<-environment()
environment(calDist)<-environment()
## Re-scoping graphics functions:
environment(fmdplot)<-environment()
environment(cbands)<-environment()
environment(points1)<-environment()
environment(points2)<-environment()
environment(updateCharts)<-environment()
environment(epimap)<-environment()
environment(filled3)<-environment()
## Re-scoping user supplied functions:
environment(indexHerdFunction)<-environment()
environment(summaryFunction)<-environment()
newInfList<-list()
newInfFun<-list()
for (i in 1:length(newInfFunctions)){
newInfList[[i]]<-as.list(newInfFunctions[[i]]) # Splits into name and arg
newInfFun[[i]]<-eval(newInfList[[i]][[1]]) # Get the function
environment(newInfFun[[i]])<-environment() # Rescope the function
}
controlList<-list()
controlFun<-list()
for (i in 1:length(controlFunctions)){
controlList[[i]]<-as.list(controlFunctions[[i]]) # Splits into name and arg
controlFun[[i]]<-eval(controlList[[i]][[1]]) # Get the function
environment(controlFun[[i]])<-environment() # Rescope the function
}
InterList<-list()
InterFun<-list()
for (i in 1:length(interventionFunctions)){
InterList[[i]]<-as.list(interventionFunctions[[i]]) # Splits into name and arg
InterFun[[i]]<-eval(InterList[[i]][[1]]) # Get the function
environment(InterFun[[i]])<-environment() # Rescope the function
}
if(verbose) cat("Rescoped functions internally\n")
## Constructing the chronicle, that logs all changes of status
## including newInfections and the mode of infection.
chronicle<-constructChronicle(herdfile=infofile, typesfile=typesfile)
createASFvars() # function in INITIALIZE library
summaryFunction("init")
## Initializing distance related objects
aInfHerd<-constructAInfHerd()
if ("long"%in%names(aHerd)) ## latlong or UTM ?
Dist<-constructDist(aHerd$lat,aHerd$long,norm=2)
else
Dist<-constructDist(aHerd$north,aHerd$east,norm=3)
## Creating and initializing the newInfFunctions
## each of which returns a list of functions: day and cleaniteration
newInfMethods<-list()
for (i in 1:length(newInfFunctions)){
newInfMethods[[i]]<-do.call(newInfFun[[i]],newInfList[[i]][-1])
}
## Same thing for the control measures:
controlMethods<-list()
for (i in 1:length(controlFunctions)){
controlMethods[[i]]<-do.call(controlFun[[i]],controlList[[i]][-1])
}
## Same thing for the optional interventions:
InterMethods<-list()
for (i in 1:length(interventionFunctions)){
InterMethods[[i]]<-do.call(InterFun[[i]],InterList[[i]][-1])
}
## Start and run the model now
ASFEngine()
## Wrapping up
chronicle$wrapUp(savefile=chroniclefile)
## Making final summary including what is returned by ASF()
summaryFunction("final") ## This should be the last line !!!
}