Webscraping Data Science

1 Scrape names & collabs

#########################################
# Title:    Webscraping in R
# Author:   Bas Hofstra
# Version:  29-07-2021
#########################################

#start with clean workspace 
rm(list=ls())

# install.packages("data.table") 
library(data.table) # mainly for faster data handling
library(tidyverse) # I assume you already installed this one!
# install.packages("httr") # we don't need this for now
# require(httr)
#install.packages("xml2")
require(xml2)
#install.packages("rvest")
require(rvest)
#install.packages("devtools")
require(devtools)
# Note we're doing something different here. We're installing a *latest* version directly from GitHub
# This is because the released version of this packages contains some errors!
#devtools::install_github("jkeirstead/scholar") 


require(scholar)

#define workdirectory, note the double *backslashes* if you're on windows
# setwd("/yourpathhere)"

# Let's first get the staff page read_html is a function that simply extracts html webpages and
# puts them in xml format
data_staff <- read_html("https://www.cs.ru.nl/das/staff/index.html")

head(data_staff)

class(data_staff)

The website of the data science department looks different. It turns out that the names, emails and pictures are written as javascript, so this is not possible to scrape how we learnt it. After a lot of googling and trying, the following script seemed to work.

#Here I need to install the extra package V8 which is able to read java data. 
#Loading both the required libraries
#library(rvest)
#install.packages("V8")
library(V8)

#URL with js-rendered content to be scraped
link <- 'https://www.cs.ru.nl/das/staff/index.html'

#Read the html page content and extract all javascript codes that are inside a list
#The names are stored after the bit of html that ends with javascript.
namesjs <- read_html(link)  %>% html_nodes('script') %>% html_text()

# Create a new v8 context
ct <- v8()

#This part gave me an error, something about undefined is not found. However, I saw that some data was stored in namesjs (the javascript names) already. So I moved on to the next chunk. 
#parse the html content from the js output and print it as text
read_html(ct$eval(gsub('document.write', namesjs))) %>% 
 html_text()

#This is to clear the data a little bit more. 
data_staff <- namesjs %>% 
gsub("[\n\t]", "", .) %>%
stringr::str_trim() %>%
gsub("\\s+", " ", .) %>%
strsplit(" ") %>% 
unlist()

#Then I made data_staff (based on the javascript names) a dataframe. 
data_staff <- as.data.frame(data_staff)

#Now I only have one column and everything is stored underneath each other. Now I have to see how I can make that normal-looking data. The first 15 can be just deleted as these were almost empty columns. 
data_staff <- data_staff[-c (1:15), , drop=FALSE]

#Now I can look whether there are certain patterns I detect in the data. Now I also have all the email-adresses stored and I don't need those. 
data_staff1 <- data_staff[!grepl("@|jpg|png", data_staff$data_staff), ]
data_staff1 <- as.data.frame(data_staff1)
data_staff <- data_staff1[c(1:160), , drop=FALSE]

All the above code didn’t help me, so I had to just put the names in a dataframe.

#Okay for the sake of time I have to create a dataframe with their names by hand. (h for handcoded). I wont include guest researchers as they may not have Radboud as affiliation and for sociology those are excluded as well.
first_name <- c("tom", "djoerd", "martha", "david", "elena", "arjen", "nico", "theo", "johannes", "tom", "perry", "faegheh", "twan", "harrie", "marieke", "gabriel", "parisa", "yuliya", "gijs", "inge", "jacopo", "ankur", "zaheer", "roel", "franka", "kai", "koen", "mirthe", "luc", "emma", "negin", "hideaki", "chris", "alex", "norman", "simone", "zhuoran","konrad", "marvin", "gido", "bob", "shabaz", "wieske", "yao", "nik", "ivan", "feri", "errol", "zhengyu")
last_name <- c("heskes", "hiemstra", "larson", "van leeuwen", "marchiori", "de vries", "karssemeijer", "van der weide", "textor", "claassen", "groot", "hasibi", "van laarhoven", "oosterhuis", "de vries", "bucur", "naseri", "shapovalova", "van tulder", "wortel", "acquarelli", "ankan", "babar", "bouman", "buytenhuijs", "chen", "dercksen", "van diepen", "evers", "gerritse", "ghasemitaheri", "joko", "kamphuis", "kolmus", "knyazev", "lederer", "liu", "mielke", "oeben", "schoenmacker", "stienen", "sultan", "de swart", "tong", "vaessen", "veul", "wijayanto", "zalmijn", "zhao")
data_staffh <- data.frame(first_name, last_name)

