1. для ПРАВИЛЬНОГО получения номера поколения по КРАТЧАЙШЕЙ ЛИНИИ надо таки отказаться от иерархического вызова (пишет первое найденное вхождение потомка, по первой попавшейся линии). Или дополнить (в случае Err в .Add проверкой записанного и текущего (в рекурсивной процедуре) поколения, а при необходимости и .Edit (номер поколения, и генетические веса, если потребуется).
2. НАстоятельно рекомендую не завязываться на id предка но на id семьи (вдвое снизит объем таблицы, запросы будут более прозрачными логически). Но если вы склоняетесь не к постоянно заполненной (редко обновляемой) таблице, то возможно имеет смысл делать как сочтете нужным.
3. не совсем понимаю, что такое "номер персоны в семье" и на кой он нужен (внутри поколения нумерация вообще произвольна). Но такого рода нумерация легко производится в нерекурсивной (последовательный перебор по поколениям) процедуре.
______
для "постоянно заполненной таблицы транзиктивных связей" примерно следующая структура:
id персона
pid семья предков (соотв уровня)
generation поколение (уровень наследования)
weght вес (семьи предков) в генетическом наследстве, Double
/* (степень родства суммарно по всем линиям) */
при этом семья:
id
муж
жена
nмуж № брака, байт
nжена № брака, байт
дети - как есть
Семья
Ребенок
/* счетчик в вашей структуре лишний == Ребенок*/
+ желательо поле очередности ребенка в семье. но я б ввел вместо него дату рождения - дата/время, правда не всегда оно известно, а для близнецов пришлось бы манипулировать искуственно временем +- часы/минуты. Т.ч. возможно и очередность не худший выход.
и я бы ввел пол, и избавился от муж/жена в структуре данных для семьи, но, как я понял, встречаются гермафродиты
хотя для семей возможно лучше разбить таблицы:
семья:
(уникум, служит для организации связей с потомками и супругами)
id -PKey
супруги:
id - Fkey семья(id)
idp - персона Fkey дети (
sx - роль в семье, boolean
nсемьи - номер брака
В таком виде данных в семье/супруги/дети более чем достаточно для первичного расчета таблицы связей "потомки", а полного набора таблиц с (учетом последней таблицы) - для формирования практически за счет одного SQL всех возможных отчетов. Если же вы настаиваете на нумерации внутри "линии", то это заведомо относительное (отсчитывается от произвольно выбранного предка) поле можно расчитывать динамически (как я писал - заполняя коллекцию или массив) при выводе отчетов, не перестраивая таблицу "потомков".
__________
ЗЫ - Если затруднились переформировать нерекурсивную разновидность процедуры, то сейчас поищу...
вот, с какими-то лишними наворотами:
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.
Option Compare Database
Option Explicit
Private dbs As Database, rstDesc As Recordset, rstS( 0 To 1 ) As Recordset, rstD As Recordset ', n As Long
Private pC() As Long, pN() As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Sub startA(id As Long, Optional bMod As Boolean)
Dim iSx As Long
Dim sIn(0 To 1) As String
Dim Start_t As Double
Start_t = Timer
Set dbs = CurrentDb
dbs.Execute ("Delete From потомки")
Set rstDesc = dbs.OpenRecordset("потомки")
sIn(0) = "Мid": sIn(1) = "Жid"
For iSx = 0 To 1
Set rstS(iSx) = dbs.OpenRecordset("семьи", dbOpenTable)
rstS(iSx).Index = sIn(iSx)
Next iSx
Set rstD = dbs.OpenRecordset("дети", dbOpenTable)
rstD.Index = "СемьяРебенок"
FindDescendantAll id, 1, bMod '29, 1
rstDesc.Close
Set rstDesc = Nothing
For iSx = 0 To 1
rstS(iSx).Close
Set rstS(iSx) = Nothing
Next iSx
rstD.Close
Set rstD = Nothing
Debug.Print Timer - Start_t
End Sub
Sub FindDescendantAll(id As Long, iGeneration As Long, Optional bMod As Boolean)
Dim nP As Long, nC As Long, iG As Long, bF As Boolean
Dim iC As Long
'On Error Resume Next
bF = FindDescendantA(id, iGeneration) 'первый вызов
iG = iGeneration
Do While bF 'цикл по поколениям
'переместим следующих в текущий
Erase pC
ReDim pC( 0 To UBoundE(pN))
If bMod Then
'сдвиг указателей
'CopyMemory pC( 0 ), pN( 0 ), x * (UBound(pN) + 1 )
'где x - количество байт в элементе массива - для инт - 2 для лонга 4
CopyMemory pC(0), pN(0), 4 * (UBoundE(pN) + 1)
Else
For iC = 0 To UBound(pN)
pC(iC) = pN(iC)
Next iC
End If
Erase pN 'очистка следующего
bF = False
iG = iG + 1
For nC = 0 To UBound(pC)
bF = FindDescendantA(pC(nC), iG) Or bF
Next nC
Loop
End Sub
Function UBoundE(Ar As Variant) As Long
On Error Resume Next
UBoundE = UBound(Ar)
If Err <> 0 Then UBoundE = - 1
End Function
Function FindDescendantA(id As Long, iGeneration As Long) As Boolean
Dim i As Long, nS As Long, nR As Long, iSx As Long
Dim kN As Long
For iSx = 0 To 1
With rstS(iSx)
'.Index = sIn(iSx)
.Seek ">=", id, 0
If Not .NoMatch Then
Do While .Fields(iSx + 1) = id
nS = .Fields("id")
With rstD
.Seek ">=", nS ', 0
If Not rstD.NoMatch Then
Do While .Fields("Семья") = nS
nR = .Fields("Ребенок")
With rstDesc
On Error Resume Next
.AddNew
.Fields( 0 ) = nR
.Fields( 1 ) = iGeneration
.Update
End With
If Err = 0 Then
i = iGeneration + 1
FindDescendantA = True 'есть хоть один
kN = UBoundE(pN) + 1
ReDim Preserve pN(0 To kN)
pN(kN) = nR 'вызовем потом
Else
End If
On Error GoTo 0
.MoveNext
If .NoMatch Or .EOF Then Exit Do
Loop
End If
End With
'.Seek ">", id, nS
.MoveNext
If .NoMatch Or .EOF Then Exit Do
Loop
End If
End With
Next iSx
End Function
- это без учета рекомендованных изменений структуры. (Ваша проблема со счетчиками номера персоны в линии решается в данной процедуре вводом одной переменной уровня модуля, навариваемой на 1-ку при успешном добавлении записи).
и я б еще поэкспериментировал с поиском в большой коллекции по "key". если окажется быстрее, чем выборка из массива перебором по значению (или модификаций с вставкой в упорядоченные массивы - с "раздвижкой", что долго), то легко решается проблема пересчета генетического веса без вызова .edit при повторном нахождении (на этапе прохода по поколению результаты грузятся в коллекцию записей с инедексом str(id) (определенный пользователем тип, вес в поколении просто пересчитывается, при ошибке добавления по ключу), а по проходу все поколение записывается из коллекции в таблицу (add or edit ранее вставленных записей). Но это именно в случае желания иметь степень генетического родства с учетом множественности линий наследования. В конце-концов может оказаться что даже вся ваша табла "потомков" шустро влезет в такую коллекцию в разумный объем памяти (у вас что-то до 40000 "записей" длиной 8 байт, +, если я праильно соображаю на счет конструкции "коллекций" и их "индексов", структурка будет более рыхлой, чем массив (записей) на некий множитель, не больший, видимо, 5-10 (вроде как даже таблички не более чем в 5 раз более рыхлы, чем плоские файлы), и ваша коллекция записей (для одного предка) влезет в 1.6 -3.2 мегабайта. Что уже интересно с точки зрения переноса логики связи не на таблицу потомков, а на функцию(и) связей, рботающую с такими массивами по предложенной ранее схеме...
