I6 Template Layer

Inform 7 6M62ContentsIntroductionFunction IndexRules Index

Relations.i6t

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; ! Assert 1-1 true 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; ! Assert 1-1 false 150    if ((obj1) && (obj1.relation_property == obj2)) obj1.relation_property = nothing; 151]; 152 153[ Relation_Now1to1V obj1 obj2 KOV relation_property ol N; ! Assert 1-1 true 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; ! Assert 1-1 false 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; ! Assert symmetric 1-1 true 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; ! Assert symmetric 1-1 false 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; ! Assert symmetric 1-1 true 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; ! Assert symmetric 1-1 false 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; ! Mark any cache as broken 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; ! Mark any cache as broken 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];

Show One to One.

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); ! Kind of left term 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); ! Kind of left term 472    t2 = KindBaseTerm(RlnGetF(relation, RR_KIND), 1); ! Kind of right term 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];

Show Equivalence.

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); ! Kind of left term 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        ! A slower method, since we have less efficient storage: 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); ! Kind of left term 631    t2 = KindBaseTerm(RlnGetF(relation, RR_KIND), 1); ! Kind of right term 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); ! Kind of left term 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                        !print "Is it faster to go from ", (name) ox, " to ", 975                        ! (name) oj, " via ", (name) oy, "?^"; 976                        axj = (FWMatrix-->(ox.room_index*NUM_ROOMS + oj.room_index))/ 977                            No_Directions; 978                        if ((axj == 0) || (axy + ayj < axj)) { 979                            !print "Yes^"; 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    !print "Routing from ", (the) from, " to ", (the) to, "^"; 1047    while (true) { 1048        progressed = false; 1049        !print "Pass begins^"; 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                        !print (the) obj, " > ", (the) dir, " > ", (the) in_direction, "^"; 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                            !print "* ", (the) obj, " vector is ", (the) dir, "^"; 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                            !print "Through door is ", (the) through_door, "^"; 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                                !print "* ", (the) obj, " vector is ", (the) dir, "^"; 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; ! Number of left instances 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];