## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(tidygedcom)

## ----stable-ids, eval = FALSE-------------------------------------------------
# # Fragile -- the ID may change with the next export
# henderson_id <- 242766628698
# 
# # Durable -- locate the person by a fact about them
# henderson_id <- ped$personID[grepl("W. Henderson Waugh", ped$name)]

## ----unzip, eval = FALSE------------------------------------------------------
# unzip("My Family Tree.zip", overwrite = TRUE)
# 
# ped <- readGedcom("My Family Tree.ged", verbose = FALSE)

## ----peek-raw, eval = FALSE---------------------------------------------------
# raw_ged <- readLines("My Family Tree.ged")
# head(raw_ged, 15)
# 
# # Jump to a specific person to see how their facts are recorded
# line_num <- which(grepl("1 NAME W. Henderson /Waugh/", raw_ged, fixed = TRUE))
# raw_ged[line_num:(line_num + 20)]

## ----build-sample-------------------------------------------------------------
sample_ged <- c(
  "0 HEAD",
  "1 GEDC",
  "2 VERS 5.5.1",
  "1 CHAR UTF-8",

  # William Pitt Waugh Sr. — the common paternal ancestor
  "0 @I1@ INDI",
  "1 NAME William Pitt /Waugh/",
  "1 SEX M",
  "1 BIRT",
  "2 DATE 28 APR 1775",
  "2 PLAC Adams County, Pennsylvania, USA",
  "1 DEAT",
  "2 DATE 14 AUG 1852",
  "2 PLAC Wilkes County, North Carolina, USA",
  "1 FAMS @F1@",
  "1 FAMS @F2@",

  # Matilda Grinton — mother of W. Henderson Waugh
  "0 @I2@ INDI",
  "1 NAME Matilda /Grinton/",
  "1 SEX F",
  "1 BIRT",
  "2 DATE ABT 1797",
  "2 PLAC North Carolina, USA",
  "1 FAMS @F1@",

  # W. Henderson Waugh — 2nd great-grandfather of focal person
  "0 @I3@ INDI",
  "1 NAME W. Henderson /Waugh/",
  "1 SEX M",
  "1 BIRT",
  "2 DATE ABT 1835",
  "2 PLAC Wilkes County, North Carolina, USA",
  "1 FAMC @F1@",
  "1 FAMS @F3@",

  # Martha Law Segraves — mother of William Pitt Waugh Jr.
  "0 @I4@ INDI",
  "1 NAME Martha Law /Segraves/",
  "1 SEX F",
  "1 BIRT",
  "2 DATE OCT 1814",
  "1 FAMS @F2@",

  # William Pitt Waugh Jr. (born William Segraves) — paternal half-brother of W. Henderson
  "0 @I5@ INDI",
  "1 NAME William Pitt /Waugh/ Jr.",
  "1 SEX M",
  "1 BIRT",
  "2 DATE 1844",
  "2 PLAC Wilkes County, North Carolina, USA",
  "1 DEAT",
  "2 DATE FEB 1880",
  "1 FAMC @F2@",
  "1 FAMS @F4@",

  # Laura Watkins — wife of W. Henderson Waugh
  "0 @I6@ INDI",
  "1 NAME Laura /Watkins/",
  "1 SEX F",
  "1 BIRT",
  "2 DATE ABT 1846",
  "2 PLAC North Carolina, USA",
  "1 FAMS @F3@",

  # John William (Bud) Waugh — son of W. Henderson; great-grandfather of focal person
  "0 @I7@ INDI",
  "1 NAME John William /Waugh/",
  "1 SEX M",
  "1 BIRT",
  "2 DATE ABT JUN 1880",
  "2 PLAC North Carolina, USA",
  "1 FAMC @F3@",

  # James Monroe Waugh — son of William Pitt Jr.; Y-DNA candidate branch
  "0 @I8@ INDI",
  "1 NAME James Monroe /Waugh/",
  "1 SEX M",
  "1 BIRT",
  "2 DATE 10 NOV 1867",
  "1 DEAT",
  "2 DATE 23 JUL 1937",
  "1 FAMC @F4@",

  # Family 1: William Pitt Sr. + Matilda Grinton -> W. Henderson Waugh
  "0 @F1@ FAM",
  "1 HUSB @I1@",
  "1 WIFE @I2@",
  "1 CHIL @I3@",

  # Family 2: William Pitt Sr. + Martha Segraves -> William Pitt Jr.
  # _SREL friend marks this as a non-marital relationship in Ancestry exports
  "0 @F2@ FAM",
  "1 HUSB @I1@",
  "1 WIFE @I4@",
  "1 CHIL @I5@",
  "1 _SREL friend",

  # Family 3: W. Henderson Waugh + Laura Watkins
  "0 @F3@ FAM",
  "1 HUSB @I3@",
  "1 WIFE @I6@",
  "1 CHIL @I7@",
  "1 MARR",
  "2 DATE 24 JUN 1877",
  "2 PLAC Wilkes County, North Carolina, USA",

  # Family 4: William Pitt Jr. + wife
  "0 @F4@ FAM",
  "1 HUSB @I5@",
  "1 CHIL @I8@",
  "0 TRLR"
)