# set affiliation to radboud, comes in handy for querying google scholar
data_staffh$affiliation <- "radboud university"

#require(scholar)
get_scholar_id_fix <- function (last_name = "", first_name = "", affiliation = NA)
{
  if (!any(nzchar(c(first_name, last_name))))
    stop("At least one of first and last name must be specified!")
  site <- getOption("scholar_site")
  url <- paste0(site, "/citations?view_op=search_authors&mauthors=",
                first_name, "+", last_name, "&hl=en&oi=ao")
  page <- get_scholar_resp(url)
  if (is.null(page))
    return(NA)
  aa <- httr::content(page, as = "text")
  # added by Bas Hofstra: bugfix for IDs that have a dash ("-")
  ids <- substring(aa, regexpr(";user=", aa))
  ids <- substr(ids, 1, 19) # error prone, but unsure how to solve otherwise
  # if (nchar(stringr::str_extract_all(string = aa, pattern = ";user=[[:alnum:]]+[[:punct:]]")[[1]][1]) < 18) {
  #   ids <- stringr::str_extract_all(string = aa, pattern = ";user=[[:alnum:]]+[[:punct:]]+[[:alnum:]]+[[:punct:]]")
  # } else {
  #   ids <- stringr::str_extract_all(string = aa, pattern = ";user=[[:alnum:]]+[[:punct:]]")
  # }
  if (length(unlist(ids)) == 0) {
    message("No Scholar ID found.")
    return(NA)
  }
  ids <- ids %>% unlist %>% gsub(";user=|[[:punct:]]$", "",
                                 .) %>% unique
  if (length(ids) > 1) {
    profiles <- lapply(ids, scholar::get_profile)
    if (is.na(affiliation)) {
      x_profile <- profiles[[1]]
      warning("Selecting first out of ", length(profiles),
              " candidate matches.")
    }
    else {
      which_profile <- sapply(profiles, function(x) {
        stringr::str_count(string = x$affiliation, pattern = stringr::coll(affiliation,
                                                                           ignore_case = TRUE))
      })
      if (all(which_profile == 0)) {
        warning("No researcher found at the indicated affiliation.")
        return(NA)
      }
      else {
        x_profile <- profiles[[which(which_profile !=
                                       0)]]
      }
    }
  }
  else {
    x_profile <- scholar::get_profile(id = ids)
  }
  return(x_profile$id)
}

# Look throught get_scholar_id_fix(last_name, first_name, affiliation) 
# if we can find google scholar profiles of sociology staff!
#Turns out 17 people data science do not have a google scholar id. Leaves us with 32 people. 
data_staffh$gs_id <- ""
for (i in 1:nrow(data_staffh)) {
  print(i)
  time <- runif(1, 0, 1)
  Sys.sleep(time)
  
  tryCatch({
     data_staffh[i,c("gs_id")] <- get_scholar_id_fix(last_name = data_staffh[i, c("last_name")], # so search on last_name of staff (third column)
                                             first_name = data_staffh[i, c("first_name")],  # search on first_name of staff (fourth column)
                                             affiliation = data_staffh[i,c("affiliation")]) # search on affiliation of each staff (fifth column)
    }, error=function(e){cat("ERROR :", conditionMessage(e), "\n")}) # continue on error, but print the error
  }
# remove those without pubs from the df
data_staffh <- data_staffh[!data_staffh$gs_id == "", ]
data_staffh

