Revert "Add option to checkpoint every evaluation"
[openmx:openmx.git] / R / MxCommunication.R
1 #
2 #   Copyright 2007-2014 The OpenMx Project
3 #
4 #   Licensed under the Apache License, Version 2.0 (the "License");
5 #   you may not use this file except in compliance with the License.
6 #   You may obtain a copy of the License at
7
8 #        http://www.apache.org/licenses/LICENSE-2.0
9
10 #   Unless required by applicable law or agreed to in writing, software
11 #   distributed under the License is distributed on an "AS IS" BASIS,
12 #   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 #   See the License for the specific language governing permissions and
14 #   limitations under the License.
15
16 generateCommunicationList <- function(modelname, checkpoint, useSocket, options) {
17         defaults <- getOption('mxOptions')
18         if (defaults[['Always Checkpoint']] == "Yes") {
19                 checkpoint <- TRUE
20         }
21         if (!checkpoint && !useSocket) return(list())
22         retval <- list()
23         if (checkpoint) {               
24                 chkpt.directory <- options[['Checkpoint Directory']]
25                 chkpt.prefix <- options[['Checkpoint Prefix']]
26                 chkpt.units <- options[['Checkpoint Units']]
27                 chkpt.count <- options[['Checkpoint Count']]
28                 if (is.null(chkpt.directory)) chkpt.directory <- defaults[['Checkpoint Directory']]
29                 if (is.null(chkpt.prefix)) chkpt.prefix <- defaults[['Checkpoint Prefix']]
30                 if (is.null(chkpt.units)) chkpt.units <- defaults[['Checkpoint Units']]
31                 if (is.null(chkpt.count)) {
32                         chkpt.count <- defaults[['Checkpoint Count']]
33                         if (length(chkpt.count) == 2) {
34                                 chkpt.count <- chkpt.count[[chkpt.units]]
35                         }
36                 }
37                 if (is.null(chkpt.count)) chkpt.count <- .Machine$integer.max
38                 chkpt.directory <- removeTrailingSeparator(chkpt.directory)
39
40                 if (!is.numeric(chkpt.count) || chkpt.count < 0) {
41                         stop(paste("'Checkpoint Count' model option",
42                                 "must be a non-negative value in", 
43                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
44                 }
45                 if (!(is.character(chkpt.prefix) && length(chkpt.prefix) == 1)) {
46                         stop(paste("'Checkpoint Prefix' model option",
47                                 "must be a string in", 
48                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
49                 }
50                 if (!(is.character(chkpt.directory) && length(chkpt.directory) == 1)) {
51                         stop(paste("'Checkpoint Directory' model option",
52                                 "must be a string in", 
53                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
54                 }
55                 if (!(is.character(chkpt.units) && length(chkpt.units) == 1)) {
56                         stop(paste("'Checkpoint Units' model option",
57                                 "must be a string in", 
58                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
59                 }
60                 filename <- paste(chkpt.prefix, paste(modelname, 'omx', sep = '.'), sep = '')
61                 if (chkpt.units == "minutes") {
62                         type <- 0L
63                 } else if (chkpt.units == "iterations") {
64                         type <- 1L
65                 } else {
66                         stop(paste("'Checkpoint Units' model option",
67                                 "must be either 'minutes' or 'iterations' in", 
68                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
69                 }
70                 description <- list(0L, chkpt.directory, filename, type, chkpt.count)
71                 retval[[length(retval) + 1]] <- description
72         }
73         if (useSocket) {
74                 sock.server <- options[['Socket Server']]
75                 sock.port <- options[['Socket Port']]
76                 sock.units <- options[['Socket Units']]
77                 sock.count <- options[['Socket Count']]
78                 if (is.null(sock.server)) sock.directory <- defaults[['Socket Server']]
79                 if (is.null(sock.port)) sock.prefix <- defaults[['Socket Port']]
80                 if (is.null(sock.units)) sock.units <- defaults[['Socket Units']]
81                 if (is.null(sock.count)) {
82                         sock.count <- defaults[['Socket Count']]
83                         if (length(sock.count) == 2) {
84                                 sock.count <- sock.count[[sock.units]]
85                         }
86                 }
87                 if (is.null(sock.count)) sock.count <- .Machine$integer.max
88
89                 if (is.null(sock.server) || is.null(sock.port)) {
90                         stop(paste("Both 'Socket Server' and 'Socket Port'",
91                                 "must be specified in", 
92                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
93                 }
94                 if (!is.numeric(sock.count) || sock.count < 0) {
95                         stop(paste("'Socket Count' model option",
96                                 "must be a non-negative value in", 
97                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
98                 }
99                 if (!(is.character(sock.server) && length(sock.server) == 1 && sock.server != "")) {
100                         stop(paste("'Socket Server' model option",
101                                 "must be a string in", 
102                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
103                 }
104                 if (!(is.numeric(sock.port) && length(sock.port) == 1)) {
105                         stop(paste("'Socket Port' model option",
106                                 "must be a numeric value in", 
107                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
108                 }
109                 if (!(is.character(sock.units) && length(sock.units) == 1)) {
110                         stop(paste("'Socket Units' model option",
111                                 "must be a string in", 
112                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
113                 }
114                 if (sock.count == 0) {
115                         stop(paste("'Socket Count' model option",
116                                 "must be a non-negative value in", 
117                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
118                 }
119                 if (sock.units == "minutes") {
120                         type <- 0L
121                 } else if (sock.units == "iterations") {
122                         type <- 1L
123                 } else {
124                         stop(paste("'Socket Units' model option",
125                                 "must be either 'minutes' or 'iterations' in", 
126                                 deparse(width.cutoff = 400L, sys.call(-1))), call. = FALSE)
127                 }
128                 description <- list(1L, sock.server, as.integer(sock.port), type, sock.count)
129                 retval[[length(retval) + 1]] <- description
130         }
131         return(retval)
132 }