Who Laughs With Who?

Social Network Analysis of Laughter Researchers

Over the past several years, I have probably read just about every paper published on laughter within the field of psychology. My interest in the topic bloomed during my last semester of undergrad, when my long-time mentor Dr. Sally Farley and I started collecting data for a project that would eventually lead to our recent peer-reviewed paper on laughter contagion. Laughter might be the most underrated research topic in all of nonverbal communication, perhaps even the broader field of social psychology. It’s niche, but not too niche – the literature is sparse enough that you can easily generate novel research questions, yet rich enough for your studies testing them to have solid theoretical grounding. After reading a lot of laughter papers, I started to recognize the names of researchers who would frequently publish on the topic, as well as distinct clusters of them who frequently collaborated and published together. I often wondered just how many unique groups of laughter researchers there were, which researchers might be working in the same labs/groups, and what countries these groups were based in. Over the course of many conversations and projects, I developed some sense of who was working (and probably laughing) with who, though some people were more difficult to pinpoint – particularly those who would collaborate across groups. For whatever reason, it took me – an incoming PhD student and self-proclaimed statistics nerd – until this week to realize that a social network analysis could probably answer all of these questions, if not more.

So like any other sane graduate student in the midst of finals, I decided to spend the very few hours of free time I had this week conducting a social network analysis of laughter researchers. Over the course of this project’s analyses, I was able to identify author collaboration patterns, isolated research clusters, and potential bridge-builders between prominent scholars/groups across subfields of laughter research.

That was a long-winded way of saying – let’s dig in!

PS: Alan Cowen, if you ever see this, I got the idea to post cool, colorful data visualization maps to my personal website from you 😉

Map 1. Laughter Researcher Social Network

The above map is an interactive social network visualization of 129 laughter researchers, with nodes (i.e., circles) colored by research community (six distinct groups identified via algorithmic clustering), sized by impact score, and connected by co-author relationships. Six distinct groups were identified, with each clearly corresponding to a specific subfield, research niche, and/or shared geographic region:

  • Group 1: Neuroscience focus; research uses fMRI and other brain imaging methods to study laughter.
  • Group 2: Research focuses on gelotophobia, humor styles, and individual differences.
  • Group 3: Evolutionary/cross-cultural focus; research examines vocal expressions of emotion across cultures.
  • Group 4: Largest group; studies voice, speech, and auditory neuroscience.
  • Group 5: Smallest group; studies laughter’s role in social cohesion.
  • Group 6: Research focus on multimodal emotion perception and facial expressions of emotion.

I started by creating a list of 33 “seed” laughter researchers. These were scholars in the field of either psychology or neuroscience who – through my years of reading laughter research papers – I knew published at least semi-regularly on the topic. Of course, there are pros and cons of using a manually selected “seed” list as your starting point. If this were a more formal analysis, I might have opted to take a purely algorithmic approach (e.g., start from the most-cited paper and expand outward), though doing so for this project could have resulted in a smaller and more homogeneous network due to oversampling of highly-cited labs. In contrast, manually selecting “seed” researchers helped to ensure balanced representation across subfields, institutions, and research niches, preventing smaller but important research clusters from being excluded.

This is where things start to get interesting. I used the R package openalexR– which interfaces with the OpenAlex API to retrieve bibliographic information about publications – to automatically search for all papers published on laughter by each of the “seed” list authors. This yielded 505 unique papers, which I compiled into a CSV file with columns for title, year, citations, authors, and journal.

From this laughter publication data, I used R to extract all unique author pairs who had co-authored a paper together. Each collaboration between two researchers became an “edge” in the network, weighted by the number of papers they had collaborated on – essentially making sure that pairs who collaborated on more papers had stronger connections in the network. To keep the network manageable and focused on the core laughter research community, I applied a three publication threshold – to be included in the final network, researchers were required to have been listed as an author on at least three laughter-related publications. This filter reduced noise by excluding one-off collaborators and retaining the most prolific laughter researchers.

