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
|
#
# Copyright 2007-2019 by the individuals mentioned in the source code history
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# returns a list object
# The names of the list are the full identifiers of named entities in the model.
#
# Given the ith element of the list, define the ith name as the source entity
# of the ith element.
#
# Each element of a list is a character vector.
# The character vector stores the named entities that are be affected by
# modifying the source entity.
transitiveClosure <- function(flatModel, dependencies) {
dependencies <- dependencies@edges
cache <- list()
if (length(flatModel@matrices) == 0) {
return(cache)
}
matrices <- names(flatModel@matrices)
for (i in 1:length(matrices)) {
target <- matrices[[i]]
if (!(target %in% names(cache))) {
cache <- transitiveClosureEntity(flatModel, dependencies, target, cache)
}
}
return(cache)
}
extractElement <- function(name, object) { object[[name, exact=TRUE]] }
transitiveClosureEntity <- function(flatModel, dependencies, target, cache) {
sinks <- dependencies[[target]]
if (is.null(sinks)) {
cache[[target]] <- character()
return(cache)
}
isMissing <- !(sinks %in% names(cache))
missing <- sinks[isMissing]
if (length(missing) > 0) {
for (i in 1:length(missing)) {
entity <- missing[[i]]
cache <- transitiveClosureEntity(flatModel, dependencies, entity, cache)
}
}
entities <- lapply(sinks, extractElement, cache)
combined <- c(entities, sinks)
result <- Reduce(union, combined, character())
cache[[target]] <- result
return(cache)
}
doLocateIndex <- function(name, model, referant) {
return(imxLocateIndex(model, name, referant))
}
|
