File: relation.ll

package info (click to toggle)
lifelines 3.0.50-2
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 11,140 kB
  • ctags: 6,517
  • sloc: ansic: 57,468; xml: 8,014; sh: 4,255; makefile: 848; yacc: 601; perl: 170; sed: 16
file content (255 lines) | stat: -rw-r--r-- 8,555 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
/*
 * @progname       relation.ll
 * @version        5.0
 * @author         Eggert
 * @category       
 * @output         Text
 * @description    

This program calculates the relationship between individuals in a
database.  It does so in three modes.  Mode 1 just does one pair of
individuals and then exits.  Mode 2 does any number of pairs with a
common "from" person.  Mode 3 does all pairs with a common "from"
person.  In general, mode 1 is fastest for simple relationships, but
if you want one complicated relationship, you may as well do them all.

relation - a LifeLines relation computing program
        by Jim Eggert (eggertj@atc.ll.mit.edu)
        Version 1,  21 November 1992
        Version 2,  23 November 1992 (completely revamped)
        Version 3,  (changed format slightly, modified code somewhat)
        Version 4,   6 July 1993 (added English language)
        Version 5,   6 September 1993 (generified language)

Each computed relation is composed of the minimal combination of
parent (fm), sibling (bsS), child (zdC), and spouse (hw) giving the
relational path from the "from" person to the "to" person.  Each
incremental relationship (or hop) is coded as follows, with the
capital letters denoting a person of unknown gender:
        father  f
        mother  m
        parent  P (not used)
        brother b
        sister  s
        sibling S
        son     z (sorry)
        daughtr d
        child   C
        husband h
        wife    w
        spouse  O (sorry again, but usually not possible)

The report gives the steps required to go from the first person to
the second person.  Thus the printout
        I93 John JONES fmshwz I95 Fred SMITH
means that John Jones' father's mother's sister's husband's wife's son
is Fred Smith.  Notice in this case, the sister's husband's wife is
not the same as the sister, and the husband's wife's son is not the
same as the husband's son.  Thus in more understandable English, John
Jones' paternal grandmother's sister's husband's wife's son from
another marriage is Fred Smith.

The program will do a trivial parsing of the path string.  You can
change the language_table to have it print in different languages, as
long as the word order is unchanged.

If there is no relation, the program says so.  That at least should be
easy to explain.  Mode 3 only prints out those individuals who are
related to the "from" individual.
*/

global(plist)
global(hlist)
global(mark)
global(keys)
global(found)
global(do_names)
global(language)
global(language_table)
global(token)
global(untoken)

proc include(person,hops,keypath,path,pathend)
{
    if (and(person,eq(found,0))) {
        set(pkey,key(person))
        if (entry,lookup(mark,pkey)) {
            if (eq(strcmp(entry,"is not related to"),0)) {
                set(found,1)
                list(plist)
                list(hlist)
                insert(mark,pkey,concat(path,pathend))
                insert(keys,pkey,concat(concat(keypath,"@"),pkey))
            }
        }
        else {
            enqueue(plist,pkey)
            enqueue(hlist,hops)
            insert(mark,pkey,concat(path,pathend))
            insert(keys,pkey,concat(concat(keypath,"@"),pkey))
        }
    }
}

proc get_token(input) {
/*  Parse a token from the input string.
    Tokens are separated by one or more "@"s.
    Set global parameter token to the first token string.
    Set global parameter untoken to the rest of the string after first token.
*/
/* strip leading @s */
    set(untoken,input)
    set(first_delim,index(untoken,"@",1))
    while (eq(first_delim,1)) {
        set(untoken,substring(untoken,2,strlen(untoken)))
        set(first_delim,index(untoken,"@",1))
    }
/* get token and untoken */
    if (not(first_delim)) {
        set(token,untoken)
        set(untoken,"")
    }
    else {
        set(token,substring(untoken,1,sub(first_delim,1)))
        set(untoken,
            substring(untoken,add(first_delim,1),strlen(untoken)))
    }
}

