How Many Ancestors does a Briton have

How Many Ancestors does a Briton have preview image

1 collaborator

Me Ian Heath (Author)

Tags

(This model has yet to be categorized with any tags)
Visible to everyone | Changeable by the author
Model was written in NetLogo 6.0.2 • Viewed 228 times • Downloaded 39 times • Run 0 times
Download the 'How Many Ancestors does a Briton have' modelDownload this modelEmbed this model

Do you have questions or comments about this model? Ask them here! (You'll first need to log in.)


Purpose

The purpose of this model is to estimate the number of your ancestors in each previous generation, where "you" are taken to represent a typical person that is indigenous to England and Wales.

For an overview of the reason for this model, how it works and how it advances the state of the art in ancestor estimation, see the accompanying paper to this model here https://www.researchgate.net/publication/323757098

Generations

In order to date Generations we use a generation interval of GenYears, which we assume is 30 years. This generation length of 30 years is based on an average maternity age of 29 and paternity age of 33, rounded to 30 to fit in with our quinquennial marriage data source.

The generations are indexed by the global variable Gen, counting backwards through time, starting with Gen0 for the generation born post-1966. Gen 1 is the generation born 1937-1966, and so on. If "You" declare you were born post-1966, then we trace back through the generations starting at Gen0, else we start at Gen1. The reason for starting generations 6 years after the start of a decade is because childbirth occurs 6 years after marriage, on average, and we use marriage data to determine the ceiling on the number of parents in each generation.

Estimating the # Ancestors by iteratively doubling lineages and calculating their confluence

We estimate #(short-hand for "the number of") Ancestors by tracing back through the generations. Each Ancestor has exactly 2 parents in its parental generation. However, as we proceed further back through the generations we inevitably encounter "genealogical coalescence" (aka "pedigree collapse"). The whole point of this model is estimate the distinct coalesced ancestors. The key to this estimation is the realisation that the # Ancestors in each generation is limited by the # Parents in that generation.

Estimating #Parents in each generation

We can assume that the #Parents is approximately double the #Marriages, as there were few unmarried parents in earlier more-religious generations (and their incidence in recent generations is insignificant anyway, as there is almost zero lineage confluence until we get back to the 18th Century).

We then adjust for childless marriages and remarriages, to get:

#Parents = 2*(# fertile marriages - % of remarriages)

Formula for #Ancestors based on the # in the children's generation

Clearly,

#Ancestors in any generation = # distinct parents of Ancestors in the children's generation

Assuming that that these parents are randomly picked from all parents in this generation, we deduce:

#Ancestors = #Parents*(1-(1-1/#Parents)^Picks)
   where Picks = 2*(#Ancestors in the children's generation)

This is based on a general formula for # distinct random Picks from a finite pool.

NonExtincts

We also estimate all non-extinct parents in each generation, i.e. all those who have at least one descendant in E&W today. We call these the NonExtincts and calculate them using a similar formula for the # distinct random picks, as follows:

#NonExtincts = #Parents*(1-(1-1/#Parents)^Picks) 
   where Picks = 2*(#NonExtincts in the children's generation)

Immigration

Finally, we adjust for Immigration. This reduces the Picks in the formula for Ancestors to:

NonImmigrantPicks = 2*Ancestors*(1-Immigrant%/100)
   where Immigrant% = % of new Immigrants in the children's generation

and reduces the Picks in the formula for #NonExtincts to:

NonImmigrantPicks = 2*NonExtincts*(1-Immigrant%/100)

Pooling

So far we have assumed that Picks are entirely random across Parents. However, in reality, Picks are proximity-weighted, as parents are closer than random to their children. We implement this as an alternative method alongside pure randomisation for comparison.

This method is labelled "Pooled" in the Interface and is a stochastic simulation, unlike the deterministic calculation of pure randomisation for "unPooled". The "Pooled" simulation gives slightly varying plots, which can be easily seen by repeating the Pooled plots by clicking SetPooled and goPooled again.

We represent this proximity gravitation in a Netlogo World with patches representing parishes, or the uninhabited green space between parishes. We assume that 50% of parents come from the same parish (based on demographic data for recent generations), and that the other 50% are scattered using proximity-weighted randomisation. The parish of each parent is selected by a proximity-weighted random pick, which is implemented by randomly picking a parish from within a proximity-weighted random radius of the child's parish.

Patch data

As just described, patches represent Parishes and the uninhabited green space between them. Parishes are assumed to contain a # Parents (= the total # Parents divided equally between the parishes).

Patches have own-variables Hits and Picks, where:

  • Hits holds the simulated # distinct Ancestors in that patch, and
  • Picks holds the simulated # non-distinct Parent picks scattered to that patch, 2 for every Hit in the children's Gen.

Color coding of patches:

  • Uninhabited green space between parishes are green
  • Parishes with no Hits are Black
  • Parishes with some Hits are White

Data Sources

GenYears:
International Society of Genetic Genealogy Conclusions show GenYears has remained remarkably constant, as far back as the medieval ages.
Marital ages in ONS - Marriages in England and Wales

Marriages:
"C:\Users\ianjh\NetLogo\Ancestors\Marriages by Gen.xlsx"
1871-1961: ONS - Annual UK figures for births, deaths, marriages etc
1541-1871: "CAMPOP PopEsts.EPHFR.xlsx" data extracted from Wrigley et al (1997), kindly supplied by The Cambridge Group for the History of Population and Social Structure.

Remarriage%:
1841-1951: ONS - Age and previous marital status at marriage
1541: Wrigley & Schofield, The Population History of England 1541-1871, p 259

%MarriagesInfertile:
English Population History from Family Reconstitution 1580-1837, Wrigley at al,
p 384, table 7.11 "Entry sterility: batchelor/spinster completed marriages".

Immigrant%:
1851-1911: VisionofBritain - Persons Born in the several parts of the UK and elsewhere

#Parishes:
1831-present: "C:\Users\ianjh\NetLogo\Ancestors\VoB#Parishes from VoB.xlsx" VisionofBritain nCube : Total Population
1560-1820: TheClergyDatabase Advanced Search

%ParentHere:
Migration and Mobility in Britain from the Eighteenth to the Twentieth Centuries, Pooley and Turnbull (1996)

%ParentInSameCounty:
"C:\Users\ianjh\NetLogo\Ancestors\1881 BornInCounty%.xlsx"
Southall, H.R. and Ell, P. Great Britain Historical Database: Census Data: Migration Statistics, 1851-1951

HOW TO CITE

If you mention this model in a publication, please attribute it as follows.

Creative Commons Licence
How Many Ancestors Do You Have? by Ian J Heath is licensed under a Creative Commons Attribution-NonCommercial 4.0 International License http://creativecommons.org/licenses/by-nc/4.0

Comments and Questions

Please start the discussion about this model! (You'll first need to log in.)

Click to Run Model

;; Model the # of your Ancestors according to the random selection of parents of your Ancestors out of the Parents, by random selection out of:
;;    (a: unPooled) - the totality of Parents, and
;;    (b: Pooled)   - individual parishes selected by their proximity to the parish of the child

patches-own [
  Hits                       ;; #distinct picked Ancestors out of Parents in this parish
  Picks                      ;; #picks out of Parents in this parish (resulting from the scattering of 2*Hits picks from across all Parishes in the children's Gen). Made integral when applied in SetPicks.
]

globals [
  ;; Interface Inputs:
  ;#Gens                     ;; # Gens to trace back
  ;%MarriagesInfertile       ;; % of marriages that are childless. Default = 10% (just a guess)
  ;Trace                     ;; Switch to trace monitors for each Gen

  GenYears                   ;; Generation interval of 30 years.  The average age at childbirth.
  Gen                        ;; generation (counting backwards, starting with 0 for the current Gen if you were born after 1966, else starting at 1)
  GenStartYearList           ;; List by Gen of start year of each birth generation. This is made negative so that it increases from left-right on the plot x-axis (to get around a limitation of NetLogo)
  Marriages                  ;; # marriages in a Gen in E&W
  MarriagesList              ;; List by Gen of #marriages
  Parents                    ;; # Parents in a Gen  (note: calculated from Marriages, assuming all parents are married, which was generally true in more-religious times)
  ParentsList                ;; List by Gen of # Parents
  NonExtincts                ;; # non-extinct Parents in a Gen, i.e. Ancestors in E&W of everyone in E&W today
  NonExtinctsList            ;; List by Gen of NonExtincts
  Immigrant%                 ;; average across all Gens of Immigrant% into E&W (mostly from Ireland and Scotland). Used in SetNonExtinctsList, SetAncestors, SetPicks.
  Ancestors                  ;; # Ancestors in E&W, unPooled
  ImmigratedAncestors        ;; Total Ancestors that immigrated across the Gens (note: this is cumulated across all Gens, and does not include Foreign ancestors of 1st generation immigrants)

  ;; For Pooled (by Parishes and their proximity) only:
  secs                       ;; for timing Pooled runs (mostly for WeightedParishPick)
  Run#                       ;; # of pooled runs
  ImmigratedAncestorsPooled  ;; Total Pooled Ancestors that immigrated across the Gens (similar to unPooled ImmigratedAncestors)
  Parishes                   ;; black and white patches representing Parishes
  #Parishes                  ;; This decreases in each successive earlier Gen by a factor = (decrease in Marriages in that Gen relative to the later Gen)^MarriagesDecreaseExponent
  ParentsPerParish           ;; # Parents averaged across all parishes. Used as the pool size for Picks within each parish
  ProximityParameter         ;; Proximity parameter to fit %ParentHere, #Parishes and their distribution
  %ParentHere                ;; % chance a Parent married in same Parish as the child.  Dependent on World size, #Parishes and ProximityParameter.  Note that it increases in earlier Gens due to Parishes becoming sparser
  TargetOf1                  ;; converges to 1 when iteratively set to (sumParishProximity*%ParentHere/100) in SetProximityParameterBy%ParentHere, because %ParentHere = 100/sumParishProximity
  sumWeights                 ;; sum of Weights within the largest radius (note: not all patches)
  Win-radiusList             ;; sum of Weights within each digital radius
  AncestorsPooled            ;; # Ancestors with pooling in E&W (output only)
  %ParishesWithAncestors     ;; %Parishes with any of Ancestors (output only)
]

to Setup   ;; Called by user and SetupPooled
  print  "***"               ;; to delineate runs
  clear-all
  set GenYears 30            ;; based on maternity/paternity ages

  ;; Date the Gens. Note: we use data for parents' marriage generations in our calculations but we always present birth generations to the user.
  let Year0 1967             ;; Start year of Gen0, the first birth generation. Their corresponding parents' marriage generation is 1961-1990.
  set GenStartYearList n-values #Gens [? -> (GenYears * ?) - Year0]  ;; note: they are negative in order to increase from left to right on the plot x-axis (to overcome a restriction of NetLogo)

  ;; Initialise lists by Gen
  SetMarriagesList           ;; Set list by Gen of Marriages
  set ParentsList            (map [[m r] -> 2 * m *(1 - r / 100) * (1 - %MarriagesInfertile / 100)] MarriagesList Remarriage%List)  ;; 2 * (marriages - remarriages - InfertileMarriages)    Note: ignoring unmarried parents
  set Immigrant%  3          ;; based on average of 4.1% for 1851-1911 and the expectation that it will be less prior to this
  SetNonExtinctsList         ;; Set list by Gen of NonExtincts

  ;; set outputs for your parents' generation, Gen 0 or Gen 1, depending on whether you were BornAfter1966
  set Gen                 ifelse-value BornAfter1966? [0] [1] ;; your birth generation
  set Ancestors           1                                   ;; you
  set ImmigratedAncestors 0
  set Parents             item Gen ParentsList                ;; the # Parents in your parents' marriage Gen.  Only required to plot an initial non-zero point, equal to the next point
  set NonExtincts         item Gen NonExtinctsList            ;; = Parents

  ;; setup plot
  set-plot-x-range (first GenStartYearList)  (last GenStartYearList)
  set-plot-y-range 0 ifelse-value (#Gens > 17) [2000000][80000]
  update-plots                                                ;; plot the initial unPooled points
end 

to go  ;; Called by user
  if Gen + 1 >= #Gens [stop] ;; stop after the last Gen
  set Gen Gen + 1

  set Parents             item Gen ParentsList
  set NonExtincts         item Gen NonExtinctsList
  SetAncestors               ;; Set Ancestors, excl. immigrants, and cumulate ImmigratedAncestors
  update-plots

  if Trace [                 ;; print monitors in each Gen Trace
    let Ancestors%NonExtincts 100 * Ancestors / Parents
    print (word
      "Gen = "                     substring (word Gen                               "      ") 0 2
      "  Parents = "               substring (word round Parents                     "      ") 0 8
      "  NonExtincts = "           substring (word round NonExtincts                 "      ") 0 8
      "  Ancestors = "             substring (word round Ancestors                   "      ") 0 7
      "  Ancestors%NonExtincts = " substring (word precision Ancestors%NonExtincts 2 "      ") 0 5
  )]
end 

to SetAncestors ;; Set Ancestors, excl. immigrants, and cumulate ImmigratedAncestors.  Called by go and goPooled
  let lPicks              2 * Ancestors
  let ImmigrantAncs       lPicks * Immigrant% / 100
  set ImmigratedAncestors ImmigrantAncs + ImmigratedAncestors ;; Cumulate ImmigratedAncestors for this Gen.  Note: we do not cumulate ancestors of immigrated ancestors (as they are too difficult to estimate and not of much interest)
  let NonImmigrantPicks   lPicks - ImmigrantAncs
  set Parents             item Gen ParentsList
  set Ancestors           ifelse-value (Gen = 1) [2] [Parents * (1 - (1 - 1 / Parents) ^ NonImmigrantPicks)] ;; # distinct Ancestors when making NonImmigrantPicks random picks from a pool of size Parents
end 

to SetMarriagesList          ;; Initialise MarriagesList. Used to estimate #Parents in each Gen (ignoring unmarried parents). Called by Setup
  set MarriagesList [        ;; Data copied from "Marriages by Gen.xlsx" for E&W
    11045925  ;; 1961-1990   Gen 0  The generation in which your parents were married, if you were     BornAfter1966
    10765634  ;; 1931-1960   Gen 1  The generation in which your parents were married, if you were not BornAfter1966
    8741190   ;; 1901-       Gen 2
    6402076   ;; 1871-       Gen 3  (for 1881 census)
    4766844   ;; 1841-       Gen 4
    3112089   ;; 1811-       Gen 5
    2211846   ;; 1781-       Gen 6
    1796616   ;; 1751-       Gen 7
    1557547   ;; 1721-       Gen 8
    1292386   ;; 1691-       Gen 9
    1203037   ;; 1661-       Gen 10
    1339099   ;; 1631-       Gen 11
    1235352   ;; 1601-       Gen 12
    1158028   ;; 1571-       Gen 13
    1101507   ;; 1541-       Gen 14
    842659    ;; 1511-       Gen 15
    719918    ;; 1481-       Gen 16
    657588    ;; 1451-       Gen 17
    649670    ;; 1421-       Gen 18 (Black Death pinch point)
    706478    ;; 1391-       Gen 19
    792849    ;; 1361-       Gen 20
    1044416   ;; 1331-       Gen 21
    1372791   ;; 1301-       Gen 22
    1493844   ;; 1271-       Gen 23
    1427854   ;; 1241-       Gen 24
    1296865   ;; 1211-       Gen 25
    1103467   ;; 1181-       Gen 26
    917004    ;; 1151-       Gen 27
    784708    ;; 1121-       Gen 28
    652411    ;; 1091-       Gen 29
    575238    ;; 1061-       Gen 30 (Norman Conquest)
  ]
  ;; pad out list with 500,000 to #Gens
  if #Gens > length MarriagesList [set MarriagesList sentence MarriagesList n-values (#Gens - length MarriagesList) [500000]]
end 

to SetNonExtinctsList        ;; Set List by Gen of Ancestors in E&W of everyone in E&W today (or in Gen 1). Called by Setup
  ;; start the list with Gen0 (and Gen1, if BornAfter1966?)
  set NonExtincts            item 0 ParentsList                                    ;; the current Parental population i.e. the assumed current population of midlife generation (age 30-59). Not all ages, as only counting non-removed cousins
  set NonExtinctsList        (list NonExtincts)                                    ;; start the list
  if not BornAfter1966? [                                                          ;; if born before 1966, set first 2 Gens
    set NonExtincts          item 1 ParentsList                                    ;; the current Parental population scaled to Gen1 by the Marriages ratio
    set NonExtinctsList      lput NonExtincts NonExtinctsList                      ;; start the list with Gen0 and Gen1
  ]

  let lGen length            NonExtinctsList                                       ;; 1 or 2, depending on whether BornAfter1966?
  let lImmigrant%            0                                                     ;; Gen1 (or Gen2) Ancestors and NonExtincts are not immigrants, as we assume Brit is not a child of immigrants
   repeat #Gens - lGen
  [ let NonImmigrantPicks    2 * NonExtincts * (1 - lImmigrant% / 100)             ;; parents of nonImmigrant NonExtincts
    set Parents              item lGen ParentsList   ;; # Parents  for this Gen
    set NonExtincts          Parents * (1 - (1 - 1 / Parents) ^ NonImmigrantPicks) ;; # distict picks from Parents
    set NonExtinctsList      lput NonExtincts NonExtinctsList                      ;; append the list
    set lGen lGen + 1
    set lImmigrant%          Immigrant%
  ]
end 

to-report Remarriage%List    ;; Report Remarriage% list of %Marriages that are Remarriages. Called by Setup
                             ;; The first 4 Gens are derived from https://www.ons.gov.uk/peoplepopulationandcommunity/birthsdeathsandmarriages/marriagecohabitationandcivilpartnerships/datasets/ageandpreviousmaritalstatusatmarriage

  let %Gen1  8.715339567     ;; Remarriage% of Marriages for 1931-1961
  let %Gen2  7.37811024      ;; Remarriage% of Marriages for 1901-1931
  let %Gen3  8.679078133     ;; Remarriage% of Marriages for 1871-1901
  let %Gen4  9.110858924     ;; Remarriage% of Marriages for 1841-1871

  let %Gen14 30              ;; Remarriage% of Marriages for 1541-1571  (Ref: Wrigley & Schofield, The Population History of England 1541-1871, page 259)
  let increment (%Gen14 - %Gen4)/ 10 ;; linear increment
  report (sentence %Gen1 %Gen1 %Gen2 %Gen3 n-values (length MarriagesList  - 4) [? -> min list 30 (%Gen4 + increment * ?)]) ;; assume it increases to 30%  in Gen14 then stays constant
end 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Following is for Pooled (and including unPooled data in the monitors and Trace)

to SetupPooled    ;; setup Pooled simulation.  Called by user
  print "BEWARE before you run goPooled! It is a slow simulation which could take up to 1 hour or more to run through all Gens if run online."
  print "You can stop it at any point by clicking the blackened button (though there will be some delay until the Gen completes)."
  if GenYears = 0 [Setup]                            ;; In case Setup has not already been run

  set Gen                 ifelse-value BornAfter1966? [0] [1] ;; your birth generation

  ;; Restart unPooled to run in parallel
  set Ancestors           1                                   ;; you
  set ImmigratedAncestors 0
  set Parents             item Gen ParentsList                ;; the # Parents in your parents' marriage Gen.  Only required to plot an initial non-zero point, equal to the next point
  set NonExtincts         item Gen NonExtinctsList            ;; = Parents

  ;; Restart Pooled, ready to reTrace and draw the next Pooled curve
  set AncestorsPooled           1                             ;; you
  set ImmigratedAncestorsPooled 0

  ;; Setup the world to hold just enough Parishes
  set #Parishes    14051                             ;; assuming that this has hardly changed since 1881. Source: VisionOfBritain data on Parishes in 1881 (ref: #Parishes from VoB.xlsx)
  let xmax         ceiling ((sqrt #Parishes - 1)/ 2)
  resize-world     (- xmax) xmax (- xmax) xmax
  clear-patches                                      ;; for re-runs of Pooled simulation

  ;; Seed the central patch and colour non-parishes green
  ask patch 0 0
  [ set Hits 1                                       ;; you in the Parish you were born
    set pcolor white                                 ;; white is just a visual indicator of the Parishes with Ancestors, it coincides with Hits > 0
  ]
  set Parishes patches                               ;; initialise to all patches before it is reduced to #Parishes
  GreenNonParishes                                   ;; Colour patches green in line with #Parishes and reset Parishes

  ;; Now we have setup the World, we can derive ProximityParameter from %ParentHere
  set %ParentHere 50 ;; 50% in 19th-20th centuries. ref: Migration and Mobility in Britain from the Eighteenth to the Twentieth Centuries, Pooley and Turnbull (1996). http://www.localpopulationstudies.org.uk/pdf/lps57/lps57_1996_50-71.pdf
                     ;; Additional evidence: 50% implies 76% from the same county (see %ParentsInSameCounty procedure) which correlates well with 75% derived from the 1881 census.
  SetupWeighting     ;; set ProximityParameter (dependent on World size), Win-radiusList and sumWeights

  ;; Setup Pooled plot
  create-temporary-plot-pen (word "Pooled" Run#)
  set-plot-pen-color 15 + Run# * 30                  ;; cycle through the base colors, starting at red
  plotxy item Gen GenStartYearList  0                ;; plot the initial point

  set   Run#   Run# + 1                              ;; count the Pooled Runs
  print word "*** Pooled Run " Run#                  ;; delineate Pooled Runs
  set secs 0                                         ;; to time this Pooled run
end 

to goPooled   ;; Called by user
  if Gen = 0 [reset-timer]                           ;; zero time at start of the first goPooled
  if Gen + 1 >= #Gens [stop]                         ;; stop after the last Gen
  set Gen Gen + 1
  SetAncestors                                       ;; For unPooled comparison: Set Ancestors, excl immigrants, and cumulate ImmigratedAncestors

  ;; Set #Parishes and GreenNonParishes
  set Marriages                 item Gen MarriagesList
  let ParishesFactor            4498 / 7864          ;; #Parishes in  1560 and for 1820. See #Records retrieved using advanced searches saved in C:\Users\ianjh\NetLogo\Ancestors\theclergydatabase Ref: http://db.theclergydatabase.org.uk/jsp/search/index.jsp
  let MarriagesFactor           1101507 / 3112089    ;; Marriages for 1560 and for 1820
  let MarriagesDecreaseExponent (ln ParishesFactor) / (ln MarriagesFactor) ;; Used to calculate #Parishes decrease
  if Gen > 3 [set #Parishes round((Marriages / item (Gen - 1) MarriagesList)^ MarriagesDecreaseExponent * #Parishes)] ;; Prior to 1871, vary both #Parishes and PotSize. Note: As the exponent > .5, #Parishes decreases a bit faster than PotSize
  let #Whites    count patches with [pcolor = white]
  set #Parishes  max list #Whites #Parishes          ;; since Whites cannot be Greened
  GreenNonParishes                                   ;; Colour black patches green in line with #Parishes

  SetPicks                                           ;; Gravitationally scatter 2 Picks for each Hit in the children's Gen

  ;; Set #distinct Hits from the Picks in all Parishes in this Gen
  set ParentsPerParish    (item Gen ParentsList) / #Parishes
  ask patches with [Picks > 0]
  [ set Hits  (#Hits ParentsPerParish)               ;; Set the Hits from this patch's Picks within pool size ParentsPerParish
    set Picks 0                                      ;; Zero these used Picks, ready for setPicks in the next Gen
  ]

  set %ParishesWithAncestors  100 * count patches with [Hits > 0] / #Parishes
  ask Parishes [set pcolor ifelse-value (Hits = 0)  [black] [white]] ;; recolour patches in line with Hits

  ;; Plot Pooled
  set AncestorsPooled               sum [Hits] of patches
  plotxy item Gen GenStartYearList  AncestorsPooled

  ;; Trace pooled monitors
  Set%ParentHere                                     ;; set for use in Trace and monitor
  if Trace [                                         ;; print monitors in each Gen
    let AncestorsPooled%Ancestors     100 * AncestorsPooled / Ancestors
    print (word
      "Gen = "                         substring (word Gen                                   "     ") 0 2
      "  Ancestors = "                 substring (word round Ancestors                       "     ") 0 6
      "  AncestorsPooled = "           substring (word round AncestorsPooled                 "     ") 0 6
      "  AncestorsPooled%Ancestors = " substring (word precision AncestorsPooled%Ancestors 1 "     ") 0 5
      "  #Parishes = "                 substring (word #Parishes                             "     ") 0 5
      "  %ParentHere = "               substring (word precision %ParentHere  1              "     ") 0 4
      "  ParentsPerParish = "          substring (word round ParentsPerParish                "     ") 0 4
      "  %ParishesWithAncestors = "    substring (word precision %ParishesWithAncestors 2    "     ") 0 5
  )]

  set secs timer                                     ;; update total time for Pooled run
end 

to GreenNonParishes      ;; Green patches to match #Parishes, by turning them green. Called by SetupPooled, goPooled and %ParentInSameCounty
  let #ToGreen         count Parishes - #Parishes

  ifelse #ToGreen >= 0
  [ ask n-of    #ToGreen  patches with [pcolor = black] [set pcolor green]] ;; Green  patches when Marriages decrease
  [ ask n-of (- #ToGreen) patches with [pcolor = green] [set pcolor black]] ;; revive patches when Marriages increase

  set Parishes  patches with [pcolor != green]                              ;; patch set of Parishes for speed in WeightedParishPick
  set #Parishes count Parishes
end 

to-report #Hits [lPoolSize]  ;; # distinct items picked in this patch's random Picks from lPoolSize. Called by goPooled
  report   lPoolSize * (1 - (1 - 1 / lPoolSize) ^ Picks)                    ;; using a similar formula to the one in SetAncestors
end 

to SetPicks ;; set Picks from the Hits of the children's generation (2 gravitationally scattered picks per hit, one for each parent). Called by Go
  let lImmigratedAncestorsPooled  ImmigratedAncestorsPooled                 ;; use a local variable to avoid updating the monitor until the end of this procedure
  ask patches with [Hits  > 0] [
    let lPicks                    2 * Hits                                  ;; Pick 2 parents for each Ancestor in the children's generation
    let ImmigrantAncs             lPicks * Immigrant% / 100                 ;; # your Immigrant Ancestors in this Gen
    set lImmigratedAncestorsPooled ImmigrantAncs + lImmigratedAncestorsPooled ;; Cumulate into lImmigratedAncestorsPooled
    set lPicks                    lPicks - ImmigrantAncs                    ;; # non-immigrant Picks

    ;; Scatter lPicks
    let floorlPicks floor lPicks                                            ;; to be scattered one-by-one
    set picks picks + lPicks - floorlPicks                                  ;; add the fractional part of lPicks into local Picks, i.e. the fractional part is not scattered
    repeat floorlPicks [ask self[Pick]]                                     ;; weighted Picks in Parishes. Must "ask self" in order to establish "myself" in Pick and its sub-procedures

    set Hits 0                                                              ;; Reset used Hits
 ]
  set ImmigratedAncestorsPooled  lImmigratedAncestorsPooled                 ;; now set the monitor
end 

to Pick   ;; Pick in a Weighted random Parish.  Called by SetPicks
  ask WeightedRandomParish   [set Picks   Picks + 1]
end 

to-report WeightedRandomParish  ;; report a random parish from within a weighted (by proximity) random radius of myself.  Called by Pick
  ;; scan Win-radiusList for a weighted radius containing a random sum of Weights
  let RandomSumOfWeights  random-float sumWeights             ;; a random sum of Weights from the spectrum of 0 to sumWeights
  if RandomSumOfWeights < 1 [report myself]                   ;; fast shortcut for 50% (approx. 100/sumWeights) of Picks, as any radius < 1 contains only "myself"
  let radius 0 while [RandomSumOfWeights > item radius Win-radiusList] [set radius  radius + 1] ;; get the first weighted digital radius containing the random sum of Weights

  report one-of Parishes with [distance myself <= radius]     ;; report a random Parish from within the weighted random radius of myself
end 

to SetupWeighting   ;; set ProximityParameter, Win-radiusList and sumWeights,  Can use patch 0 0 as the origin, as these are largely insensitive to choice of origin (i.e. myself).
  SetProximityParameterBy%ParentHere                          ;; set ProximityParameter. Dependent on World size
  set Win-radiusList map [radius -> [sum [Proximity] of patches in-radius radius] of patch 0 0] range (max-pxcor + 1)  ;; sum of Weights within each digital radius
  set sumWeights last Win-radiusList                          ;; it is the total with the largest radius (note: not for all patches)
end 

to SetProximityParameterBy%ParentHere  ;; Called by SetupPooled and %ParentInSameCounty
  ;; fit ProximityParameter so that TargetOf1 (dependent on %ParentHere, ProximityParameter, World size and Parish distribution) converges to 1
  set ProximityParameter  5                                   ;; initial estimate for %ParentHere=50%
  setTargetOf1                                                ;; set initial value of TargetOf1
  while [abs(TargetOf1 - 1) > 1E-14] [
    set ProximityParameter  ProximityParameter * TargetOf1    ;; TargetOf1 converges to 1 since TargetOf1 decreases as ProximityParameter increases (and by a smaller ratio)
    if ProximityParameter < .1 [error ProximityParameter]     ;; experience shows TargetOf1 is probably diverging, if ProximityParameter < .1
    setTargetOf1                                              ;; iterate using the updated ProximityParameter
  ]
end 

to SetTargetOf1  ;; set TargetOf1 so that %ParentHere=100/sumParishProximity.   Called by SetProximityParameterBy%ParentHere
  let sumParishProximity  [sum [Proximity] of patches in-radius max-pxcor] of patch 0 0
  set TargetOf1           sumParishProximity * %ParentHere / 100  ;; as the Proximity of patch 0 0 = 1
end 

to Set%ParentHere ;; % chance a Parent is married in same Parish.  Dependent on World size, #Parishes and ProximityParameter. Called by goPooled
  set %ParentHere 100 / [sum [Proximity] of Parishes in-radius max-pxcor] of patch 0 0  ;; maximum parent distance = max-pxcor (as assumed in SetTargetOf1 when setting ProximityParameter). patch 0 0 is a good origin as it is largely insensitive to this
end 

to-report Proximity  ;;  This is the Weight applied to each Pick. It is a measure of the Proximity of the Picked Parish to myself. Called by PooledTrace, report%ParentHere, SetCumProxList and %ParentInSameCounty
  report 1 / (1 + ProximityParameter *(distance myself))^ 2
end 

to-report %ParentInSameCounty ;; This user-called utility validates the default 50% for %ParentHere as it reports 76% which tallies well with 75% estimated in "1881 BornInCounty%.xlsx" which is based on data downloaded from "The UK Data Service".  Called by user
  set %ParentHere 50

  ;; Setup World
  set #Parishes    14051                                      ;; assuming that this has hardly changed since 1881. Source: VisionOfBritain data on Parishes in 1881 (ref: #Parishes from VoB.xlsx)
  clear-patches

  ;; Seed the central patch and Green non-parishes
  ask patch 0 0
  [ set Hits 2                                                ;; your Parents
    set pcolor white
  ]
  set Parishes patches
  GreenNonParishes

  SetProximityParameterBy%ParentHere

  let countyRadius               sqrt(count patches / 55 / pi) ;; radius of circular county of average area, out of 55 counties
  let sumParishProximityInCounty [sum [Proximity] of Parishes in-radius countyRadius] of patch 0 0
  let sumParishProximity         [sum [Proximity] of Parishes] of patch 0 0
  report 100 * sumParishProximityInCounty / sumParishProximity
end 

There are 6 versions of this model.

Uploaded by When Description Download
Ian Heath over 6 years ago correct time to complete goPooled Download this version
Ian Heath over 6 years ago set precision in monitors as decimals ignored online Download this version
Ian Heath over 6 years ago set precision in monitors as decimals ignored online Download this version
Ian Heath over 6 years ago remove reporter from monitor Download this version
Ian Heath over 6 years ago Updated Info tab Download this version
Ian Heath over 6 years ago Initial upload Download this version

Attached files

File Type Description Last updated
How Many Ancestors does a Briton have.png preview Preview for 'How Many Ancestors does a Briton have' over 6 years ago, by Ian Heath Download

This model does not have any ancestors.

This model does not have any descendants.