/*

alive - a LifeLines report program for finding live people

This finds who in the database, or among ancestors or descendants of
an individual, was likely alive in a certain year.  Good for looking at
population snapshots like censuses, tax rolls, etc.

Version 1, 13 July 1994, by Jim Eggert, eggertj@ll.mit.edu
Version 2, 14 July 1994, by Jim Eggert, fixed bug in estimate_byear
Version 3, 22 July 1994, by Jim Eggert, fixed another bug in estimate_byear,
                                        minor format improvement

*/

global(byear)
global(byear_delta)
global(byear_est)
global(byear_est_delta)
global(dyear_est)
global(dyear_est_delta)
global(old_age)
global(maximum_age)
global(mother_age)
global(father_age)
global(years_between_kids)
global(first_person)
global(who)
global(of)

proc main() {
    /* Assumptions for guessing year of birth */
    set(old_age,60)     /* assumed age at death */
    set(maximum_age,120)/* maximum possible age */
    set(mother_age,23)  /* assumed age of first motherhood */
    set(father_age,25)  /* assumed age of first fatherhood */
    set(years_between_kids,2) /* assumed years between children */

    indiset(people)
    set(first_person,1)

    getintmsg(who,
        "Find live persons (0=all, 1=desc, 2=desc and spouses, 3=anc) ")
    if (who) { getindimsg(of,"of ") }
    getintmsg(when,"alive in which year?")

    if (eq(who,0)) {
        forindi(person,pnum) {
            call alive(person,when)
        }
    }
    else {
        addtoset(people,of,0)
        if (or(eq(who,1),eq(who,2))) { set(people,descendentset(people)) }
        elsif (eq(who,3)) { set(people,ancestorset(people)) }
        addtoset(people,of,0)
        if (eq(who,2)) { set(people,union(people,spouseset(people))) }
        forindiset(people,person,pval,pnum) {
            call alive(person,when)
        }
    }
}

proc print_person(person) {
    key(person)
    col(9) fullname(person,0,1,50)
    col(61) "("
    if (gt(byear_est_delta,1)) { "c" }
    d(byear_est)
    "-"
    if (gt(dyear_est_delta,1)) { "c" }
    d(dyear_est)
    ")\n"
}

proc print_header(year) {
    set(current_year,d(year(gettoday())))
    if (ge(year,current_year)) { set(future,1) } else { set(future,0) }

  "________________________________________________________________________\n"
    "List of "
    if (eq(who,0)) { "all persons" }
    elsif (or(eq(who,1),eq(who,2))) { "descendants" }
    elsif (eq(who,3)) { "ancestors" }
    if (ge(who,1)) { " of\n" key(of) " " fullname(of,0,1,70) "\n" }
    else { " " }
    if (eq(who,2)) { "and their spouses" }
    if (future) { "who are likely to be" }
    else { "who are likely to have been" }
    " alive in " d(year) "\n\n"
  "________________________________________________________________________\n"
    "Key" col(9) "Name" col(61) "(born-died)\n"
  "________________________________________________________________________\n"
}

proc alive(person,year) {
    set(dyear_est,0)
    call estimate_byear(person)
    if (byear_est) {
        if (and(le(byear_est,add(year,byear_est_delta)),
                gt(byear_est,sub(year,maximum_age)))) {
            set(dyear_est,atoi(year(death(person))))
            if (not(dyear_est)) {
                set(dyear_est,atoi(year(burial(person))))
            }
            else { set(dyear_est_delta,0) }
            if (not(dyear_est)) {
                set(dyear_est,add(byear_est,old_age))
                set(dyear_est_delta,20)
            }
            else { set(dyear_est_delta,1) }
            if (ge(dyear_est,year)) {
                if (first_person) {
                    call print_header(year)
                    set(first_person,0)
                }
                call print_person(person)
            }
        }
    }
}