proc parse_relation(relation,keypath) {
    if (not(language)) {
        " " relation
        if (do_names) {
            set(untoken,keypath)
            call get_token(untoken)
            while(strlen(untoken)) {
                call get_token(untoken)
                " " token " " name(indi(token))
            }
        }
        " "
    }
    else {
        set(charcounter,1)
        set(untoken,keypath)
        call get_token(untoken)
        while (le(charcounter,strlen(relation))) {
            lookup(language_table,substring(relation,charcounter,charcounter))
            if (do_names) {
                call get_token(untoken)
                " " token " " name(indi(token))
            }
            set(charcounter,add(charcounter,1))
        }
        " is "
    }
}

proc main ()
{
    table(mark)
    table(keys)
    list(plist)
    list(hlist)

    table(language_table)
    insert(language_table,"f","'s father")
    insert(language_table,"m","'s mother")
    insert(language_table,"P","'s parent")
    insert(language_table,"b","'s brother")
    insert(language_table,"s","'s sister")
    insert(language_table,"S","'s sibling")
    insert(language_table,"z","'s son")
    insert(language_table,"d","'s daughter")
    insert(language_table,"C","'s child")
    insert(language_table,"h","'s husband")
    insert(language_table,"w","'s wife")
    insert(language_table,"O","'s spouse")

    getindimsg(from_person,
        "Enter person to compute relation from:")
    set(from_key,key(from_person))
    set(hopcount,0)
    set(prev_hopcount,neg(1))
    set(found,0)
    call include(from_person,hopcount,"","","")
    getintmsg(mode,"Enter 1 for a single relation, 2 for several, 3 for all:")
    getintmsg(language,
        "Enter 0 for brief, 1 for English-language relationships:")
    getintmsg(do_names,
        "Enter 0 to omit, 1 to output names of all intervening relatives:")
    if (eq(mode,1)) {
        getindimsg(to_person,
            "Enter one person to compute relation to:")
        set(to_key,key(to_person))
        if (strcmp(from_key,to_key)) {
            insert(mark,to_key,"is not related to")
        }
        else {
            list(plist)
            list(hlist)
        }
    }
    while (pkey,dequeue(plist)) {
        set(person,indi(pkey))
        set(hopcount,dequeue(hlist))
        set(path,lookup(mark,pkey))
        set(keypath,lookup(keys,pkey))
        if (ne(hopcount,prev_hopcount)) {
            print(".")
            set(prev_hopcount,hopcount)
        }
        set(hopcount,add(hopcount,1))
        call include(father(person),hopcount,keypath,path,"f")
        call include(mother(person),hopcount,keypath,path,"m")
        children(parents(person),child,cnum) {
            if (male(child)) { set(pathend,"b") }
            elsif (female(child)) { set(pathend,"s") }
            else { set(pathend,"S") }
            call include(child,hopcount,keypath,path,pathend)
        }
        families(person,fam,spouse,pnum) {
            if (male(spouse)) { set(pathend,"h") }
            elsif (female(spouse)) { set(pathend,"w") }
            else { set(pathend,"O") }
            call include(spouse,hopcount,keypath,path,pathend)
            children(fam,child,cnum) {
                if (male(child)) { set(pathend,"z") }
                elsif (female(child)) { set(pathend,"d") }
                else { set(pathend,"C") }
                call include(child,hopcount,keypath,path,pathend)
            }
        }
    }
    if (eq(mode,1)) {
        from_key " " name(indi(from_key))
        call parse_relation(lookup(mark,to_key),lookup(keys,to_key))
        to_key   " " name(indi(to_key)) "\n"
    }
    if (eq(mode,2)) {
        set(want_another,1)
        while (want_another) {
            getindimsg(to_person,"Enter person to compute relation to:")
            set(to_key,key(to_person))
            from_key " " name(indi(from_key))
            if (path,lookup(mark,to_key)) {
                call parse_relation(path,lookup(keys,to_key))
            }
            else { " is not related to " }
            to_key  " "  name(to_person) "\n"
            getintmsg(want_another,
                  "Enter 0 if done, 1 if you want another to person:")
        }
    }
    if (eq(mode,3)) {
        from_key " " name(indi(from_key)) " --->\n"
        forindi(to_person,num) {
            set(to_key,key(to_person))
            if (path,lookup(mark,to_key)) {
                call parse_relation(path,lookup(keys,to_key))
                to_key " " name(to_person) "\n"
            }
        }
    }
}