Dependent variables: Revision

Last compiled on May, 2025

---

This is the code with which we make our dependent variables.

---

1 Initatiating R environment

Start out with a custom function to load a set of required packages.

# packages and read data
rm(list = ls())

# (c) Jochem Tolsma
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)
        }
    })
}
packages = c("haven", "coda", "matrixStats", "parallel", "MASS", "doParallel", "dplyr", "cowplot", "tidyverse",
    "naniar", "dotwhisker", "gt", "reshape2", "VGAM", "expss", "networkscaleup")
fpackage.check(packages)
rm(packages)

# repo <- '/yourscratch/' # yourpath
df <- read_dta("data/DQUESTUU_eindbestand.dta")

# personid
dfpid <- read.csv("data/iomatch.csv")

# df <- data.frame(df) nrow(as.matrix(na.omit(df[,c(89:100)]))) # no NAs on the demographic
# variables

---

2 Data manipulation

Essentially making the same data frame as the NSUM data frame (that I didn’t safe at that point). It’s a copy of that code chunk.

#--------------------------------------------------------------------------------
# some data prep

# v1 in data
ref1 <- c(84957, 75214, 145600, 168066, 2500, 29808, 1558549)
# ORDER: uni, hbo, mbo, dochter/zoon, tweeling, randstad, corona
df1_1 <- df[, c(8:14)]
df1_2 <- df[, c(1:7)]

# conditional filling in of zeros when respondents answer 'no' I don't know that person loop of
# collength
for (i in 1:length(df1_2)) {
    df1_1[[i]] <- ifelse(df1_2[[i]] == 2, 0, df1_1[[i]])
}

This is the second chunk of the NSUM questions that I make.

#--------------------------------------------------------------------------------
# v2 in data
ref2 <- c(273259, 460618, 261000)
# ORDER: elecauto, scooter, vegan,
df2_1 <- df[, c(18:20)]
df2_2 <- df[, c(15:17)]

# filling of zeros loop of collength
for (i in 1:length(df2_2)) {
    df2_1[[i]] <- ifelse(df2_2[[i]] == 2, 0, df2_1[[i]])
}

And this is the third.

#--------------------------------------------------------------------------------
# v3 in data
ref3 <- c(15276, 16350, 27394, 21200, 25681, 334502, 29955, 266522, 39481, 2692, 136296, 110231, 112807,
    98208, 1386, 2186, 11640, 22704, 13276, 40543, 17024, 23167, 307032, 36411, 49182, 186746, 35973,
    134956, 118610, 86500, 102296, 4213, 5003, 4517)
# ORDER: Sophie, Julia,Sanne,Lisa,Laura,Maria,Linda,Johanna,Monique,Ester,
# Anna,Elisabeth,Cornelia,Wilhelmina,Amira,Samira,Sara,Daan,Sem,
# Thomas,Max,Kevin,Johannes,Dennis,Jeroen,Jan,Marcel,Cornelis,Hendrik,Petrus,
# Willem,Ali,Mohammed,Noor

df3_1 <- df[, c(55:88)]
df3_2 <- df[, c(21:54)]

# filling in of zeros loop of collength
for (i in 1:length(df3_2)) {
    df3_1[[i]] <- ifelse(df3_2[[i]] == 2, 0, df3_1[[i]])
}

I then columbind those all together and drop the missing values. This ultimately leads to the data set that we start out with.

#--------------------------------------------------------------------------------
# now cbind those matrices together
cont <- cbind(df1_1[, c(1, 2, 3, 4, 5, 7)], df2_1, df3_1)
cont <- as.matrix(na.omit(cont))  # nice, only 60 or so missings
pop <- c(ref1[c(1, 2, 3, 4, 5, 7)], ref2, ref3)  #without randstad (only 4 grote steden, not 'randstad'), These are the known population sizes 
totpop <- 17407585  # Total dutch population in 2020


#--------------------------------------------------------------------------------
# this is important: these are the data we can directly match to, same row order.
df_nomissings <- cbind(df1_2[, c(1, 2, 3, 4, 5, 7)], df1_1[, c(1, 2, 3, 4, 5, 7)], df2_2, df2_1, df3_2,
    df3_1, df[, c(89:100)], dfpid[, c(1)])  # loose randstad to get at same N
names(df_nomissings)[99] <- "personid"
df_nomissings <- na.omit(df_nomissings)

I attach a number of substantive columnnames to those such that we know what is going on.

#--------------------------------------------------------------------------------

# So this is the initial data set we start out with
head(df_nomissings[, c(87:99)])

df_answers1 <- df_nomissings[, c(7:12)]
names(df_answers1) <- c("uni", "hbo", "mbo", "dochterzoon", "tweeling", "corona")

df_answers2 <- df_nomissings[, c(16:18)]
names(df_answers2) <- c("elauto", "scooter", "vegan")