After creating these collaboration edges, I used the igraph package in R to build the actual network graph. The resulting social network of 129 researchers, connected by 269 collaboration relationships, confirmed what I had suspected all along: there ARE distinct groups of laughter researchers – some more insular than others – with specific, identifiable people facilitating between-group collaborations. However, what makes this laughter network particularly awesome – at least in my opinion – is the strength of its community structure. Put simply, not all social networks are created equal; some end up looking like giant hairballs, where everyone kind of connects to each other but specific relationships are nearly impossible to make out. In contrast, researchers in our laughter network naturally clustered into six distinct groups – identified via the “Louvain algorithm”, which maximizes the density of connections within communities while minimizing connections between them – providing structure to the overall social network.

Beyond identifying specific communities, I calculated several network centrality metrics for each researcher. These are different ways of measuring an individual’s relative “importance” or influence within the larger network. Degree centrality counts direct collaborators, with Sophie Scott emerging as the most well-connected person in the network (84 connections!). Betweenness centrality identifies “bridge” researchers who connect otherwise separate groups – here, Willibald Ruch scored the highest.

If you haven’t noticed it yet, a small orange dot in the middle of the map connects Groups 2, 3, and 4. Represented by this dot – which bridges clusters that rarely interact – is none other than Paul Ekman, who scored highly on betweenness despite collaborating with only three other people in the network. Pretty sweet, huh?

–

For my fellow research/statistics nerds, I have provided a comprehensive, step-by-step overview of how you can run this analysis yourself – including the R code I used – in the drop-down below:

Step-by-Step Guide: Social Network Analysis/Visualization

Step 1: Manually create a list of “seed” researchers – in this case, scholars within the fields of psychology/neuroscience who frequently publish papers on laughter.

Step 2: Install necessary R packages + load required libraries. 

# Install required packages (only need to run once)
install.packages(c("tidyverse", "igraph", "visNetwork", "openalexR",
                   "plotly", "htmlwidgets", "leaflet"))

# Load libraries
library(tidyverse)
library(igraph)
library(visNetwork)
library(openalexR)
library(plotly)
library(htmlwidgets)
library(leaflet)

Step 3: Use the openalexR package to search for each identified seed author. 

seed_authors <- data.frame(
    name = c(
        '(NAME 1)',
        '(NAME 2)',
        '(NAME 3)',
        '(ETC...)',
    ),
    is_seed = TRUE,
    stringsAsFactors = FALSE
)

# Search OpenAlex for each author to get their OpenAlex ID
get_author_id <- function(author_name) {
    cat("Searching:", author_name, "... ")
    Sys.sleep(0.3)  # Rate limiting

    tryCatch({
        result <- oa_fetch(
            entity = "authors",
            search = author_name,
            options = list(per_page = 1),
            verbose = FALSE
        )

        if (nrow(result) == 0) {
            cat("not found\n")
            return(NA)
        }

        id <- result$id[1]
        cat("✓\n")
        return(id)

    }, error = function(e) {
        cat("ERROR\n")
        return(NA)
    })
}

cat("Searching OpenAlex for author IDs...\n")
cat("Total seed researchers:", nrow(seed_authors), "\n\n")

seed_authors$openalex_id <- sapply(seed_authors$name, get_author_id)

# Remove any that weren't found
seed_authors <- seed_authors %>% filter(!is.na(openalex_id))

cat("\n\nFound OpenAlex IDs for", nrow(seed_authors), "out of 33 seed authors\n")
print(head(seed_authors))

# Save
write_csv(seed_authors, "author_ids_clean.csv")
cat("\nSaved to author_ids_clean.csv\n")

Step 4: Get all papers published by seed authors.

seed_authors <- read_csv("author_ids_clean.csv", show_col_types = FALSE)