tmp_ged <- tempfile(fileext = ".ged")
writeLines(sample_ged, tmp_ged)

## ----read-individuals---------------------------------------------------------
ped <- readGedcom(tmp_ged, verbose = FALSE)
ped[, c("personID", "name", "sex", "birth_date", "death_date", "momID", "dadID")]

## ----gedcom-version-----------------------------------------------------------
attr(ped, "gedcom_version")

## ----summarize----------------------------------------------------------------
summarizeGedcom(ped)

## ----parse-dates--------------------------------------------------------------
ped_dates <- readGedcom(tmp_ged, parse_dates = TRUE, verbose = FALSE)
ped_dates[, c("name", "birth_date", "death_date")]

## ----date-precision-----------------------------------------------------------
exact <- readGedcom(tmp_ged,
  parse_dates = TRUE,
  impute_partial_dates = FALSE, verbose = FALSE
)

data.frame(
  name = ped_dates$name,
  birth = ped_dates$birth_date,
  was_exact = !is.na(exact$birth_date)
)

## ----extract-year-------------------------------------------------------------
dates_raw <- c(
  "28 APR 1775", "14 AUG 1852", "ABT 1835", "OCT 1814",
  "1844", "ABT JUN 1880", NA
)
extractGedcomYear(dates_raw)

## ----birth-year---------------------------------------------------------------
ped$birth_year <- extractGedcomYear(ped$birth_date)
ped$death_year <- extractGedcomYear(ped$death_date)
ped[, c("name", "birth_year", "death_year")]

## ----read-families------------------------------------------------------------
fam <- readGedcomFamilies(tmp_ged, verbose = FALSE)
fam[, c("famID", "husbID", "wifeID", "marr_date", "marr_place")]

## ----join-families------------------------------------------------------------
merge(
  fam[, c("famID", "husbID", "wifeID", "marr_date", "marr_place")],
  ped[, c("personID", "name")],
  by.x = "husbID", by.y = "personID", all.x = TRUE
) |>
  merge(
    ped[, c("personID", "name")],
    by.x = "wifeID", by.y = "personID", all.x = TRUE,
    suffixes = c("_husb", "_wife")
  )

## ----coords-------------------------------------------------------------------
coord_ged <- c(
  "0 HEAD", "1 GEDC", "2 VERS 5.5.1", "1 CHAR UTF-8",
  "0 @I1@ INDI",
  "1 NAME William Pitt /Waugh/",
  "1 SEX M",
  "1 BURI",
  "2 PLAC Smithey Cemetery, Wilkes County, NC",
  "2 MAP",
  "3 LATI N36.1548",
  "3 LONG W81.1845",
  "0 TRLR"
)
tmp_coord <- tempfile(fileext = ".ged")
writeLines(coord_ged, tmp_coord)

ped_raw <- readGedcom(tmp_coord, remove_empty_cols = FALSE, verbose = FALSE)
ped_conv <- convertGedcomCoords(ped_raw)
ped_raw[, c("name", "burial_lat", "burial_long")]
ped_conv[, c("name", "burial_lat", "burial_long")]
unlink(tmp_coord)

## ----coord-converters---------------------------------------------------------
gedcomLat2Numeric(c("N36.1548", "S33.8688", NA))
gedcomLon2Numeric(c("W81.1845", "E151.2093", NA))

## ----bgmisc, eval = requireNamespace("BGmisc", quietly = TRUE)----------------
library(BGmisc)

ped <- readGedcom(tmp_ged, verbose = FALSE)

# Check the pedigree is acyclic and well-formed
checks <- checkPedigreeNetwork(ped,
  personID = "personID", momID = "momID", dadID = "dadID",
  verbose = FALSE
)
checks$is_acyclic

## ----ggped, eval = requireNamespace("BGmisc", quietly = TRUE) && requireNamespace("ggpedigree", quietly = TRUE), warning = FALSE, message = FALSE----
library(BGmisc)
library(ggpedigree)
ped <- readGedcom(tmp_ged, verbose = FALSE)

ggpedigree(
  ped,
  personID = "personID",
  momID = "momID",
  dadID = "dadID",
  sexVar = "sex",
  config = list(
    label_include = TRUE,
    code_male = "M",
    code_female = "F",
    label_column = "name",
    label_text_size = 2,
    focal_fill_include = TRUE,
    sex_color_include = F,
    focal_fill_personID = 1,
    focal_fill_method = "viridis_c",
    segment_lineage_include = TRUE,
    segment_lineage_focal_personID = 1,
    segment_lineage_component = "paternal",
    segment_lineage_legend_title = "Patriline",
    add_phantoms = TRUE
  )
)

## ----cleanup------------------------------------------------------------------
unlink(tmp_ged)