Week 6

Still to-do:

• Behaviour model (continuous dep variable!)
• Make plot (department + discipline)
• Goodness of fit analyses + plot
• Use new dataset?
• Functie as varying covariate
• Write introduction etc.
• Data/methods: explain why undirected network

#Trying behaviour as dependent variable

#start clean
rm(list=ls())

fpackage.check <- function(packages) {
    lapply(packages, FUN = function(x) {
        if (!require(x, character.only = TRUE)) {
            install.packages(x, dependencies = TRUE)
            library(x, character.only = TRUE)
        }
    })
}

fsave <- function(x, file = NULL, location = "./data/processed/") {
    ifelse(!dir.exists("data"), dir.create("data"), FALSE)
    ifelse(!dir.exists("data/processed"), dir.create("data/processed"), FALSE)
    if (is.null(file))
        file = deparse(substitute(x))
    datename <- substr(gsub("[:-]", "", Sys.time()), 1, 8)
    totalname <- paste(location, datename, file, ".rda", sep = "")
    save(x, file = totalname)  #need to fix if file is reloaded as input name, not as x. 
}

fload <- function(filename) {
    load(filename)
    get(ls()[ls() != "filename"])
}

fshowdf <- function(x, ...) {
    knitr::kable(x, digits = 2, "html", ...) %>%
        kableExtra::kable_styling(bootstrap_options = c("striped", "hover")) %>%
        kableExtra::scroll_box(width = "100%", height = "300px")
}

fcolnet <- function(data = scholars, university = "RU", discipline = "sociology", waves = list(c(2015,
    2018), c(2019, 2023)), type = c("first")) {

    # step 1
    demographics <- do.call(rbind.data.frame, data$demographics)
    demographics <- demographics %>%
        mutate(Universiteit1.22 = replace(Universiteit1.22, is.na(Universiteit1.22), ""), Universiteit2.22 = replace(Universiteit2.22,
            is.na(Universiteit2.22), ""), Universiteit1.24 = replace(Universiteit1.24, is.na(Universiteit1.24),
            ""), Universiteit2.24 = replace(Universiteit2.24, is.na(Universiteit2.24), ""), discipline.22 = replace(discipline.22,
            is.na(discipline.22), ""), discipline.24 = replace(discipline.24, is.na(discipline.24), ""))

    sample <- which((demographics$Universiteit1.22 %in% university | demographics$Universiteit2.22 %in%
        university | demographics$Universiteit1.24 %in% university | demographics$Universiteit2.24 %in%
        university) & (demographics$discipline.22 %in% discipline | demographics$discipline.24 %in% discipline))

    demographics_soc <- demographics[sample, ]
    scholars_sel <- lapply(scholars, "[", sample)

    # step 2
    ids <- demographics_soc$au_id
    nwaves <- length(waves)
    nets <- array(0, dim = c(nwaves, length(ids), length(ids)), dimnames = list(wave = 1:nwaves, ids,
        ids))
    dimnames(nets)

    # step 3
    df_works <- tibble(works_id = unlist(lapply(scholars_sel$work, function(l) l$id)), works_author = unlist(lapply(scholars_sel$work,
        function(l) l$author), recursive = FALSE), works_year = unlist(lapply(scholars_sel$work, function(l) l$publication_year),
        recursive = FALSE))

    df_works <- df_works[!duplicated(df_works), ]

    # step 4
    if (type == "first") {
        for (j in 1:nwaves) {
            df_works_w <- df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
                ]
            for (i in 1:nrow(df_works_w)) {
                ego <- df_works_w$works_author[i][[1]]$au_id[1]
                alters <- df_works_w$works_author[i][[1]]$au_id[-1]
                if (sum(ids %in% ego) > 0 & sum(ids %in% alters) > 0) {
                  nets[j, which(ids %in% ego), which(ids %in% alters)] <- 1
                }
            }
        }
    }

    if (type == "last") {
        for (j in 1:nwaves) {
            df_works_w <- df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
                ]
            for (i in 1:nrow(df_works_w)) {
                ego <- rev(df_works_w$works_author[i][[1]]$au_id)[1]
                alters <- rev(df_works_w$works_author[i][[1]]$au_id)[-1]
                if (sum(ids %in% ego) > 0 & sum(ids %in% alters) > 0) {
                  nets[j, which(ids %in% ego), which(ids %in% alters)] <- 1
                }
            }
        }
    }

    if (type == "all") {
        for (j in 1:nwaves) {
            df_works_w <- df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
                ]
            for (i in 1:nrow(df_works_w)) {
                egos <- df_works_w$works_author[i][[1]]$au_id
                if (sum(ids %in% egos) > 0) {
                  nets[j, which(ids %in% egos), which(ids %in% egos)] <- 1
                }
            }
        }
    }
    output <- list()
    output$data <- scholars_sel
    output$nets <- nets
    return(output)
}