proc estimate_byear(person) {
    set(byear_est,0)
    set(byear_est_delta,neg(1))
    call get_byear(person)
    if (byear) {
        set(byear_est,byear)
        set(byear_est_delta,byear_delta)
    }
    else { /* estimate from siblings */
        set(older,person)
        set(younger,person)
        set(yeardiff,0)
        set(border,0)
        set(this_uncertainty,1)
        while (and(not(byear_est),or(older,younger))) {
            set(older,prevsib(older))
            set(younger,nextsib(younger))
            set(yeardiff,add(yeardiff,years_between_kids))
            set(this_uncertainty,add(this_uncertainty,1))
            if (older) {
                set(border,add(border,1))
                call get_byear(older)
                if (byear) {
                    set(byear_est,add(byear,yeardiff))
                    set(byear_est_delta,this_uncertainty)
                }
            }
            if (and(not(byear_est),younger))  {
                call get_byear(younger)
                if (byear) {
                    set(byear_est,sub(byear,yeardiff))
                    set(byear_est_delta,this_uncertainty)
                }
            }
        }
    }
    if (not(byear_est)) { /* estimate from parents' marriage */
        if (m,marriage(parents(person))) { extractdate(m,bd,bm,my) }
        if (my) {
            set(byear_est,add(add(my,mul(years_between_kids,border)),1))
            set(byear_est_delta,add(border,1))
        }
    }
    if (not(byear_est)) { /* estimate from first marriage */
        families(person,fam,spouse,fnum) {
            if (eq(fnum,1)) {
                if (m,marriage(fam)) { extractdate(m,bd,bm,my) }
                if (my) {
                    if (female(person)) { set(byear_est,sub(my,mother_age)) }
                    else { set(byear_est,sub(my,father_age)) }
                    set(byear_est_delta,5)
                }
                else {
                    children(fam,child,cnum) {
                        if (not(byear_est)) {
                            call get_byear(child)
                            if (byear) {
                                if (female(person)) {
                                set(byear_est,sub(sub(byear,
                                        mul(sub(cnum,1),years_between_kids)),
                                        mother_age))
                                }
                                else {
                                set(byear_est,sub(sub(byear,
                                        mul(sub(cnum,1),years_between_kids)),
                                        father_age))
                                }
                                set(byear_est_delta,add(5,cnum))
                            }
                        }
                    }
                }
            }
        }
    }
    if (not(byear_est)) { /* estimate from parents' birthyear */
        call get_byear(mother(person))
        if (byear) {
            set(byear_est,add(byear,mother_age))
        }
        else {
            call get_byear(father(person))
            if (byear) {
                set(byear_est,add(byear,father_age))
            }
        }
        if (byear) {
            set(byear_est_delta,5)
            set(older,person)
            while(older,prevsib(older)) {
                set(byear_est,add(byear_est,years_between_kids))
                set(byear_est_delta,add(byear_est_delta,1))
            }
        }
    }
}

proc get_byear(person) {
    set(byear,0)
    if (person) {
        if (b,birth(person)) { extractdate(b,day,month,byear) }
        if (byear) {
            set(byear_delta,0)
            set(dstring,trim(date(b),3))
            if (not(strcmp(dstring,"BEF"))) { set(byear_delta,3) }
            elsif (not(strcmp(dstring,"AFT"))) { set(byear_delta,3) }
            elsif (not(strcmp(dstring,"ABT"))) { set(byear_delta,2) }
        }
        else {
            if (b,baptism(person)) { extractdate(b,day,month,byear) }
            if (byear) {
                set(byear_delta,1)
                set(dstring,trim(date(b),3))
                if (not(strcmp(dstring,"BEF"))) { set(byear_delta,3) }
                elsif (not(strcmp(dstring,"AFT"))) { set(byear_delta,3) }
                elsif (not(strcmp(dstring,"ABT"))) { set(byear_delta,2) }
            }
        }
    }
}