get_author_papers <- function(author_id, author_name) {
    cat("Fetching papers for", author_name, "... ")

    tryCatch({
        # Query OpenAlex for papers by this author
        works <- oa_fetch(
            entity = "works",
            author.id = author_id,
            verbose = FALSE
        )

        if (is.null(works) || nrow(works) == 0) {
            cat("no papers found\n")
            return(data.frame())
        }

        papers <- works %>%
            select(id, display_name, publication_year, cited_by_count) %>%
            mutate(seed_author = author_name)

        cat(nrow(papers), "papers\n")
        return(papers)

    }, error = function(e) {
        cat("ERROR:", e$message, "\n")
        return(data.frame())
    })
}

cat("Fetching papers from OpenAlex...\n")
cat("This will take several minutes...\n\n")

# Collect all papers
all_papers <- map_df(1:nrow(seed_authors), function(i) {
    Sys.sleep(0.5)  # Rate limiting
    get_author_papers(
        seed_authors$openalex_id[i],
        seed_authors$name[i]
    )
})

# Remove duplicates
papers_df <- all_papers %>%
    distinct(id, .keep_all = TRUE)

cat("\nTotal unique papers:", nrow(papers_df), "\n")

# Save
saveRDS(papers_df, "laughter_papers.rds")
write_csv(papers_df, "laughter_papers_summary.csv")
cat("Saved to laughter_papers.rds and laughter_papers_summary.csv\n")

Step 5: For each paper, get ALL authors (not just seed authors). This is needed to build the collaboration network!

papers_df <- read_csv("laughter_papers_summary.csv", show_col_types = FALSE)

get_paper_authors <- function(paper_id) {
    # Remove URL prefix if present
    clean_id <- str_remove(paper_id, "https://openalex.org/")

    tryCatch({
        work <- oa_fetch(
            entity = "works",
            identifier = clean_id,
            verbose = FALSE
        )

        if (nrow(work) == 0) {
            return(data.frame(
                paper_id = paper_id,
                author_position = NA,
                author_name = NA,
                author_id = NA,
                stringsAsFactors = FALSE
            ))
        }

        # Extract authorship information
        if (!"authorships" %in% names(work) || is.null(work$authorships[[1]])) {
            return(data.frame(
                paper_id = paper_id,
                author_position = NA,
                author_name = NA,
                author_id = NA,
                stringsAsFactors = FALSE
            ))
        }

        authorships <- work$authorships[[1]]

        if (nrow(authorships) == 0) {
            return(data.frame(
                paper_id = paper_id,
                author_position = NA,
                author_name = NA,
                author_id = NA,
                stringsAsFactors = FALSE
            ))
        }

        # Return dataframe with author info
        data.frame(
            paper_id = paper_id,
            author_position = authorships$author_position,
            author_name = authorships$display_name,
            author_id = authorships$id,
            stringsAsFactors = FALSE
        )

    }, error = function(e) {
        return(data.frame(
            paper_id = paper_id,
            author_position = NA,
            author_name = NA,
            author_id = NA,
            stringsAsFactors = FALSE
        ))
    })
}

cat("Fetching authors for", nrow(papers_df), "papers...\n")
cat("This will take 10-15 minutes...\n\n")

# Process with progress indicator
all_authors <- map_df(1:nrow(papers_df), function(i) {
    if (i %% 50 == 0) {
        cat("Processed", i, "of", nrow(papers_df), "papers...\n")
    }
    Sys.sleep(0.1)  # Rate limiting
    get_paper_authors(papers_df$id[i])
})

cat("\nFetching complete!\n")
cat("Total author records:", nrow(all_authors), "\n")

# Join with paper metadata
papers_with_authors <- all_authors %>%
    left_join(
        papers_df %>% select(id, display_name, publication_year, cited_by_count),
        by = c("paper_id" = "id")
    ) %>%
    filter(!is.na(author_name))  # Remove rows where we couldn't get authors

