Load libraries.

# R markdown link: https://rpubs.com/jasohosk/1428122

# Load libraries
packages <- c("ideanet", "kableExtra", "tidyverse", "psych", "purrr")

installed <- packages %in% rownames(installed.packages())
if (any(!installed)) {
  install.packages(packages[!installed])
}
lapply(packages, library, character.only = TRUE)

# Set working directory
setwd(
  "/Users/jasonhoskin/Library/CloudStorage/OneDrive-IndianaUniversity/spring-2026/saa/sgm-caregivers"
)

Load survey/demographics dataset. Test for and remove any rows with NAs.

# Import dataset
url <- "final-combined-table.csv"
df0 <- read.csv(url)

## Assess for NAs
colSums(is.na(df0))
##                      id          current.gender                    race 
##                       0                       0                       0 
##               ethnicity      sexual.orientation               education 
##                       0                       0                       0 
##                military        living.situation          marital.status 
##                       0                       0                       0 
##       employment.status         personal.income         food.insecurity 
##                       0                       0                       0 
##     biological.children not.biological.children     work.hours.per.week 
##                       0                       0                       0 
##        caregiver.burden         ipaq.continuous        ipaq.categorical 
##                       1                       0                       0 
##              loneliness                     qol 
##                       1                       0
# Conduct listwise deletions
df0 <- na.omit(df0)

Read in Network Canvas data.

networks <- nc_read(
  path = "networkcanvasexport_merged")

# Exclude ego_id = 1 (missing data, excluded from analysis)
networks$egos             <- networks$egos             |> filter(ego_id != 1)
networks$alters           <- networks$alters           |> filter(ego_id != 1)
networks$alter_edgelists  <- networks$alter_edgelists  |> filter(ego_id != 1)

res <- ego_netwrite(networks$egos, 
            ego_id = "ego_id",
            networks$alters,
            alter_id = "alter_id",
            alter_ego = "ego_id",
            max_alters = Inf,
            alter_alter = networks$alter_edgelists,
            aa_ego = "ego_id",
            i_elements = "from",
            j_elements = "to")

Check results.

# Average across all networks
res$overall_summary |>
  knitr::kable() |>
  kable_styling(full_width = TRUE, bootstrap_options = c("striped", "hover")) |> 
  column_spec(1, bold = TRUE)
measure_labels measure_descriptions measures
Number of egos/ego networks Total number of egos providing ego networks in dataset 19
Number of alters Total number of alters nominated by egos across entire dataset 214
Number of isolates Number of egos who did not report any alters in their personal network 0
Number of one-node networks Number of egos who reported only one alter in their personal network 0
Smallest non-isolate network size Smallest number of alters provided by a single ego 4
Largest network size Largest number of alters provided by a single ego 21
Average network size Average number of alters provided by a single ego 11.2631578947368
Average network density The average density of personal networks provided by egos (networks with 0-1 alters excluded from calculation) 0.465546476227591
Average fragmentation The mean fragmentation index score of personal networks provided by egos (networks with 0-1 alters excluded from calculation) 0.215077354705838 
# Summaries for each network (ego)
res$summaries |>
  knitr::kable() |>
  kable_styling(full_width = TRUE, bootstrap_options = c("striped", "hover")) |> 
  column_spec(1, bold = TRUE)