data_list_profiles <- list()  # first we create an empty list that we then fill up with the for loop
data_list_publications <- list()
for (i in 1:nrow(data_staffh)) {
    print(i)
    time <- runif(1, 0, 1)
    Sys.sleep(time)
    # note how you call different elements in a list '[[]]', fill in the i-th element
    data_list_profiles[[i]] <- get_profile(data_staffh[i, c("gs_id")])  # Note how we call row i (remember how to call rows in a DF/Matrix) and then the associated scholar id
    data_list_publications[[i]] <- get_publications(data_staffh[i, c("gs_id")])
    data_list_publications[[i]][, c("gs_id")] <- data_staffh[i, c("gs_id")]  # note that we again attach an id
    # so both functions here call the entire profile and pubs for an author, based on google
    # scholar ids
}
# Notice how fast the data blow up! The 34 RU sociology scholars publish ~3000 papers
data_df_publications <- bind_rows(data_list_publications)

data_profiles_df <- list()
for (i in 1:length(data_list_profiles)) {
    # soc_profiles_df[[i]] <- data.frame(t(unlist(soc_list_profiles[[i]][1:8]))) #some annyoing
    # data handling
    data_profiles_df[[i]] <- unlist(data_list_profiles[[i]][1:8])
    data_profiles_df[[i]] <- data.frame(data_profiles_df[[i]])
    data_profiles_df[[i]] <- data.frame(t(data_profiles_df[[i]]))
}
data_profiles_df <- bind_rows(data_profiles_df)
data_df <- left_join(data_staffh, data_profiles_df, by = c(gs_id = "id"))  # merge data with soc_df
data_df  # notice all the new information we were able to get from the scholar profiles!

# get citation history of a scholar
data_staff_cit <- list()
for (i in 1:nrow(datadef_df)) {
    data_staff_cit[[i]] <- get_citation_history(datadef_df[i, c("gs_id")])
    if (nrow(data_staff_cit[[i]]) > 0) {
        data_staff_cit[[i]][, c("gs_id")] <- datadef_df[i, c("gs_id")]  # again attach the gs_id as third column
    }
}
data_staff_cit <- bind_rows(data_staff_cit)
colnames(data_staff_cit)[3] <- "gs_id"

save(data_staff_cit, file="/Users/anuschka/Documents/labjournal/data/data_staff_cit.RData")

require(rvest)
require(xml2)
require(tidyverse)
# function to get collaborators and names from GS profiles
fcollabs <- function(gsid, lookforcollabs) {
  htmlpage1 <- read_html(paste0("https://scholar.google.nl/citations?user=", gsid, "&hl=en")) # so we paste the google scholar id
  profilename <- htmlpage1 %>% html_nodes(xpath = "//*/div[@id='gsc_prf_in']") %>% html_text() # we extract the profile name of that google scholar page
  profilecollabs1 <- as.data.frame(0) # empty df necessary for later
  profilecollabs2 <- as.data.frame(0) # empty df necessary for later
  if (lookforcollabs == 1) { # so if you want to look for collabs, set function to 1
    htmlpage2 <- read_html(paste0("https://scholar.google.com/citations?view_op=list_colleagues&hl=en&user=", gsid)) # so we paste the google scholar id
    profilecollabs1 <-  htmlpage2 %>% html_nodes(css="h3") %>% html_text() # get names
    profilecollabs1 <-  as.data.frame(profilecollabs1)
    profilecollabs2 <- htmlpage2 %>% html_nodes("a") %>% html_attr("href") # get the link
    profilecollabs2 <- profilecollabs2[seq_along(profilecollabs2) %% 2 > 0]
    profilecollabs2 <- substring(profilecollabs2, 23)
  }
  if (nrow(profilecollabs1)>1) { # if there ARE collabs
    profilecollabs1 <- as.data.frame(profilecollabs1) # we want to...
    profilecollabs2 <-  as.data.frame(profilecollabs2)
    profilecollabs1[,c("coauth_id")] <- profilecollabs2[,1]
    profilecollabs1[,c("gs_id")] <- gsid #... add gs_ids of focal GS profile
    profilecollabs1[,c("name")] <- profilename #...and the the profile name of GS profile attached
    names(profilecollabs1)[1] <- "coauth"
  } else {
    profilecollabs1 <- as.data.frame(cbind(gsid, profilename)) # if NOT looking for collabs...
    names(profilecollabs1) <- c("gs_id", "name") #...we only attach gs_id and profilename
  }
  return(profilecollabs1)
}