cat("Papers with author data:", n_distinct(papers_with_authors$paper_id), "\n")
cat("Unique authors:", n_distinct(papers_with_authors$author_id), "\n")

# Save
write_csv(papers_with_authors, "papers_with_all_authors.csv")
cat("\nSaved to papers_with_all_authors.csv\n")

# Show example of first authors
first_authors <- papers_with_authors %>%
    filter(author_position == "first") %>%
    select(display_name, author_name, publication_year)

cat("\nExample first authors (first 5 papers):\n")
print(head(first_authors, 5))

Step 6: Build collaboration network edges. Create co-authorship pairs and filter by publication threshold.

papers_authors <- read_csv("papers_with_all_authors.csv", show_col_types = FALSE)
seed_authors <- read_csv("author_ids_clean.csv", show_col_types = FALSE)

cat("Building collaboration network edges...\n")

# ── Extract co-authorship pairs ────────────────────────────────────────────────
# For each paper, create edges between all pairs of authors
edges_list <- papers_authors %>%
    group_by(paper_id) %>%
    filter(n() > 1) %>%  # Only papers with 2+ authors
    summarise(
        authors = list(author_name),
        .groups = 'drop'
    ) %>%
    rowwise() %>%
    mutate(
        pairs = list(
            if(length(authors) >= 2) {
                combn(authors, 2, simplify = FALSE)
            } else {
                list()
            }
        )
    ) %>%
    pull(pairs) %>%
    unlist(recursive = FALSE)

# Convert to dataframe
edges_df <- map_df(edges_list, ~{
    data.frame(
        from_name = .x[1],
        to_name = .x[2],
        stringsAsFactors = FALSE
    )
})

cat("Extracted", nrow(edges_df), "author pairs\n")

# Count collaborations (edge weights)
edges_weighted <- edges_df %>%
    count(from_name, to_name, name = "weight") %>%
    arrange(desc(weight))

cat("Unique collaborations:", nrow(edges_weighted), "\n")

# ── Apply threshold: non-seed authors need 3+ laughter papers ─────────────────
# Count papers per author
author_paper_counts <- papers_authors %>%
    count(author_name, name = "n_papers")

# Filter edges: keep if both authors meet criteria
edges_filtered <- edges_weighted %>%
    left_join(
        author_paper_counts,
        by = c("from_name" = "author_name")
    ) %>%
    rename(from_papers = n_papers) %>%
    left_join(
        author_paper_counts,
        by = c("to_name" = "author_name")
    ) %>%
    rename(to_papers = n_papers) %>%
    left_join(
        seed_authors %>% select(name, is_seed),
        by = c("from_name" = "name")
    ) %>%
    rename(from_seed = is_seed) %>%
    left_join(
        seed_authors %>% select(name, is_seed),
        by = c("to_name" = "name")
    ) %>%
    rename(to_seed = is_seed) %>%
    replace_na(list(from_seed = FALSE, to_seed = FALSE)) %>%
    filter(
        # Keep edge if:
        # - Both are seed authors, OR
        # - From is seed OR has 3+ papers, AND
        # - To is seed OR has 3+ papers
        (from_seed | from_papers >= 3) & (to_seed | to_papers >= 3)
    ) %>%
    select(from_name, to_name, weight)

cat("Edges after filtering:", nrow(edges_filtered), "\n")

# Save
saveRDS(edges_filtered, "edges_final.rds")
write_csv(edges_filtered, "edges_final.csv")
cat("\nSaved edges_final.rds and edges_final.csv\n")

Step 7: Build igraph network and detect communities. Calculate network centrality metrics.

edges_final <- readRDS("edges_final.rds")
seed_authors <- read_csv("author_ids_clean.csv", show_col_types = FALSE)

cat("Building igraph network...\n")

# ── Create igraph object ───────────────────────────────────────────────────────
g <- graph_from_data_frame(
    d = edges_final,
    directed = FALSE
)