ego_id network_size mean_degree density num_isolates prop_isolates num_weakcomponent size_largest_weakcomponent prop_largest_weakcomponent num_strongcomponent size_largest_strongcomponent prop_largest_strongcomponent component_ratio pairwise_strong_un pairwise_weak_un fragmentation_index effective_size efficiency constraint betweenness norm_betweenness dyad_mut dyad_null triad_003 triad_102 triad_201 triad_300
1 9 5.1111111 0.6388889 0 0.0000000 1 9 1.0000000 1 9 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 3.888889 0.4320988 0.3804137 4.333333 0.1203704 23 13 2 28 29 25
2 15 3.4666667 0.2476190 2 0.1333333 4 10 0.6666667 4 10 0.6666667 0.2142857 0.4571429 0.4571429 0.5428571 11.533333 0.7688889 0.1927847 73.333333 0.6984127 26 79 183 232 14 26
3 21 6.5714286 0.3285714 0 0.0000000 2 12 0.5714286 2 12 0.5714286 0.0500000 0.4857143 0.4857143 0.5142857 14.428571 0.6870748 0.1654584 133.000000 0.6333333 69 141 297 885 18 130
4 9 6.2222222 0.7777778 1 0.1111111 2 8 0.8888889 2 8 0.8888889 0.1250000 0.7777778 0.7777778 0.2222222 2.777778 0.3086420 0.3595679 8.000000 0.2222222 28 8 0 28 0 56
5 13 9.6923077 0.8076923 0 0.0000000 1 13 1.0000000 1 13 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 3.307692 0.2544379 0.2826019 2.276984 0.0291921 63 15 4 33 87 162
6 4 1.5000000 0.5000000 0 0.0000000 1 4 1.0000000 1 4 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 2.500000 0.6250000 0.6835938 1.500000 0.2500000 3 3 1 0 3 0
7 6 2.6666667 0.5333333 0 0.0000000 1 6 1.0000000 1 6 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 3.333333 0.5555556 0.4910571 5.000000 0.3333333 8 7 0 12 4 4
8 6 0.6666667 0.1333333 2 0.3333333 4 2 0.3333333 4 2 0.3333333 0.6000000 0.1333333 0.1333333 0.8666667 5.333333 0.8888889 0.3055556 13.000000 0.8666667 2 13 12 8 0 0
9 6 5.0000000 1.0000000 0 0.0000000 1 6 1.0000000 1 6 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 1.000000 0.1666667 0.5601852 0.000000 0.0000000 15 0 0 0 0 20
10 18 3.2222222 0.1895425 2 0.1111111 4 14 0.7777778 4 14 0.7777778 0.1764706 0.6013072 0.6013072 0.3986928 14.777778 0.8209877 0.1605335 105.583333 0.6900871 29 124 438 311 48 19
11 18 6.8888889 0.4052288 1 0.0555556 2 17 0.9444444 2 17 0.9444444 0.0588235 0.8888889 0.8888889 0.1111111 11.111111 0.6172840 0.1883356 68.904762 0.4503579 62 91 170 423 100 123
12 11 2.0000000 0.2000000 2 0.1818182 3 9 0.8181818 3 9 0.8181818 0.2000000 0.6545455 0.6545455 0.3454545 9.000000 0.8181818 0.2342080 39.000000 0.7090909 11 44 82 70 10 3
13 15 4.4000000 0.3142857 0 0.0000000 1 15 1.0000000 1 15 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 10.600000 0.7066667 0.2162960 57.666667 0.5492063 33 72 134 249 36 36
14 12 2.5000000 0.2272727 5 0.4166667 6 7 0.5833333 6 7 0.5833333 0.4545455 0.3181818 0.3181818 0.6818182 9.500000 0.7916667 0.1954317 46.700000 0.7075758 15 51 110 82 16 12
15 7 2.2857143 0.3809524 1 0.1428571 2 6 0.8571429 2 6 0.8571429 0.1666667 0.7142857 0.7142857 0.2857143 4.714286 0.6734694 0.4003685 9.500000 0.4523810 8 13 10 14 7 4
16 9 2.8888889 0.3611111 0 0.0000000 1 9 1.0000000 1 9 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 6.111111 0.6790123 0.3545259 14.250000 0.3958333 13 23 26 32 19 7
17 4 3.0000000 1.0000000 0 0.0000000 1 4 1.0000000 1 4 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 1.000000 0.2500000 0.7656250 0.000000 0.0000000 6 0 0 0 0 4
18 17 5.4117647 0.3382353 1 0.0588235 2 16 0.9411765 2 16 0.9411765 0.0625000 0.8823529 0.8823529 0.1176471 11.588235 0.6816609 0.2074136 45.816667 0.3368873 46 90 234 261 126 59
19 14 6.0000000 0.4615385 0 0.0000000 1 14 1.0000000 1 14 1.0000000 0.0000000 1.0000000 1.0000000 0.0000000 8.000000 0.5714286 0.2451334 31.133333 0.3421245 42 49 54 181 64 65 
plot(res$igraph_objects[[1]]$igraph_ego)

