/*
partition - a LifeLines database partitioning program
        by Jim Eggert (eggertj@atc.ll.mit.edu)
        Version 1,  19 November 1992 (unreleased)
        Version 2,  20 November 1992 (completely revamped using queues)
        Version 3,  23 November 1992 (added GEDCOM TRLR line,
                                        changed to key-based queues)
        Version 4,   1 December 1992 (slight code updates)
        Version 5,   9 January  1993 (added birth and death dates to full)
        Version 6,  30 January  1993 (now writes multiple GEDCOM output files)
                This version requires LifeLines v2.3.3 or later.

This program partitions individuals in a database into disjoint
partitions.  Each partition is composed of people related by one or
more multiples of the following relations: parent, sibling, child,
spouse.  There is no known relationship between people in different
partitions.  The partitions are written to the report in overview
form or full form with the partitions delimited by a
------------------------------------------------------------
long line, or in GEDCOM form to separate partition files.  The
overview form merely lists the number of people in each partition by
the number of hops from the first person found in the partition.
(They are found in order of the forindi iterator.)  The full form
lists each person in each partition, giving the number of hops, key,
name, and birth and death dates (if known).  The GEDCOM form writes
the partitions in GEDCOM format.  You will be prompted for a root
filename for the GEDCOM files; individual GEDCOM filenames will be of
the form root_filename.p, where p is the partition number.

Each allowed relationship (parent, sibling, child, spouse) is called a
hop, and the degree of relationship is called the hop count.  While
the program is processing, it displays to the screen the number of the
partition it is working on followed by a colon, then the cumulative
number of individuals in that partition for each hop increment.

*/

global(include_new)
global(plist)
global(hlist)
global(mark)
global(pset)
global(pcount)

proc include(person,hops,setcount,report_type)
{
    if (person) {
        set(pkey,key(person))
        if (lookup(mark,pkey)) {
            set(include_new,0)
        }
        else {
            enqueue(plist,save(pkey))
            enqueue(hlist,hops)
            insert(mark,save(pkey),setcount)
            addtoset(pset,person,hops)
            set(pcount,add(pcount,1))
            set(include_new,1)
            if (eq(report_type,1)) {
                d(setcount) col(6) d(hops)
                col(11) pkey col(18) name(person)
                col(48) stddate(birth(person))
                col(62) stddate(death(person)) "\n"
            }
        }
    }
}

proc main ()
{
    table(mark)
    list(plist)
    list(hlist)
    indiset(pset)

    dayformat(0)
    monthformat(4)
    dateformat(0)

    getintmsg(report_type,
        "Enter 0 for overview, 1 for full, 2 for GEDCOM report:")
    if (eq(report_type,2)) {
        getstrmsg(gedcom_root,"Enter root filename for GEDCOM partitions:")
        set(gedcom_root,save(concat(gedcom_root,".")))
    }
    set(setcount,1)
    set(pcount,0)
    set(hopcount,0)
    set(prev_hopcount,neg(1))
    set(prev_pcount,0)
    set(cumcount,0)
    if (eq(report_type,1)) {
        "Ptn  Hops Key    Person"
        col(48) "Birthdate" col(62) "Deathdate\n"
    }
    forindi(person,num) {
        call include(person,hopcount,setcount,report_type)
        if (include_new) {
            if (eq(report_type,0)) {
                "Ptn  Hops Individuals\n"
            }
            print("\n") print(d(setcount)) print(": ")
            while (pkey,dequeue(plist)) {
                set(person,indi(pkey))
                set(hopcount,dequeue(hlist))
                if (ne(hopcount,prev_hopcount)) {
                    print(d(pcount)) print(" ")
                    if (eq(report_type,0)) {
                        d(setcount) col(6) d(hopcount)
                        col(11) d(sub(pcount,prev_pcount)) "\n"
                    }
                    set(prev_pcount,pcount)
                    set(prev_hopcount,hopcount)
                }
                set(hopcount,add(hopcount,1))
                call include(father(person),hopcount,setcount,report_type)
                call include(mother(person),hopcount,setcount,report_type)
                children(parents(person),sibling,snum) {
                    call include(sibling,hopcount,setcount,report_type)
                }
                families(person,fam,spouse,pnum) {
                    call include(spouse,hopcount,setcount,report_type)
                    children(fam,child,cnum) {
                        call include(child,hopcount,setcount,report_type)
                    }
                }
            }
            if (le(report_type,1)) {
                "Partition " d(setcount) " contains " d(pcount)
                " individual"
                if (gt(pcount,1)) { "s" }
                ".\n"
            "------------------------------------------------------------\n"
            }
            if (eq(report_type,2)) {
                newfile(concat(gedcom_root,d(setcount)),0)
                gengedcom(pset)
                "0 TRLR\n"
            }
            set(cumcount,add(cumcount,pcount))
            indiset(pset)
            set(pcount,0)
            set(hopcount,0)
            set(prev_hopcount,neg(1))
            set(prev_pcount,pcount)
            set(setcount,add(setcount,1))
        }
    }
    if (le(report_type,1)) {
        "Entire database contains " d(num) " individual"
        if (gt(num,1)) { "s" }
        " in " d(sub(setcount,1)) " partition"
        if (gt(setcount,2)) { "s" }
        ".\n"
    }
}

