Real-world example of imaginarycss • imaginarycss

Krackhardt advice network (concise demo)

# Setup
library(imaginarycss)
library(ggplot2)
library(dplyr)


Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(tidyr)
library(scales)
library(reshape2)


Attaching package: 'reshape2'

The following object is masked from 'package:tidyr':

    smiths

knitr::opts_chunk$set(message = FALSE, warning = FALSE, fig.width = 7.2, fig.height = 4.4)
theme_set(theme_minimal(base_size = 13))
set.seed(42)

Data & perceptions

# Load Krackhardt advice network and attributes
data(krack_advice); data(krack_attributes)

# True network
advice_matrix <- acast(krack_advice, from ~ to, value.var = "value", fill = 0)
n_people <- nrow(advice_matrix)

# Simple generator of realistic perception errors (status, visibility, reciprocity)
create_realistic_perceptions <- function(true_net) {
  n <- nrow(true_net); out <- vector("list", n)
  colsums <- colSums(true_net); highdeg <- colsums > median(colsums)
  for (i in seq_len(n)) {
    P <- true_net
    for (j in seq_len(n)) for (k in seq_len(n)) if (i != j && i != k) {
      if (true_net[j,k] == 1 && runif(1) < 0.20) P[j,k] <- 0                 # visibility FN
      if (true_net[j,k] == 0 && highdeg[k] && runif(1) < 0.15) P[j,k] <- 1   # status FP
      if (true_net[j,k] == 1 && true_net[k,j] == 0 && runif(1) < 0.10) P[k,j] <- 1  # reciprocity
    }
    diag(P) <- 0; out[[i]] <- P
  }
  out
}

perceived_networks <- create_realistic_perceptions(advice_matrix)

# Build CSS graph: first = true network, then each perceiver's network
krack_graph <- new_barry_graph(c(list(advice_matrix), perceived_networks))
attr(krack_graph, "network_type") <- "advice"
attr(krack_graph, "n_employees")  <- n_people

Accuracy & quick summary

# Individual accuracy (coerce to plain data.frame for tidy verbs)
acc <- tie_level_accuracy(krack_graph)
acc <- acc[, names(acc)]; class(acc) <- "data.frame"

# Summary stats
summary_stats <- acc |>
  select(-k) |>
  summarise(across(everything(), list(mean = mean, sd = sd), na.rm = TRUE))
summary_stats

  p_0_ego_mean p_0_ego_sd p_1_ego_mean p_1_ego_sd p_0_alter_mean p_0_alter_sd
1            1          0            1          0      0.9050816   0.01593255
  p_1_alter_mean p_1_alter_sd
1      0.7950561   0.03076498

# Plot individual accuracy (TP/TN × Ego/Alter)
acc_long <- acc |>
  select(-k) |>
  pivot_longer(everything(), names_to = "measure", values_to = "p") |>
  mutate(measure = recode(measure,
    p_1_ego="TP (Ego)", p_0_ego="TN (Ego)", p_1_alter="TP (Alter)", p_0_alter="TN (Alter)"
  ),
  measure = factor(measure, levels = c("TP (Ego)","TN (Ego)","TP (Alter)","TN (Alter)")))

ggplot(acc_long, aes(measure, p, fill = measure)) +
  geom_violin(trim = FALSE, alpha = 0.65) +
  geom_boxplot(width = 0.18, outlier.alpha = 0.3, color = "gray25") +
  geom_jitter(width = 0.08, size = 1.2, alpha = 0.5) +
  scale_y_continuous(labels = percent_format()) +
  guides(fill = "none") +
  labs(title = "Individual accuracy", subtitle = "TP/TN × Ego/Alter", x = NULL, y = "Accuracy")

Perceptual structure

# Census and reciprocity error counts
krack_census <- count_imaginary_census(krack_graph)
krack_recip  <- count_recip_errors(krack_graph)

head(krack_census,5)

  id                   name value
1  0 (01) Accurate null (0)    60
2  1 (01) Accurate null (1)    56
3  2 (01) Accurate null (2)    56
4  3 (01) Accurate null (3)    57
5  4 (01) Accurate null (4)    61

head(krack_recip,5)

  id                                 name value
1  0 Partially false recip (omission) (0)    37
2  1 Partially false recip (omission) (1)    27
3  2 Partially false recip (omission) (2)    33
4  3 Partially false recip (omission) (3)    38
5  4 Partially false recip (omission) (4)    30

Quick organizational takeaways

# Basic org metrics
density <- sum(advice_matrix) / (n_people * (n_people - 1))
avg_tp_ego <- mean(acc$p_1_ego, na.rm = TRUE)

most_acc <- which.max(acc$p_1_ego)
least_acc <- which.min(acc$p_1_ego)

cat(
  "Employees:", n_people,
  "\nAdvice density:", round(density, 3),
  "\nAvg TP (Ego):", round(avg_tp_ego, 3),
  "\nMost accurate perceiver:", most_acc, "(", round(acc$p_1_ego[most_acc], 3), ")",
  "\nLeast accurate perceiver:", least_acc, "(", round(acc$p_1_ego[least_acc], 3), ")\n"
)

Employees: 21
Advice density: 0.452
Avg TP (Ego): 1
Most accurate perceiver: 1 ( 1 )
Least accurate perceiver: 1 ( 1 )

References

Krackhardt, D. (1987). Cognitive social structures. Social Networks, 9(2), 109–134.
Vega Yon, G. G., & Demarais, A. (2022). Exponential random graph models for little networks. Social Networks, 70, 181–195.

Built with imaginarycss version 0.1.0.