AuthorNetFilter.Rmd

---
title: "AuthorNet2"
output: html_document
date: "2026-03-21"
---
# 1. Data Ingestion and Name Extraction
```{r}
# ================================
# LOAD DATA & EXTRACT GRANTEE NAMES
# ================================

# Load required packages for API calls and data handling

# Read raw text file containing grantee information

# Extract candidate names using regex (Firstname Lastname format)

# Clean and filter extracted names:
# - Remove institutional or non-person entries
# - Keep only two-word names
# - Ensure uniqueness


# install.packages(c("httr","jsonlite","dplyr"))
library(httr)
library(jsonlite)
library(dplyr)

# -------------------------------
# STEP 0: Read grantee text file
# -------------------------------
text <- readLines("jus2026adult.txt", warn = FALSE)

# -------------------------------
# STEP 1: Extract grantee names
# -------------------------------
pattern <- "\\b[A-ZÅÄÖ][a-zåäöA-ZÅÄÖ\\-]+\\s+[A-ZÅÄÖ][a-zåäöA-ZÅÄÖ\\-]+"
matches <- gregexpr(pattern, text, perl = TRUE)
names_raw <- regmatches(text, matches)[[1]]

author_names <- unique(names_raw)
author_names <- author_names[!grepl("Apurahansaaja|Stipendiat|Tutkimuslaitos|Forskningsinstitut|Määrä|Belopp|Vuotta|År", author_names)]
(author_names <- author_names[sapply(strsplit(author_names, " "), length) == 2])
```

# 2. Author Identification via OpenAlex API
```{r}
# ================================
# RESOLVE AUTHORS USING OPENALEX
# ================================

# Function to query OpenAlex API and retrieve author candidates

# Loop through names:
# - Search OpenAlex
# - Handle missing results
# - Select best match using highest works_count (proxy for relevance)
# - Store author IDs and metadata
# - Pause requests to avoid API rate limits (HTTP 429)


search_author <- function(name) {
  url <- paste0("https://api.openalex.org/authors?search=", URLencode(name))
  res <- GET(url)
  data <- fromJSON(content(res, "text", encoding="UTF-8"))
  
  if(length(data$results) == 0) return(data.frame(id=NA, display_name=NA, works_count=NA))
  
  if(is.data.frame(data$results)) {
    return(data$results[, c("id","display_name","works_count")])
  }
  
  df <- do.call(rbind, lapply(data$results, function(x) {
    data.frame(
      id = x$id,
      display_name = x$display_name,
      works_count = x$works_count,
      stringsAsFactors = FALSE
    )
  }))
  return(df)
}

# Resolve IDs for all grantees
author_ids <- c()
author_id_map <- data.frame(id=character(), name=character(), stringsAsFactors = FALSE)
```


```{r}
## Pickup based on highest value

# for(name in author_names){
#   cat("\nSearching for:", name, "\n")
#   
#   res <- search_author(name)
#   
#   if(is.null(res) || all(is.na(res$id))) next
#   
#   # Pick author with highest works_count
#   best_idx <- which.max(res$works_count)
#   chosen <- res[best_idx, ]
#   
#   author_ids <- c(author_ids, chosen$id)
#   
#   author_id_map <- rbind(
#     author_id_map,
#     data.frame(
#       id = chosen$id,
#       name = name,
#       display_name = chosen$display_name,
#       works_count = chosen$works_count,
#       stringsAsFactors = FALSE
#     )
#   )
#   
#   cat("Selected:", chosen$display_name, 
#       "| works:", chosen$works_count, "\n")
#   
#   Sys.sleep(1)  # avoid 429
# }

#### Manual pickup

# for(name in author_names){
#   cat("\n============================\n")
#   cat("Searching for:", name, "\n")
#   
#   res <- search_author(name)
#   
#   if(is.null(res) || all(is.na(res$id))){
#     cat("No results found. Skipping...\n")
#     next
#   }
#   
#   # Show results to user
#   print(data.frame(
#     index = seq_len(nrow(res)),
#     display_name = res$display_name,
#     works_count = res$works_count
#   ))
#   
#   # Ask user to choose
#   choice <- readline(prompt = "Select author index (or press Enter to skip): ")
#   
#   if(choice == "") {
#     cat("Skipped.\n")
#     next
#   }
#   
#   choice <- as.numeric(choice)
#   
#   if(is.na(choice) || choice < 1 || choice > nrow(res)){
#     cat("Invalid choice. Skipping...\n")
#     next
#   }
#   
#   chosen <- res[choice, ]
#   
#   # Store selection
#   author_ids <- c(author_ids, chosen$id)
#   
#   author_id_map <- rbind(
#     author_id_map,
#     data.frame(
#       id = chosen$id,
#       name = name,
#       display_name = chosen$display_name,
#       works_count = chosen$works_count,
#       stringsAsFactors = FALSE
#     )
#   )
#   
#   cat("Selected:", chosen$display_name,
#       "| works:", chosen$works_count, "\n")
#   
#   Sys.sleep(1)  # avoid 429
# }
# 
# write.csv(author_id_map, "author_id_map.csv", row.names = FALSE)
# write.csv(author_ids, "author_ids.csv", row.names = FALSE)
author_ids <- read.csv("author_ids.csv")
author_id_map <- read.csv("author_id_map.csv")
```