cat("Full network:", vcount(g), "nodes,", ecount(g), "edges\n")

# ── Extract main connected component ───────────────────────────────────────────
components <- components(g)
main_component <- which(components$membership == which.max(components$csize))
g_main <- induced_subgraph(g, main_component)

cat("Main component:", vcount(g_main), "nodes,", ecount(g_main), "edges\n")

# ── Run Louvain community detection ────────────────────────────────────────────
cat("\nRunning Louvain community detection...\n")
louvain <- cluster_louvain(g_main, weights = E(g_main)$weight)

cat("Found", max(louvain$membership), "communities\n")
cat("Modularity:", round(modularity(louvain), 3), "\n")

# ── Calculate network metrics ──────────────────────────────────────────────────
cat("\nCalculating network centrality metrics...\n")

node_metrics <- data.frame(
    name = V(g_main)$name,
    community = louvain$membership,
    degree = degree(g_main),
    strength = strength(g_main, weights = E(g_main)$weight),
    betweenness = betweenness(g_main, weights = E(g_main)$weight),
    closeness = closeness(g_main, weights = E(g_main)$weight),
    eigenvector = eigen_centrality(g_main, weights = E(g_main)$weight)$vector,
    constraint = constraint(g_main, weights = E(g_main)$weight)
) %>%
    left_join(
        seed_authors %>% select(name, is_seed),
        by = "name"
    ) %>%
    mutate(is_seed = replace_na(is_seed, FALSE))

cat("\nTop 10 by betweenness centrality (bridge researchers):\n")
node_metrics %>%
    arrange(desc(betweenness)) %>%
    select(name, community, degree, betweenness) %>%
    head(10) %>%
    print()

cat("\nTop 10 by degree centrality (most collaborators):\n")
node_metrics %>%
    arrange(desc(degree)) %>%
    select(name, community, degree, betweenness) %>%
    head(10) %>%
    print()

# ── Save results ───────────────────────────────────────────────────────────────
saveRDS(g_main, "network_main.rds")
saveRDS(node_metrics, "node_metrics.rds")
write_csv(node_metrics, "node_metrics.csv")

cat("\nSaved:\n")
cat("  - network_main.rds (igraph object)\n")
cat("  - node_metrics.rds/.csv (centrality metrics)\n")

Step 8: Calculate author-level impact scores. Weighted by authorship position and citations.

papers_summary <- read_csv("laughter_papers_summary.csv", show_col_types = FALSE)
papers_authors <- read_csv("papers_with_all_authors.csv", show_col_types = FALSE)

cat("Calculating impact scores for researchers...\n")

# ── Calculate author-level impact ──────────────────────────────────────────────
# For each author, calculate weighted authorship contributions
author_contributions <- papers_authors %>%
    left_join(
        papers_summary %>% select(id, cited_by_count),
        by = c("paper_id" = "id")
    ) %>%
    mutate(
        # Authorship position weights
        position_weight = case_when(
            author_position == "first" ~ 1.0,
            author_position == "last" ~ 0.7,
            author_position == "middle" ~ 0.3,
            TRUE ~ 0.5
        ),
        # Log-transform citations to reduce outlier influence
        log_citations = log1p(cited_by_count),
        # Weighted contribution
        contribution = position_weight * log_citations
    )

# Aggregate by author
author_impact <- author_contributions %>%
    group_by(author_name, author_id) %>%
    summarise(
        total_papers = n_distinct(paper_id),
        first_author_n = sum(author_position == "first"),
        last_author_n = sum(author_position == "last"),
        middle_author_n = sum(author_position == "middle"),
        total_citations = sum(cited_by_count, na.rm = TRUE),
        max_cited_paper = max(cited_by_count, na.rm = TRUE),
        # Raw impact score = sum of weighted contributions / papers
        impact_score_raw = sum(contribution, na.rm = TRUE) / n_distinct(paper_id),
        .groups = 'drop'
    )