df_answers3 <- df_nomissings[, c(53:86)]
names(df_answers3) <- c("Sophie", "Julia", "Sanne", "Lisa", "Laura", "Maria", "Linda", "Johanna", "Monique",
    "Ester", "Anna", "Elisabeth", "Cornelia", "Wilhelmina", "Amira", "Samira", "Sara", "Daan", "Sem",
    "Thomas", "Max", "Kevin", "Johannes", "Dennis", "Jeroen", "Jan", "Marcel", "Cornelis", "Hendrik",
    "Petrus", "Willem", "Ali", "Mohammed", "Noor")
df_answers <- cbind(df_answers1, df_answers2, df_answers3)

#--------------------------------------------------------------------------------

---

3 Data merging

Now it’s time to merge the different NSUM estimates. Note the four different scenarios that are each loaded into the environment. They each correspondent to a different tauK scenario.

# let's load the lower tauKs=25
dfl25 <- list()
for (i in 1:43) {

    dfl25[[i]] <- read.csv(paste0("data/degree_estimates_tauK025_holdout", i, ".txt"), header = TRUE)
    dfl25[[i]][, 1] <- NULL
    names(dfl25[[i]]) <- c(paste0("ns25_", i), paste0("se25_", i))

}
dfl25 <- bind_cols(dfl25)

The second match.

#--------------------------------------------------------------------------------

# let's load the lower tauKs=50
dfl50 <- list()
for (i in 1:43) {

    dfl50[[i]] <- read.csv(paste0("data/degree_estimates_tauK050_holdout", i, ".txt"), header = TRUE)
    dfl50[[i]][, 1] <- NULL
    names(dfl50[[i]]) <- c(paste0("ns50_", i), paste0("se50_", i))

}
dfl50 <- bind_cols(dfl50)

The third match.

#--------------------------------------------------------------------------------

# let's load the lower tauKs=75
dfl75 <- list()
for (i in 1:43) {

    dfl75[[i]] <- read.csv(paste0("data/degree_estimates_tauK075_holdout", i, ".txt"), header = TRUE)
    dfl75[[i]][, 1] <- NULL
    names(dfl75[[i]]) <- c(paste0("ns75_", i), paste0("se75_", i))

}
dfl75 <- bind_cols(dfl75)

And finally the fourth match. These are essentially the dependent variables to our study: the 142 different network size estimates per individual respondent.

#--------------------------------------------------------------------------------

# let's load the lower tauKs=99
dfl99 <- list()
for (i in 1:43) {

    dfl99[[i]] <- read.csv(paste0("data/degree_estimates_tauK075_holdout", i, ".txt"), header = TRUE)
    dfl99[[i]][, 1] <- NULL
    names(dfl99[[i]]) <- c(paste0("ns99_", i), paste0("se99_", i))

}
dfl99 <- bind_cols(dfl99)
dfs <- cbind(dfl25, dfl50, dfl75, dfl99)


# let's extract the even and odd rows such that we know the standard errors and netsizes
col_odd <- seq_len(ncol(dfs))%%2  # Create column indicator
netsizes <- dfs[, col_odd == 1]  # df with netsizes
stanerrs <- dfs[, col_odd == 0]  # df with standard errors
write.table(netsizes, file = "data/dutch_netsize_desc.txt")

Note that I made that identifier in a prior page. I now match those nonmissing demographic variables, the network sizes, and answers to that identifier on the basis of the identifier that I gave to I&O research. I know that I don’t have diplicates on my side, so only looking at the ID 19496, I know that that is a duplicate that I drop from the rest of the paper. We save the data, and continue with the independent variables on the next page.

#--------------------------------------------------------------------------------
######################## INPUT NEW IO DATA


df <- cbind(df_nomissings[, c(87:99)], netsizes, df_answers)
# df$personid <- df[,13] df[,13] <- NULL

# input extra info from io here
dfio <- read_spss("data/DQUESTUU_eindbestand_3.sav")

df <- left_join(df, dfio, by = c(personid = "personid"))

# x<-data.frame(table(dfio$personid))

# any doubles?
x <- data.frame(table(df$personid))
x[which.max(x$Freq), ]  # --> 19496

df[df$personid == 19496, ]
df <- df[!df$personid == 19496, ]

---

4 Naive estimator

So now we want to make a number of variables with the naive NSUM estimator. This to compare the network sizes across different blocks of questions and names.

#--------------------------------------------------------------------------------
######################## Get naive scores from three blocks ant total

ref1 <- c(84957, 75214, 145600, 168066, 2500, 1558549)
# 'uni', 'hbo', 'mbo', 'dochterzoon', 'tweeling', 'corona',
ref2 <- c(273259, 460618, 261000)
# 'elauto', 'scooter', 'vegan',
ref3 <- c(15276, 16350, 27394, 21200, 25681, 334502, 29955, 266522, 39481, 2692, 136296, 110231, 112807,
    98208, 1386, 2186, 11640, 22704, 13276, 40543, 17024, 23167, 307032, 36411, 49182, 186746, 35973,
    134956, 118610, 86500, 102296, 4213, 5003, 4517)