# 3. Retrieve Publication Data and Construct Co-authorship Relationships
```{r}
# ================================
# FETCH PUBLICATIONS FOR EACH AUTHOR
# ================================

# Function to retrieve all works for an author using cursor-based pagination

# Loop through all author IDs:
# - Download complete publication lists
# - Store in a combined structure


get_all_papers <- function(author_id){
  papers <- list()
  cursor <- "*"
  
  repeat {
    url <- paste0("https://api.openalex.org/works?filter=author.id:", author_id,
                  "&per-page=200&cursor=", cursor)
    res <- GET(url)
    data <- fromJSON(content(res, "text", encoding="UTF-8"), simplifyVector = FALSE)
    
    papers <- append(papers, data$results)
    
    if(is.null(data$meta$next_cursor)) break
    cursor <- data$meta$next_cursor
  }
  papers
}

# ================================
# BUILD COAUTHORSHIP EDGES
# ================================

# Extract coauthor IDs from each paper:
# - Keep only authors within the target group
# - Remove single-author papers

# Generate pairwise coauthor combinations

# Convert to edge list and map author IDs back to names

# Aggregate repeated collaborations into weighted edges


all_papers <- list()
for(aid in author_ids){
  cat("\nFetching papers for:", aid, "\n")
  papers <- get_all_papers(aid)
  all_papers <- append(all_papers, papers)
}

# -------------------------------
# STEP 5: Extract coauthor IDs from each paper
# -------------------------------
author_lists_ids <- lapply(all_papers, function(p){
  if(!is.list(p) || is.null(p$authorships)) return(NULL)
  
  ids <- sapply(p$authorships, function(a){
    if(!is.null(a$author$id)) a$author$id else NA
  })
  ids <- na.omit(ids)
  
  # Keep only coauthors who are in our grantee list
  ids <- ids[ids %in% author_ids]
  
  if(length(ids) < 2) return(NULL)
  ids
})

author_lists_ids <- author_lists_ids[!sapply(author_lists_ids, is.null)]

# -------------------------------
# STEP 6: Build pairwise edges (IDs)
# -------------------------------
edges <- do.call(rbind, lapply(author_lists_ids, function(ids){
  if(length(ids) < 2) return(NULL)
  t(combn(ids,2))
}))

edges_df <- as.data.frame(edges)
colnames(edges_df) <- c("author1_id","author2_id")

# -------------------------------
# STEP 7: Map IDs back to names
# -------------------------------
edges_df$author1 <- author_id_map$name[match(edges_df$author1_id, author_id_map$id)]
edges_df$author2 <- author_id_map$name[match(edges_df$author2_id, author_id_map$id)]

# Optional: count multiple coauthorships
edges_weighted <- edges_df %>%
  group_by(author1, author2) %>%
  summarise(weight=n(), .groups="drop")

# -------------------------------
# STEP 8: Preview edges
# -------------------------------
print(edges_weighted)
```


