Relations contents
Relation Records.
See RelationKind.i6t for further explanation.
12Constant RR_NAME 5;
13Constant RR_PERMISSIONS 6;
14Constant RR_STORAGE 7;
15Constant RR_KIND 8;
16Constant RR_HANDLER 9;
17Constant RR_DESCRIPTION 10;
Valency Adjectives.
These are defined in the Standard Rules; the following routines must either test the state (if set is negative), or change the state to set.
24Constant VALENCY_MASK = RELS_EQUIVALENCE+RELS_SYMMETRIC+RELS_X_UNIQUE+RELS_Y_UNIQUE;
25[ RELATION_TY_EquivalenceAdjective rel set perms state handler;
26 perms = RlnGetF(rel, RR_PERMISSIONS);
27 if (perms & RELS_EQUIVALENCE) state = true;
28 if (set < 0) return state;
29 if ((set) && (state == false)) {
30 perms = perms + RELS_EQUIVALENCE;
31 if (perms & RELS_SYMMETRIC == 0) perms = perms + RELS_SYMMETRIC;
32 }
33 if ((set == false) && (state)) {
34 perms = perms - RELS_EQUIVALENCE;
35 if (perms & RELS_SYMMETRIC) perms = perms - RELS_SYMMETRIC;
36 }
37 RlnSetF(rel, RR_PERMISSIONS, perms);
38 handler = RlnGetF(rel, RR_HANDLER);
39 if (handler(rel, RELS_SET_VALENCY, perms & VALENCY_MASK) == 0)
40 "*** Cant change this to an equivalence relation ***";
41];
42
43[ RELATION_TY_SymmetricAdjective rel set perms state handler;
44 perms = RlnGetF(rel, RR_PERMISSIONS);
45 if (perms & RELS_SYMMETRIC) state = true;
46 if (set < 0) return state;
47 if ((set) && (state == false)) perms = perms + RELS_SYMMETRIC;
48 if ((set == false) && (state)) perms = perms - RELS_SYMMETRIC;
49 RlnSetF(rel, RR_PERMISSIONS, perms);
50 handler = RlnGetF(rel, RR_HANDLER);
51 if (handler(rel, RELS_SET_VALENCY, perms & VALENCY_MASK) == 0)
52 "*** Cant change this to a symmetric relation ***";
53];
54
55[ RELATION_TY_OToOAdjective rel set perms state handler i;
56 perms = RlnGetF(rel, RR_PERMISSIONS);
57 if (perms & (RELS_X_UNIQUE+RELS_Y_UNIQUE) == RELS_X_UNIQUE+RELS_Y_UNIQUE) state = true;
58 if (set < 0) return state;
59 if ((set) && (state == false)) {
60 if (perms & RELS_X_UNIQUE == 0) perms = perms + RELS_X_UNIQUE;
61 if (perms & RELS_Y_UNIQUE == 0) perms = perms + RELS_Y_UNIQUE;
62 if (perms & RELS_EQUIVALENCE) perms = perms - RELS_EQUIVALENCE;
63 }
64 if ((set == false) && (state)) {
65 if (perms & RELS_X_UNIQUE) perms = perms - RELS_X_UNIQUE;
66 if (perms & RELS_Y_UNIQUE) perms = perms - RELS_Y_UNIQUE;
67 }
68 RlnSetF(rel, RR_PERMISSIONS, perms);
69 handler = RlnGetF(rel, RR_HANDLER);
70 if (handler(rel, RELS_SET_VALENCY, perms & VALENCY_MASK) == 0)
71 "*** Cant change this to a one-to-one relation ***";
72];
73
74[ RELATION_TY_OToVAdjective rel set perms state handler;
75 perms = RlnGetF(rel, RR_PERMISSIONS);
76 if (perms & (RELS_X_UNIQUE+RELS_Y_UNIQUE) == RELS_X_UNIQUE) state = true;
77 if (set < 0) return state;
78 if ((set) && (state == false)) {
79 if (perms & RELS_X_UNIQUE == 0) perms = perms + RELS_X_UNIQUE;
80 if (perms & RELS_Y_UNIQUE) perms = perms - RELS_Y_UNIQUE;
81 if (perms & RELS_SYMMETRIC) perms = perms - RELS_SYMMETRIC;
82 if (perms & RELS_EQUIVALENCE) perms = perms - RELS_EQUIVALENCE;
83 }
84 if ((set == false) && (state)) {
85 if (perms & RELS_X_UNIQUE) perms = perms - RELS_X_UNIQUE;
86 if (perms & RELS_Y_UNIQUE) perms = perms - RELS_Y_UNIQUE;
87 }
88 RlnSetF(rel, RR_PERMISSIONS, perms);
89 handler = RlnGetF(rel, RR_HANDLER);
90 if (handler(rel, RELS_SET_VALENCY, perms & VALENCY_MASK) == 0)
91 "*** Cant change this to a one-to-various relation ***";
92];
93
94[ RELATION_TY_VToOAdjective rel set perms state handler;
95 perms = RlnGetF(rel, RR_PERMISSIONS);
96 if (perms & (RELS_X_UNIQUE+RELS_Y_UNIQUE) == RELS_Y_UNIQUE) state = true;
97 if (set < 0) return state;
98 if ((set) && (state == false)) {
99 if (perms & RELS_X_UNIQUE) perms = perms - RELS_X_UNIQUE;
100 if (perms & RELS_Y_UNIQUE == 0) perms = perms + RELS_Y_UNIQUE;
101 if (perms & RELS_SYMMETRIC) perms = perms - RELS_SYMMETRIC;
102 if (perms & RELS_EQUIVALENCE) perms = perms - RELS_EQUIVALENCE;
103 }
104 if ((set == false) && (state)) {
105 if (perms & RELS_X_UNIQUE) perms = perms - RELS_X_UNIQUE;
106 if (perms & RELS_Y_UNIQUE) perms = perms - RELS_Y_UNIQUE;
107 }
108 RlnSetF(rel, RR_PERMISSIONS, perms);
109 handler = RlnGetF(rel, RR_HANDLER);
110 if (handler(rel, RELS_SET_VALENCY, perms & VALENCY_MASK) == 0)
111 "*** Cant change this to a various-to-one relation ***";
112];
113
114[ RELATION_TY_VToVAdjective rel set perms state handler;
115 perms = RlnGetF(rel, RR_PERMISSIONS);
116 if (perms & (RELS_X_UNIQUE+RELS_Y_UNIQUE) == 0) state = true;
117 if (set < 0) return state;
118 if ((set) && (state == false)) {
119 if (perms & RELS_X_UNIQUE) perms = perms - RELS_X_UNIQUE;
120 if (perms & RELS_Y_UNIQUE) perms = perms - RELS_Y_UNIQUE;
121 }
122 if ((set == false) && (state)) {
123 if (perms & RELS_X_UNIQUE == 0) perms = perms + RELS_X_UNIQUE;
124 if (perms & RELS_Y_UNIQUE == 0) perms = perms + RELS_Y_UNIQUE;
125 }
126 RlnSetF(rel, RR_PERMISSIONS, perms);
127 handler = RlnGetF(rel, RR_HANDLER);
128 if (handler(rel, RELS_SET_VALENCY, perms & VALENCY_MASK) == 0)
129 "*** Cant change this to a various-to-various relation ***";
130];
One To One Relations.
We provide routines to assert a 1-to-1 relation true, or to assert it false. The relation rel is represented by a property number, and the property in question is used to store the fact of a relationship: O1 ~ O2 if and only if O1.rel == O2.
There is no routine to test a 1-to-1 relation, since the predicate calculus code in NI simplifies propositions which test these into direct looking up of the property relation.
143[ Relation_Now1to1 obj1 relation_property obj2 ol;
144 if (obj2) objectloop (ol provides relation_property)
145 if (ol.relation_property == obj2) ol.relation_property = nothing;
146 if (obj1) obj1.relation_property = obj2;
147];
148
149[ Relation_NowN1toV obj1 relation_property obj2;
150 if ((obj1) && (obj1.relation_property == obj2)) obj1.relation_property = nothing;
151];
152
153[ Relation_Now1to1V obj1 obj2 KOV relation_property ol N;
154 if (obj2) {
155 N = KOVDomainSize(KOV);
156 for (ol=1: ol<=N: ol++)
157 if (GProperty(KOV, ol, relation_property) == obj2)
158 WriteGProperty(KOV, ol, relation_property, 0);
159 }
160 if (obj1) WriteGProperty(KOV, obj1, relation_property, obj2);
161];
162
163[ Relation_NowN1toVV obj1 obj2 KOV relation_property;
164 if ((obj1) && (GProperty(KOV, obj1, relation_property) == obj2))
165 WriteGProperty(KOV, obj1, relation_property, 0);
166];
Symmetric One To One Relations.
Here the relation is used for both objects: O1 ~ O2 if and only if both O1.relation_property == O2 and O2.relation_property == O1.
173[ Relation_NowS1to1 obj1 relation_property obj2;
174 if ((obj1 ofclass Object) && (obj1 provides relation_property) &&
175 (obj2 ofclass Object) && (obj2 provides relation_property)) {
176 if (obj1.relation_property) { (obj1.relation_property).relation_property = 0; }
177 if (obj2.relation_property) { (obj2.relation_property).relation_property = 0; }
178 obj1.relation_property = obj2; obj2.relation_property = obj1;
179 }
180];
181
182[ Relation_NowSN1to1 obj1 relation_property obj2;
183 if ((obj1 ofclass Object) && (obj1 provides relation_property) &&
184 (obj2 ofclass Object) && (obj2 provides relation_property) &&
185 (obj1.relation_property == obj2)) {
186 obj1.relation_property = 0; obj2.relation_property = 0;
187 }
188];
189
190[ Relation_NowS1to1V obj1 obj2 KOV relation_property;
191 if (GProperty(KOV, obj1, relation_property))
192 WriteGProperty(KOV, GProperty(KOV, obj1, relation_property), relation_property, 0);
193 if (GProperty(KOV, obj2, relation_property))
194 WriteGProperty(KOV, GProperty(KOV, obj2, relation_property), relation_property, 0);
195 WriteGProperty(KOV, obj1, relation_property, obj2);
196 WriteGProperty(KOV, obj2, relation_property, obj1);
197];
198
199[ Relation_NowSN1to1V obj1 obj2 KOV relation_property;
200 if (GProperty(KOV, obj1, relation_property) == obj2) {
201 WriteGProperty(KOV, obj1, relation_property, 0);
202 WriteGProperty(KOV, obj2, relation_property, 0);
203 }
204];
Various To Various Relations.
Here the relation is represented by an array holding its metadata. Each object in the domain of the relation provides two properties, holding its left index and its right index. The index is its position in the left or right domain. For instance, suppose we relate things to doors, and there are five things in the world, two of which are doors; then the left indexes will range from 0 to 4, while the right indexes will range from 0 to 1. It's very likely that the doors will have different left and right indexes. (If the relation relates a given kind to itself, say doors to doors, then left and right indexes will always be equal.)
It is possible for either the left or right domain set to be an enumerated kind of value, where the I6 representation of values is 1, 2, 3, ..., N, where there are N possibilities. In that case we obtain the index simply by subtracting 1 in order to begin from 0. We mark the domain set as being a KOV rather than a kind of object by storing 0 instead of a property in the relevant part of the relation metadata: note that 0 is not a valid property number.
The structure for a relation consists of eight --> words, followed by a bitmap in which we store 16 bits in each --> word. (Yes, this is wasteful in Glulx, where --> words store 32 bits, but memory is not in short supply in Glulx and the total cost of relations is in practice small; we prefer to keep all the code involved simple.) The structure is precompiled by the Inform compiler: we do not create new ones on the fly.
In the case of a symmetric various to various relation, we could in theory save memory once again by storing only the lower triangle of the bitmap, but the time and complexity overhead are not worth it. When asserting that O1 ~ O2 for a symmetric V-to-V, we also automatically assert that O2 ~ O1, thus maintaining the bitmap as a symmetric matrix; but in reading the bitmap, we look only at the lower triangle. This costs a little time, but has the advantage of allowing the route-finding routine for V-to-V to use the same code for symmetric and asymmetric relations.
If this all seems rather suboptimally programmed in order to reduce code complexity, I can only say that careless drafts here were the source of some extremely difficult bugs to find.
246Constant VTOVS_LEFT_INDEX_PROP = 0;
247Constant VTOVS_RIGHT_INDEX_PROP = 1;
248Constant VTOVS_LEFT_DOMAIN_SIZE = 2;
249Constant VTOVS_RIGHT_DOMAIN_SIZE = 3;
250Constant VTOVS_LEFT_PRINTING_ROUTINE = 4;
251Constant VTOVS_RIGHT_PRINTING_ROUTINE = 5;
252Constant VTOVS_CACHE_BROKEN = 6;
253Constant VTOVS_CACHE = 7;
254
255[ Relation_NowVtoV obj1 relation obj2 sym pr pr2 i1 i2 vtov_structure;
256 if (sym && (obj2 ~= obj1)) { Relation_NowVtoV(obj2, relation, obj1, false); }
257 vtov_structure = RlnGetF(relation, RR_STORAGE);
258 pr = vtov_structure-->VTOVS_LEFT_INDEX_PROP;
259 pr2 = vtov_structure-->VTOVS_RIGHT_INDEX_PROP;
260 vtov_structure-->VTOVS_CACHE_BROKEN = true;
261 if (pr) {
262 if ((obj1 ofclass Object) && (obj1 provides pr)) i1 = obj1.pr;
263 else return RunTimeProblem(RTP_IMPREL, obj1, relation);
264 } else i1 = obj1-1;
265 if (pr2) {
266 if ((obj2 ofclass Object) && (obj2 provides pr2)) i2 = obj2.pr2;
267 else return RunTimeProblem(RTP_IMPREL, obj2, relation);
268 } else i2 = obj2-1;
269 pr = i1*(vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE) + i2;
270 i1 = IncreasingPowersOfTwo_TB-->(pr%16);
271 pr = pr/16 + 8;
272 vtov_structure-->pr = (vtov_structure-->pr) | i1;
273];
274
275[ Relation_NowNVtoV obj1 relation obj2 sym pr pr2 i1 i2 vtov_structure;
276 if (sym && (obj2 ~= obj1)) { Relation_NowNVtoV(obj2, relation, obj1, false); }
277 vtov_structure = RlnGetF(relation, RR_STORAGE);
278 pr = vtov_structure-->VTOVS_LEFT_INDEX_PROP;
279 pr2 = vtov_structure-->VTOVS_RIGHT_INDEX_PROP;
280 vtov_structure-->VTOVS_CACHE_BROKEN = true;
281 if (pr) {
282 if ((obj1 ofclass Object) && (obj1 provides pr)) i1 = obj1.pr;
283 else return RunTimeProblem(RTP_IMPREL, obj1, relation);
284 } else i1 = obj1-1;
285 if (pr2) {
286 if ((obj2 ofclass Object) && (obj2 provides pr2)) i2 = obj2.pr2;
287 else return RunTimeProblem(RTP_IMPREL, obj2, relation);
288 } else i2 = obj2-1;
289 pr = i1*(vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE) + i2;
290 i1 = IncreasingPowersOfTwo_TB-->(pr%16);
291 pr = pr/16 + 8;
292 if ((vtov_structure-->pr) & i1) vtov_structure-->pr = vtov_structure-->pr - i1;
293];
294
295[ Relation_TestVtoV obj1 relation obj2 sym pr pr2 i1 i2 vtov_structure;
296 vtov_structure = RlnGetF(relation, RR_STORAGE);
297 pr = vtov_structure-->VTOVS_LEFT_INDEX_PROP;
298 pr2 = vtov_structure-->VTOVS_RIGHT_INDEX_PROP;
299 if (sym && (obj2 > obj1)) { sym = obj1; obj1 = obj2; obj2 = sym; }
300 if (pr) {
301 if ((obj1 ofclass Object) && (obj1 provides pr)) i1 = obj1.pr;
302 else { RunTimeProblem(RTP_IMPREL, obj1, relation); rfalse; }
303 } else i1 = obj1-1;
304 if (pr2) {
305 if ((obj2 ofclass Object) && (obj2 provides pr2)) i2 = obj2.pr2;
306 else { RunTimeProblem(RTP_IMPREL, obj2, relation); rfalse; }
307 } else i2 = obj2-1;
308 pr = i1*(vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE) + i2;
309 i1 = IncreasingPowersOfTwo_TB-->(pr%16);
310 pr = pr/16 + 8;
311 if ((vtov_structure-->pr) & i1) rtrue; rfalse;
312];
Equivalence Relations.
For every equivalence relation there is a corresponding function f such that x ~ y if and only if f(x)=f(y), where f(x) is a number identifying the equivalence class of x. Rather than inefficiently storing a large relation bitmap (and then having a very complicated time updating it to keep the relation transitive), we store f: that is, for every object in the domain set, there is a property prop such that O.prop is the value f(O).
324[ Relation_NowEquiv obj1 relation_property obj2 big little;
325 big = obj1.relation_property; little = obj2.relation_property;
326 if (big == little) return;
327 if (big < little) { little = obj1.relation_property; big = obj2.relation_property; }
328 objectloop (obj1 provides relation_property)
329 if (obj1.relation_property == big) obj1.relation_property = little;
330];
331
332[ Relation_NowNEquiv obj1 relation_property obj2 old new;
333 old = obj1.relation_property; new = obj2.relation_property;
334 if (old ~= new) return;
335 new = 0;
336 objectloop (obj2 provides relation_property)
337 if (obj2.relation_property > new) new = obj2.relation_property;
338 new++;
339 obj1.relation_property = new;
340];
341
342[ Relation_NowEquivV obj1 obj2 KOV relation_property n big little i;
343 big = GProperty(KOV, obj1, relation_property);
344 little = GProperty(KOV, obj2, relation_property);
345 if (big == little) return;
346 if (big < little) {
347 little = GProperty(KOV, obj1, relation_property);
348 big = GProperty(KOV, obj2, relation_property);
349 }
350 n = KOVDomainSize(KOV);
351 for (i=1: i<=n: i++)
352 if (GProperty(KOV, i, relation_property) == big)
353 WriteGProperty(KOV, i, relation_property, little);
354];
355
356[ Relation_NowNEquivV obj1 obj2 KOV relation_property n old new i;
357 old = GProperty(KOV, obj1, relation_property);
358 new = GProperty(KOV, obj2, relation_property);
359 if (old ~= new) return;
360 new = 0;
361 n = KOVDomainSize(KOV);
362 for (i=1: i<=n: i++)
363 if (GProperty(KOV, i, relation_property) > new)
364 new = GProperty(KOV, i, relation_property);
365 new++;
366 WriteGProperty(KOV, obj1, relation_property, new);
367];
Show Various to Various.
The rest of the code for relations has no use except for debugging: it implements the RELATIONS testing command. Speed is unimportant here.
374[ Relation_ShowVtoV relation sym x obj1 obj2 pr pr2 proutine1 proutine2 vtov_structure;
375 vtov_structure = RlnGetF(relation, RR_STORAGE);
376 pr = vtov_structure-->VTOVS_LEFT_INDEX_PROP;
377 pr2 = vtov_structure-->VTOVS_RIGHT_INDEX_PROP;
378 proutine1 = vtov_structure-->VTOVS_LEFT_PRINTING_ROUTINE;
379 proutine2 = vtov_structure-->VTOVS_RIGHT_PRINTING_ROUTINE;
380
381 if (pr && pr2) {
382 objectloop (obj1 provides pr)
383 objectloop (obj2 provides pr2) {
384 if (sym && obj2 > obj1) continue;
385 if (Relation_TestVtoV(obj1, relation, obj2)) {
386 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
387 print " ", (The) obj1;
388 if (sym) print " <=> "; else print " >=> ";
389 print (the) obj2, "^";
390 }
391 }
392 return;
393 }
394 if (pr && (pr2==0)) {
395 objectloop (obj1 provides pr)
396 for (obj2=1:obj2<=vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE:obj2++) {
397 if (Relation_TestVtoV(obj1, relation, obj2)) {
398 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
399 print " ", (The) obj1, " >=> ";
400 (proutine2).call(obj2);
401 print "^";
402 }
403 }
404 return;
405 }
406 if ((pr==0) && (pr2)) {
407 for (obj1=1:obj1<=vtov_structure-->2:obj1++)
408 objectloop (obj2 provides pr2) {
409 if (Relation_TestVtoV(obj1, relation, obj2)) {
410 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
411 print " ";
412 (proutine1).call(obj1);
413 print " >=> ", (the) obj2, "^";
414 }
415 }
416 return;
417 }
418 for (obj1=1:obj1<=vtov_structure-->2:obj1++)
419 for (obj2=1:obj2<=vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE:obj2++)
420 if (Relation_TestVtoV(obj1, relation, obj2)) {
421 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
422 print " ";
423 (proutine1).call(obj1);
424 print " >=> ";
425 (proutine2).call(obj2);
426 print "^";
427 }
428];
433[ Relation_ShowOtoO relation sym x relation_property t N obj1 obj2;
434 relation_property = RlnGetF(relation, RR_STORAGE);
435 t = KindBaseTerm(RlnGetF(relation, RR_KIND), 0);
436 N = KOVDomainSize(t);
437 if (t == OBJECT_TY) {
438 objectloop (obj1 provides relation_property) {
439 obj2 = obj1.relation_property;
440 if (sym && obj2 < obj1) continue;
441 if (obj2 == 0) continue;
442 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
443 print " ", (The) obj1;
444 if (sym) print " == "; else print " >=> ";
445 print (the) obj2, "^";
446 }
447 } else {
448 for (obj1=1: obj1<=N: obj1++) {
449 obj2 = GProperty(t, obj1, relation_property);
450 if (sym && obj2 < obj1) continue;
451 if (obj2 == 0) continue;
452 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
453 print " ";
454 PrintKindValuePair(t, obj1);
455 if (sym) print " == "; else print " >=> ";
456 PrintKindValuePair(t, obj2);
457 print "^";
458 }
459 }
460];
Show Reversed One to One.
There's no such kind of relation as this: but the same code used to show 1-to-1 relations is also used to show various-to-1 relations, since the storage is the same. To show 1-to-various relations, we need a transposed form of the same code in which left and right are exchanged: this is it.
469[ Relation_RShowOtoO relation sym x relation_property obj1 obj2 t1 t2 N1 N2;
470 relation_property = RlnGetF(relation, RR_STORAGE);
471 t1 = KindBaseTerm(RlnGetF(relation, RR_KIND), 0);
472 t2 = KindBaseTerm(RlnGetF(relation, RR_KIND), 1);
473 if (t2 == OBJECT_TY) {
474 if (t1 == OBJECT_TY) {
475 objectloop (obj1) {
476 objectloop (obj2 provides relation_property) {
477 if (obj2.relation_property ~= obj1) continue;
478 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
479 print " ", (The) obj1;
480 print " >=> ";
481 print (the) obj2, "^";
482 }
483 }
484 } else {
485 N1 = KOVDomainSize(t1);
486 for (obj1=1: obj1<=N1: obj1++) {
487 objectloop (obj2 provides relation_property) {
488 if (obj2.relation_property ~= obj1) continue;
489 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
490 print " "; PrintKindValuePair(t1, obj1);
491 print " >=> ";
492 print (the) obj2, "^";
493 }
494 }
495 }
496 } else {
497 N2 = KOVDomainSize(t2);
498 if (t1 == OBJECT_TY) {
499 objectloop (obj1) {
500 for (obj2=1: obj2<=N2: obj2++) {
501 if (GProperty(t2, obj2, relation_property) ~= obj1) continue;
502 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
503 print " ", (The) obj1;
504 print " >=> ";
505 PrintKindValuePair(t2, obj2);
506 print "^";
507 }
508 }
509 } else {
510 N1 = KOVDomainSize(t1);
511 for (obj1=1: obj1<=N1: obj1++) {
512 for (obj2=1: obj2<=N2: obj2++) {
513 if (GProperty(t2, obj2, relation_property) ~= obj1) continue;
514 if (x == 0) { print (string) RlnGetF(relation, RR_DESCRIPTION), ":^"; x=1; }
515 print " ";
516 PrintKindValuePair(t1, obj1);
517 print " >=> ";
518 PrintKindValuePair(t2, obj2);
519 print "^";
520 }
521 }
522 }
523 }
524];
529[ RSE_Flip KOV v relation_property x;
530 x = GProperty(KOV, v, relation_property); x = -x;
531 WriteGProperty(KOV, v, relation_property, x);
532];
533[ RSE_Set KOV v relation_property;
534 if (GProperty(KOV, v, relation_property) < 0) rtrue; rfalse;
535];
536[ Relation_ShowEquiv relation relation_property obj1 obj2 v c d somegroups t N x;
537 print (string) RlnGetF(relation, RR_DESCRIPTION), ":^";
538 relation_property = RlnGetF(relation, RR_STORAGE);
539 t = KindBaseTerm(RlnGetF(relation, RR_KIND), 0);
540 N = KOVDomainSize(t);
541 if (t == OBJECT_TY) {
542 objectloop (obj1 provides relation_property)
543 obj1.relation_property = -(obj1.relation_property);
544 objectloop (obj1 provides relation_property) {
545 if (obj1.relation_property < 0) {
546 v = obj1.relation_property; c = 0;
547 objectloop (obj2 has workflag2) give obj2 ~workflag2;
548 objectloop (obj2 provides relation_property) {
549 if (obj2.relation_property == v) {
550 give obj2 workflag2;
551 obj2.relation_property = -v;
552 c++;
553 }
554 }
555 if (c>1) {
556 somegroups = true;
557 print " { ";
558 WriteListOfMarkedObjects(ENGLISH_BIT);
559 print " }^";
560 } else obj1.relation_property = v;
561 }
562 }
563 objectloop (obj2 has workflag2) give obj2 ~workflag2;
564 c = 0; objectloop (obj1 provides relation_property)
565 if (obj1.relation_property < 0) { c++; give obj1 workflag2; }
566 if (c == 0) return;
567 if (somegroups) print " and "; else print " ";
568 if (c < 4) { WriteListOfMarkedObjects(ENGLISH_BIT); print " in"; }
569 else print c;
570 if (c == 1) print " a";
571 print " single-member group";
572 if (c > 1) print "s";
573 print "^";
574 objectloop (obj1 provides relation_property)
575 if (obj1.relation_property < 0)
576 obj1.relation_property = -(obj1.relation_property);
577 } else {
578
579 for (obj1 = 1: obj1 <= N: obj1++)
580 RSE_Flip(t, obj1, relation_property);
581 for (obj1 = 1: obj1 <= N: obj1++) {
582 if (RSE_Set(t, obj1, relation_property)) {
583 v = GProperty(t, obj1, relation_property);
584 c = 0;
585 for (obj2 = 1: obj2 <= N: obj2++)
586 if (GProperty(t, obj2, relation_property) == v)
587 c++;
588 if (c>1) {
589 somegroups = true;
590 print " {";
591 d = 0;
592 for (obj2 = 1: obj2 <= N: obj2++) {
593 if (GProperty(t, obj2, relation_property) == v) {
594 print " "; PrintKindValuePair(t, obj2);
595 if (d < c-1) print ","; print " ";
596 RSE_Flip(t, obj2, relation_property);
597 d++;
598 }
599 }
600 print "}^";
601 } else WriteGProperty(t, obj1, relation_property, v);
602 }
603 }
604 objectloop (obj2 has workflag2) give obj2 ~workflag2;
605 c = 0;
606 for (obj1 = 1: obj1 <= N: obj1++)
607 if (RSE_Set(t, obj1, relation_property)) c++;
608 if (c == 0) return;
609 if (somegroups) print " and "; else print " ";
610 if (c == 1) print "a"; else print c;
611 print " single-member group";
612 if (c > 1) print "s";
613 print "^";
614 for (obj1 = 1: obj1 <= N: obj1++)
615 if (RSE_Set(t, obj1, relation_property))
616 RSE_Flip(t, obj1, relation_property);
617 }
618];
Relation Emptying.
These routines, mercifully a little simpler, define the adjective "empty" as it applied to relations. Each routine has to forcibly empty the relation if the clear flag is set, and in any case return either true or false to say whether the relation is empty at the end of the call. For relations in groups, "empty" is understood to mean that each object relates only to itself.
628[ Relation_EmptyOtoO relation sym clear relation_property obj1 obj2 t1 t2 N1 N2;
629 relation_property = RlnGetF(relation, RR_STORAGE);
630 t1 = KindBaseTerm(RlnGetF(relation, RR_KIND), 0);
631 t2 = KindBaseTerm(RlnGetF(relation, RR_KIND), 1);
632 if (t2 == OBJECT_TY) {
633 objectloop (obj2 provides relation_property) {
634 obj1 = obj2.relation_property;
635 if (obj1) {
636 if (clear) obj2.relation_property = nothing;
637 else rfalse;
638 }
639 }
640 } else {
641 for (obj2=1: obj2<=N2: obj2++) {
642 obj1 = GProperty(t2, obj2, relation_property);
643 if (obj1) {
644 if (clear) WriteGProperty(t2, obj2, relation_property, 0);
645 else rfalse;
646 }
647 }
648 }
649 if (t1 ~= t2) {
650 if (t1 == OBJECT_TY) {
651 objectloop (obj1 provides relation_property) {
652 obj2 = obj1.relation_property;
653 if (obj2) {
654 if (clear) obj1.relation_property = nothing;
655 else rfalse;
656 }
657 }
658 } else {
659 for (obj1=1: obj1<=N2: obj1++) {
660 obj2 = GProperty(t1, obj1, relation_property);
661 if (obj2) {
662 if (clear) WriteGProperty(t1, obj1, relation_property, 0);
663 else rfalse;
664 }
665 }
666 }
667 }
668 rtrue;
669];
670[ Relation_EmptyEquiv relation sym clear
671 relation_property obj1 obj2 t N v;
672 relation_property = RlnGetF(relation, RR_STORAGE);
673 t = KindBaseTerm(RlnGetF(relation, RR_KIND), 0);
674 N = KOVDomainSize(t);
675 if (clear) {
676 v = 1;
677 if (t == OBJECT_TY) {
678 objectloop (obj1 provides relation_property)
679 obj1.relation_property = v++;
680 } else {
681 for (obj1=1: obj1<=N: obj1++)
682 WriteGProperty(t, obj1, relation_property, v++);
683 }
684 rtrue;
685 }
686 if (t == OBJECT_TY) {
687 objectloop (obj1 provides relation_property)
688 objectloop (obj2 provides relation_property)
689 if ((obj1 < obj2) && (obj1.relation_property == obj2.relation_property))
690 rfalse;
691 } else {
692 for (obj1=1: obj1<=N: obj1++)
693 for (obj2=obj1+1: obj1<=N: obj1++)
694 if (GProperty(t, obj1, relation_property) == GProperty(t, obj2, relation_property))
695 rfalse;
696 }
697 rtrue;
698];
699[ Relation_EmptyVtoV relation sym clear vtov_structure obj1 obj2 pr pr2 proutine1 proutine2;
700 vtov_structure = RlnGetF(relation, RR_STORAGE);
701 pr = vtov_structure-->VTOVS_LEFT_INDEX_PROP;
702 pr2 = vtov_structure-->VTOVS_RIGHT_INDEX_PROP;
703 proutine1 = vtov_structure-->VTOVS_LEFT_PRINTING_ROUTINE;
704 proutine2 = vtov_structure-->VTOVS_RIGHT_PRINTING_ROUTINE;
705
706 if (pr && pr2) {
707 objectloop (obj1 provides pr)
708 objectloop (obj2 provides pr2) {
709 if (sym && obj2 > obj1) continue;
710 if (Relation_TestVtoV(obj1, relation, obj2)) {
711 if (clear) Relation_NowNVtoV(obj1, relation, obj2, sym);
712 else rfalse;
713 }
714 }
715 return;
716 }
717 if (pr && (pr2==0)) {
718 objectloop (obj1 provides pr)
719 for (obj2=1:obj2<=vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE:obj2++) {
720 if (Relation_TestVtoV(obj1, relation, obj2)) {
721 if (clear) Relation_NowNVtoV(obj1, relation, obj2, sym);
722 else rfalse;
723 }
724 }
725 return;
726 }
727 if ((pr==0) && (pr2)) {
728 for (obj1=1:obj1<=vtov_structure-->2:obj1++)
729 objectloop (obj2 provides pr2) {
730 if (Relation_TestVtoV(obj1, relation, obj2)) {
731 if (clear) Relation_NowNVtoV(obj1, relation, obj2, sym);
732 else rfalse;
733 }
734 }
735 return;
736 }
737 for (obj1=1:obj1<=vtov_structure-->2:obj1++)
738 for (obj2=1:obj2<=vtov_structure-->VTOVS_RIGHT_DOMAIN_SIZE:obj2++)
739 if (Relation_TestVtoV(obj1, relation, obj2)) {
740 if (Relation_TestVtoV(obj1, relation, obj2)) {
741 if (clear) Relation_NowNVtoV(obj1, relation, obj2, sym);
742 else rfalse;
743 }
744 }
745 rtrue;
746];
Map Route-Finding.
The general problem we have to solve here is: given x, y ∈ R, where R is the set of rooms and we write x ~ y if there is a map connection from x to y, (i) find the smallest m such that there exist x = r1 ~ r2 ~ ... ~ rm = y ∈ R, or determine that no such m exists, and (ii) find d, the first direction to take from x to lead to r2, or set d=0 if no such path exists or if m=1 so that x=y.
Thus a typical outcome might be either "a shortest path from the Town Square to the Hilltop takes 11 moves, starting by going northeast from the Town Square", or alternatively "there's no path from the Town Square to the Hilltop at all". Note that the length of the shortest path is unambiguous, but that there might be many alternative paths of this minimum length: we deliberately do not specify which path is chosen if so, and the two algorithms used below do not necessarily choose the same one.
Route-finding is not an easy operation in computation terms: the various algorithms available have theoretical running times which are easy (if sobering) to compute, but which are not in practice typical of what will happen, because they are quite sensitive to the map in question. Are all the rooms laid out in a long line? Are there clusters of connected rooms like islands? Are there dense clumps of interconnecting rooms? Are there huge but possibly time-saving loops? And so on. Overhead is also important. We present a choice of two algorithms: the "fast" one has a theoretical running time of O(n3), where n is the number of rooms, whereas the "slow" one runs in O(n2), yet in practice the fast one easily outperforms the slow on typical heavy-use cases with large maps.
The other issue is memory usage: we essentially have to strike a bargain between speed and memory overhead. Our "slow" algorithm needs only O(n) storage, whereas our "fast" algorithm needs O(n2), and this is very significant in the Z-machine where array space is in desperately short supply and where, if n > 50 or so, the user is already likely to be fighting for the last few bytes in readable memory.
The user is therefore offered the choice, by selecting the use options "Use fast route-finding" and "Use slow route-finding": and the defaults, if neither option is explicitly set, are fast on Glulx and slow on the Z-machine. If both use options are explicitly set – which might happen due to a disagreement between extensions – "fast" wins.
792#ifndef FAST_ROUTE_FINDING;
793#ifndef SLOW_ROUTE_FINDING;
794#ifdef TARGET_GLULX;
795Constant FAST_ROUTE_FINDING;
796#ifnot;
797Constant SLOW_ROUTE_FINDING;
798#endif;
799#endif;
800#endif;
Cache Control.
We provide code to enable our route-finding algorithms to cache their partial results from one usage to the next (though at present only the "fast" algorithm does this). The difficulty here is that the result of a route search depends on three things, any of which may change:
(a) which subset of rooms we are route-finding through; (b) which subset of doors we are allowing ourselves to use; and (c) the current map connections between rooms.
We keep track of (c) by watching for calls to SignalMapChange() from the routines in WorldModel.i6t which alter the map. (a) and (b), however, require tracking from call to call what the current subset of rooms and doors is. (It is not sufficient to remember the criteria used last time and this time, because circumstances could have changed such that the criteria produce a different outcome. For instance, searching through lighted rooms and using unlocked doors will produce a different result if a door has been locked or unlocked since last time, or if a room has become lighted or not.) We store the set of applicable rooms and doors by enumerating them in the property room_index and by the flags in the DoorRoutingViable array respectively.
825Constant NUM_DOORS = {-value:Instances::count(K_door)};
826Constant NUM_ROOMS = {-value:Instances::count(K_room)};
827
828Array DoorRoutingViable -> NUM_DOORS+1;
829
830Global map_has_changed = true;
831Global last_filter; Global last_use_doors;
832
833[ SignalMapChange; map_has_changed = true; ];
834
835[ MapRouteTo from to filter use_doors count oy oyi ds;
836 if (from == nothing) return nothing;
837 if (to == nothing) return nothing;
838 if (from == to) return nothing;
839 if ((filter) && (filter(from) == 0)) return nothing;
840 if ((filter) && (filter(to) == 0)) return nothing;
841 if ((last_filter ~= filter) || (last_use_doors ~= use_doors)) map_has_changed = true;
842 oyi = 0;
843 objectloop (oy has mark_as_room) {
844 if ((filter == 0) || (filter(oy))) {
845 if (oy.room_index == -1) map_has_changed = true;
846 oy.room_index = oyi++;
847 } else {
848 if (oy.room_index >= 0) map_has_changed = true;
849 oy.room_index = -1;
850 }
851 }
852 oyi = 0;
853 objectloop (oy ofclass K4_door) {
854 ds = false;
855 if ((use_doors & 2) ||
856 (oy has open) || ((oy has openable) && (oy hasnt locked))) ds = true;
857 if (DoorRoutingViable->oyi ~= ds) map_has_changed = true;
858 DoorRoutingViable->oyi = ds;
859 oyi++;
860 }
861 if (map_has_changed) {
862 #ifdef FAST_ROUTE_FINDING; ComputeFWMatrix(filter, use_doors); #endif;
863 map_has_changed = false; last_filter = filter; last_use_doors = use_doors;
864 }
865 #ifdef FAST_ROUTE_FINDING;
866 if (count) return FastCountRouteTo(from, to, filter, use_doors);
867 return FastRouteTo(from, to, filter, use_doors);
868 #ifnot;
869 if (count) return SlowCountRouteTo(from, to, filter, use_doors);
870 return SlowRouteTo(from, to, filter, use_doors);
871 #endif;
872];
Fast Route-Finding.
The following is a form of Floyd's adaptation of Warshall's algorithm for finding the transitive closure of a directed graph.
We need to store a matrix which for each pair of rooms Ri and Rj records aij, the shortest path length from Ri to Rj or 0 if no path exists, and also dij, the first direction to take on leaving Ri along a shortest path to Rj, or 0 if no path exists. For the sake of economy we represent the directions as their instance counts (numbered from 0 in order of creation), not as their direction object values, and then store a single word for each pair (i, j): we store dij + D aij. This restricts us on a signed 16-bit virtual machine, and with the conventional set of D=12 directions, to the range 0 ≤ aij ≤ 5461, that is, to path lengths of 5461 steps or fewer. A work of IF with 5461 rooms will not fit in the Z-machine anyway: such a work would be on Glulx, which is 32-bit, and where 0 ≤ aij ≤ 357,913,941.
We begin with aij = 0 for all pairs except where there is a viable map connection between Ri and Rj: for those we set aij=1 and dij equal to the direction of that map connection.
Following Floyd and Warshall we test if each known shortest path Rx to Ry can be used to shorten the best known path from Rx to anywhere else: that is, we look for cases where axy + ayj < axj, since those show that going from Rx to Rj via Ry takes fewer steps than going directly. See for instance Robert Sedgewick, Algorithms (1988), chapter 32.
The trouble with the Floyd-Warshall algorithm is not so much that it takes in principle O(n3) time to construct the matrix: it does, but the coefficient is low, and in the early stages of the outer loop the fact that the vertex degree is at most D and usually much lower helps to reduce the work further. The trouble is that there is no way to compute only the part of the matrix we want: we have to have the entire thing, and that means storing n2 words of data, by which point we have computed not only the fastest route from Rx to Ry but also the fastest route from anywhere to anywhere else. Even when the original map is sparse, the Floyd-Warshall matrix is not, and it is difficult to store in any very compressed way without greatly increasing the complexity of the code. This is why we cache the results: we might as well, since we had to build the entire memory structure anyway, and it means the time expense is only paid once (or once for every time the state of doors and map connections changes), and the cache is useful for all future routes whatever their endpoints.
919#ifdef FAST_ROUTE_FINDING;
920Array FWMatrix --> NUM_ROOMS*NUM_ROOMS;
921
922[ FastRouteTo from to filter use_doors diri i dir oy;
923 if (from == to) return nothing;
924 i = (FWMatrix-->(from.room_index*NUM_ROOMS + to.room_index))/No_Directions;
925 if (i == 0) return nothing;
926 diri = (FWMatrix-->(from.room_index*NUM_ROOMS + to.room_index))%No_Directions;
927 i=0; objectloop (dir ofclass K3_direction) {
928 if (i == diri) return dir;
929 i++;
930 }
931 return nothing;
932];
933
934[ FastCountRouteTo from to filter use_doors k;
935 if (from == to) return 0;
936 k = (FWMatrix-->(from.room_index*NUM_ROOMS + to.room_index))/No_Directions;
937 if (k == 0) return -1;
938 return k;
939];
940
941[ ComputeFWMatrix filter use_doors oy ox oj axy ayj axj dir diri nd row;
942 objectloop (oy has mark_as_room) if (oy.room_index >= 0)
943 objectloop (ox has mark_as_room) if (ox.room_index >= 0)
944 FWMatrix-->(oy.room_index*NUM_ROOMS + ox.room_index) = 0;
945
946 objectloop (oy has mark_as_room) if (oy.room_index >= 0) {
947 row = (oy.IK1_Count)*No_Directions;
948 for (diri=0: diri<No_Directions: diri++) {
949 ox = Map_Storage-->(row+diri);
950 if ((ox) && (ox has mark_as_room) && (ox.room_index >= 0)) {
951 FWMatrix-->(oy.room_index*NUM_ROOMS + ox.room_index) = No_Directions + diri;
952 continue;
953 }
954 if (use_doors && (ox ofclass K4_door) &&
955 ((use_doors & 2) || (DoorRoutingViable->(ox.IK4_Count)))) {
956 @push location; location = oy;
957 ox = ox.door_to();
958 @pull location;
959 if ((ox) && (ox has mark_as_room) && (ox.room_index >= 0)) {
960 FWMatrix-->(oy.room_index*NUM_ROOMS + ox.room_index) = No_Directions + diri;
961 continue;
962 }
963 }
964 }
965 }
966
967 objectloop (oy has mark_as_room) if (oy.room_index >= 0)
968 objectloop (ox has mark_as_room) if (ox.room_index >= 0) {
969 axy = (FWMatrix-->(ox.room_index*NUM_ROOMS + oy.room_index))/No_Directions;
970 if (axy > 0)
971 objectloop (oj has mark_as_room) if (oj.room_index >= 0) {
972 ayj = (FWMatrix-->(oy.room_index*NUM_ROOMS + oj.room_index))/No_Directions;
973 if (ayj > 0) {
974
975
976 axj = (FWMatrix-->(ox.room_index*NUM_ROOMS + oj.room_index))/
977 No_Directions;
978 if ((axj == 0) || (axy + ayj < axj)) {
979
980 FWMatrix-->(ox.room_index*NUM_ROOMS + oj.room_index) =
981 (axy + ayj)*No_Directions +
982 (FWMatrix-->(ox.room_index*NUM_ROOMS + oy.room_index))%
983 No_Directions;
984 }
985 }
986 }
987 }
988];
989#ENDIF;
Slow Route-Finding.
The alternative algorithm, used when only O(n) memory is available, computes only some of the shortest paths leading to Ry, and is not cached – both because the storage is likely to be reused often by other searches and because there is little gain from doing so, given that a subsequent search with different endpoints will not benefit from the results of this one. On the other hand, to call it "slow" is a little unfair. It is somewhat like Prim's algorithm for finding a minimum spanning tree, rooted at Ry, and grows the tree outward from Ry until either Rx is reached – in which case we stop immediately – or the (directed) component containing Ry has been exhausted – in which case Rx, which must lie outside this, can have no path to Ry. In principle, the running time is O(dn2), where d ≤ D is the maximum vertex degree and n is the number of rooms in the component containing Ry: in practice the degree is often much less than 12, while the algorithm finishes quickly in cases where Ry is relatively isolated and inaccessible or where a shortish route does exist, and those are very common cases in typical usage. There will be circumstances where, because few routes need to be found and because of the shape of the map, the "slow" algorithm will outperform the "fast" one: this is why the user is allowed to control which algorithm is used.
For each room Rz, the property vector stores the direction object of the way to go to its parent room in the tree rooted at Ry. Thus if the algorithm succeeds in finding a route from Rx to Ry then we generate the route by starting at Rx and repeatedly going in the vector direction from where we currently stand until we reach Ry. Since every room needs a vector value, this requires n words of storage. (The vector values store only enough of the minimal spanning tree to go upwards through the tree, but that's the only way we need to traverse it.)
The method can be summed up thus:
(a) Begin with every vector blank except that of Ry, the destination. (b) Repeatedly: For every room in the domain set, try each direction: if this leads to a room whose vector was determined on the last round ( not on this one, as that may be a suboptimal route), set the vector to point to that room. (c) Stop as soon as the vector from the origin is set, or when a round happens in which no further vectors are found: in which case, we have completely explored the component of the map from which the destination can be reached, and the origin isn't in it, so we can return "no".
To prove the correctness of this, we show inductively that after round n we have set the vector for every room having a shortest path to Ry of length n, and that every vector points to a room having a vector in the direction of the shortest path from there to Ry.
1039#ifndef FAST_ROUTE_FINDING;
1040[ SlowRouteTo from to filter use_doors obj dir in_direction progressed sl through_door;
1041 if (from == nothing) return nothing;
1042 if (to == nothing) return nothing;
1043 if (from == to) return nothing;
1044 objectloop (obj has mark_as_room) obj.vector = 0;
1045 to.vector = 1;
1046
1047 while (true) {
1048 progressed = false;
1049
1050 objectloop (obj has mark_as_room)
1051 if ((filter == 0) || (filter(obj)))
1052 if (obj.vector == 0)
1053 objectloop (dir ofclass K3_direction) {
1054 in_direction = Map_Storage-->((obj.IK1_Count)*No_Directions + dir.IK3_Count);
1055 if (in_direction == nothing) continue;
1056
1057 if ((in_direction)
1058 && (in_direction has mark_as_room)
1059 && (in_direction.vector > 0)
1060 && ((filter == 0) || (filter(in_direction)))) {
1061 obj.vector = dir | WORD_HIGHBIT;
1062
1063 progressed = true;
1064 continue;
1065 }
1066 if (use_doors && (in_direction ofclass K4_door) &&
1067 ((use_doors & 2) ||
1068 (in_direction has open) ||
1069 ((in_direction has openable) && (in_direction hasnt locked)))) {
1070 sl = location; location = obj;
1071 through_door = in_direction.door_to();
1072 location = sl;
1073
1074 if ((through_door)
1075 && (through_door has mark_as_room)
1076 && (through_door.vector > 0)
1077 && ((filter == 0) || (filter(through_door)))) {
1078 obj.vector = dir | WORD_HIGHBIT;
1079
1080 progressed = true;
1081 continue;
1082 }
1083 }
1084 }
1085 objectloop (obj has mark_as_room) obj.vector = obj.vector &~ WORD_HIGHBIT;
1086 if (from.vector) return from.vector;
1087 if (progressed == false) return from.vector;
1088 }
1089];
1090
1091[ SlowCountRouteTo from to filter use_doors obj i;
1092 if (from == nothing) return -1;
1093 if (to == nothing) return -1;
1094 if (from == to) return 0;
1095 if (from has mark_as_room && to has mark_as_room) {
1096 obj = MapRouteTo(from,to,filter,use_doors);
1097 if (obj == nothing) return -1;
1098 i = 0; obj = from;
1099 while ((obj ~= to) && (i<NUM_ROOMS)) { i++; obj = MapConnection(obj,obj.vector); }
1100 return i;
1101 }
1102 return -1;
1103];
1104#ENDIF;
Relation Route-Finding.
The general problem we have to solve here is: given x, y ∈ D, where ~ is a relation on a domain set D of objects,
(i) find the smallest n such that there exist x = r1 ~ r2 ~ ... ~ rn = y ∈ D such that ri ~ ri+1, or determine that no such n exists, and if so (ii) find a value of r2 in such a "route" between x and y, or set r2=0 if x=y so that n=1.
While in general a relation can have different left and right domains (a relation between doors and rooms, say), route-finding on those relations is unlikely to be very useful, so is discouraged. (In the case of doors and rooms, a route could never be longer than 1 step, since no object is both a door and a room, for instance.) The "fast" V-to-V algorithm requires D to have the same left and right domains; NI compiles the memory caches for V-to-V relations to force any cases with different domains into using the "slow" algorithm.
MAX_ROUTE_LENGTH is used simply as a sanity check to prevent hangs if something should go wrong, for instance if the property of a 1-to-V relation has been modified by some third-party code in such a way that it loses its defining invariant.
1131Constant MAX_ROUTE_LENGTH = {-value:Instances::count(K_object)} + 32;
1132
1133[ RelationRouteTo relation from to count handler;
1134 if (count) {
1135 if (from == nothing) return -1;
1136 if (to == nothing) return -1;
1137 if (relation == 0) return -1;
1138 } else {
1139 if (from == nothing) return nothing;
1140 if (to == nothing) return nothing;
1141 if (relation == 0) return nothing;
1142 }
1143 if (from == to) return nothing;
1144 if (((RlnGetF(relation, RR_PERMISSIONS)) & RELS_ROUTE_FIND) == 0) {
1145 RunTimeProblem(RTP_ROUTELESS);
1146 return nothing;
1147 }
1148 if (RlnGetF(relation, RR_STORAGE) == 0) return nothing;
1149 handler = RlnGetF(relation, RR_HANDLER);
1150 if (count) return handler(relation, RELS_ROUTE_FIND_COUNT, from, to);
1151 return handler(relation, RELS_ROUTE_FIND, from, to);
1152];
1153
1154[ RelFollowVector rv from to obj i;
1155 if (rv == nothing) return -1;
1156 i = 0; obj = from;
1157 while ((obj ~= to) && (i<=MAX_ROUTE_LENGTH)) { i++; obj = obj.vector; }
1158 return i;
1159];
One To Various Route-Finding.
Here we can immediately determine, given y, the unique y' such that y' ~ y, so finding a path from x to y is a matter of following the only path leading to y and seeing if it ever passed through x; thus the running time is O(n), where n is the size of the domain. It would be pointless to cache this.
Note that we can assume here that x ≠ y, or rather, that from ~= to, because that case has already been taken care of.
1172[ OtoVRelRouteTo relation_property from to previous;
1173 while ((to) && (to provides relation_property) && (to.relation_property)) {
1174 previous = to.relation_property;
1175 previous.vector = to;
1176 if (previous == from) return to;
1177 to = previous;
1178 }
1179 return nothing;
1180];
Various To One Route-Finding.
This time the simplifying assumption is that, given x, we can immediately determine the unique x' such that x ~ x', so it suffices to follow the only path forwards from x and see if it ever reaches y. The routine is not quite a mirror image of the one above, because both have the same return requirements: we have to ensure that the vector properties lay out the path, and also return the next step after x.
1191[ VtoORelRouteTo relation_property from to next start;
1192 start = from;
1193 while ((from) && (from provides relation_property) && (from.relation_property)) {
1194 next = from.relation_property;
1195 from.vector = next;
1196 if (next == to) return start.vector;
1197 from = next;
1198 }
1199 return nothing;
1200];
Slow Various To Various Route-Finding.
Now there are no simplifying assumptions and the problem is essentially the same as the one solved for route-finding in the map, above. Once again we present two different algorithms: first, a form of Prim's algorithm for minimal spanning trees. Note that, whereas this algorithm was not always so "slow" for the map – because of the fairly low vertex degrees involved, i.e., because most rooms had few connections to other rooms – here the relation might well be almost complete, with almost all the objects related to each other, and then the algorithm will indeed be "slow". So it is likely that the "fast" algorithm will always be better, if the memory can be spared for it.
We use the fast algorithm for a given relation if and only if the NI compiler has allocated the necessary cache memory; the two use options above, for map route-finding, don't control this.
1219[ VtoVRelRouteTo relation from to count obj obj2 related progressed left_ix pr2 i vtov_structure;
1220 vtov_structure = RlnGetF(relation, RR_STORAGE);
1221 if (vtov_structure-->VTOVS_CACHE)
1222 return FastVtoVRelRouteTo(relation, from, to, count);
1223 left_ix = vtov_structure-->VTOVS_LEFT_INDEX_PROP;
1224 pr2 = vtov_structure-->VTOVS_RIGHT_INDEX_PROP;
1225 objectloop (obj ofclass Object && obj provides vector) obj.vector = 0;
1226 to.vector = 1;
1227 while (true) {
1228 progressed = false;
1229 objectloop (obj ofclass Object && obj provides left_ix)
1230 if (obj.vector == 0) {
1231 objectloop (obj2 ofclass Object && obj2 provides pr2 && obj2.vector > 0) {
1232 if (Relation_TestVtoV(obj, relation, obj2)) {
1233 obj.vector = obj2 | WORD_HIGHBIT;
1234 progressed = true;
1235 continue;
1236 }
1237 }
1238 }
1239 objectloop (obj ofclass Object && obj provides left_ix)
1240 obj.vector = obj.vector &~ WORD_HIGHBIT;
1241 if (from.vector) break;
1242 if (progressed == false) break;
1243 }
1244 if (count) {
1245 if (from.vector == nothing) return -1;
1246 i = 0; obj = from;
1247 while ((obj ~= to) && (i<=MAX_ROUTE_LENGTH)) { i++; obj = obj.vector; }
1248 return i;
1249 }
1250 return from.vector;
1251];
Fast Various To Various Route-Finding.
Now, as above, a form of the Floyd-Warshall algorithm. The matrix is here stored in the cache of memory pointed to in the V-to-V relation structure. We are unable to combine aij and dij into a single cell of memory, so in fact we store two separate matrices: one for aij (this is cache below), the other for nij, where nij is the next object in the shortest path from Oi to Oj (this is cache2 below).
Where n<256 a shortest path must be such that aij ≤ 255, so can be stored in a single byte, and we similarly store nij as the index of the object rather than the object value itself: the index ranges from 0 to n-1, so that 0 ≤ nij < 255 and we can use nij = 255 as a sentinel value meaning "no path". Although the reconversion of nij back into a valid object value takes a little time, it is only O(n), and of course we know n is relatively small; and in this way we reduce the storage overhead to only n2 bytes.
Where n ≥ 256, we resign ourselves to storing two words for each pair (i,j), making 2n2 bytes of storage on the Z-machine and 4n2 bytes of storage on Glulx, but lookup of a cached result is slightly faster.
1276[ FastVtoVRelRouteTo relation from to count
1277 domainsize cache cache2 left_ix ox oy oj offset axy axj ayj;
1278 domainsize = RlnGetF(relation, RR_STORAGE)-->2;
1279 left_ix = RlnGetF(relation, RR_STORAGE)-->VTOVS_LEFT_INDEX_PROP;
1280 if ((from provides left_ix) && (to provides left_ix)) {
1281 if (domainsize < 256) {
1282 cache = RlnGetF(relation, RR_STORAGE)-->VTOVS_CACHE;
1283 cache2 = cache + domainsize*domainsize;
1284 if (RlnGetF(relation, RR_STORAGE)-->VTOVS_CACHE_BROKEN == true) {
1285 RlnGetF(relation, RR_STORAGE)-->VTOVS_CACHE_BROKEN = false;
1286 objectloop (oy provides left_ix)
1287 objectloop (ox provides left_ix)
1288 if (Relation_TestVtoV(oy, relation, ox)) {
1289 offset = ((oy.left_ix)*domainsize + (ox.left_ix));
1290 cache->offset = 1;
1291 cache2->offset = ox.left_ix;
1292 } else {
1293 offset = ((oy.left_ix)*domainsize + (ox.left_ix));
1294 cache->offset = 0;
1295 cache2->offset = 255;
1296 }
1297 for (oy=0: oy<domainsize: oy++)
1298 for (ox=0: ox<domainsize: ox++) {
1299 axy = cache->(ox*domainsize + oy);
1300 if (axy > 0)
1301 for (oj=0: oj<domainsize: oj++) {
1302 ayj = cache->(oy*domainsize + oj);
1303 if (ayj > 0) {
1304 offset = ox*domainsize + oj;
1305 axj = cache->offset;
1306 if ((axj == 0) || (axy + ayj < axj)) {
1307 cache->offset = (axy + ayj);
1308 cache2->offset = cache2->(ox*domainsize + oy);
1309 }
1310 }
1311 }
1312 }
1313 }
1314 if (count) {
1315 count = cache->((from.left_ix)*domainsize + (to.left_ix));
1316 if (count == 0) return -1;
1317 return count;
1318 }
1319 oy = cache2->((from.left_ix)*domainsize + (to.left_ix));
1320 if (oy < 255)
1321 objectloop (ox provides left_ix)
1322 if (ox.left_ix == oy) return ox;
1323 return nothing;
1324 } else {
1325 cache = RlnGetF(relation, RR_STORAGE)-->VTOVS_CACHE;
1326 cache2 = cache + WORDSIZE*domainsize*domainsize;
1327 if (RlnGetF(relation, RR_STORAGE)-->VTOVS_CACHE_BROKEN == true) {
1328 RlnGetF(relation, RR_STORAGE)-->VTOVS_CACHE_BROKEN = false;
1329 objectloop (oy provides left_ix)
1330 objectloop (ox provides left_ix)
1331 if (Relation_TestVtoV(oy, relation, ox)) {
1332 offset = ((oy.left_ix)*domainsize + (ox.left_ix));
1333 cache-->offset = 1;
1334 cache2-->offset = ox;
1335 } else {
1336 offset = ((oy.left_ix)*domainsize + (ox.left_ix));
1337 cache-->offset = 0;
1338 cache2-->offset = nothing;
1339 }
1340 for (oy=0: oy<domainsize: oy++)
1341 for (ox=0: ox<domainsize: ox++) {
1342 axy = cache-->(ox*domainsize + oy);
1343 if (axy > 0)
1344 for (oj=0: oj<domainsize: oj++) {
1345 ayj = cache-->(oy*domainsize + oj);
1346 if (ayj > 0) {
1347 offset = ox*domainsize + oj;
1348 axj = cache-->offset;
1349 if ((axj == 0) || (axy + ayj < axj)) {
1350 cache-->offset = (axy + ayj);
1351 cache2-->offset = cache2-->(ox*domainsize + oy);
1352 }
1353 }
1354 }
1355 }
1356 }
1357 if (count) {
1358 count = cache-->((from.left_ix)*domainsize + (to.left_ix));
1359 if (count == 0) return -1;
1360 return count;
1361 }
1362 return cache2-->((from.left_ix)*domainsize + (to.left_ix));
1363 }
1364 }
1365 if (count) return -1;
1366 return nothing;
1367];
Iterating Relations.
The following is provided to make it possible to run an I6 routine on each relation in turn. (Each right-way-round relation, at any rate.)
1374[ IterateRelations callback;
1375 {-call:Relations::relations_command}
1376];