Family Ordering: algorithm and logic help please.
Posted: 02 Sep 2022 14:07
what I intend is to order and classify families\
PTG:
2 = fathers family SEQ starts at 0
3 = mothers family SEQ starts at 0
4 = descendants shared by mother and father SEQ starts at 0
5 = unlinked families and records. sequence SEQ starts at 0 (this is unfinished, and not of concern at this time, it needs work but fundamentals are there. class 5s are processed correctly)
I process father then mother seeds
what you will see is, once I have gotten to mother and fathers family record the descendants become mothers family. If I trigger the class 4, those unprocessed mothers family become 4s as well. So at present there are no class 4 records.
the program layout is:
32 que:enQ(ent)
37 que:deQ()
44 que:isNotEmpty()
48 que:isEmpty()
52 que.create()
63 que:reset() **not yet implemented**
87 local sltROOT()
94 local mat_spc_root()
130 local mat_file_root()
** materialize a program root and family, *NB: may be existing file root and family**e
164 local trim(str)
171 local trime(str)
178 local matNAM(iptr)
180 local rtvElemCount(varptr)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
**ignore all functions above this line, they all work correctly**
224 local rtv_FAM_pool(fptr)
** works, but not fully implemented, used only for class 5s**
234 local rtv_FAM_marr(fptr)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
**ignore above functions they all work correctly**
284 local rgz_anc_seeds()
**sifts out the oldest mother's and father's treetop only in the ancestors chain**
320 local rtv_anc_seeds(rcd, tag)
**main wrapper call to initialize recursion**
324 local rtv_anc_chain(rcd, tag)
**recursive get ancestors**
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
**these 'work' crrectly, but are not being used as intended**
**process root seed, to build 1 father and 1 mother treetop**
385 local enQtbl(ftbl)
**enqueue table of only FAMC, only FAMS, or both FAMC and FAMS records for processing**
395 local rtv_FAM_tbl(rcd, tag)
**build table of only FAMC, only FAMS, or both FAMC and FAMS records depending on tag**
425 local prc_Q()
**dequeue records produced by enQtbl or queued by the procedure itself as records are revealed**
521 local list_FAM()
** build and process root seed, to build mother and father treetops**
564 Order_FAM()
**when this becomes a working module within a program, this will be called to build the ordered family table.
---------------------------------------
What is dissatifying?
1. any descendant algorithm I can find does not include wife. I can see why, it is no longer a trivial exercise.
2. because I include otwife, and enqueue root wifes FAMC and FAM, the second seed is not read until after all the wifes records are processed, which are ignored because the records have all been hashed, but resulting in the root wifes tree being upside down.
3. FAMC and FAMS records need different processing. generation is -1 for FAMC and +1 for FAMS, additionally CHIL records generation must be +1
4. in order to actually order records I think I need a 'lining up function':
let's by convention give priority to Father records over Mother records (although realistically we can only be nearly absolutely sure of mother, only a couple cases where we cannot)
given a FAMC or FAMS of mother and father (father will be on left side)
let us consider a FAMS
[1] = 22 [1] = 14
[2] = 33 [2] = 75
[3] = 56 [3] = 89
[4] = 75
[5] = 89
the resulting FAMS order should be (I think)
[1] = 22 H
[2] = 33 H
[3] = 56 H
[4] = 14 W
[5] = 75 B
[6] = 89 B
Yes, this shows them married twice (I got em in my file)
5. for class 4 records one possible way is:
seed could be:
Fathers Treetop
Mothers Treetop
ROOT FAM
when the ROOT FAM is reached for Father, end
when the ROOT FAM is reached for Mother, end
process ROOT FAM and descndants.
finish and process class 5s.
this is undoable in my current code because if I signal root fam for husb or root fam for wife, that 'leg' would stop all proceesing.
I am not slick when it comes to algorithms, and I am sure current code can be simplified,
6. I intend to order the families in a 'register-generational' like order. but a method should be included in the records so that i can sort in order of
all fathers records, generationally then all mothers records generationally, then all shared records genrationally.
*NB: in the output, where there is no partnership for an individual, they are not displayed, but the entry is in the famOBJ record.
I hope this has made sense, and/or has sparked some brilliant ideas.
PTG:
2 = fathers family SEQ starts at 0
3 = mothers family SEQ starts at 0
4 = descendants shared by mother and father SEQ starts at 0
5 = unlinked families and records. sequence SEQ starts at 0 (this is unfinished, and not of concern at this time, it needs work but fundamentals are there. class 5s are processed correctly)
I process father then mother seeds
what you will see is, once I have gotten to mother and fathers family record the descendants become mothers family. If I trigger the class 4, those unprocessed mothers family become 4s as well. So at present there are no class 4 records.
the program layout is:
32 que:enQ(ent)
37 que:deQ()
44 que:isNotEmpty()
48 que:isEmpty()
52 que.create()
63 que:reset() **not yet implemented**
87 local sltROOT()
94 local mat_spc_root()
130 local mat_file_root()
** materialize a program root and family, *NB: may be existing file root and family**e
164 local trim(str)
171 local trime(str)
178 local matNAM(iptr)
180 local rtvElemCount(varptr)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
**ignore all functions above this line, they all work correctly**
224 local rtv_FAM_pool(fptr)
** works, but not fully implemented, used only for class 5s**
234 local rtv_FAM_marr(fptr)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
**ignore above functions they all work correctly**
284 local rgz_anc_seeds()
**sifts out the oldest mother's and father's treetop only in the ancestors chain**
320 local rtv_anc_seeds(rcd, tag)
**main wrapper call to initialize recursion**
324 local rtv_anc_chain(rcd, tag)
**recursive get ancestors**
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
**these 'work' crrectly, but are not being used as intended**
**process root seed, to build 1 father and 1 mother treetop**
385 local enQtbl(ftbl)
**enqueue table of only FAMC, only FAMS, or both FAMC and FAMS records for processing**
395 local rtv_FAM_tbl(rcd, tag)
**build table of only FAMC, only FAMS, or both FAMC and FAMS records depending on tag**
425 local prc_Q()
**dequeue records produced by enQtbl or queued by the procedure itself as records are revealed**
521 local list_FAM()
** build and process root seed, to build mother and father treetops**
564 Order_FAM()
**when this becomes a working module within a program, this will be called to build the ordered family table.
---------------------------------------
What is dissatifying?
1. any descendant algorithm I can find does not include wife. I can see why, it is no longer a trivial exercise.
2. because I include otwife, and enqueue root wifes FAMC and FAM, the second seed is not read until after all the wifes records are processed, which are ignored because the records have all been hashed, but resulting in the root wifes tree being upside down.
3. FAMC and FAMS records need different processing. generation is -1 for FAMC and +1 for FAMS, additionally CHIL records generation must be +1
4. in order to actually order records I think I need a 'lining up function':
let's by convention give priority to Father records over Mother records (although realistically we can only be nearly absolutely sure of mother, only a couple cases where we cannot)
given a FAMC or FAMS of mother and father (father will be on left side)
let us consider a FAMS
[1] = 22 [1] = 14
[2] = 33 [2] = 75
[3] = 56 [3] = 89
[4] = 75
[5] = 89
the resulting FAMS order should be (I think)
[1] = 22 H
[2] = 33 H
[3] = 56 H
[4] = 14 W
[5] = 75 B
[6] = 89 B
Yes, this shows them married twice (I got em in my file)
5. for class 4 records one possible way is:
seed could be:
Fathers Treetop
Mothers Treetop
ROOT FAM
when the ROOT FAM is reached for Father, end
when the ROOT FAM is reached for Mother, end
process ROOT FAM and descndants.
finish and process class 5s.
this is undoable in my current code because if I signal root fam for husb or root fam for wife, that 'leg' would stop all proceesing.
I am not slick when it comes to algorithms, and I am sure current code can be simplified,
6. I intend to order the families in a 'register-generational' like order. but a method should be included in the records so that i can sort in order of
all fathers records, generationally then all mothers records generationally, then all shared records genrationally.
*NB: in the output, where there is no partnership for an individual, they are not displayed, but the entry is in the famOBJ record.
I hope this has made sense, and/or has sparked some brilliant ideas.
Code: Select all
-- _prf = require('_prf')
-- _prf.start('call')
-- require('_STD_HDR')
-- require('_STD_SYS')
local ipairs = ipairs
-- local pairs = pairs
local fhNewItemPtr = fhNewItemPtr
local fhGetItemPtr = fhGetItemPtr
local fhGetItemText = fhGetItemText
local fhGetValueAsLink = fhGetValueAsLink
local fhGetRecordId = fhGetRecordId
local fhNewDate = fhNewDate
local fhGetValueAsDate = fhGetValueAsDate
local fhGetTag = fhGetTag
local fhCallBuiltInFunction = fhCallBuiltInFunction
local fhMessageBox = fhMessageBox
local fhPromptUserForRecordSel = fhPromptUserForRecordSel
local famOBJ = {}
local SEQ = 0
local seed = {} -- selected root table
local uhash = {} -- setll unique hash for fam order
local rootfam = {}
local _ptyp -- pointer type
local _ptag -- pointer tag for linking
-- (next two lines used for compiling, it will be immediately discarded)
que = {}
que.__index = que
function que:enQ(ent)
self.q[self.tail] = ent
self.tail = self.tail + 1
end
function que:deQ()
if self.tail == self.head then return end
local ent = self.q[self.head]
self.head = self.head + 1
return ent
end
function que:isNotEmpty()
return self.tail ~= self.head
end
function que:isEmpty()
return self.tail == self.head
end
function que.create()
local _q = {}
setmetatable(_q, que)
_q.__index = _q
_q.head = 0
_q.tail = 0
_q.q = {nil}
_q.len = 0
return _q
end
function que:reset()
local _q = {}
setmetatable(_q, que)
_q.__index = _q
_q.head = 0
_q.tail = 0
_q.q = {nil}
_q.len = 0
return _q
end
local QFAM = que.create()
-- compiling done, discard
setmetatable(que, nil)
que = nil
-- str sltROOT variables
local WS_CANCEL = false
local WS_Cancel = 'Cancel'
local WS_ENTER = true
local WS_OK = 'OK'
local _slt = {}
-- end sltROOT variables
local function sltROOT()
_slt['_root'] =
{fn_key = '', _YROOT = '', _YFATHER = '', _YMOTHER = '', _YFAM = '', _CROOT = '', _CFATHER = '', _CMOTHER = '', _CFAM = ''}
local WS_RC
local function mat_spc_root()
local ptrFAM = fhGetItemPtr(_YROOT, '~.FAMC')
local lnkFAM = fhGetValueAsLink(ptrFAM)
if ptrFAM:IsNotNull() then
local lnkHUSB = fhGetItemPtr(lnkFAM, '~.HUSB[1]>')
local ptrHUSB = fhGetItemPtr(lnkFAM, '~.HUSB[2]>')
local lnkWIFE = fhGetItemPtr(lnkFAM, '~.WIFE[1]>')
local ptrWIFE = fhGetItemPtr(lnkFAM, '~.WIFE[2]>')
-- same sex male
if lnkHUSB:IsNotNull() and ptrHUSB:IsNotNull() then lnkWIFE = ptrHUSB end
-- same sex female
if lnkWIFE:IsNotNull() and ptrWIFE:IsNotNull() then lnkHUSB = lnkWIFE lnkWIFE = ptrWIFE end
_CROOT = fhGetRecordId(_YROOT)
_YFATHER = lnkHUSB
_CFATHER = fhGetRecordId(lnkHUSB)
_YMOTHER = lnkWIFE
_CMOTHER = fhGetRecordId(lnkWIFE)
_YFAM = lnkFAM
_CFAM = fhGetRecordId(lnkFAM)
_slt['_root'].fn_key = WS_ENTER
_slt['_root']._YROOT = _YROOT
_slt['_root']._YFATHER = lnkHUSB
_slt['_root']._YMOTHER = lnkWIFE
_slt['_root']._YFAM = lnkFAM
_slt['_root']._CROOT = _CROOT
_slt['_root']._CFATHER = _CFATHER
_slt['_root']._CMOTHER = _CMOTHER
_slt['_root']._CFAM = _CFAM
end
end -- fn mat_spc_root
-- if cancel key is pressed and there is a file root, ask to use it.
local function mat_file_root()
local txt
_YROOT = fhCallBuiltInFunction('FileRoot')
if _YROOT:IsNull()then
txt = 'File Root not set: plug-in requires a Root'
else
local fileroot = fhGetItemText(_YROOT, '~.NAME')
txt = ('Use File Root: %s'):format(fileroot)
end
WS_RC = fhMessageBox(txt, 'MB_OKCANCEL')
if WS_RC == WS_OK then
if _YROOT:IsNotNull()then
mat_spc_root()
else
sltROOT()
end
elseif WS_RC == WS_Cancel then
_slt['_root'].fn_key = WS_CANCEL
end
end -- fn mat_file_root
-- *ENTRY()
local _ = fhPromptUserForRecordSel('INDI', 1)
if #_ == 0 then
mat_file_root()
elseif #_ == 1 then
_YROOT = _[1]
mat_spc_root()
end
return _slt['_root']
end -- fn sltROOT
-- trim string internal and ends
local function trim(str)
str = tostring(str) or ''
if str == '' then return str end
return (str:gsub('^%s+', ''):gsub('%s+', ' '):gsub('%s+$', ''))
end -- fn trim
-- trim string ends
local function trime(str)
str = tostring(str) or ''
if str == '' then return str end
return (str:gsub('^%s+', ''):gsub(' *$', ''))
end -- fn trime
-- materialize combined name
local function matNAM(iptr)
local function rtvElemCount(varptr)
-- Count instances of varptr TAG
local eptr = varptr:Clone()
local elem = 0
while eptr:IsNotNull() do
elem = elem + 1
eptr:MoveNext('SAME_TAG')
end
return elem
end -- fn rtvElemCount
-- ENTRYPOINT matNAM()
_ptyp = type(iptr)
if _ptyp == 'userdata' then
_ptag = fhGetTag(iptr)
if _ptag ~= 'INDI' then
error(('_STD_MAT.matNAM: INDI ptr unresolved: %s TAG: %s'):format(tostring(iptr) or '*null', _ptag or '?'))
end
elseif _ptyp == 'number' then
local xptr = fhNewItemPtr()
xptr:MoveToRecordById('INDI', iptr)
iptr = xptr:Clone()
else
error(('_STD_MAT.matNAM: INDI ptr unresolved: %s TYPE: %s'):format(iptr or '*null', _ptyp or '?'))
end
local bNAM = ''
local nSFX = trim(fhGetItemText(iptr, '~.NAME.NSFX'))
local sNAM = trim(fhGetItemText(iptr, '~.NAME:SURNAME'))
local gNAM = fhGetItemText(iptr, '~.NAME:GIVEN_ALL')
local ptrWRK = fhNewItemPtr()
ptrWRK = fhGetItemPtr(iptr, '~.NAME')
local nc = rtvElemCount(ptrWRK)
if nc > 1 then
sNAM = fhGetItemText(iptr, ('~.NAME[%i]:SURNAME'):format(nc))
bNAM = (' (%s)'):format(trim(fhGetItemText(iptr, '~.NAME:SURNAME')))
end
if nSFX:match('Sr') then nSFX = (' %s'):format(nSFX) end
return trime(('%s%s, %s %s'):format(sNAM, bNAM, gNAM, nSFX))
end --fn matNAM
local function rtv_FAM_pool(fptr)
rtvptr = fhGetItemPtr(fptr, '~.HUSB>')
if rtvptr:IsNotNull() then return fhCallBuiltInFunction('RelationPool', rtvptr) end
rtvptr = fhGetItemPtr(fptr, '~.WIFE>')
if rtvptr:IsNotNull() then return fhCallBuiltInFunction('RelationPool', rtvptr) end
rtvptr = fhGetItemPtr(fptr, '.CHIL>')
if rtvptr:IsNotNull() then return fhCallBuiltInFunction('RelationPool', rtvptr) end
return
end
local function rtv_FAM_marr(fptr)
_ptyp = type(fptr)
if _ptyp == 'userdata' then
_ptag = fhGetTag(fptr)
if _ptag == 'FAMC'
or _ptag == 'FAMS' then
fptr = fhGetValueAsLink(fptr)
end
elseif _ptyp == 'number' then
local xptr = fhNewItemPtr()
xptr:MoveToRecordById('FAM', fptr)
fptr = xptr:Clone()
end
-- marriage date
local MDAT = ''
local mdat = ''
local mdptr = fhNewItemPtr()
mdptr = fhGetItemPtr(fptr, '~.MARR.DATE:COMPACT')
local fmdat = fhNewDate()
if mdptr:IsNotNull() then
-- formatted marriage date
fmdat = fhGetValueAsDate(mdptr)
MDAT = ((fmdat:GetDisplayText('COMPACT')) or '')
mdat = ((fmdat:GetValueAsText()) or '')
end
-- divorce date
local DDAT = ''
local ddat = ''
local ddptr = fhNewItemPtr()
ddptr = fhGetItemPtr(fptr, '~.DIV.DATE:COMPACT')
local dmdat = fhNewDate()
if ddptr:IsNotNull() then
-- formatted divorce date
dmdat = fhGetValueAsDate(ddptr)
DDAT = ((dmdat:GetDisplayText('COMPACT')) or '')
ddat = ((dmdat:GetValueAsText()) or '')
end
return
{
fID = fhGetRecordId(fptr),
MDAT = (MDAT or ''),
DDAT = (DDAT or ''),
}
end -- fn rtv_FAM_marr
-- reorganize _tbl (treetops table)
local function rgz_anc_seeds()
-- sort
-- 1. GEN: generation oldest first
-- 2. PTG: fathers line(2) before mothers line(3) if all else equal
-- 2. SEQ: males(2) before females(3)
table.sort(seed,
function(a, b)
if a.PTG == b.PTG then
if a.GEN == b.GEN then
return a.SEQ < b.SEQ
end
return a.GEN < b.GEN
end
return a.PTG < b.PTG
end
)
-- get one each greatest treetop father and greatest treetop mother (HUSB: PTG = 2, WIFE: PTG = 3)
local hash = {} -- hash table to produce unique families
local _tbl = seed -- temporary table holder
seed = {}
for _, rcd in pairs(_tbl) do
if not hash[rcd.PTG] then
seed[#seed + 1] = rcd
hash[rcd.PTG] = true
end
end
_tbl = {}
uhash = {}
hash = nil
return
end -- fn rgz_anc_seeds
-- _tbl: retrieve the tops of the FAM chain (no FAMC)
local function rtv_anc_seeds(rcd, tag)
local _tbl = {} -- unique treetops processing ancestors table
-- retrieve ancestor chain
local function rtv_anc_chain(rcd, tag)
-- ENTRYPOINT fn rtv_anc_chain()
local fptr = fhNewItemPtr()
local xptr = fhNewItemPtr()
xptr:MoveToRecordById('FAM', rcd.fID)
fptr = xptr:Clone()
local fID = fhGetRecordId(fptr)
-- start exception handling
-- same sex male
local lnkHUSB = fhNewItemPtr()
lnkHUSB = fhGetItemPtr(fptr, '~.HUSB[1]>')
local ptrHUSB = fhNewItemPtr()
ptrHUSB = fhGetItemPtr(fptr, '~.HUSB[2]>')
-- same sex female
local lnkWIFE = fhNewItemPtr()
lnkWIFE = fhGetItemPtr(fptr, '~.WIFE[1]>')
local ptrWIFE = fhNewItemPtr()
ptrWIFE = fhGetItemPtr(fptr, '~.WIFE[2]>')
if lnkHUSB:IsNotNull() and ptrHUSB:IsNotNull() then lnkWIFE = ptrHUSB end
if lnkWIFE:IsNotNull() and ptrWIFE:IsNotNull() then lnkHUSB = lnkWIFE lnkWIFE = ptrWIFE end
-- end exception handling
-- _tbl is the table of all ancestors of selected root
-- there are cases where the INDI ID and/or FAM ID can be multiples
if lnkHUSB:IsNotNull() then
if lnkHUSB:IsSame(_YFATHER) then rcd.PTG = 2 end
_tbl[#_tbl + 1] = {iID = fhGetRecordId(lnkHUSB), fID = fID, GEN = rcd.GEN, PTG = rcd.PTG, SEQ = '2'}
local que = _tbl[#_tbl]
que.fID = fhGetRecordId(fhGetValueAsLink(fhGetItemPtr(lnkHUSB, tag)))
que.GEN = que.GEN - 1
rtv_anc_chain(que, tag)
end
if lnkWIFE:IsNotNull() then
if lnkWIFE:IsSame(_YMOTHER) then rcd.PTG = 3 end
_tbl[#_tbl + 1] = {iID = fhGetRecordId(lnkWIFE), fID = fID, GEN = rcd.GEN, PTG = rcd.PTG, SEQ = '3'}
local que = _tbl[#_tbl]
que.fID = fhGetRecordId(fhGetValueAsLink(fhGetItemPtr(lnkWIFE, tag)))
que.GEN = que.GEN - 1
rtv_anc_chain(que, tag)
end
end -- fn rtv_anc_chain
-- function ENTRYPOINT rtv_anc_seeds
-- from a family pointer get HUSB and WIFE recursively
-- no need to get CHIL records since CHIL will be a: HUSB, WIFE, or dead end.
-- start chain: from this FAM tree all FAMC
rtv_anc_chain(rcd, tag)
-- sort and sift the table resulting in the root's: father's treetop and mother's treetop
seed = _tbl
_tbl = {}
rgz_anc_seeds()
end -- fn rtv_anc_seeds
-- enqueues unique FAMS and FAMC from rtv_FAM_tbl
local function enQtbl(ftbl)
for _, rcd in ipairs(ftbl) do
if not uhash[rcd.fID] then
QFAM:enQ(rcd)
uhash[rcd.fID] = true
end
end
end -- fn enQtbl
-- retrieves a table containing INDI FAMS and FAMC records
local function rtv_FAM_tbl(rcd, tag)
local xptr = fhNewItemPtr()
xptr:MoveToRecordById('INDI', rcd.iID)
local iptr = xptr:Clone()
local tagtbl = {}
if tag then
tagtbl = {[1] = tag,}
else
tagtbl = {[1] = '~.FAMC', [2] = '~.FAMS'}
end
local itbl = {}
local lnkFAM = fhNewItemPtr()
for k, _ in ipairs(tagtbl) do
local ptrFAM = fhGetItemPtr(iptr, tagtbl[k])
while ptrFAM:IsNotNull() do
lnkFAM = fhGetValueAsLink(ptrFAM)
local iID = fhGetRecordId(iptr)
local fID = fhGetRecordId(lnkFAM)
itbl[#itbl + 1] = {iID = iID, fID = fID, GEN = rcd.GEN, PTG = rcd.PTG}
ptrFAM:MoveNext('SAME_TAG')
end
end
return itbl
end -- fn rtv_FAM_tbl
-- reads the queue entries in order of descendants
local function prc_Q()
while QFAM:isNotEmpty() do
local rcd = QFAM:deQ()
local xptr = fhNewItemPtr()
xptr:MoveToRecordById('FAM', rcd.fID)
local ptrFAM = xptr:Clone()
-- same sex male
local lnkHUSB = fhNewItemPtr()
local ptrHUSB = fhNewItemPtr()
lnkHUSB = fhGetItemPtr(ptrFAM, '~.HUSB[1]>')
ptrHUSB = fhGetItemPtr(ptrFAM, '~.HUSB[2]>')
-- same sex female
local lnkWIFE = fhNewItemPtr()
local ptrWIFE = fhNewItemPtr()
lnkWIFE = fhGetItemPtr(ptrFAM, '~.WIFE[1]>')
ptrWIFE = fhGetItemPtr(ptrFAM, '~.WIFE[2]>')
if lnkHUSB:IsNotNull() and ptrHUSB:IsNotNull() then lnkWIFE = ptrHUSB end
if lnkWIFE:IsNotNull() and ptrWIFE:IsNotNull() then lnkHUSB = lnkWIFE lnkWIFE = ptrWIFE end
local HUSB = ''
local WIFE = ''
local HNAM = ''
local WNAM = ''
local cnn = ''
local _cs
-- and/or lnkHUSB:IsSame(_YFATHER) and lnkWIFE:IsSame(_YMOTHER)
if rcd.fID == _CFAM then
SEQ = 0
rcd.PTG = 4
end
if lnkWIFE:IsSame(_YMOTHER) then
SEQ = 0
rcd.PTG = 3
elseif lnkHUSB:IsSame(_YFATHER) then
SEQ = 0
rcd.PTG = 2
end
if lnkHUSB:IsNotNull() then
HNAM = matNAM(lnkHUSB)
HUSB = fhGetRecordId(lnkHUSB)
local que = {iID = HUSB, fID = rcd.fID, GEN = rcd.GEN, PTG = rcd.PTG}
enQtbl(rtv_FAM_tbl(que)) --** (rcd, tag))
end
if lnkWIFE:IsNotNull() then
WNAM = matNAM(lnkWIFE)
WIFE = fhGetRecordId(lnkWIFE)
local que = {iID = WIFE, fID = rcd.fID, GEN = rcd.GEN, PTG = rcd.PTG}
enQtbl(rtv_FAM_tbl(que)) --** (rcd, tag))
end
if (HNAM > '' and WNAM > '') then cnn = ' and ' end
local FAM = trim(('%s%s%s'):format(HNAM, cnn, WNAM))
_cs = rtv_FAM_marr(ptrFAM)
famOBJ[#famOBJ + 1] =
{
fID = _cs.fID, -- FAM rcd nbr
PTG = rcd.PTG, -- PTG
GEN = rcd.GEN, -- generation (not correct)
SEQ = SEQ, -- sequence
FAM = FAM, -- text
MDAT = _cs.MDAT, -- marriage date
DDAT = _cs.DDAT, -- divorce date
HUSB = HUSB, -- husband name
WIFE = WIFE, -- wife name
CHIL = {}, -- child array built immediately following
}
local lnkCHIL = fhNewItemPtr()
local ptrCHIL = fhNewItemPtr()
local cgen = famOBJ[#famOBJ].GEN + 1
lnkCHIL = fhGetItemPtr(ptrFAM, '~.CHIL')
while lnkCHIL:IsNotNull() do
ptrCHIL = fhGetValueAsLink(lnkCHIL)
local chil = fhGetRecordId(ptrCHIL)
-- object = famOBJ[#famOBJ].CHIL
-- local instance = #famOBJ[#famOBJ].CHIL
-- object[instance + 1] = chil
famOBJ[#famOBJ].CHIL[#famOBJ[#famOBJ].CHIL + 1] = chil
-- if fhGetItemPtr(ptrCHIL, '~.FAMS'):IsNotNull() then
rcd = {iID = chil, fID = 0, GEN = cgen, PTG = rcd.PTG}
enQtbl(rtv_FAM_tbl(rcd)) --** (rcd, tag))
-- end
lnkCHIL:MoveNext('SAME_TAG')
end
SEQ = SEQ + 1
end
return
end
local function list_FAM()
-- starter record for ancestors recursion
rootfam = {iID = fhGetRecordId(_YROOT), fID = fhGetRecordId(_YFAM), GEN = 0, PTG = 4}
local tag = '~.FAMC'
seed = rtv_FAM_tbl(rootfam, tag)
for _, rcd in ipairs(seed) do
rtv_anc_seeds(rcd, tag)
end
-- seed has 1 treetop for father and 1 treetop for mother
-- retrieve each treetops descendants by family, thus:
-- get their FAMC and FAMS if the FAM(x) is not in the index then:
-- add that FAM(x) to the unique index (uhash).
for _, rcd in ipairs(seed) do
enQtbl(rtv_FAM_tbl(rcd))
prc_Q()
end
-- read all FAM records and find missing FAM(s) (they are not in uhash)
-- will be stuck at the end of the unique index ordering. In my tests, missing FAM records are those not in pool 1 this will be improved once the rest of the ordering is correct.
seed = {}
SEQ = 0
local fptr = fhNewItemPtr()
fptr:MoveToFirstRecord('FAM')
while fptr:IsNotNull() do
local fID = fhGetRecordId(fptr)
if not uhash[fID] then
seed[#seed + 1] = {fID = fID, GEN = 5, PTG = 5, SEQ = rtv_FAM_pool(fptr)}
-- SEQ = SEQ + 1
uhash[fID] = true
end
fptr:MoveNext('SAME_TAG')
end
for _, rcd in ipairs(seed) do
QFAM:enQ(rcd)
prc_Q()
end
return
end -- fn get_fam
-- MAIN()
-- *ENTRY()
function Order_FAM()
local _ro = sltROOT()
if _ro.fn_key == WS_CANCEL then return end
list_FAM()
--[[
table.sort(famOBJ,
function(a, b)
if a.PTG == b.PTG then
if a.GEN == b.GEN then
return a.SEQ < b.SEQ
end
return a.GEN < b.GEN
end
return a.PTG < b.PTG
end
)
]]
return
end
Order_FAM()
-- return famOBJ
-- end of module
-- _prf.stop()
-- _prf.report()
local tblK = {}
local tblfID = {}
local tblPTG = {}
local tblGEN = {}
local tblSEQ = {}
local tblFAM = {}
for k, _ in ipairs(famOBJ) do
local t = famOBJ[k]
local fid = t.fID
local ptg = t.PTG
local gen = t.GEN
local seq = t.SEQ
local fam = t.FAM
table.insert(tblK, k)
table.insert(tblfID, fid)
table.insert(tblPTG, ptg)
table.insert(tblGEN, gen)
table.insert(tblSEQ, seq)
table.insert(tblFAM, fam)
end
fhOutputResultSetColumn('ord', 'integer', tblK, #tblK, 48, 'align_right')
fhOutputResultSetColumn('fID', 'integer', tblfID, #tblfID, 36, 'align_right')
fhOutputResultSetColumn('ptg', 'integer', tblPTG, #tblPTG, 36, 'align_right', 1)
fhOutputResultSetColumn('gen', 'integer', tblGEN, #tblGEN, 36, 'align_right', 2)
fhOutputResultSetColumn('seq', 'integer', tblSEQ, #tblSEQ, 36, 'align_right', 3)
fhOutputResultSetColumn('FAM', 'text', tblFAM, #tblFAM, 320)
return