# 4. Network Construction and Metrics
```{r}
# ================================
# 📦 Install & load packages
# ================================
#install.packages(c("igraph", "ggraph", "tidygraph", "dplyr", "ggplot2"))

library(igraph)
library(ggraph)
library(tidygraph)
library(dplyr)
library(ggplot2)

# ================================
# 📥 INPUT: your edge list
# ================================
# edges_weighted must have:
# author1 | author2 | weight

# ================================
# NETWORK CREATION & CENTRALITY ANALYSIS
# ================================

# Build undirected graph from edge list

# Compute centrality measures:
# - Degree (collaboration count)
# - Betweenness (bridge role)
# - Closeness (reachability)
# - Eigenvector (influence)

# Detect communities using Louvain algorithm

# Optionally remove low-degree nodes to simplify network

# Prepare graph for visualization

# ================================
# 🧠 Build graph
# ================================
(g <- graph_from_data_frame(edges_weighted, directed = FALSE))

# ================================
# 📊 Centrality measures
# ================================
V(g)$degree <- degree(g)
V(g)$betweenness <- betweenness(g, normalized = TRUE)
V(g)$closeness <- closeness(g, normalized = TRUE)
V(g)$eigen <- eigen_centrality(g)$vector

# ================================
# 🧩 Community detection
# ================================
communities <- cluster_louvain(g)
V(g)$community <- membership(communities)

# ================================
# 🧹 Optional: filter low-degree nodes
# ================================
g <- delete_vertices(g, degree(g) < 2)

# ================================
# 🔄 Convert for ggraph
# ================================
tg <- as_tbl_graph(g)

# ================================
# 🎨 Visualization
# ================================
gg <- ggraph(tg, layout = "fr") +
  geom_edge_link(aes(width = weight), alpha = 0.3) +
  geom_node_point(aes(size = degree, color = as.factor(community))) +
  geom_node_text(aes(label = name), repel = TRUE, size = 3) +
  theme_void()

# ================================
# 🔍 Top central authors
# ================================
cat("\nTop Degree (most collaborators):\n")
print(sort(V(g)$degree, decreasing = TRUE)[1:10])

cat("\nTop Betweenness (key connectors):\n")
print(sort(V(g)$betweenness, decreasing = TRUE)[1:10])

cat("\nTop Closeness (most reachable):\n")
print(sort(V(g)$closeness, decreasing = TRUE)[1:10])

cat("\nTop Eigenvector (most influential):\n")
print(sort(V(g)$eigen, decreasing = TRUE)[1:10])

# ================================
# 💾 Optional: export for Gephi
# ================================
write_graph(g, file = "coauthorship_network.gml", format = "gml")
```


```{r}
netSummary <- data.frame(
  author = V(g)$name,
  degree = degree(g),
  wdegree = strength(g, mode="all", weights=E(g)$weight),
  betweenness = betweenness(g, normalized = TRUE),
  #closeness = closeness(g, normalized = TRUE),
  eigenvector = eigen_centrality(g)$vector,
  community = V(g)$community
)


# Simplify the graph: combine multiple edges
g_simple <- simplify(g,
                     remove.multiple = TRUE,    # combine multiple edges
                     edge.attr.comb = list(weight = "sum"))  # sum the weights
# -------------------------------
# Add all neighbors ordered by edge weight
# -------------------------------
primary_neighbor_MaxW <- sapply(V(g), function(v) {
  # Get neighbors of v
  neigh <- neighbors(g, v)
  if(length(neigh) == 0) return(NA)
  
  # Get edge weights between v and each neighbor
  ew <- sapply(neigh, function(u) {
    E(g)[get.edge.ids(g, c(v,u))]$weight
  })
  
  # Pick neighbor with maximum weight
  neigh_name <- names(neigh)
  neigh_name[which.max(ew)]
})

# Add to your summary dataframe
netSummary$primary_neighbor_MaxW <- primary_neighbor_MaxW 

primary_neighbors_all <- sapply(V(g_simple), function(v) {
  neigh <- neighbors(g_simple, v)
  if(length(neigh) == 0) return(NA)
  
  # Edge weights
  ew <- sapply(neigh, function(u) {
    E(g_simple)[get.edge.ids(g_simple, c(v,u))]$weight
  })
  
  neigh_ordered <- names(neigh)[order(ew, decreasing = TRUE)]
  paste(neigh_ordered, collapse = ", ")
})

netSummary$primary_neighbors <- primary_neighbors_all

# Preview
head(netSummary)

write.csv(netSummary, "netSummary.csv", row.names = FALSE)
```


# 5. Network Visualization and Key Players
```{r}
# ================================
# VISUALIZATION & IDENTIFICATION OF KEY AUTHORS
# ================================

# Plot network using force-directed layout

# Display node size (degree) and color (community)

# Identify and print top authors by centrality metrics

# Export network for external tools (e.g., Gephi)

library(tidyr)
netSummary_long <- netSummary %>%
  select(where(is.numeric)) %>%       # select only numeric columns
  mutate(row_id = row_number()) %>%   # optional: keep row index
  pivot_longer(-row_id, names_to = "metric", values_to = "value")

# -------------------------------
# Plot faceted histograms
# -------------------------------
ggplot(netSummary_long, aes(x=value)) +
  geom_histogram(fill="skyblue", color="black", bins=20) +
  facet_wrap(~metric, scales="free") +
  theme_minimal() +
  labs(title="Distribution of Network Metrics", x=NULL, y="Count")
```