# 'Sophie', 'Julia','Sanne','Lisa','Laura','Maria','Linda','Johanna','Monique','Ester',
# 'Anna','Elisabeth','Cornelia','Wilhelmina','Amira','Samira','Sara','Daan','Sem',
# 'Thomas','Max','Kevin','Johannes','Dennis','Jeroen','Jan','Marcel','Cornelis','Hendrik','Petrus',
# 'Willem','Ali','Mohammed','Noor'
totpop <- 17407585
ref <- c(ref1, ref2, ref3)
naive <- df[, c("uni", "hbo", "mbo", "dochterzoon", "tweeling", "corona", "elauto", "scooter", "vegan",
    "Sophie", "Julia", "Sanne", "Lisa", "Laura", "Maria", "Linda", "Johanna", "Monique", "Ester", "Anna",
    "Elisabeth", "Cornelia", "Wilhelmina", "Amira", "Samira", "Sara", "Daan", "Sem", "Thomas", "Max",
    "Kevin", "Johannes", "Dennis", "Jeroen", "Jan", "Marcel", "Cornelis", "Hendrik", "Petrus", "Willem",
    "Ali", "Mohammed", "Noor")]



# naive estimator total
naes <- list()
for (i in 1:length(naive)) {

    naes[[i]] <- data.frame((naive[, c(i)]/ref[i]) * totpop)

}
x <- do.call(cbind, naes)
names(x) <- c("uni", "hbo", "mbo", "dochterzoon", "tweeling", "corona", "elauto", "scooter", "vegan",
    "Sophie", "Julia", "Sanne", "Lisa", "Laura", "Maria", "Linda", "Johanna", "Monique", "Ester", "Anna",
    "Elisabeth", "Cornelia", "Wilhelmina", "Amira", "Samira", "Sara", "Daan", "Sem", "Thomas", "Max",
    "Kevin", "Johannes", "Dennis", "Jeroen", "Jan", "Marcel", "Cornelis", "Hendrik", "Petrus", "Willem",
    "Ali", "Mohammed", "Noor")

# all
x$nsize_naive <- rowSums(x[, c(1:43)])/43

# block 1
x$nsize_b1 <- (x$uni + x$hbo + x$mbo + x$dochterzoon + x$tweeling + x$corona)/9

# block 2
x$nsize_b2 <- (x$elauto + x$scooter + x$vegan)/3

# block 3
x$nsize_b3 <- rowSums(x[, c(10:43)])/34

# block 1+2
x$nsize_b1b2 <- (x$uni + x$hbo + x$mbo + x$dochterzoon + x$tweeling + x$corona + x$elauto + x$scooter +
    x$vegan)/12

# some names 1
x$nsize_n1 <- (x$Sophie + x$Anna + x$Thomas + x$Willem)/4

# some names 2
x$nsize_n2 <- (x$Julia + x$Elisabeth + x$Max + x$Ali)/4

# some names 3
x$nsize_n3 <- (x$Sanne + x$Cornelia + x$Kevin + x$Mohammed)/4

# some names 3
x$nsize_n123 <- (x$Sophie + x$Anna + x$Thomas + x$Willem + x$Julia + x$Elisabeth + x$Max + x$Ali + x$Sanne +
    x$Cornelia + x$Kevin + x$Mohammed)/12


# correlations blocks
cor(x$nsize_b1, x$nsize_b2)
cor(x$nsize_b2, x$nsize_b3)
cor(x$nsize_b1, x$nsize_b3)
cor(x$nsize_b1b2, x$nsize_b3)

# correlation names
cor(x$nsize_n1, x$nsize_n2)
cor(x$nsize_n2, x$nsize_n3)
cor(x$nsize_n1, x$nsize_n3)

# correlation with naive
cor(x$nsize_n1, x$nsize_naive)
cor(x$nsize_n2, x$nsize_naive)
cor(x$nsize_n3, x$nsize_naive)
cor(x$nsize_n123, x$nsize_naive)

summary(x$nsize_naive)

summary(x$nsize_b1)
summary(x$nsize_b2)
summary(x$nsize_b1b2)
summary(x$nsize_b3)

summary(x$nsize_n1)
summary(x$nsize_n2)
summary(x$nsize_n3)
summary(x$nsize_n123)

x <- x[, c("nsize_naive", "nsize_b1", "nsize_b2", "nsize_b3", "nsize_b1b2", "nsize_n1", "nsize_n2", "nsize_n3",
    "nsize_n123")]

df <- cbind(df, x)

# save data
save(df, file = "data/dutch_netsize_analyses_deps.rda")


# load(file = 'data/dutch_netsize_analyses_deps.rda')