File: longlines.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 (107 lines) | stat: -rw-r--r-- 3,058 bytes parent folder | download | duplicates (5)
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
/*
 * @progname       longlines.ll
 * @version        2.0
 * @author         Chandler
 * @category       
 * @output         Text
 * @description    

Find the maximal-length male and female lineages in the database.
Optionally, find the maximal-length lineage through a specified ancestor.
 
longlines

Version 1 - 1994 May 19 - John F. Chandler
Version 2 - 2000 May 4 - John F. Chandler

This program works only with LifeLines.

*/
global(len)     /* current lineage length */
global(lenmax)  /* longest lineage found */
global(ends)    /* keys of last persons */
global(linsex)  /* sex of lineage desired */

proc main(){
getindi(indi,"Enter specific ancestor, if any, whose longest line you want:")
if(indi) {
        "Longest descent from " name(indi) " (" key(indi) ")\n\n"
        set(linsex,sex(indi))
        set(len,1)
        call getline(indi)
        call dumplines()
} else {
        "Longest lineages in database\n\n   Male"
        call getall("M")
        call dumplines()
        "\n   Female"
        call getall("F")
        call dumplines()
}
}

/* scan all offspring matching the sex of the input person, and
   return the longest lineage(s) from those -- if no matching
   offspring, just return the input person as a lineage */
proc getline(indi)
{
incr(len)
families(indi,fam,spou,num) {
        children(fam,child,numc) {
                if(eq(0,strcmp(linsex,sex(child)))) {
                        set(found,1)
                        call getline(child)
                }
        }
}
decr(len)
if(and(not(found),ge(len,lenmax))) {
        if(gt(len,lenmax)) {list(ends)}
        enqueue(ends,save(key(indi)))
        set(lenmax,len)
}}

proc getall(this_sex)
{
set(linsex,this_sex)
set(lenmax,0)
print("Starting ", linsex, " ...\n")

/* find all eligible starting points */
/* assume that a nameless person doesn't count */
forindi (indi, num) {
        set(skip,"")
        if(eq(0,strcmp(linsex,"M"))) {set(par,father(indi))}
        else {set(par,mother(indi))}
        if(par) {set(skip,name(par))}
        if(and(eq(0,strcmp(linsex,sex(indi))),eq(0,strcmp("",skip)))) {
                set(len,1)
                call getline(indi)
        }
}}

proc dumplines()
{
/* report results */
"\n   Maximal length " d(lenmax) "\n"
/* dump each lineage, starting with most recent person */
while(end, dequeue(ends)) {
        "\n"
        set(count, lenmax)
        set(line,indi(end))
        while(line) {
                if(eq(count,0)) {"   (extension of the requested line...)\n"}
                decr(count)
                if(eq(0,strcmp(name(line),""))) {"_____"}
                name(line) " (" key(line) ")"
                if(x, birth(line)) {" b. " year(x)}
                if(y, death(line)) {
                        if(x) {","}
                        " d. " year(y)
                }
                "\n"
                if(eq(0,strcmp(linsex,"M"))) {set(line,father(line))}
                else {set(line,mother(line))}
        }
        if(lt(count,0)) {"   (length " d(sub(lenmax,count)) " with extension)\n"}
}}