```{r}
library(dplyr)

# Choose centrality to rank by, e.g., weighted degree
centrality_col <- "wdegree"

top3_per_community <- netSummary %>%
  group_by(community) %>%
  arrange(desc(.data[[centrality_col]])) %>%  # sort descending by chosen centrality
  slice_head(n = 3) %>%                     # pick top 3
  ungroup() %>%
  dplyr::select(community, author, all_of(centrality_col), primary_neighbors)

# Preview
top3_per_community

write.csv(top3_per_community, "top3_per_community.csv", row.names = FALSE)
```

## Readme plot
```{r}
library(ggplot2)
library(ggrepel)
library(viridis)

slope <- median(netSummary$wdegree / netSummary$degree, na.rm = TRUE)
slope

p <- ggplot(netSummary, aes(x = degree, y = wdegree, fill = as.factor(community))) +
  
  # Points
  geom_point(shape = 21, size = 3, colour = "black", stroke = 0.5) +
  
  # Labels
  geom_text_repel(aes(label = author), size = 3, max.overlaps = 20) +
  
  # 🔹 Diagonal line y = x
  geom_abline(slope = slope, intercept = 0, linetype = "solid", color = "blue") +
  
  # 🔹 Region annotations
  # Upper region label
  geom_label(
    aes(
      x = max(netSummary$degree)*0.65,
      y = max(netSummary$wdegree)*0.9
    ),
    label = "Researchers who would like to\nstrengthen the current network",
    size = 4,
    fill = "lightpink",
    color = "black",
    label.size = 0.3,
    hjust = 0
  ) +
  
  # Lower region label
  geom_label(
    aes(
      x = max(netSummary$degree)*0.65,
      y = max(netSummary$wdegree)*0.1
    ),
    label = "Researchers who would like to\nexpand network",
    size = 4,
    fill = "palegreen",
    color = "black",
    label.size = 0.3,
    hjust = 0
  )+
  
  scale_fill_brewer(palette = "Paired", name = "Community") +
  
  labs(
    x = "Count of One-Time Coauthorships",
    y = "Total Count of Coauthorships"
  ) +
  
  theme_minimal()

# Save
ggsave("coauthorship_plot.png", plot = p, width = 8, height = 6)
p
```

```{r}
library(plotly)
library(dplyr)

# Create base plotly scatter
plotly_plot <- plot_ly(
  data = netSummary,
  x = ~degree,
  y = ~wdegree,
  type = 'scatter',
  mode = 'markers+text',
  color = ~as.factor(community),
  colors = RColorBrewer::brewer.pal(length(unique(netSummary$community)), "Paired"),
  text = ~author,
  textposition = 'top right',
  marker = list(size = 10, line = list(width = 0.5, color = 'black'))
) %>%
  # Add diagonal line y = slope * x
  add_lines(
    x = c(0, max(netSummary$degree, na.rm = TRUE)),
    y = c(0, max(netSummary$degree, na.rm = TRUE) * slope),
    line = list(color = 'blue', dash = 'solid'),
    inherit = FALSE,
    showlegend = FALSE
  ) %>%
  # Add upper region annotation
  layout(
    annotations = list(
      list(
        x = max(netSummary$degree)*0.65,
        y = max(netSummary$wdegree)*0.9,
        text = "Researchers who would like to<br>strengthen the current network",
        showarrow = FALSE,
        font = list(size = 14, color = "black"),
        bgcolor = "lightpink",
        bordercolor = "black",
        borderwidth = 0.5,
        xanchor = "left"
      ),
      list(
        x = max(netSummary$degree)*0.65,
        y = max(netSummary$wdegree)*0.1,
        text = "Researchers who would like to<br>expand network",
        showarrow = FALSE,
        font = list(size = 14, color = "black"),
        bgcolor = "palegreen",
        bordercolor = "black",
        borderwidth = 0.5,
        xanchor = "left"
      )
    ),
    xaxis = list(title = "Count of One-Time Coauthorships"),
    yaxis = list(title = "Total Count of Coauthorships")
  )

plotly_plot
htmlwidgets::saveWidget(plotly_plot, "interactive_plot.html", selfcontained = TRUE)
```