# Normalize to 0-100 scale
author_impact <- author_impact %>%
    mutate(
        impact_score_norm = scales::rescale(
            impact_score_raw,
            to = c(0, 100),
            from = c(0, max(impact_score_raw, na.rm = TRUE))
        )
    ) %>%
    arrange(desc(impact_score_norm))

cat("\nTop 10 researchers by impact score:\n")
author_impact %>%
    select(author_name, total_papers, total_citations, impact_score_norm) %>%
    head(10) %>%
    print()

# Save
saveRDS(author_impact, "impact_scores.rds")
write_csv(author_impact, "impact_scores.csv")
cat("\nSaved to impact_scores.rds and impact_scores.csv\n")

Step 9: Create interactive network visualization.

library(tidyverse)
library(igraph)
library(visNetwork)

# ── Load data ──────────────────────────────────────────────────────────────────
g_main       <- readRDS("network_main.rds")
node_metrics <- readRDS("node_metrics.rds")
impact       <- readRDS("impact_scores.rds")
seed_authors <- read_csv("author_ids_clean.csv", show_col_types = FALSE)

# ── Community labels and colors ────────────────────────────────────────────────
community_labels <- c(
    "1" = "Group 1",
    "2" = "Group 2",
    "3" = "Group 3",
    "4" = "Group 4",
    "5" = "Group 5",
    "6" = "Group 6"
)

community_colors <- c(
    "1" = "#ffbe0b",
    "2" = "#fb5607",
    "3" = "#ff006e",
    "4" = "#c11cad",
    "5" = "#8338ec",
    "6" = "#3a86ff"
)

# ── Prepare node data ──────────────────────────────────────────────────────────
# Join impact scores
nodes_data <- node_metrics %>%
    left_join(
        impact %>% select(author_name, total_papers, total_citations,
                         max_cited_paper, impact_score_norm),
        by = c("name" = "author_name")
    )

# Count first/last author papers
papers_authors <- read_csv("papers_with_all_authors.csv", show_col_types = FALSE)
author_positions <- papers_authors %>%
    group_by(author_name) %>%
    summarise(
        first_author_n = sum(author_position == "first"),
        last_author_n = sum(author_position == "last"),
        .groups = 'drop'
    )

nodes_data <- nodes_data %>%
    left_join(author_positions, by = c("name" = "author_name"))

# ── Create nodes for visNetwork ────────────────────────────────────────────────
nodes_vis <- nodes_data %>%
    mutate(
        id = name,
        label = name,
        # Size by impact score (8-45px radius)
        value = scales::rescale(impact_score_norm, to = c(8, 45), from = c(0, 100)),
        # Color by community
        color.background = community_colors[as.character(community)],
        color.border = "#ffffff",
        color.highlight.background = "#ffffff",
        color.highlight.border = "#000000",
        group = community_labels[as.character(community)],
        # Font settings - seed authors visible, others hidden initially
        font.size = if_else(is_seed, 13, 0),
        font.color = "#333333",
        # Tooltip
        title = paste0(
            "<b>", name, "</b><br>",
            "<span style='color:", community_colors[as.character(community)],
            "; font-style: italic;'>", community_labels[as.character(community)],
            "</span><br><br>",
            "Laughter papers: <b>", total_papers, "</b><br>",
            "First author: <b>", first_author_n, "</b> | ",
            "Last author: <b>", last_author_n, "</b><br>",
            "Total citations: <b>", total_citations, "</b><br>",
            "Top cited paper: <b>", max_cited_paper, "</b> citations<br>",
            "Impact score: <b>", round(impact_score_norm, 1), "/100</b>"
        )
    )

# ── Create edges for visNetwork ────────────────────────────────────────────────
edges_final <- readRDS("edges_final.rds")