save(data_df, file = "addfiles\\data_df.RData") 

# first the soc collaborators note how we already build a function (fcollabs()) for you you need to
# input a google scholar id and a 1 (if you want to find collabs) or 0 (only extracting names)
# fcollabs --> you can check it out if you're interested
data_collabs <- list()
for (i in 1:nrow(data_df)) {
    time <- runif(1, 0, 1)
    Sys.sleep(time)
    data_collabs[[i]] <- fcollabs(data_df[i, c("gs_id")], 1)
}
data_collabs <- bind_rows(data_collabs)  # bind rows, get the unique ones!
data_collabs_unique <- unique(data_collabs[, "coauth_id"])  # so 229 unique collaborators for RU staff?
data_collabs_unique <- data_collabs_unique[!is.na(data_collabs_unique)]
save(data_collabs, file = "addfiles\\data_df_collabs1.RData")  # you notice this takes a while, so we save the data here.

# then the names of those collaborators plus THEIR collaborators understand that we don't have
# names of them yet from the code above?
collabsdata_1deep <- list()
for (i in 1:length(data_collabs_unique)) {
    time <- runif(1, 0, 3)
    Sys.sleep(time)
    if (!data_collabs_unique[i] %in% data_df$gs_id) {
        collabsdata_1deep[[i]] <- fcollabs(data_collabs_unique[i], 1)
    }
}
collabsdata_1deep <- bind_rows(collabsdata_1deep)
collabsdata_1deep_unique <- unique(collabsdata_1deep[, 2])
collabsdata_1deep_unique <- collabsdata_1deep_unique[!is.na(collabsdata_1deep_unique)]
save(collabsdata_1deep, file = "addfiles\\data_collabs2.RData")  # you notice this takes a while, so we save the data here.

fgender <- function(firstname_df, me, file=NULL) {

####################################
# Author: Bas Hofstra, Anne Maaike Mulders, Jochem Tolsma
# DAte:   13-10-2021, last edit: 22-09-2022
# Tasks:  - assign gender baed on name
#         - Adapted from Rense Corten code April 2021
####################################


#Input: 
#  - firstname_df: a data.frame with a column named firstname  and gender!
#  - me: a character vector introducing yourself: e.g. "J Tolsma, Radboud University"
#  - file: location and name of file to be saved. 
  
#------------------------------------------------------------------------------------
# Load required packages

if (!require("tidyverse", character.only = TRUE)) {
  install.packages("tidyverse", dependencies = TRUE)
  library(tidyverse, character.only = TRUE)
}

if (!require("rvest", character.only = TRUE)) {
  install.packages("rvest", dependencies = TRUE)
  library(rvest, character.only = TRUE)
}

if (!require("polite", character.only = TRUE)) {
  install.packages("polite", dependencies = TRUE)
  library(polite, character.only = TRUE)
}



# make links to scrape
firstname_df$name_url <- paste0("https://www.meertens.knaw.nl/nvb/naam/is/", firstname_df[, c("firstname")])



#------------------------------------------------------------------------------------
### 2: introduce to server ###

# Introduce myself to the server
session <- bow("https://www.meertens.knaw.nl/nvb/naam/is", user_agent = me , delay = 1)


#------------------------------------------------------------------------------------
### 3: make function to get table from ###
  fnames <- function(link){ 
    name_session <-nod(session, path = link)
    name_page <- scrape(name_session) 
    return(name_page)
  }
  
name_list <- list()
table_list <- list()


  for (i in 1:nrow(firstname_df)) {
    print(i)
    if (!(is.na(firstname_df$gender))) next
    name_list[[i]] <- fnames(firstname_df[i, c("name_url")])
    # extract name frequency table and gender info
    if (length(name_list[[i]] %>% html_table())>0) {
      
      table_list[[i]] <- name_list[[i]] %>% html_table()
      table_list[[i]][[1]][table_list[[i]][[1]]=="--"] <- "0"
      if (as.numeric(table_list[[i]][[1]]$X3[2]) > as.numeric(table_list[[i]][[1]]$X3[6])) {
        firstname_df$gender[i] <- "male" } else {
          firstname_df$gender[i] <- "female"
        }
    }
    if (!is.null(file)) (save(firstname_df, file=file))
    
    }
  return(firstname_df)
}

