R/create_network.R

In cstubben/aRkivet: Census records and maps from Norway

#' Link events and names in baptism and marriage records in the Norway Digital Archives
#'
#' Links events and full names for plotting D3 networks
#'
#' Nodes include names and a group for coloring where group=1 for events and group=0 for people.
#' If any names match the highlight option, these will be assigned group=2.  Links include source,
#' target and a value for line thickness where value=5 for family relationships (father, son, etc)
#' and value=1 for witnesses (trulovar or fadder).
#'
#' @param x baptism and marriage records from \code{\link{get_records}}
#' @param highlight assign names matching pattern to group 2
#'
#' @return A list with nodes and links
#'
#' @author Chris Stubben
#'
#' @examples
#' \dontrun{
#'   s1 <- advanced_search(1638, first="Siv*", last="Lars*", residence="Stub*")
#'   sivert <- get_records(s1)
#'   # check full names and fix alternative spellings
#'   #  sivert$full[sivert$full=="Arnt Elevsen Kjelstad"] <- "Arnt Ellevsen Kjelstad"
#'   net <- create_network(sivert, highlight="Stub")
#' }
#' @export
create_network <- function(x, highlight ){
   x$full <- factor(x$full, unique(x$full))
   x$event <- factor(x$event, unique(x$event))  # in order in table
   x$role <- ordered(x$role)
   n <- length(unique(x$event))
   fullgrp <- 0
   if(!missing(highlight)) fullgrp <- ifelse(grepl( highlight, x$full), 0,2 )
   x1 <- rbind(
     unique(data.frame(name=x$event, group=1)),
     unique(data.frame(name=x$full, group= fullgrp ))
   )
   y1 <- data.frame(source=as.numeric(x$full) + (n-1),
                       target=as.numeric(x$event)-1,
                       value=ifelse(x$role %in% c("fadder", "trulovar"), 1, 5) )
   list(Links = y1, Nodes= x1 )
}