# 6. Keyword Extraction and Community Labeling
```{r}
# ================================
# EXTRACT RESEARCH TOPICS & LABEL COMMUNITIES
# ================================

# Extract keywords (concepts) from OpenAlex metadata

# Clean and normalize terms:
# - Lowercase
# - Remove generic stopwords

# Aggregate keywords:
# - Per paper → per author → per community

# Select dominant keyword per community

# Assign research theme labels to communities

# Attach labels to summary dataset

library(tidytext)
library(stringr)

# Step 1: Extract keywords from papers
# OpenAlex uses 'concepts' for keywords
all_keywords <- lapply(all_papers, function(p) {
  if(!is.null(p$concepts) && length(p$concepts) > 0){
    sapply(p$concepts, function(c) c$display_name)
  } else {
    NULL
  }
})
all_keywords <- unlist(all_keywords)
all_keywords <- tolower(all_keywords)  # normalize

# Optional: remove very generic terms (like "science", "research")
stopwords <- c("science", "research", "study", "analysis", "method")
all_keywords <- all_keywords[!all_keywords %in% stopwords]

# Step 2: Map papers to authors
paper_author_map <- lapply(all_papers, function(p) {
  ids <- sapply(p$authorships, function(a) a$author$id)
  ids <- ids[ids %in% author_ids]  # keep only our grantees
  ids
})

# Step 3: Aggregate keywords per author
# -------------------------------
# 🔑 Safe extraction of specific keywords
# -------------------------------
author_keywords <- list()

for(paper in all_papers){
  kws <- paper$concepts
  if(is.null(kws) || length(kws) == 0) next
  
  # Extract levels safely
  levels <- sapply(kws, function(c) {
    if(!is.null(c$level)) c$level else NA
  })
  
  # Keep only level >= 3
  kws <- kws[!is.na(levels) & levels >= 3]
  if(length(kws) == 0) next
  
  # Extract names safely
  kws_names <- sapply(kws, function(c) {
    if(!is.null(c$display_name)) tolower(c$display_name) else NA
  })
  kws_names <- kws_names[!is.na(kws_names)]
  if(length(kws_names) == 0) next
  
  # Map to authors in grantee list
  authors_in_paper <- sapply(paper$authorships, function(a) {
    if(!is.null(a$author$id)) a$author$id else NA
  })
  authors_in_paper <- authors_in_paper[!is.na(authors_in_paper) & authors_in_paper %in% author_ids]
  
  for(aid in authors_in_paper){
    author_keywords[[aid]] <- c(author_keywords[[aid]], kws_names)
  }
}

# Step 4: Aggregate keywords per community
community_keywords <- lapply(unique(V(g)$community), function(comm){
  member_ids <- V(g)$name[V(g)$community == comm]
  member_aids <- author_id_map$id[author_id_map$name %in% member_ids]
  
  kws <- unlist(author_keywords[member_aids])
  kws <- kws[!is.na(kws)]
  
  if(length(kws) == 0) return(NA)
  
  # Most frequent keyword
  kw_table <- sort(table(kws), decreasing = TRUE)
  names(kw_table)[1]
})

names(community_keywords) <- unique(V(g)$community)

# Step 5: Assign community labels
V(g)$community_label <- sapply(V(g)$community, function(comm) community_keywords[[as.character(comm)]])

# Preview community labels
community_keywords
netSummary$community_keywords <- community_keywords[
  as.character(netSummary$community)
]

community_ratio_summary <- netSummary %>%
+     group_by(community) %>%
+     summarise(
+         mean_ratio = mean(wdegree / degree, na.rm = TRUE),
+         .groups = "drop"
+     ) %>%
+     arrange(desc(mean_ratio))
> 
> community_ratio_summary
```

# 7. Interactive Network Visualization
```{r}
# ================================
# BUILD INTERACTIVE NETWORK (networkD3)
# ================================

# Prepare nodes and edges for D3 format

# Map node attributes:
# - Community label (color)
# - Degree (size)

# Create interactive force-directed network:
# - Zoomable
# - Scalable node sizes
# - Weighted edges

# Export as HTML for sharing

library(igraph)
library(networkD3)
library(htmlwidgets)

# Extract nodes and edges
nodes <- data.frame(
  name = V(g)$name,
  group = V(g)$community_label   # use your community label for coloring
)

edges <- as.data.frame(get.edgelist(g))
colnames(edges) <- c("source_name", "target_name")

# networkD3 expects numeric indices starting from 0
edges$source <- match(edges$source_name, nodes$name) - 1
edges$target <- match(edges$target_name, nodes$name) - 1

# Optional: include edge weights if you want
edges$value <- E(g)$weight
nodes$degree <- degree(g)
nodes$degree_scaled <- sqrt(nodes$degree)
# Create interactive network
fn <- forceNetwork(
  Links = edges,
  Nodes = nodes,
  Source = "source",
  Target = "target",
  NodeID = "name",
  Group = "group",
  Value = "value",          # edge thickness
  Nodesize = "degree_scaled", # node size
  opacity = 0.9,
  zoom = TRUE,
  fontSize = 12
)


fn

# Save as HTML
saveWidget(fn, "network.html", selfcontained = TRUE)
browseURL("network.html")

```