data_df %>% mutate(firstname=first_name) -> data_df
data_df$gender <- NA

#GIVES ERROR
data_df$firstname
data_df <- fgender(data_df, me="Jochem Tolsma, RU/RUG", file="tempgender_data_d2.RData")

save(cs_df, file="cs_df_s2b.RData") #genderized last. 

2 Ethnicity

data_df %>% mutate(lastname=last_name) -> data_df
lastname_df <- data_df

#voorvoegsels correct zetten voor scraper
voorvoegsels <- c("'t ", "d' ", "de ", "de la ", "den ", "del ", "der ", "des ", "el ", "el- ", "in 't ", "la ", "le ", "les ", "op den ", "ten ", "ter ", "tes ", "van ", "van 't ", "van de " , "van der ", "van den ", "von der ", "op den ", "ul ") 

for (i in 1: length(lastname_df$lastname)) {
  if (sum(str_detect(lastname_df$lastname[i], voorvoegsels))>0) {
    last <-  as.character(str_split(lastname_df$lastname[i], pattern=" ", simplify = TRUE))
    last <- last[length(last)]
    first <- as.character(unlist(strsplit(lastname_df$lastname[i], split=last, fixed=TRUE)))
    lastname_df$lastname[i] <- paste(last, ", ", first, sep="")
  }
}

#dubbele namen verwijderen. let op dubbele namen met voorvoegsel worden niet gecleaned. TO DO 
for (i in 1: length(lastname_df$lastname)) {
  if (!sum(str_detect(lastname_df$lastname[i], voorvoegsels))>0) {
    lastname_df$lastname[i] <- as.character(str_split(lastname_df$lastname[i], pattern=" ", n = 2, simplify = TRUE)[,1])
    lastname_df$lastname[i] <- as.character(str_split(lastname_df$lastname[i], pattern="-", n = 2, simplify = TRUE)[,1])
  }
}

lastname_df$lastname<- trimws(lastname_df$lastname, which = c("right"), whitespace = "[ \t\r\n]")
lastname_df$lastname <- str_replace_all(lastname_df$lastname, " ", "%20") #html links houden niet van spaties. 

lastname_df$np <- ""

# Load required packages

if (!require("tidyverse", character.only = TRUE)) {
  install.packages("tidyverse", dependencies = TRUE)
  library(tidyverse, character.only = TRUE)
}

if (!require("rvest", character.only = TRUE)) {
  install.packages("rvest", dependencies = TRUE)
  library(rvest, character.only = TRUE)
}

# if (!require("polite", character.only = TRUE)) {
#   install.packages("polite", dependencies = TRUE)
#   library(polite, character.only = TRUE)
# }
#   
# if (!require("xml2", character.only = TRUE)) {
#   install.packages("xml2", dependencies = TRUE)
#   library(polite, character.only = TRUE)
# }

hier maken we de links voor de website.

# creating URLs: origin
lastname_df$name_origin <- ifelse((lastname_df$np==""),
                                paste0("https://www.cbgfamilienamen.nl/nfb/detail_naam.php?gba_naam=",
                                       stringr::str_to_title(lastname_df[, c("lastname")]), 
                                       "&gba_naam=",
                                       stringr::str_to_title(lastname_df[, c("lastname")]),
                                       "&nfd_naam=",
                                       stringr::str_to_title(lastname_df[, c("lastname")]), 
                                       "&info=analyse+en+verklaring&operator=eq&taal="), 
                                paste0("https://www.cbgfamilienamen.nl/nfb/detail_naam.php?gba_naam=",
                                       lastname_df[, c("np2")],
                                       stringr::str_to_title(lastname_df[, c("lastname")]), 
                                       "&gba_naam=",
                                       lastname_df[, c("np2")],
                                       stringr::str_to_title(lastname_df[, c("lastname")]), 
                                       "&nfd_naam=",
                                       stringr::str_to_title(lastname_df[, c("lastname")]),
                                       "%2C+",
                                       lastname_df[, c("np")],
                                       "&info=analyse+en+verklaring&operator=eq&taal="))