edges_vis <- edges_final %>%
    rename(from = from_name, to = to_name, value = weight) %>%
    mutate(
        title = paste0("Collaborations: ", value),
        color = list(color = "rgba(150,150,150,0.3)"),
        scaling = list(min = 0.4, max = 5)
    )

# ── Create base visNetwork ─────────────────────────────────────────────────────
cat("Creating interactive network visualization...\n")

network <- visNetwork(nodes_vis, edges_vis, width = "100%", height = "100vh") %>%
    # Physics settings - "molasses" for slow, stable layout
    visPhysics(
        solver = "barnesHut",
        barnesHut = list(
            gravitationalConstant = -2000,
            centralGravity = 0.1,
            springLength = 95,
            springConstant = 0.01,
            damping = 0.95,
            avoidOverlap = 0.5
        ),
        stabilization = list(
            enabled = TRUE,
            iterations = 1000
        )
    ) %>%
    # Node styling
    visNodes(
        shape = "dot",
        shadow = list(enabled = TRUE, size = 6, color = "rgba(0,0,0,0.2)"),
        font = list(face = "PT Sans")
    ) %>%
    # Edge styling
    visEdges(
        smooth = FALSE,
        color = list(color = "rgba(150,150,150,0.3)", highlight = "rgba(0,0,0,0.5)")
    ) %>%
    # Interaction
    visInteraction(
        navigationButtons = FALSE,
        hover = TRUE,
        tooltipDelay = 80,
        zoomView = TRUE,
        dragView = TRUE,
        hideEdgesOnDrag = TRUE,
        hideNodesOnDrag = FALSE
    ) %>%
    visOptions(
        highlightNearest = list(enabled = TRUE, hover = FALSE, degree = 1),
        nodesIdSelection = list(enabled = TRUE, main = "Select researcher...")
    )

# ── Add manual legend ──────────────────────────────────────────────────────────
legend_nodes <- data.frame(
    label = c("Group 1", "Group 2", "Group 3", "Group 4", "Group 5", "Group 6"),
    color = c("#ffbe0b", "#fb5607", "#ff006e", "#c11cad", "#8338ec", "#3a86ff"),
    shape = rep("dot", 6),
    size = rep(10, 6),
    font.size = rep(10, 6),
    font.face = rep("PT Sans", 6),
    stringsAsFactors = FALSE
)

network <- network %>%
    visLegend(
        addNodes = legend_nodes,
        useGroups = FALSE,
        position = "left",
        width = 0.12
    )

# ── Save raw HTML ──────────────────────────────────────────────────────────────
visSave(network, "laughter_network_raw.html", selfcontained = TRUE)
cat("Saved raw network to laughter_network_raw.html\n")

# ── Build custom UI with JavaScript ────────────────────────────────────────────
cat("Injecting custom UI (buttons, header, footer)...\n")

# Read raw HTML
html_content <- readLines("laughter_network_raw.html", warn = FALSE)
html_text <- paste(html_content, collapse = "\n")

# Create seed names array for JavaScript
seed_names_js <- paste0(
    "var seedNames = new Set([",
    paste0("'", seed_authors$name, "'", collapse = ", "),
    "]);"
)

# Custom UI HTML/CSS/JS
custom_ui <- paste0('
<style>
* { font-family: "PT Sans", sans-serif !important; }
body, html, .visNetwork { background-color: #ffffff !important; }

#network-header {
    position: fixed;
    top: 0;
    left: 0;
    right: 0;
    background: linear-gradient(to bottom, rgba(255,255,255,0.98), rgba(255,255,255,0.85));
    padding: 20px 30px 15px;
    z-index: 1000;
    border-bottom: 1px solid #e0e0e0;
}

#network-title {
    font-size: 24px;
    font-weight: 600;
    color: #333333;
    margin: 0 0 5px 0;
}

#network-subtitle {
    font-size: 11px;
    color: #777777;
    margin: 0;
}