Incorporate SNA data into df0.

# Extract SNA variables from ego_netwrite results
sna_vars <- res$summaries |>
  select(
    ego_id,
    network.size   = network_size,
    mean.degree    = mean_degree,
    ego.density    = density,
    effective.size = effective_size
  )

# Match IDs
df0$id = 1:19

## Join SNA results into df0
df1 <- df0 |>
  left_join(sna_vars, by = c("id" = "ego_id"))

Provide descriptive statistics for continuous variables.

# Create descriptive table
continuous_vars <- df1 |>
  select(
    caregiver.burden,
    ipaq.continuous,
    network.size,
    effective.size,
    mean.degree,
    ego.density,
    work.hours.per.week,
    loneliness,
    qol,
    biological.children,
    not.biological.children
  )

continuous_descriptives <- psych::describe(continuous_vars) |>
  as.data.frame() |>
  select(n, mean, sd, median, min, max, skew, kurtosis)

continuous_descriptives |>
  mutate(across(where(is.numeric), \(x) round(x, 2))) |>
  knitr::kable(
    caption = "Descriptive Statistics for Continuous Variables",
    col.names = c("n", "Mean", "SD", "Median", "Min", "Max", "Skew", "Kurtosis"),
    align = c("r", "r", "r", "r", "r", "r", "r", "r")
  ) |>
  kableExtra::kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE,
    position = "left"
  )
Descriptive Statistics for Continuous Variables
n Mean SD Median Min Max Skew Kurtosis
caregiver.burden 19 19.84 5.30 20.00 11.00 29.00 0.12 -0.84
ipaq.continuous 19 3249.95 3794.43 1884.00 0.00 13488.00 1.90 2.45
network.size 19 11.26 5.16 11.00 4.00 21.00 0.21 -1.30
effective.size 19 7.08 4.43 6.11 1.00 14.78 0.23 -1.40
mean.degree 19 4.18 2.25 3.47 0.67 9.69 0.57 -0.36
ego.density 19 0.47 0.26 0.38 0.13 1.00 0.77 -0.68
work.hours.per.week 19 27.37 19.55 35.00 0.00 60.00 -0.17 -1.52
loneliness 19 8.74 3.28 8.00 3.00 14.00 -0.24 -1.07
qol 19 6.11 2.00 7.00 2.00 9.00 -0.45 -1.09
biological.children 19 0.21 0.54 0.00 0.00 2.00 2.25 4.09
not.biological.children 19 0.42 1.12 0.00 0.00 4.00 2.31 3.96 
# Create histograms
continuous_vars <- c(
  "biological.children",
  "not.biological.children",
  "work.hours.per.week",
  "ego.density",
  "network.size",
  "effective.size",
  "mean.degree",
  "ipaq.continuous",
  "loneliness",
  "qol"
)

df_hist_long <- df1 |>
  select(all_of(continuous_vars)) |>
  pivot_longer(cols = everything(),
               names_to = "variable",
               values_to = "value")

ggplot(df_hist_long, aes(x = value)) +
  geom_histogram(bins = 30, color = "white") +
  facet_wrap(~ variable, scales = "free") +
  theme_bw()

# Create scatterplots of continuous variables by caregiver burden
df_scatter_long <- df1 |>
  select(caregiver.burden, all_of(continuous_vars)) |>
  pivot_longer(
    cols = all_of(continuous_vars),
    names_to = "variable",
    values_to = "value"
  )

ggplot(df_scatter_long, aes(x = value, y = caregiver.burden)) +
  geom_point(alpha = 0.7) +
  facet_wrap(~ variable, scales = "free_x") +
  theme_bw() + 
  labs(x = "Value", y = "Caregiver Burden")