hier slaan we alles op

name_originl <- list()
table_originl <- list()
time <- 0.1

3 crucical scrape loop

kom voorlopig geen fouten tegen, toch alles alvast in een trycatch gezet. let op dat ik niet netjes scrape. dus zonder functie ‘polite’ gezien de kleine aantallen in onze cursus, mag dat wmb wel.

for (i in 1:nrow(lastname_df)) {
  print(i)
  Sys.sleep(time)
  tryCatch({ 
    name_originl[[i]]  <- read_html(lastname_df[i, c("name_origin")])
    table_originl[[i]] <- name_originl[[i]] %>% html_table()
  }, 
    warning = function(w) {
        cat("WARNING:", conditionMessage(w), "\n") #WARNING message
    },
    error=function(e){
      err <- conditionMessage(e)
      cat("Error:", conditionMessage(e), "\n") #ERROR message
    }  
  )
}

en vanaf hier is het eigenlijk alleen maar opschonen.

origin_txt <- list()
for (i in 1:length(name_originl)) {
    origin_txt [[i]] <- name_originl[[i]] %>% html_text() %>% as.character()
}

# Get out the relevant origin information from the xml lists
origin_ln <- list()

for (i in 1:length(name_originl)) {
  origin_ln[[i]] <- name_originl[[i]] %>% html_nodes("div") %>% rvest::html_text()
  origin_ln[[i]] <- origin_ln[[i]][[3]]
}

# Remove mess
for (i in 1:length(origin_ln)) {
  origin_ln[[i]] <- gsub("\\t", " ", origin_ln[[i]])
  origin_ln[[i]] <- gsub("\\n", " ", origin_ln[[i]])
}

# Flatten nested structure of the origin information
#origin_ln <- rbind(flatten(origin_ln))

# Detaching the names and origin info for easier data handling
origin <- unlist(origin_ln)



origin <- str_extract_all(origin, "varianten(.*?)©")

# Origin information is usually mentioned after "verklaring" or "kenmerken"
origin <- str_remove_all(origin, "varianten")
origin <- str_remove_all(origin, "CBG Bronnen")
origin <- str_remove_all(origin, "catalogus")
origin <- str_remove_all(origin, "©")


verklaring <- str_remove_all(origin, "kenmerken:(.*?)$")
kenmerken <- str_extract_all(origin, "kenmerken:(.*?)$")
kenmerken <- str_remove_all(kenmerken, "specifieke componenten:(.*?)$")
sc <- str_extract_all(origin, "specifieke componenten:(.*?)$") # Not directly relevant to us, but does mean that the name has a webpage


# Make into a neat dataframe with the names attached
verklaring <- trimws(verklaring, which = "both")
kenmerken <- trimws(kenmerken, which = "both")
sc <- trimws(sc, which = "both")
vk <- data.frame(data_df$lastname, verklaring, kenmerken, sc)

4 Separating names with Dutch & unknown origin

Next, we identify those names for which no additional information was found. This is important to distinguish Dutch names from names with unknown origins.

• Dutch names: no label indicating that the name is Dutch, but some other information available on name origin
• Unknown names: web page cannot be found, so origin information is empty.

# Identify last names that could not be found
vk <- vk %>%
  mutate(verklaring = ifelse(verklaring=="", 0, verklaring), 
         kenmerken = ifelse(kenmerken=="character(0)", 0, kenmerken),
         sc = ifelse(sc=="character(0)", 0, sc),
         no_info = nchar(verklaring) + nchar(kenmerken) + nchar(sc))

vk <- vk %>%
  mutate(no_info = ifelse(no_info==3, 1, 0), 
         verklaring = ifelse(verklaring==0, NA, verklaring),
         kenmerken = ifelse(kenmerken==0, NA, kenmerken))
# If there is no text in verklaring or kenmerken, the name could not be found in the databases. 

5 Extracting specific origin information

There are three main ways to get information about the origin of last names:

1. Under “kenmerken”, last names are assigned clickable tags. These tags include unspecified foreign name tags (“andere taal”), as well as specific foreign origins of the name (“Franse naam”, “Indische naam”). -> origin1 + origin4

2. Several names have more extensively written out stories behind the name, under “verklaring”. A number of names contain detailed (either country-level or regional) origins, usually in the form of “De naam [xyz] is afkomstig uit [country]”. -> origin2

3. Some names have origin information under “verklaring” in the form of the linguistic origins of the name. This can be country specific (e.g. Chinese name), but it can also apply to multiple countries when the language is spoken in more than 1 countries (e.g. Spanish name). -> origin3

# Step 1: extracting origin tags from kenmerken
vk <- vk %>%
  mutate(origin1 = str_extract(kenmerken, "[:upper:]([:lower:]{2,}) naam"))

# Note: sometimes multiple origins are mentioned. Currently, I only extract the first one. Otherwise, we should use str_extract_all. 



# Step 2: extracting origin info from verklaring 
vk <- vk %>%
  mutate(origin2 = ifelse(as.numeric(str_detect(verklaring, "afkomstig uit")) == 1, 
         str_remove(verklaring, ".*afkomstig uit"), NA))


# Step 3: extracting additional origin info from verklaring
vk <- vk %>%
  mutate(origin3 = str_extract(verklaring, "[:upper:]([:lower:]{2,}) (achter)?(familie)?(beroeps)?naam"))



# Finally, we clean up the origin information extracted above

# Origin1: already neat
vk$origin1 <- str_remove(vk$origin1, "Joodse naam") # can be Dutch & non-Dutch

# Origin2: messy
vk$origin2 <- str_remove(vk$origin2, "\\..*") # remove extra info in the following sentence 
vk$origin2 <- str_remove(vk$origin2, "\\;.*") # remove extra info in the following sentence 
vk$origin2 <- str_remove(vk$origin2, "\\(.*") # remove extra info in the following sentence 


vk$dpg <- as.numeric(str_detect(vk$origin2, "(dorp)|(plaats)|(gemeente)|(graafschap)|(stad)|(deel)|(Friesland)")) # origin info too regional 
vk <- vk %>% mutate(origin2 = ifelse((dpg==1), NA, origin2)) # removing regional origin info
vk <- subset(vk, select = -dpg) # removing intermediate variable

# Sometimes, there were multiple countries mentioned. Take only the first:
vk$origin2 <- str_remove(vk$origin2, "\\,.*") # Only first
vk$origin2 <- str_remove(vk$origin2, "\\s(en).*") # Only first 
vk$origin2 <- str_remove(vk$origin2, "\\s(of).*") # Only first 


# Origin3: pretty neat
vk$origin3 <- str_remove(vk$origin3, "D(i)?e(ze)? (familie)?(achter)?(beroeps)?naam") # slipped through the regex
vk$origin3 <- str_remove(vk$origin3, "Een (familie)?(achter)?(beroeps)?naam") # slipped through the regex
vk$origin3 <- str_remove(vk$origin3, "Zijn (familie)?(achter)?(beroeps)?naam") # slipped through the regex
vk$origin3 <- str_remove(vk$origin3, "Als (familie)?(achter)?(beroeps)?naam") # slipped through the regex
vk$origin3 <- str_remove(vk$origin3, "Joodse (familie)?(achter)?naam")
vk$origin3 <- str_remove(vk$origin3, "Bijbelse (familie)?(achter)?naam")


# Setting empty origin variables to NA (Dutch or unfound foreign)
vk <- vk %>%
  mutate(origin1 = as.character(ifelse(origin1==""|origin1=="character(0)", NA, origin1)),
         origin2 = as.character(ifelse(origin2==""|origin2=="character(0)", NA, origin2)),
         origin3 = as.character(ifelse(origin3==""|origin3=="character(0)", NA, origin3)))



# Finally, the tag "andere taal" was used to distinguish foreign names of unknown origin from known Dutch names. 
vk <- vk %>%
  mutate(origin4 = ifelse((as.numeric(str_detect(kenmerken, "andere taal"))==1), "non-Dutch", NA))