packages = c("RSiena", "tidyverse")
fpackage.check(packages)

##load data

#network
scholars <- fload("C:/Users/kalle/OneDrive/Documenten/REMA/Jaar 2/Social Networks/KS_labjournal/data/processed/scholars_20240924.rda")
  
scholars_net <- fcolnet(data = scholars, 
                university = c("RU", "UU", "RUG", "UvA", "VU", "EUR", "Leiden", "UvT"), 
                discipline = c("sociology", "political science"), 
                waves = list(c(2015, 2018), c(2019, 2023)), 
                type = c("all"))

wave1 <- scholars_net$nets[1,,]
wave2 <- scholars_net$nets[2,,]


#ego characteristics

df_ego <- fload("C:/Users/kalle/OneDrive/Documenten/REMA/Jaar 2/Social Networks/KS_labjournal/data/processed/20251010df_ego.rda")

citations <- df_ego |>
  select(citations_w1, citations_w2) |>
  as.matrix()

str(citations)

##some checks
dim(wave1)
dim(wave2)

#should be 0
sum(is.na(wave1))

#set diagonal to 0
sum(diag(wave2)==0)

diag(wave1) <- 0
diag(wave2) <- 0

#only 1s and 0s
sum(wave1>1)

#at least some 1s
sum(wave1>0)

#make array
nets <- array(data = c(wave1, wave2), dim = c(dim(wave1), 2))

## dependent
net <- sienaDependent(nets)

citation_dep <- sienaDependent(citations, type = "continuous")

str(citation_dep)


## independent

functie <- coCovar(df_ego$functie_level)

df_ego$Universiteit1.22 <- as.numeric(as.factor(df_ego$Universiteit1.22))
uni <- coCovar(df_ego$Universiteit1.22)

df_ego$discipline.22 <- as.numeric(as.factor(df_ego$discipline.22))
disc <- coCovar(df_ego$discipline.22)

mydata <- sienaDataCreate(net, citation_dep, functie, uni, disc)

#Initial effects and look at data
myeff <- getEffects(mydata)
myeff

print01Report(mydata, modelname = "./results/behavtest_scholars")

##Specify model
myeff <- getEffects(mydata)

#basic structural elements
myeff <- includeEffects(myeff, gwesp, outAct)

#homophily based on position
myeff <- includeEffects(myeff, simX, interaction1 = "functie") #sameX proberen? 
#egoX of AltX toevoegen

#control for same uni and discipline, (gender?)
myeff <- includeEffects(myeff, sameX, interaction1 = "uni")
myeff <- includeEffects(myeff, sameX, interaction1 = "disc")

##behavioural effects?

#attraction towards higher/lower citation scores of alters
myeff <- includeEffects(myeff, linear, quadratic, name = "citation_dep")
myeff <- includeEffects(myeff, avAlt, name = "citation_dep")
myeff <- includeEffects(myeff, avXAlt, interaction1 = "functie", name = "citation_dep")
myeff

#Estimate model

myAlgorithm <- sienaAlgorithmCreate(projname = "scholars", modelType = 3)
EstM1 <- siena07(myAlgorithm, data = mydata, effects = myeff, returnDeps = TRUE)

EstM1