#label-controls {
    position: fixed;
    top: 90px;
    right: 20px;
    z-index: 1000;
    display: flex;
    gap: 8px;
}

.label-btn {
    background: #eeeeee;
    border: none;
    padding: 8px 16px;
    cursor: pointer;
    font-size: 11px;
    font-weight: 500;
    border-radius: 4px;
    transition: all 0.2s;
    font-family: "PT Sans", sans-serif !important;
}

.label-btn:hover {
    background: #dddddd;
}

.label-btn.active {
    background: #333333;
    color: #ffffff;
}

#network-footer {
    position: fixed;
    bottom: 20px;
    left: 0;
    right: 0;
    text-align: center;
    font-size: 10px;
    color: #999999;
    z-index: 1000;
    pointer-events: none;
}

.vis-legend {
    background: rgba(255,255,255,0.95) !important;
    border: 1px solid #dddddd !important;
    border-radius: 4px !important;
    padding: 8px 10px !important;
    font-size: 10px !important;
}
</style>

<div id="network-header">
    <div id="network-title">Laughter Research Collaboration Network</div>
    <div id="network-subtitle">1990 - 2026 · OpenAlex · Louvain community detection · Node size = impact score</div>
</div>

<div id="label-controls">
    <button class="label-btn" onclick="showAllLabels()">ALL LABELS</button>
    <button class="label-btn active" onclick="showSeedLabels()">SEED AUTHORS</button>
    <button class="label-btn" onclick="hideAllLabels()">NO LABELS</button>
</div>

<div id="network-footer">
    scroll to zoom · drag to pan · click node to highlight connections · hover for details
</div>

<script>
', seed_names_js, '

// Get the network instance
function getNetwork() {
    return HTMLWidgets.find(".visNetwork");
}

// Show all labels
function showAllLabels() {
    var network = getNetwork();
    if (!network) return;

    var nodes = network.body.data.nodes;
    nodes.update(nodes.getIds().map(function(id) {
        return { id: id, font: { size: 12, color: "#333333" } };
    }));

    // Update button states
    document.querySelectorAll(".label-btn").forEach(function(btn) {
        btn.classList.remove("active");
    });
    document.querySelectorAll(".label-btn")[0].classList.add("active");
}

// Show seed labels only
function showSeedLabels() {
    var network = getNetwork();
    if (!network) return;

    var nodes = network.body.data.nodes;
    nodes.update(nodes.get().map(function(node) {
        return {
            id: node.id,
            font: {
                size: seedNames.has(node.id) ? 13 : 0,
                color: "#333333"
            }
        };
    }));

    // Update button states
    document.querySelectorAll(".label-btn").forEach(function(btn) {
        btn.classList.remove("active");
    });
    document.querySelectorAll(".label-btn")[1].classList.add("active");
}

// Hide all labels
function hideAllLabels() {
    var network = getNetwork();
    if (!network) return;

    var nodes = network.body.data.nodes;
    nodes.update(nodes.getIds().map(function(id) {
        return { id: id, font: { size: 0 } };
    }));

    // Update button states
    document.querySelectorAll(".label-btn").forEach(function(btn) {
        btn.classList.remove("active");
    });
    document.querySelectorAll(".label-btn")[2].classList.add("active");
}
</script>
')

# Insert before </body>
html_final <- str_replace(html_text, "</body>", paste0(custom_ui, "\n</body>"))

# Write final HTML
writeLines(html_final, "laughter_network_interactive.html")

cat("\n✓ Saved laughter_network_interactive.html\n")
cat("\nNetwork visualization complete!\n")
cat("  Nodes:", nrow(nodes_vis), "\n")
cat("  Edges:", nrow(edges_vis), "\n")
cat("  Communities:", max(node_metrics$community), "\n")

Leave a Reply

Comments (

0

)

Discover more from

Subscribe now to keep reading and get access to the full archive.

Continue reading