-
Notifications
You must be signed in to change notification settings - Fork 2
/
utilities-parameters.R
407 lines (362 loc) · 14.5 KB
/
utilities-parameters.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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
#' Read parameter values from a structured Excel file.
#' Each excel sheet must consist of columns 'Container Path', 'Parameter Name',
#' 'Value', and 'Units'
#'
#' @param paramsXLSpath Path to the excel file
#' @param sheets Names of the excel sheets containing the information about the
#' parameters. Multiple sheets can be processed. If no sheets are provided,
#' the first one in the Excel file is used.
#'
#' @return A list containing vectors 'paths' with the full paths to the
#' parameters, 'values' the values of the parameters, and 'units' with the
#' units the values are in.
#' @export
readParametersFromXLS <- function(paramsXLSpath, sheets = NULL) {
columnNames <- c("Container Path", "Parameter Name", "Value", "Units")
validateIsString(paramsXLSpath)
validateIsString(sheets, nullAllowed = TRUE)
if (is.null(sheets)) {
sheets <- c(1)
}
pathsValuesVector <- vector(mode = "numeric")
pathsUnitsVector <- vector(mode = "character")
for (sheet in sheets) {
data <- readExcel(path = paramsXLSpath, sheet = sheet)
if (!all(columnNames %in% names(data))) {
stop(messages$errorWrongXLSStructure(filePath = paramsXLSpath, expectedColNames = columnNames))
}
fullPaths <- paste(data[["Container Path"]], data[["Parameter Name"]], sep = "|")
pathsValuesVector[fullPaths] <- as.numeric(data[["Value"]])
pathsUnitsVector[fullPaths] <- tidyr::replace_na(data = as.character(data[["Units"]]), replace = "")
}
return(.parametersVectorToList(pathsValuesVector, pathsUnitsVector))
}
#' Write parameter structure to excel that can be loaded in MoBi
#'
#' @param parameterStructure A list containing vectors 'paths' with the full paths to the parameters,
#' 'values' the values of the parameters, and 'units' with the units the values are in.
#'
#' @param paramsXLSpath Path to the excel file
#' @param sheet (Optional) name of the excel sheet
#' @param append If TRUE, the existing excel file/sheet will be appended with the new
#' parameter structure. If FALSE (default), the existing file will be
#' overwritten.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' params <- list(paths = c("Container1|Path1", "Container|Second|Third|Path2"), values = c(1, 2), units = c("", "µmol"))
#'
#' writeParameterStructureToXLS(params, "test.xlsx")
#' }
#'
writeParameterStructureToXLS <- function(parameterStructure, paramsXLSpath, sheet = NULL, append = FALSE) {
if (isTRUE(append)) {
existingData <- readParametersFromXLS(paramsXLSpath = paramsXLSpath, sheets = sheet)
parameterStructure$paths <- c(existingData$paths, parameterStructure$paths)
parameterStructure$values <- c(existingData$values, parameterStructure$values)
parameterStructure$units <- c(existingData$units, parameterStructure$units)
}
.validateParametersStructure(parameterStructure, "parameterStructure")
# Split full parameter paths into container path and parameter name
containerPaths <- unlist(lapply(parameterStructure$paths, \(x){
.splitParameterPathIntoContainerAndName(x)$containerPath
}), use.names = FALSE)
parameterNames <- unlist(lapply(parameterStructure$paths, \(x){
.splitParameterPathIntoContainerAndName(x)$parameterName
}), use.names = FALSE)
# Create a data frame with the parameter structure
output <- data.frame(
"Container Path" = containerPaths,
"Parameter Name" = parameterNames,
Value = parameterStructure$values,
Units = parameterStructure$units,
check.names = FALSE
)
# Write the results into an excel file.
# Wrap the output data frame into a list and name the list if sheet name
# has been provided
data <- list(output)
if (!is.null(sheet)) {
names(data) <- sheet
}
.writeExcel(data = data, path = paramsXLSpath)
}
#' Export simulation parameters to excel
#'
#' @description Creates an excel file with information from the passed
#' parameters. The excel sheet will contain columns "Container Path",
#' "Parameter Name", "Value", and "Units". The resulting file can be loaded in
#' `MoBi` or in `R` with the function `readParametersFromXLS()`.
#'
#' @param parameters A single or a list of `Parameter` objects
#' @param paramsXLSpath Path to the excel file
#' @param sheet (Optional) name of the excel sheet
#' @export
exportParametersToXLS <- function(parameters, paramsXLSpath, sheet = NULL) {
validateIsOfType(parameters, "Parameter")
validateIsCharacter(sheet, nullAllowed = TRUE)
if (!is.null(sheet)) {
validateIsOfLength(sheet, 1)
}
# Make sure parameters is a list even if only one parameter is passed
parameters <- c(parameters)
parameterContainerPath <-
parameterUnits <-
parameterName <- vector("character", length(parameters))
parameterValue <- vector("numeric", length(parameters))
for (paramIdx in seq_along(parameters)) {
param <- parameters[[paramIdx]]
value <- param$value
if (!is.nan(value)) {
parameterContainerPath[[paramIdx]] <- param$parentContainer$path
parameterName[[paramIdx]] <- param$name
parameterUnits[[paramIdx]] <- param$unit
parameterValue[[paramIdx]] <- param$value
} else {
# Set to NA so these entries are removed
parameterContainerPath[[paramIdx]] <- NA
parameterName[[paramIdx]] <- NA
parameterUnits[[paramIdx]] <- NA
parameterValue[[paramIdx]] <- NA
}
}
output <- data.frame(
unlist(parameterContainerPath, use.names = FALSE),
unlist(parameterName, use.names = FALSE),
unlist(parameterValue, use.names = FALSE),
unlist(parameterUnits, use.names = FALSE)
) %>%
# Remove rows for which all values are NA
dplyr::filter(dplyr::if_any(dplyr::everything(), ~ !is.na(.)))
if (length(output) > 0) {
colnames(output) <- c("Container Path", "Parameter Name", "Value", "Units")
}
# Write the results into an excel file.
# Wrap the output data frame into a list and name the list if sheet name
# has been provided
data <- list(output)
if (!is.null(sheet)) {
names(data) <- sheet
}
.writeExcel(data = data, path = paramsXLSpath)
}
#' Extend parameters structure with new entries
#'
#' @param parameters A list containing vectors 'paths' with the full paths to the
#' parameters, 'values' the values of the parameters, and 'units' with the
#' units the values are in. This list will be extended.
#' @param newParameters A list containing vectors 'paths' with the full paths to the
#' parameters, 'values' the values of the parameters, and 'units' with the
#' units the values are in. Entries from this list will extend or overwrite
#' the list `parameters`
#'
#' @details This function adds new parameter entries from `newParameters` to
#' `parameters`. If an entry with the same path is already present in `parameters`,
#' its value and unit will be overwritten with the values from `newParameters`.
#'
#' @return Updated list of parameter paths, values, and units
#' @export
extendParameterStructure <- function(parameters, newParameters) {
.validateParametersStructure(
parameterStructure = parameters,
argumentName = "parameters"
)
.validateParametersStructure(
parameterStructure = newParameters,
argumentName = "newParameters"
)
# If the parameters structure is empty, return new parameters
if (isEmpty(parameters$paths)) {
return(newParameters)
}
# If the new parameters structure is empty, return parameters
if (isEmpty(newParameters$paths)) {
return(parameters)
}
# Convert the input parameter structure into named vectors.
pathsValuesVector <- parameters$values
names(pathsValuesVector) <- parameters$paths
pathsUnitsVector <- parameters$units
names(pathsUnitsVector) <- parameters$paths
# Add new entries resp. update with new values
pathsValuesVector[newParameters$paths] <- newParameters$values
pathsUnitsVector[newParameters$paths] <- newParameters$units
return(.parametersVectorToList(pathsValuesVector, pathsUnitsVector))
}
#' Convert parameters vector structure to list structure
#'
#' @param pathsValuesVector Named vector of numerical parameter values
#' with parameter paths as names
#' @param pathsUnitsVector Named vector of parameter values units with parameter
#' paths as names
#'
#' @noRd
#'
#' @return A named list with vectors `paths`, `values`, and `units`
#' @keywords internal
.parametersVectorToList <- function(pathsValuesVector, pathsUnitsVector) {
paths <- names(pathsValuesVector)
returnVal <- list(
paths = paths,
values = unname(pathsValuesVector[paths]),
units = unname(pathsUnitsVector[paths])
)
return(returnVal)
}
#' @title Check if two parameters are equal with respect to certain properties.
#'
#' @details
#' The parameters are not equal if:
#' The paths of the parameters are not equal;
#' The types of the formulas differ (types checked: isConstant, isDistributed, isExplicit, isTable);
#' Constant formulas have different values;
#' Distributed formulas have different values (not checking for distribution)
#' Explicit formulas: If formula string are not equal, OR one of the parameter
#' values is fixed (formula is overridden),
#' OR both parameter values are fixed and differ,
#' OR checkFormulaValues is TRUE and the values differ (disregarding of overridden or not)
#' Table formulas: If the number of points differ, OR any of the points differ,
#' OR one of the parameter values is fixed (formula is overridden),
#' OR both parameter values are fixed and differ.
#'
#' @param parameter1 First parameter to compare
#' @param parameter2 Second parameter to compare
#' @param checkFormulaValues If TRUE, values of explicit formulas are always
#' compared. Otherwise, the values are only compared if the formulas are
#' overridden (isFixedValue == TRUE). FALSE by default.
#' @param compareFormulasByValue If `FALSE`(default), formulas are compared by their types and string. If `TRUE`,
#' only values are compared.
#'
#' @return `TRUE` if parameters are considered equal, `FALSE` otherwise
#' @export
isParametersEqual <- function(parameter1, parameter2, checkFormulaValues = FALSE, compareFormulasByValue = FALSE) {
validateIsOfType(c(parameter1, parameter2), "Parameter")
# Check for the path
if (parameter1$path != parameter2$path) {
return(FALSE)
}
formula1 <- parameter1$formula
formula2 <- parameter2$formula
# Compare by value
if (compareFormulasByValue) {
return(identical(parameter1$value, parameter2$value))
}
# Check for formula type equality
if (!all(
c(formula1$isConstant, formula1$isDistributed, formula1$isExplicit, formula1$isTable) ==
c(formula2$isConstant, formula2$isDistributed, formula2$isExplicit, formula2$isTable)
)) {
return(FALSE)
}
# Constant or distributed formula - check for value
# Comparing using 'identical' to capture NaN and NA cases which can happen
if (formula1$isConstant || formula1$isDistributed) {
return(identical(parameter1$value, parameter2$value))
}
# Explicit or table formula - check if values are overridden
if (parameter1$isFixedValue) {
if (!parameter2$isFixedValue) {
return(FALSE)
}
if (parameter1$value != parameter2$value) {
return(FALSE)
}
}
# Explicit
if (formula1$isExplicit) {
if (checkFormulaValues && (!identical(parameter1$value, parameter2$value))) {
return(FALSE)
}
return(formula1$formulaString == formula2$formulaString)
}
if (formula1$isTable) {
return(isTableFormulasEqual(formula1, formula2))
}
return(FALSE)
}
#' Check if two table formulas are equal.
#'
#' Table formulas are equal if the number of points is equal and all x-y value
#' pairs are equal between the two formulas
#'
#' @param formula1 First formula to compare
#' @param formula2 Second formula to compare
#'
#' @return TRUE if the table formulas are equal, FALSE otherwise
#' @export
isTableFormulasEqual <- function(formula1, formula2) {
allPoints1 <- formula1$allPoints
allPoints2 <- formula2$allPoints
if (length(allPoints1) != length(allPoints2)) {
return(FALSE)
}
for (i in seq_along(allPoints1)) {
point1 <- allPoints1[[i]]
point2 <- allPoints2[[i]]
return((point1$x == point2$x) && (point1$y == point2$y))
}
}
#' Set the values of parameters in the simulation by path, if the `condition` is true.
#'
#' @param parameterPaths A single or a list of parameter path
#' @param values A numeric value that should be assigned to the parameters or a vector
#' of numeric values, if the value of more than one parameter should be changed. Must have the same
#' length as 'parameterPaths'
#' @param condition A function that receives a parameter path as an argument
#' and returns `TRUE` of `FALSE`
#' @param units A string or a list of strings defining the units of the `values`. If `NULL` (default), values
#' are assumed to be in base units. If not `NULL`, must have the same length as 'parameterPaths'.
#' @param simulation Simulation used to retrieve parameter instances from given paths.
#'
#' @examples
#' simPath <- system.file("extdata", "simple.pkml", package = "ospsuite")
#' sim <- loadSimulation(simPath)
#' condition <- function(path) {
#' ospsuite::isExplicitFormulaByPath(
#' path = path,
#' simulation = sim
#' )
#' }
#' setParameterValuesByPathWithCondition(
#' c("Organism|Liver|Volume", "Organism|Volume"),
#' c(2, 3),
#' sim,
#' condition
#' )
#' @import ospsuite
#' @export
setParameterValuesByPathWithCondition <- function(parameterPaths, # nolint: object_length_linter.
values,
simulation,
condition = function(path) {
TRUE
},
units = NULL) {
for (i in seq_along(parameterPaths)) {
path <- parameterPaths[[i]]
if (condition(path)) {
ospsuite::setParameterValuesByPath(
parameterPaths = parameterPaths[[i]],
values = values[[i]],
simulation = simulation,
units = units[[i]]
)
}
}
}
#' Split parameter path into container path and parameter name
#'
#' @param parameterPath Full path to the parameter, with path elements separated
#' by '|'
#'
#' @return A list with elements 'containerPath' and 'parameterName'
#' @keywords internal
#' @noRd
.splitParameterPathIntoContainerAndName <- function(parameterPath) {
fullPathParts <- strsplit(parameterPath, split = "|", fixed = TRUE)[[1]]
containerPath <- paste(fullPathParts[seq_along(fullPathParts) - 1], collapse = "|")
paramName <- fullPathParts[[length(fullPathParts)]]
return(list(containerPath = containerPath, parameterName = paramName))
}