Webscraping Sociology Staff

1 Names and 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
soc_staff <- read_html("https://www.ru.nl/sociology/research/staff/")

head(soc_staff)

class(soc_staff)

soc_staff <- soc_staff %>%
    rvest::html_nodes("body") %>%
    xml2::xml_find_all("//td") %>%
    rvest::html_text()

fodd <- function(x) {
  #what is x, x is a vector
 x%%2 != 0 
}

nstaf <- length(soc_staff)
nstaf
fodd(1:nstaf)

soc_names <- soc_staff[fodd(1:nstaf)] 
head(soc_names)
soc_names

soc_names

soc_experts <- soc_staff[!fodd(1:nstaf)]  # in the 1 until 94st number, get the even elements
head(soc_experts)

soc_df <- data.frame(cbind(soc_names, soc_experts))  

# inspect again, and remove the rows we don't need (check for yourself to be certain!)

delrows <- which(soc_df$soc_names == "Staff:" | soc_df$soc_names == "PhD:" | soc_df$soc_names == "External PhD:" |
    soc_df$soc_names == "Guest researchers:" | soc_df$soc_names == "Other researchers:")

soc_df <- soc_df[-delrows, ]

# Last name seems to be everything before the comma
soc_df$last_name <- gsub(",.*$", "", soc_df$soc_names)

# first name is everything between brackets
soc_df$first_name <- str_extract_all(soc_df$soc_names, "(?<=\\().+?(?=\\))", simplify = TRUE)

soc_df$last_name <- gsub(" J. \\(Jansje\\) van MSc", "", soc_df$last_name)
soc_df$first_name <- tolower(soc_df$first_name)  # everything to lower!
soc_df$last_name <- tolower(soc_df$last_name)

# trimws looses all spacing before and after (if you specify 'both') a character string
soc_df$last_name <- trimws(soc_df$last_name, which = c("both"), whitespace = "[ \t\r\n]")
soc_df$first_name <- trimws(soc_df$first_name, which = c("both"), whitespace = "[ \t\r\n]")
soc_df$soc_experts <- trimws(soc_df$soc_experts, which = c("both"), whitespace = "[ \t\r\n]")
soc_df$soc_names <- trimws(soc_df$soc_names, which = c("both"), whitespace = "[ \t\r\n]")

# set affiliation to radboud, comes in handy for querying google scholar
soc_df$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!
soc_df$gs_id <- ""