Provide descriptive statistics for categorical variables.

# Create cross tables
categorical_vars <- c(
  "current.gender",
  "race",
  "ethnicity",
  "sexual.orientation",
  "education",
  "military",
  "living.situation",
  "marital.status",
  "employment.status",
  "personal.income",
  "food.insecurity",
  "ipaq.categorical"
)

df1 <- df1 |>
  mutate(across(all_of(categorical_vars), as.factor))

cat_tables <- map(categorical_vars, function(v) {
  df1 |>
    count(.data[[v]], name = "n") |>
    mutate(percent = round(100 * n / sum(n), 1), variable = v) |>
    relocate(variable)
})

names(cat_tables) <- categorical_vars

cat_summary <- map_dfr(categorical_vars, function(v) {
  df1 |>
    count(.data[[v]], name = "n") |>
    mutate(percent = round(100 * n / sum(n), 1), variable = v) |>
    rename(category = .data[[v]]) |>
    select(variable, category, n, percent)
})

cat_summary |>
  knitr::kable(
    col.names = c("Variable", "Category", "n", "%"),
    caption = "Descriptive Statistics for Categorical Variables",
    align = c("l", "l", "r", "r")
  ) |>
  kableExtra::kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE,
    position = "left"
  ) |>
  kableExtra::pack_rows(index = table(cat_summary$variable)[unique(cat_summary$variable)])
Descriptive Statistics for Categorical Variables
Variable Category n %
current.gender
current.gender Female 8 42.1
current.gender Male 9 47.4
current.gender Nonbinary 2 10.5
race
race Asian 1 5.3
race Black 1 5.3
race Multiracial 4 21.1
race White 13 68.4
ethnicity
ethnicity Hispanic/Latino 1 5.3
ethnicity not Hispanic/Latino 18 94.7
sexual.orientation
sexual.orientation Asexual 1 5.3
sexual.orientation Bisexual 2 10.5
sexual.orientation Gay or Lesbian 15 78.9
sexual.orientation Queer 1 5.3
education
education Advanced degree 7 36.8
education College degree 8 42.1
education Doctorate 1 5.3
education High school graduate 2 10.5
education Some college (no degree) 1 5.3
military
military No 18 94.7
military Yes 1 5.3
living.situation
living.situation Assisted living facility 1 5.3
living.situation Other 3 15.8
living.situation Own personal home 12 63.2
living.situation Pay rent on an apartment 3 15.8
marital.status
marital.status Married 9 47.4
marital.status Never been married 7 36.8
marital.status Not married but living with partner 3 15.8
employment.status
employment.status Disabled; Homemaker 1 5.3
employment.status Other 3 15.8
employment.status Student 1 5.3
employment.status Unemployed and looking for work 3 15.8
employment.status Working full-time 8 42.1
employment.status Working part-time 3 15.8
personal.income
personal.income $15,000-$24,999 4 21.1
personal.income $35,000-$49,999 3 15.8
personal.income $50,000-$74,999 2 10.5
personal.income $75,000 and over 6 31.6
personal.income Under $5,000 4 21.1
food.insecurity
food.insecurity 0 11 57.9
food.insecurity 1 8 42.1
ipaq.categorical
ipaq.categorical High 5 26.3
ipaq.categorical Low 3 15.8
ipaq.categorical Moderate 11 57.9 
# Create boxplots
df_cat_long <- df1 |>
  select(caregiver.burden, all_of(categorical_vars)) |>
  pivot_longer(
    cols = all_of(categorical_vars),
    names_to = "variable",
    values_to = "category"
  ) |>
  mutate(category = as.factor(category))

ggplot(df_cat_long, aes(x = category, y = caregiver.burden)) +
  geom_boxplot() +
  facet_wrap( ~ variable, scales = "free_x") +
  theme_minimal() +
  labs(x = "Category", y = "Caregiver burden") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))