Ik zou alles waar no_info op 1 staat of waar origin4 op “non-Dutch” staat coderen als buitenlands!

save(vk, file="vk_data.RData")

6 Making RSiena frame

I see that i dont have the data saved for the publications from data science, but I do not have time to fix that now. So I will start in class # network based on publications

NATURALLY, THIS IS JUST AN EXAMPLE. fOR rSIENA, YOU NEED AT LEAST 3 NETWORKS. tHUS YOU HAVE TO TWEAK THE PERIOD AS YOU DEEM FIT.

library(stringr)

#empty adjacency matrix for the years 2001-2010
network2010_2012 <- matrix(NA, nrow=nrow(soc_df), ncol=nrow(soc_df))
network2013_2015 <- matrix(NA, nrow=nrow(soc_df), ncol=nrow(soc_df))
network2016_2018 <- matrix(NA, nrow=nrow(soc_df), ncol=nrow(soc_df))
network2019_2021 <- matrix(NA, nrow=nrow(soc_df), ncol=nrow(soc_df))


#select publications of the corresponding time era
pubs_sel <- soc_df_publications %>%
              mutate(author = tolower(author)) %>%
              filter(year>=2010 & year<=2012)
#fill the matrix
for (ego in 1: nrow(soc_df)) {
  name_ego <- soc_df$last_name[ego] #which ego? 
  pubs_sel2 <- pubs_sel[str_detect(pubs_sel$author, name_ego),] #publications of ego
  for (alter in 1:nrow(soc_df)){
    name_alter <- soc_df$last_name[alter] #which alter? 
    network2010_2012[ego,alter] <- as.numeric(sum(str_detect(pubs_sel2$author, name_alter)) > 1)  #did alter publish with ego
  }
}

#select publications of the corresponding time era
pubs_sel <- soc_df_publications %>%
              mutate(author = tolower(author)) %>%
              filter(year>=2013 & year<=2015)
#fill the matrix
for (ego in 1: nrow(soc_df)) {
  name_ego <- soc_df$last_name[ego] #which ego? 
  pubs_sel2 <- pubs_sel[str_detect(pubs_sel$author, name_ego),] #publications of ego
  for (alter in 1:nrow(soc_df)){
    name_alter <- soc_df$last_name[alter] #which alter? 
    network2013_2015[ego,alter] <- as.numeric(sum(str_detect(pubs_sel2$author, name_alter)) > 1) #did alter publish with ego
  }
}

#select publications of the corresponding time era
pubs_sel <- soc_df_publications %>%
              mutate(author = tolower(author)) %>%
              filter(year>=2016 & year<=2018)
#fill the matrix
for (ego in 1: nrow(soc_df)) {
  name_ego <- soc_df$last_name[ego] #which ego? 
  pubs_sel2 <- pubs_sel[str_detect(pubs_sel$author, name_ego),] #publications of ego
  for (alter in 1:nrow(soc_df)){
    name_alter <- soc_df$last_name[alter] #which alter? 
    network2016_2018[ego,alter] <- as.numeric(sum(str_detect(pubs_sel2$author, name_alter)) > 1) #did alter publish with ego
  }
}

#select publications of the corresponding time era
pubs_sel <- soc_df_publications %>%
              mutate(author = tolower(author)) %>%
              filter(year>=2019 & year<=2021)
#fill the matrix
for (ego in 1: nrow(soc_df)) {
  name_ego <- soc_df$last_name[ego] #which ego? 
  pubs_sel2 <- pubs_sel[str_detect(pubs_sel$author, name_ego),] #publications of ego
  for (alter in 1:nrow(soc_df)){
    name_alter <- soc_df$last_name[alter] #which alter? 
    network2019_2021[ego,alter] <- as.numeric(sum(str_detect(pubs_sel2$author, name_alter)) > 1) #did alter publish with ego
  }
}

c(dim(network2010_2012),4)
net_array <- array(data = c(network2010_2012, network2013_2015, network2016_2018, network2019_2021), dim=c(dim(network2010_2012),4))

net_array[1,1,1]

save(net_array, file="soc_net_array.RData")