for (i in 1:nrow(soc_df)) {
  print(i)
  time <- runif(1, 0, 1)
  Sys.sleep(time)
  
  tryCatch({
     soc_df[i,c("gs_id")] <- get_scholar_id_fix(last_name = soc_df[i, c("last_name")], # so search on last_name of staff (third column)
                                             first_name = soc_df[i, c("first_name")],  # search on first_name of staff (fourth column)
                                             affiliation = soc_df[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
# seems we're left with about 34 sociology staff members!
soc_df <- soc_df[!soc_df$gs_id == "", ]
soc_df

soc_list_profiles <- list()  # first we create an empty list that we then fill up with the for loop
soc_list_publications <- list()

for (i in 1:nrow(soc_df)) {
    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
    soc_list_profiles[[i]] <- get_profile(soc_df[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
    soc_list_publications[[i]] <- get_publications(soc_df[i, c("gs_id")])
    soc_list_publications[[i]][, c("gs_id")] <- soc_df[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
soc_df_publications <- bind_rows(soc_list_publications)

soc_profiles_df <- list()
for (i in 1:length(soc_list_profiles)) {
    # soc_profiles_df[[i]] <- data.frame(t(unlist(soc_list_profiles[[i]][1:8]))) #some annyoing
    # data handling
    soc_profiles_df[[i]] <- unlist(soc_list_profiles[[i]][1:8])
    soc_profiles_df[[i]] <- data.frame(soc_profiles_df[[i]])
    soc_profiles_df[[i]] <- data.frame(t(soc_profiles_df[[i]]))

}
soc_profiles_df <- bind_rows(soc_profiles_df)
soc_df <- left_join(soc_df, soc_profiles_df, by = c(gs_id = "id"))  # merge data with soc_df
soc_df  # notice all the new information we were able to get from the scholar profiles!

# get citation history of a scholar
soc_staff_cit <- list()
for (i in 1:nrow(soc_df)) {

    soc_staff_cit[[i]] <- get_citation_history(soc_df[i, c("gs_id")])

    if (nrow(soc_staff_cit[[i]]) > 0) {
        soc_staff_cit[[i]][, c("gs_id")] <- soc_df[i, c("gs_id")]  # again attach the gs_id as third column
    }
}
soc_staff_cit <- bind_rows(soc_staff_cit)
colnames(soc_staff_cit)[3] <- "gs_id"

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)

}

# 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
soc_collabs <- list()
for (i in 1:nrow(soc_df)) {

    time <- runif(1, 0, 1)
    Sys.sleep(time)

    soc_collabs[[i]] <- fcollabs(soc_df[i, c("gs_id")], 1)

}
soc_collabs <- bind_rows(soc_collabs)  # bind rows, get the unique ones!
soc_collabs_unique <- unique(soc_collabs[, "coauth_id"])  # so 229 unique collaborators for RU staff?
soc_collabs_unique <- soc_collabs_unique[!is.na(soc_collabs_unique)]
save(soc_collabs, file = "addfiles\\soc_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?
collabs_1deep <- list()
for (i in 1:length(soc_collabs_unique)) {

    time <- runif(1, 0, 3)
    Sys.sleep(time)

    if (!soc_collabs_unique[i] %in% soc_df$gs_id) {
        collabs_1deep[[i]] <- fcollabs(soc_collabs_unique[i], 1)

    }
}
collabs_1deep <- bind_rows(collabs_1deep)
collabs_1deep_unique <- unique(collabs_1deep[, 2])
collabs_1deep_unique <- collabs_1deep_unique[!is.na(collabs_1deep_unique)]
save(collabs_1deep, file = "addfiles\\soc_collabs2.RData")  # you notice this takes a while, so we save the data here.

for (i in c("_ukytQYAAAAJ", "lkVq32sAAAAJ", "p3IwtT4AAAAJ")) {
    # drop google scholar ids that look suspiciously productive
    soc_df <- soc_df[!soc_df$gs_id == i, ]
    soc_df_publications <- soc_df_publications[!(soc_df_publications$gs_id == i), ]
    soc_staff_cit <- soc_staff_cit[!(soc_staff_cit$gs_id == i), ]
    soc_collabs <- soc_collabs[!(soc_collabs$gs_id == i), ]
}

2 Gender

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  
#  - 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()
firstname_df$gender <- NA

  for (i in 1:nrow(firstname_df)) {
    print(i)
    name_list[[i]] <- fnames(firstname_df[i, c("name_url")])
    # extract name frequency table and gender info
    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)
}

soc_df %>% mutate(firstname=first_name) -> soc_df

soc_df$firstname
soc_df <- fgender(soc_df, me="Jochem Tolsma, RU/RUG")

save(soc_df, file="soc_df_s2.RData")

3 Ethnicity

load("/Users/anuschka/Documents/labjournal/soc_df22.RData")
soc_df %>% mutate(lastname=last_name) -> soc_df
lastname_df <- soc_df

We moeten de namen in het juiste format zetten.

Dus niet “van der meer”, maar: “meer, van der”.

Dan verwijder ik dubbele achternamen.

#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

4 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(soc_df$lastname, verklaring, kenmerken, sc)

5 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. 

6 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!

soc_df <- cbind(soc_df, vk)
save(soc_df, file="soc_df22")

7 RSiena dataframe

8 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_2013 <- matrix(NA, nrow=nrow(soc_df), ncol=nrow(soc_df))
network2014_2018 <- matrix(NA, nrow=nrow(soc_df), ncol=nrow(soc_df))
network2019_2022 <- 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<=2013)
#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_2013[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>=2014 & 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? 
    network2014_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<=2022)
#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_2022[ego,alter] <- as.numeric(sum(str_detect(pubs_sel2$author, name_alter)) > 1) #did alter publish with ego
  }
}

c(dim(network2010_2013),3)
net_array <- array(data = c(network2010_2013, network2014_2018, network2019_2022), dim=c(dim(network2010_2013),3))

net_array[1,1,1]

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

I didn’t run the last part yet to estimate a model because it will still be altered (more variables)