-
Notifications
You must be signed in to change notification settings - Fork 7
/
model.clj
176 lines (149 loc) · 6.04 KB
/
model.clj
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
(ns com.yetanalytics.datasim.model
(:require [clojure.spec.alpha :as s]
[xapi-schema.spec :as xs]
[com.yetanalytics.datasim.input.model :as model]
[com.yetanalytics.datasim.input.model.alignments :as model.alignments]
[com.yetanalytics.datasim.util.random :as random]
[com.yetanalytics.datasim.model.weights :as-alias weights]
[com.yetanalytics.datasim.model.pattern :as-alias pattern]
[com.yetanalytics.datasim.model.alignment :as-alias alignment]
[com.yetanalytics.datasim.model.alignment.period :as-alias alignment.period]
[com.yetanalytics.datasim.model.object-override :as-alias obj-override]
[com.yetanalytics.datasim.model.bounds :as bounds]
[com.yetanalytics.datasim.model.periods :as periods]
[com.yetanalytics.datasim.xapi.actor :as actor]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Specs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::objects
(s/coll-of ::model.alignments/object))
(s/def ::weights/verbs
(s/map-of ::model.alignments/id ::random/weight))
(s/def ::weights/activities
(s/map-of ::model.alignments/id ::random/weight))
(s/def ::weights/activity-types
(s/map-of ::model.alignments/id ::random/weight))
(s/def ::weights/object-overrides
(s/map-of ::model.alignments/object ::random/weight))
(s/def ::weights
(s/keys :opt-un [::weights/verbs
::weights/activities
::weights/activity-types
::weights/object-overrides]))
(s/def ::pattern/weights
(s/map-of ::model.alignments/id ::random/weight))
(s/def ::pattern/bounds
::bounds/bounds)
(s/def ::pattern/bound-restarts
(s/every ::xs/iri :kind set?))
(s/def ::pattern/period
::periods/period)
(s/def ::pattern/repeat-max
pos-int?)
(s/def ::pattern
(s/keys :opt-un [::pattern/weights
::pattern/bounds
::pattern/bound-restarts
::pattern/period
::pattern/repeat-max]))
(s/def ::patterns
(s/every ::pattern))
(s/def ::alignments
(s/keys :req-un [::weights
::objects
::patterns]))
(s/def ::default-model (s/nilable ::alignments))
(s/def ::agent-models (s/map-of ::actor/actor-ifi ::alignments))
(s/def ::group-models (s/map-of ::actor/actor-ifi ::alignments))
(s/def ::role-models (s/map-of string? ::alignments))
(def model-map-spec
(s/keys :req-un [::default-model
::agent-models
::group-models
::role-models]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def default-repeat-max 5)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- reduce-weights
([alignments]
(reduce-weights alignments :id))
([alignments id-keyword]
(reduce (fn [acc m]
(let [id (get m id-keyword)]
(if-some [weight (:weight m)]
(assoc acc id weight)
acc)))
{}
alignments)))
(defn- reduce-patterns
[patterns]
(reduce
(fn [acc {:keys [id weights repeatMax bounds boundRestarts periods]}]
(let [m (cond-> {}
weights (assoc :weights (reduce-weights weights))
bounds (assoc :bounds (bounds/convert-bounds bounds))
boundRestarts (assoc :bound-restarts (set boundRestarts))
periods (assoc :periods (periods/convert-periods periods))
repeatMax (assoc :repeat-max repeatMax))]
(assoc acc id m)))
{}
patterns))
(defn- mapify-alignments
[{:keys [verbs activities activityTypes patterns templates objectOverrides]}]
{:weights {:verbs (reduce-weights verbs)
:activities (reduce-weights activities)
:activity-types (reduce-weights activityTypes)
:object-overrides (reduce-weights objectOverrides :object)}
:objects (mapv :object objectOverrides)
:patterns (merge (reduce-patterns patterns)
(reduce-patterns templates))})
(s/fdef models->map
:args (s/cat :models ::model/models)
:ret model-map-spec)
(defn models->map
"Given `models`, return a map of maps from agent, group, and role IDs to
models, as well as the singular `:default-model`."
[models]
(let [init-map {:default-model nil
:agent-models {}
:group-models {}
:role-models {}}
persona-type-m {"Agent" :agent-models
"Group" :group-models
"Role" :role-models}]
(reduce
(fn [acc {:keys [personae] :as model}]
(let [model* (mapify-alignments model)]
(if (some? personae)
(reduce
(fn [acc* {persona-id :id
persona-type :type}]
(let [persona-kw (get persona-type-m persona-type)]
(assoc-in acc* [persona-kw persona-id] model*)))
acc
personae)
(assoc acc :default-model model*))))
init-map
models)))
(s/fdef get-actor-model
:args (s/cat :model-map model-map-spec
:agent-id ::actor/actor-ifi
:group-id ::actor/actor-ifi
:role-id (s/and string? not-empty))
:ret ::alignments)
(defn get-actor-model
"Get the appropriate model associated with the actor described by
the various IDs, with `agent-id`, `group-id`, and `role-id` going
from greatest to least precedence."
[{:keys [default-model agent-models group-models role-models]}
agent-id
group-id
role-id]
(or (get agent-models agent-id)
(get group-models group-id)
(get role-models role-id)
default-model))