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
|
/*
* @progname common.ll
* @version 0 of 1996-06-11
* @author H. Väisänen
* @category
* @output Text
* @description
Show common ancestors of a person.
Pedigree collapse means that someone is descended from some persons
in two or more ways. If person's father and mother are related,
this program lists the common ancestors and the people between them
and the person.
The program probably does not work if person is descended from
common ancestors in more than two ways or if there is different
number of generations in those two ways.
by H. V<a-umlaut>is<a-umlaut>nen
Version 0, 11 June 1996
*/
proc main()
{
getindi (person)
"Common ancestors of " name (person) "\n\n\n"
/* Father and his ancestors. */
indiset (father_set)
if (f, father(person)) {
addtoset (father_set, f, 0)
set (father_set, union (father_set, ancestorset (father_set)))
}
/* Mother and her ancestors. */
indiset (mother_set)
if (m, mother(person)) {
addtoset (mother_set, m, 0)
set (mother_set, union (mother_set, ancestorset (mother_set)))
}
/* Their intersection. */
indiset (intersection_set)
set (intersection_set, intersect (father_set, mother_set))
valuesort (intersection_set)
/* Is minimum of v always zero? I'm not sure... */
set (min, 10000)
forindiset (intersection_set, indi, v, n) {
if (lt(v, min)) {set (min, v)}
}
/* First common ancestors. */
indiset (common_ancestor_set)
forindiset (intersection_set, indi, v, n) {
if (eq(min, v)) {
addtoset (common_ancestor_set, indi, 0)
}
}
if (eq(lengthset(common_ancestor_set), 0)) {
print ("Person's father and mother are not related.")
"Person's father and mother are not related.\n"
return()
}
set (max_name_length, max_length (common_ancestor_set))
/* Print first common ancestors. */
forindiset (common_ancestor_set, indi, v, n) {
col (20)
call print_indi (indi, v, add(max_name_length, 20)) "\n"
}
"\n"
/* Descendants of first common ancestors. */
indiset (descendant_set)
set (descendant_set, descendantset(common_ancestor_set))
/* Links from the father's side. */
indiset (set1)
set (set1, intersect (descendant_set, father_set))
valuesort (set1)
/* Links from the mother's side. */
indiset (set2)
set (set2, intersect (descendant_set, mother_set))
valuesort (set2)
set (max_name_length, max_length(set1))
set (length2, max_length(set2))
if (gt(length2, max_name_length)) {set (max_name_length, length2)}
/* Print father's line on the left, mother's line on the right. */
table (mom)
forindiset (set2, indi, v, n) {
insert (mom, d(v), indi)
}
forindiset (set1, indi, v, n) {
call print_indi (indi, v, add(max_name_length,1)) col(40)
call print_indi (lookup(mom, d(v)), v, add(max_name_length,40)) "\n"
}
"\n"
col (20)
call print_indi (person, add(v,1), add(max_name_length, 20)) "\n"
}
proc print_indi (indi, v, length)
{
name (indi) col(length) " ("
if (p, birth(indi)) {year(p)} else {" "}
" - "
if (p, death(indi)) {year(p)} else {" "}
") (" d(v) ")"
}
/* Maximum length of a name of a person in person_set.
*/
func max_length (person_set)
{
set (max_name_length, 0)
forindiset (person_set, indi, v, n) {
if (lt(max_name_length, strlen(name(indi)))) {
set (max_name_length, strlen(name(indi)))
}
}
return (max_name_length)
}
/*
-----------------------------------------------------------------------
This is an example of the output. I have deleted the surnames because
they contain 8 bit letters.
Common ancestors of Juho XXXXXXXX
Maria AAAAAAAAAAA (1606 - 1661) (0)
Heikki XXXXXXXX (1603 - 1670) (0)
Heikki XXXXXXXX (1628 - 1705) (1) Lauri XXXXXXXX (1637 - 1701) (1)
Heikki XXXXXXXX (1666 - 1731) (2) Eeva XXXXXXXX (1659 - 1724) (2)
Aatami XXXXXXXX (1687 - 1733) (3) Anna BBBBBBBB (1691 - 1746) (3)
Juho XXXXXXXX (1721 - 1775) (4) Ulla CCCCCCCC (1724 - 1789) (4)
Juho XXXXXXXX (1761 - 1848) (5)
*/
|
