Supplementary Materials

SOPHIS: An Open-Access Database for Quantitative Studies of Contemporary Philosophy of Science

Preliminaries

Load SOPHIS tables and needed packages.

NB: In the following, we always use the relational version, not the graph version!

Remember to change the folder_path variable to the path of the folder where you download the .csv files.

library(tidyverse)
library(reactable)
library(ggpmisc)
library(scales)
library(stringr)


## Change this
folder_path <- "data"

csv_files <- list.files(path = folder_path, pattern = "\\.csv$", full.names = TRUE)

file_names <- tools::file_path_sans_ext(basename(csv_files))

for (i in seq_along(csv_files)) {
  df <- read.csv(csv_files[i])
  assign(file_names[i], df, envir = .GlobalEnv)
}

remove(df)

article <- article %>%
  mutate(Ack_Text = ifelse(Ack_Text == "", NA, Ack_Text))

Various descriptive stats

Corpus

Articles by journal

articles_by_journal <- article %>%
  group_by(Journal_Abb) %>%
  summarise(n_articles = n_distinct(UT)) %>%
  mutate(perc_articles = n_articles/sum(n_articles))

articles_by_journal %>%
  ggplot(aes(x = reorder(Journal_Abb, perc_articles), y = perc_articles))+
  geom_col(fill = "steelblue")+
  geom_text(aes(label = round(perc_articles * 100,1)), hjust = -0.2)+
  scale_y_continuous(
      labels = scales::percent_format(),
      limits = c(0, 1)
    ) +
    labs(x = "", y = "Proportion of articles in the corpus") +
  coord_flip()+
  theme_minimal()

Articles by publication year:

articles_by_year <- article %>%
  group_by(Pub_Year) %>%
  summarise(n_articles = n_distinct(UT)) %>%
  mutate(perc_articles = n_articles/sum(n_articles))

articles_by_year %>%
  ggplot(aes(x = Pub_Year, y = n_articles))+
  geom_col(fill = "steelblue")+
  geom_text(aes(label = n_articles), vjust = 1.2, color = "white") +
    labs(x = "Publication Year", y = "Number of articles") +
  theme_minimal()

Acknowledgements stats

Number of distinct acknowledgees, number of distinct authors, number of actors that are 1) both authors and acknowledgees, 2) acknowledgees only, 3) authors only:

n_distinct(mention$H_ID) - 1

## [1] 8952

n_distinct(authorship$H_ID)

## [1] 4380

n_distinct(intersect(mention$H_ID, authorship$H_ID))

## [1] 2456

n_distinct(mention$H_ID) - 1 - n_distinct(intersect(mention$H_ID, authorship$H_ID))

## [1] 6496

n_distinct(authorship$H_ID) - n_distinct(intersect(mention$H_ID, authorship$H_ID))

## [1] 1924

Number of articles with acknowledgements:

ack_freq <- sum(!is.na(article$Ack_Text))

ack_freq

## [1] 5376

Acknowledgements intensity (proportion of articles with acknowledgements):

ack_int <- round(100-sum(is.na(article$Ack_Text))/n_distinct(article$UT)*100, 2)

ack_int

## [1] 78.76

Personal acknowledgements intensity (proportion of articles thanking at least one person):

given_mentions_by_article <- mention %>%
  filter(Ent_Category == "PERSON") %>%
  group_by(UT) %>%
  summarise(n_mentions = n_distinct(H_ID)) %>%
  right_join(article, by = "UT") %>%
  mutate(n_mentions = replace_na(n_mentions, 0))


articles_with_personal_ackgees = given_mentions_by_article %>% filter(n_mentions > 0)

ack_pers_int <- round(n_distinct(articles_with_personal_ackgees$UT)/n_distinct(article$UT)*100, 2)

ack_pers_int

## [1] 68.22

Average number of acknowledgees per paper (including only papers with personal acknowledgements):

mention %>%
  filter(!is.na(H_ID)) %>%
  group_by(UT) %>%
  summarise(n_ackgees = n_distinct(H_ID)) %>%
  summarise(avg_n_ackgees = round(mean(n_ackgees),1),
            sd_n_ackgees = round(sd(n_ackgees),1),
            median_n_ackgees = median(n_ackgees)) %>%
  reactable()

Distribution of acknowledgement length (in words):

article %>%
  mutate(ack_word_len = str_count(Ack_Text, "\\S+")) %>%
  filter(!is.na(ack_word_len)) %>%
  ggplot(aes(x=ack_word_len)) +
  geom_histogram(fill = "steelblue")+
  geom_vline(aes(xintercept = mean(ack_word_len)), color = "red")+
  geom_vline(aes(xintercept = median(ack_word_len)), color = "blue")+
  theme_minimal()+
  labs(y = "n articles", x = "Acknowledgement length (in words)")

article %>%
  mutate(ack_word_len = str_count(Ack_Text, "\\S+")) %>%
  filter(!is.na(ack_word_len)) %>%
  summarise(mean_len = round(mean(ack_word_len), 2),
            sd_len = round(sd(ack_word_len),2),
            min_len = min(ack_word_len),
            max_len = max(ack_word_len),
            median_len = median(ack_word_len)) %>%
  reactable()

Out-going mentions per article. We count how many distinct acknowledgees are thanked in each paper and visualize the distribution of the variable

given_mentions_by_article %>%
  filter(n_mentions > 1) %>%
  ggplot(aes(x = n_mentions)) +
    geom_histogram(binwidth = 1, fill = "steelblue") +
    theme_minimal() +
    labs(x = "Mentions given", y = "Number of articles")

given_mentions_by_article %>%
  ggplot(aes(x = n_mentions)) +
    stat_ecdf() +
    theme_minimal() +
    scale_y_continuous(labels = scales::percent_format())+
    labs(x = "Mentions given", y = "Proportion of actors")

Personal acknowledgement intensity by sub-discipline. The average personal intensity is \(68.2\%\)

articles_by_area <- article %>%
  left_join(clustering, by = "UT") %>%
  filter(Resolution == "Intermediate") %>%
  left_join(cluster, by = c("Resolution", "Cluster")) %>%
  group_by(Cluster_Label) %>%
  summarise(n_articles = n_distinct(UT))

number_personal_ack <- given_mentions_by_article %>%
  filter(n_mentions > 0) %>%
  left_join(clustering, by = "UT") %>%
  filter(Resolution == "Intermediate") %>%
  left_join(cluster, by = c("Resolution", "Cluster")) %>%
  group_by(Cluster_Label) %>%
  summarise(n_articles_with_ack = n_distinct(UT)) %>%
  left_join(articles_by_area, by = "Cluster_Label") %>%
  mutate(perc_pers_ack = n_articles_with_ack/n_articles)


avg_pers_ack_intensity = n_distinct(articles_with_personal_ackgees$UT)/n_distinct(article$UT)

avg_pers_ack_intensity

## [1] 0.6822444

number_personal_ack %>%
  ggplot(aes(x = Cluster_Label, y = perc_pers_ack)) +
    geom_col(fill = "steelblue") +
    geom_text(aes(label=round(perc_pers_ack*100, 1)), hjust = -0.2)+
  theme_classic() +
  geom_hline(aes(yintercept = avg_pers_ack_intensity))+
   scale_y_continuous(
      labels = scales::percent_format(),
      limits = c(0, 1)
    ) +
    labs(x = "Subdiscipline", y = "Proportion of articles with acknowledgments") +
  coord_flip()

Personal acknowledgement intensity by journal:

number_personal_ack_by_journal <- given_mentions_by_article %>%
  filter(n_mentions > 0) %>%
  group_by(Journal_Abb)%>%
  summarise(n_articles_with_ack = n_distinct(UT)) %>%
  left_join(articles_by_journal, by = "Journal_Abb") %>%
  mutate(perc_pers_ack = n_articles_with_ack/n_articles)


number_personal_ack_by_journal %>%
  ggplot(aes(x = Journal_Abb, y = perc_pers_ack)) +
    geom_col(fill = "steelblue") +
    geom_text(aes(label=round(perc_pers_ack*100, 1)), hjust = -0.2)+
  theme_classic() +
  geom_hline(aes(yintercept = avg_pers_ack_intensity))+
   scale_y_continuous(
      labels = scales::percent_format(),
      limits = c(0, 1)
    ) +
    labs(x = "Journal", y = "Proportion of articles with acknowledgments") +
  coord_flip()

Funding incidence

Number and proportion of articles mentioning at least one funder (and proportion of articles with acknowledgments):

n_distinct(funding$UT)

## [1] 1990

perc_fund_articles <- round(n_distinct(funding$UT)/n_distinct(article$UT)*100, 2)

perc_fund_articles

## [1] 29.15

perc_fund_article_2 <- round(n_distinct(funding$UT)/sum(!is.na(article$Ack_Text))*100, 2)

perc_fund_article_2

## [1] 37.02

Number of funding bodies and funding countries, followed by top funding bodies and top funding countries:

n_distinct(funder$Funder_ID)

## [1] 515

n_distinct(funder$Funder_Country)

## [1] 51

funding %>%
  group_by(Funder_ID) %>%
  summarise(n_articles = n_distinct(UT)) %>%
  mutate(prop_articles = round(n_articles/n_distinct(article$UT)*100, 2)) %>%
  left_join(funder, by = "Funder_ID") %>%
  select(Funder_Label, Funder_Country_ISO, n_articles, prop_articles) %>%
  arrange(desc(n_articles)) %>%
  reactable(searchable = TRUE)

funding %>%
  left_join(funder, by = "Funder_ID") %>%
  group_by(Funder_Country) %>%
  summarise(n_articles = n_distinct(UT)) %>%
  mutate(prop_articles = round(n_articles/n_distinct(article$UT)*100, 2)) %>%
  select(Funder_Country, n_articles, prop_articles) %>%
  arrange(desc(n_articles)) %>%
  reactable(searchable = TRUE, resizable = TRUE, filterable = TRUE)

Capturing the semantic layer

The Sankey network shows inter-cluster relationships. The nodes are the clusters, the links represent the number of articles shared across clusters.

library(networkD3)

clustering_df <- clustering %>%
  left_join(cluster, by = c("Cluster" = "Cluster", "Resolution" = "Resolution")) %>%
  select(UT, Resolution, Cluster_Label) %>%
  pivot_wider(names_from = Resolution, values_from = Cluster_Label)

all_cluster_labels <- unique(unlist(clustering_df[ , -1]))  # exclude 'DI'

sankey_nodes <- data.frame(name = all_cluster_labels, stringsAsFactors = FALSE)

resolution_pairs <- list(
  c("Coarse", "Intermediate"),
  c("Intermediate", "Fine"))


sankey_links_df <- data.frame()

for (pair in resolution_pairs) {
  res_from <- pair[1]
  res_to <- pair[2]
  
  temp_links <- clustering_df %>%
    filter(!is.na(.data[[res_from]]), !is.na(.data[[res_to]])) %>%
    group_by(source = .data[[res_from]], target = .data[[res_to]]) %>%
    summarise(value = n()) %>%
    mutate(
      source = match(source, sankey_nodes$name) - 1,
      target = match(target, sankey_nodes$name) - 1
    )
  
  sankey_links_df <- bind_rows(sankey_links_df, temp_links)
}


sankey_plot <- sankeyNetwork(
  Links = sankey_links_df,
  Nodes = sankey_nodes,
  Source = "source",
  Target = "target",
  Value = "value",
  NodeID = "name",
  units = "articles",
  fontSize = 20,
  nodeWidth = 30,
  height = 800
)

The flow diagram (a.k.a. alluvial plot) shows relationships across clusters at different levels of resolution:

library(ggalluvial)
library(colorspace)


cluster_flow <- clustering_df %>%
  group_by(Coarse, Intermediate, Fine) %>%
  summarise(Freq = n()) %>%
  filter(Freq >= 20)

colors_raw <- qualitative_hcl(26, palette = "Dynamic")

reordered_indices <- c(seq(1, 26, 2), seq(2, 26, 2))

colors_reordered <- colors_raw[reordered_indices]

cluster_ids <- sort(unique(cluster$Cluster_Label))

cluster_color_map <- setNames(colors_reordered, cluster_ids)

alluvial_plt <- ggplot(data = cluster_flow, aes(y = Freq,
                                      axis1 = Coarse,
                                      axis2 = Intermediate,
                                      axis4 = Fine))+
  geom_flow(aes(fill = after_stat(stratum)))+
  geom_stratum(width = 0.5, aes(fill = after_stat(stratum)))+
  geom_label(stat = "stratum", aes(label=after_stat(stratum)))+
  scale_x_discrete(limits = c("Coarse", "Intermediate","Fine"))+
  scale_fill_manual(values = cluster_color_map) +
  theme_classic()+
  theme(legend.position = "none")+
  labs(x = "Resolution", y = "Number of articles",
       title = "Clustering solutions at different resolutions",
       subtitle = "Flows of 20 articles or less are not shown",
       caption = "R package: ggalluvial") 


ggsave("alluvial.png", dpi = 500, units = "cm", height = 40, width =40) 

Top actors

Individuals

Most productive authors (production broken down by journal, only authors with at least 10 articles are considered):

actor_associations <- actor %>%
  inner_join(association %>% mutate(ass_role = paste0(Association, " (", Role, ")")) %>% select(H_ID, ass_role), by = "H_ID") %>%
  group_by(H_ID) %>%
  summarise(all_ass_roles = paste(unique(ass_role), collapse = ", "))

actor_prizes <- actor %>%
  inner_join(prize %>% mutate(prize_year = paste0(Prize, " (", Award_Year, ")")) %>% select(H_ID, prize_year), by = "H_ID") %>%
  group_by(H_ID) %>%
  summarise(prizes = paste(unique(prize_year), collapse = ", "))



authorship %>%
  group_by(H_ID)%>%
  summarise(n_articles = n_distinct(UT))%>%
  filter(n_articles >= 10) %>% 
  inner_join(authorship, by = "H_ID") %>%
  left_join(article %>% select(UT, Journal_Abb), by = "UT") %>%
  group_by(H_ID, Journal_Abb) %>%
  summarise(n_articles = n_distinct(UT)) %>%
  left_join(actor, by = "H_ID") %>%
  select(H_ID, Standard_Label, Gender, Journal_Abb, n_articles) %>%
  pivot_wider(names_from = Journal_Abb, values_from = n_articles) %>%
  mutate(across(where(is.numeric), ~ replace_na(., 0))) %>%
  mutate(tot_articles = rowSums(across(where(is.numeric)))) %>%
  arrange(desc(tot_articles)) %>%
  left_join(actor_associations, by = "H_ID") %>%
  left_join(actor_prizes, by = "H_ID") %>%
  reactable(searchable = TRUE, filterable = TRUE, sortable = TRUE)

Most mentioned actors:

mention %>%
  filter(H_ID %in% actor$H_ID) %>%
  group_by(H_ID) %>%
  summarise(n_mentions = n_distinct(UT)) %>%
  left_join(actor, by = "H_ID") %>%
  left_join(actor_associations, by = "H_ID") %>%
  left_join(actor_prizes, by = "H_ID") %>%
  select(H_ID, Standard_Label, all_ass_roles, prizes, Gender, n_mentions) %>%
  arrange(desc(n_mentions)) %>%
  reactable(searchable = TRUE,resizable = TRUE, filterable = TRUE)

Correlations between variables at the individual level:

library(corrplot)


men_con_ind <- mention %>%
  filter(H_ID %in% actor$H_ID) %>%
  group_by(H_ID) %>%
  summarise(n_mentions = n_distinct(UT))

author_productivity <- authorship %>%
  group_by(H_ID)%>%
  summarise(n_articles = n_distinct(UT))

ind_data <- actor %>%
  select(H_ID) %>%
  left_join(men_con_ind, by = "H_ID") %>%
  mutate(n_mentions = ifelse(is.na(n_mentions), 0, n_mentions)) %>%
  left_join(author_productivity, by = "H_ID") %>%
  mutate(n_articles = ifelse(is.na(n_articles), 0, n_articles))


cor_matrix <- cor(ind_data %>% select(n_articles, n_mentions), use = "pairwise.complete.obs", method = "pearson")


corrplot(cor_matrix, method = "color", type = "upper",
         tl.col = "black", tl.srt = 45, addCoef.col = "white", diag = FALSE,
          number.digits = 3)

cor_matrix <- cor(ind_data %>% select(n_articles, n_mentions) %>% filter(n_articles > 0 & n_mentions > 0), use = "pairwise.complete.obs", method = "pearson")

corrplot(cor_matrix, method = "color", type = "upper",
         tl.col = "black", tl.srt = 45, addCoef.col = "white", diag = FALSE,
          number.digits = 3)

Institutions

Most prestigious institutions (by authorship, number of distinct authors, number of mentions, and number of officials):

officials_per_inst <- actor_associations %>%
  left_join(affiliation %>% distinct(H_ID, Inst_ID), by = "H_ID") %>%
  group_by(Inst_ID) %>%
  summarise(n_officials = n_distinct(H_ID))

mention_inst <- mention %>%
  filter(H_ID %in% actor$H_ID) %>%
  left_join(article %>% select(UT, Pub_Year), by = "UT") %>%
  left_join(affiliation, by = c("H_ID", "Pub_Year" = "Year")) %>%
  group_by(Inst_ID) %>%
  summarise(n_mentions = n_distinct(UT)) %>%
  left_join(institution, by = "Inst_ID") %>%
  arrange(desc(n_mentions)) %>%
  select(Inst_ID, n_mentions) %>%
  filter(!is.na(Inst_ID))

## Warning in left_join(., affiliation, by = c("H_ID", Pub_Year = "Year")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 2 of `x` matches multiple rows in `y`.
## ℹ Row 16636 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

inst_data <- authorship %>%
  left_join(article %>% select(UT, Pub_Year), by = "UT") %>%
  left_join(affiliation, by = c("H_ID", "Pub_Year" = "Year")) %>%
  group_by(Inst_ID) %>%
  summarise(n_authorships = n_distinct(AT_ID),
            n_authors = n_distinct(H_ID)) %>%
  left_join(officials_per_inst, by = "Inst_ID") %>%
  full_join(mention_inst, by = "Inst_ID") %>%
  left_join(institution, by = "Inst_ID")%>%
  select(Inst_ID, Affiliation_Name, Affiliation_City, Affiliation_Country, n_mentions, n_authorships, n_authors, n_officials) %>%
  filter(!is.na(Inst_ID)) %>%
  mutate(across(where(is.numeric), ~ replace_na(., 0)))

## Warning in left_join(., affiliation, by = c("H_ID", Pub_Year = "Year")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 5 of `x` matches multiple rows in `y`.
## ℹ Row 18 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

inst_data %>%
  arrange(desc(n_authorships)) %>%
  reactable(searchable = TRUE,resizable = TRUE, filterable = TRUE, sortable = TRUE)

Correlations between variables at the institutional level:

vars <- inst_data %>%
  select(n_mentions, n_authorships, n_authors, n_officials)

cor_matrix <- cor(vars, use = "pairwise.complete.obs", method = "pearson")



corrplot(cor_matrix, method = "color", type = "upper",
         tl.col = "black", tl.srt = 45, addCoef.col = "white", diag = FALSE,
          number.digits = 3)

Countries

Most prestigious countries (by authorship, number of distinct authors, number of mentions, and number of officials):

officials_per_country <- actor_associations %>%
  left_join(affiliation %>% distinct(H_ID, Inst_ID), by = "H_ID") %>%
  left_join(institution, by = "Inst_ID") %>%
  group_by(Affiliation_Country) %>%
  summarise(n_officials = n_distinct(H_ID))

country_mention <- mention %>%
  filter(H_ID %in% actor$H_ID) %>%
  left_join(article %>% select(UT, Pub_Year), by = "UT") %>%
  left_join(affiliation, by = c("H_ID", "Pub_Year" = "Year")) %>%
  left_join(institution, by = "Inst_ID") %>%
  group_by(Affiliation_Country) %>%
  summarise(n_mentions = n_distinct(UT)) %>%
  arrange(desc(n_mentions)) %>%
  filter(!is.na(Affiliation_Country))

## Warning in left_join(., affiliation, by = c("H_ID", Pub_Year = "Year")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 2 of `x` matches multiple rows in `y`.
## ℹ Row 16636 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

country_data <- authorship %>%
  left_join(article %>% select(UT, Pub_Year), by = "UT") %>%
  left_join(affiliation, by = c("H_ID", "Pub_Year" = "Year")) %>%
  left_join(institution, by = "Inst_ID") %>%
  group_by(Affiliation_Country) %>%
  summarise(n_authorships = n_distinct(AT_ID),
            n_authors = n_distinct(H_ID)) %>%
  left_join(officials_per_country, by = "Affiliation_Country") %>%
  full_join(country_mention, by = "Affiliation_Country") %>%
  select(Affiliation_Country, n_mentions, n_authorships, n_authors, n_officials) %>%
  filter(!is.na(Affiliation_Country)) %>%
  mutate(across(where(is.numeric), ~ replace_na(., 0))) %>%
  arrange(desc(n_authorships)) 

## Warning in left_join(., affiliation, by = c("H_ID", Pub_Year = "Year")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 5 of `x` matches multiple rows in `y`.
## ℹ Row 18 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

country_data %>%
  reactable(searchable = TRUE,resizable = TRUE, filterable = TRUE, sortable = TRUE)

Correlations between variables at the country level:

vars <- country_data %>%
  select(n_mentions, n_authorships, n_authors, n_officials)

cor_matrix <- cor(vars, use = "pairwise.complete.obs", method = "pearson")



corrplot(cor_matrix, method = "color", type = "upper",
         tl.col = "black", tl.srt = 45, addCoef.col = "white", diag = FALSE,
          number.digits = 3)

Concentration stats

We investigate the concentration of mentions and authorships at the individual and institutional levels, using the Lorentz Curve and the Gini index.

Mention concentration

Let’s start with mentions

library(ineq)


lc_ind <- Lc(men_con_ind$n_mentions)
gini_ind <- ineq(men_con_ind$n_mentions, type = "Gini")
df_ind <- data.frame(p = lc_ind$p, L = lc_ind$L, group = "Individuals")

men_con_inst <- mention %>%
  filter(H_ID %in% actor$H_ID) %>%
  left_join(article %>% select(UT, Pub_Year), by = "UT") %>%
  left_join(affiliation, by = c("H_ID", "Pub_Year" = "Year")) %>%
  group_by(Inst_ID) %>%
  summarise(n_mentions = n_distinct(UT))

## Warning in left_join(., affiliation, by = c("H_ID", Pub_Year = "Year")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 2 of `x` matches multiple rows in `y`.
## ℹ Row 16636 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

lc_inst <- Lc(men_con_inst$n_mentions)
gini_inst <- ineq(men_con_inst$n_mentions, type = "Gini")
df_inst <- data.frame(p = lc_inst$p, L = lc_inst$L, group = "Institutions")

df_lc <- bind_rows(df_ind, df_inst)

p1<-ggplot(df_lc, aes(x = p, y = L, color = group)) +
  geom_line(linewidth = 1.2) +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray50") +
  labs(
    title = "Mentions",
    x = "Cumulative share of actors",
    y = "Cumulative share of mentions",
    color = "Actor type"
  ) +
  scale_color_manual(values = c("Individuals" = "darkred", "Institutions" = "steelblue")) +
  theme_minimal(base_size = 14) +
  theme(plot.title = element_text(hjust = 0.5)) +
  scale_y_continuous(labels = scales::percent_format(),
                     breaks = seq(0, 1, 0.1),
    limits = c(0, 1)) +
  scale_x_continuous(labels = scales::percent_format(),
                     breaks = seq(0, 1, 0.1),
    limits = c(0, 1)) +
  annotate("text", x = 0.1, y = 0.9,
           label = paste0("Gini (Individuals) = ", round(gini_ind, 3)),
           color = "darkred", hjust = 0) +
  annotate("text", x = 0.1, y = 0.8,
           label = paste0("Gini (Institutions) = ", round(gini_inst, 3)),
           color = "steelblue", hjust = 0)
  
p1

Authorship concentration

Now the authorship

lc_ind <- Lc(author_productivity$n_articles)
gini_ind <- ineq(author_productivity$n_articles, type = "Gini")
df_ind <- data.frame(p = lc_ind$p, L = lc_ind$L, group = "Individuals")

au_con_inst <- authorship %>%
  left_join(article %>% select(UT, Pub_Year), by = "UT") %>%
  left_join(affiliation, by = c("H_ID", "Pub_Year" = "Year")) %>%
  group_by(Inst_ID) %>%
  summarise(n_authorships = n_distinct(AT_ID))

## Warning in left_join(., affiliation, by = c("H_ID", Pub_Year = "Year")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 5 of `x` matches multiple rows in `y`.
## ℹ Row 18 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

lc_inst <- Lc(au_con_inst$n_authorships)
gini_inst <- ineq(au_con_inst$n_authorships, type = "Gini")
df_inst <- data.frame(p = lc_inst$p, L = lc_inst$L, group = "Institutions")

df_lc <- bind_rows(df_ind, df_inst)

p2 <- ggplot(df_lc, aes(x = p, y = L, color = group)) +
  geom_line(linewidth = 1.2) +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray50") +
  labs(
    title = "Authorships",
    x = "Cumulative share of actors",
    y = "Cumulative share of authorships",
    color = "Actor type"
  ) +
  scale_color_manual(values = c("Individuals" = "darkred", "Institutions" = "steelblue")) +
  theme_minimal(base_size = 14) +
  theme(plot.title = element_text(hjust = 0.5)) +
  scale_y_continuous(labels = scales::percent_format(),
                     breaks = seq(0, 1, 0.1),
    limits = c(0, 1)) +
  scale_x_continuous(labels = scales::percent_format(),
                     breaks = seq(0, 1, 0.1),
    limits = c(0, 1)) +
  annotate("text", x = 0.1, y = 0.9,
           label = paste0("Gini (Individuals) = ", round(gini_ind, 3)),
           color = "darkred", hjust = 0) +
  annotate("text", x = 0.1, y = 0.8,
           label = paste0("Gini (Institutions) = ", round(gini_inst, 3)),
           color = "steelblue", hjust = 0)
  

p2

library(patchwork)

combined_plot <- p1 + p2 + plot_layout(guides = "collect") & theme(legend.position = "bottom")

ggsave(
  filename = "lorenz_curves.png",  
  plot = combined_plot,            
  width = 12,                      
  height = 6,                      
  dpi = 600                        
)

Mentions model

We use a negative binomial regression to check how the number of mentions is affected by various characteristics of the actors.

For a negative binomial regression, the expected mention count \(\mu_{i}\) for person \(i\) is modeled as:

\[Y_{i} \sim \text{NegBin}(\mu_{i}, \theta)\]

where:

• \(Y_{i}\) = mentions of person \(i\)
• \(\mu_{i}\) = expected mentions
• \(\theta\) = overdispersion parameter

Using a log-link, the model is:

\[log(\mu_{i}) = \beta_0 + \beta_1 \text{Awards}_{i} + \beta_2 \text{PhilSciPubs} + \beta_3 \text{GovRole} + \beta_4 \text{Eng} + \beta_5 \text{Gender} + \beta_6 \text{Pubs} + \beta_7 \text{Cits} + \beta_8\text{Funding}\]

where:

• \(\beta_0\) = intercept
• \(\beta_1\) = effect of number of awards received
• \(\beta_2\) = effect of number of publications in philosophy of science journals
• \(\beta_3\) = effect of number of governing roles in professional associations
• \(\beta_4\) = effect of being affiliated with at least one English-speaking country during the career (being affiliated = \(1\))
• \(\beta_5\) = effect of gender (male = \(1\))
• \(\beta_6\) = effect of the overall number of publications (in Scopus, at 2024)
• \(\beta_7\) = effect of the overall number of citations (in Scopus, at 2024)
• \(\beta_8\) = effect of the number of externally funded articles

Building data for the regression

Let’s collect data from the various tables of SOPHIS.

NB: We remove all actors for which some data are missing. Of the \(\approx 10,000\) actors, \(\approx 40\%\) have no affiliation data recorded. This leaves us with \(6.477\) observations of \(8\) variables (\(1\) response variable + \(8\) predictors).

n_mentions = mention %>%
  filter(!is.na(H_ID)) %>%
  group_by(H_ID) %>%
  summarise(n_mentions = n_distinct(UT))

n_awards <- prize %>%
  group_by(H_ID) %>%
  summarise(n_awards = n())

n_phil_sci_pubs <- authorship %>%
  group_by(H_ID) %>%
  summarise(n_phil_sci_pubs = n_distinct(UT))

n_gov_roles <- association %>%
  group_by(H_ID) %>%
  summarise(n_gov_roles = n_distinct(Assoc_ID))


english_countries <- c("United States", "United Kingdom", "Australia", "New Zealand")

english_speaking_authors <- authorship %>%
  left_join(article, by = "UT") %>% 
  dplyr::select(H_ID, UT, Pub_Year) %>%
  left_join(affiliation, by = c("H_ID", "Pub_Year" = "Year")) %>%
  left_join(institution, by = "Inst_ID") %>%
  mutate(english_dummy = ifelse(is.na(Affiliation_Country), NA,
                                ifelse(Affiliation_Country %in% english_countries, 1,
                                       0))) %>%
  group_by(H_ID) %>%
  summarise(english_aff = max(english_dummy)) 

## Warning in left_join(., affiliation, by = c("H_ID", Pub_Year = "Year")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 5 of `x` matches multiple rows in `y`.
## ℹ Row 18 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

english_speaking_ackgees <- mention %>%
  left_join(article, by = "UT") %>% 
  inner_join(actor, by = "H_ID") %>%
  dplyr::select(H_ID, UT, Pub_Year) %>%
  left_join(affiliation, by = c("H_ID", "Pub_Year" = "Year")) %>%
  left_join(institution, by = "Inst_ID") %>%
  mutate(english_dummy = ifelse(is.na(Affiliation_Country), NA,
                                ifelse(Affiliation_Country %in% english_countries, 1,
                                       0))) %>%
  group_by(H_ID) %>%
  summarise(english_aff = max(english_dummy)) 

## Warning in left_join(., affiliation, by = c("H_ID", Pub_Year = "Year")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 2 of `x` matches multiple rows in `y`.
## ℹ Row 16636 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

english_speaking_actors <- dplyr::union(english_speaking_authors, english_speaking_ackgees) %>%
  group_by(H_ID) %>%
  summarise(english_affiliation = max(english_aff)) 


gender <- actor %>%
  mutate(gender_dummy = ifelse(Gender == "", NA,
                               ifelse(Gender == "male", 1, 0))) %>%
  dplyr::select(H_ID, gender_dummy)
  

n_funded_articles <- authorship %>%
  inner_join(funding %>% distinct(UT), by = "UT") %>%
  group_by(H_ID) %>%
  summarise(n_funded_articles = n_distinct(UT))


reg_data <- actor %>%
  left_join(n_mentions, by = "H_ID") %>%
  mutate(n_mentions = ifelse(is.na(n_mentions), 0, n_mentions)) %>%
  mutate(gender_dummy = ifelse(Gender == "", NA,
                               ifelse(Gender == "male", 1, 0))) %>%
  left_join(n_awards, by = "H_ID") %>%
  mutate(n_awards = ifelse(is.na(n_awards), 0 , n_awards)) %>%
  left_join(n_gov_roles, by = "H_ID") %>%
  mutate(n_gov_roles = ifelse(is.na(n_gov_roles), 0, n_gov_roles)) %>%
  left_join(english_speaking_actors, by = "H_ID") %>%
  left_join(n_phil_sci_pubs, by = "H_ID") %>%
  mutate(n_phil_sci_pubs = ifelse(is.na(n_phil_sci_pubs), 0 , n_phil_sci_pubs)) %>%
  left_join(n_funded_articles, by = "H_ID") %>%
  mutate(n_funded_articles = ifelse(is.na(n_funded_articles), 0, n_funded_articles)) %>%
  dplyr::select(H_ID, n_mentions, n_awards, n_phil_sci_pubs, n_gov_roles, english_affiliation, gender_dummy, Tot_Publications, Citations, n_funded_articles) %>%
  #### WE REMOVE ACTORS WITH MISSING DATA
  filter(!is.na(english_affiliation)) %>%
  filter(!is.na(gender_dummy)) %>%
  filter(!is.na(Tot_Publications)) %>%
  filter(!is.na(Citations))

reg_data %>%
  left_join(actor %>% dplyr::select(H_ID, Standard_Label), by = "H_ID") %>%
  dplyr::select(Standard_Label, n_mentions, n_awards, n_phil_sci_pubs, n_gov_roles, english_affiliation, gender_dummy, Tot_Publications, Citations, n_funded_articles) %>%
  arrange(desc(n_mentions)) %>%
  reactable(searchable = TRUE, filterable = TRUE, sortable = TRUE)

summary(reg_data)

##      H_ID             n_mentions        n_awards      n_phil_sci_pubs 
##  Length:6477        Min.   :  0.00   Min.   :0.0000   Min.   : 0.000  
##  Class :character   1st Qu.:  0.00   1st Qu.:0.0000   1st Qu.: 0.000  
##  Mode  :character   Median :  1.00   Median :0.0000   Median : 1.000  
##                     Mean   :  2.49   Mean   :0.0088   Mean   : 1.073  
##                     3rd Qu.:  2.00   3rd Qu.:0.0000   3rd Qu.: 1.000  
##                     Max.   :104.00   Max.   :2.0000   Max.   :22.000  
##   n_gov_roles       english_affiliation  gender_dummy    Tot_Publications 
##  Min.   : 0.00000   Min.   :0.0000      Min.   :0.0000   Min.   :   1.00  
##  1st Qu.: 0.00000   1st Qu.:0.0000      1st Qu.:1.0000   1st Qu.:  10.00  
##  Median : 0.00000   Median :1.0000      Median :1.0000   Median :  21.00  
##  Mean   : 0.05558   Mean   :0.5864      Mean   :0.7774   Mean   :  39.07  
##  3rd Qu.: 0.00000   3rd Qu.:1.0000      3rd Qu.:1.0000   3rd Qu.:  43.00  
##  Max.   :14.00000   Max.   :1.0000      Max.   :1.0000   Max.   :1781.00  
##    Citations      n_funded_articles
##  Min.   :     0   Min.   : 0.0000  
##  1st Qu.:    48   1st Qu.: 0.0000  
##  Median :   186   Median : 0.0000  
##  Mean   :  1347   Mean   : 0.3585  
##  3rd Qu.:   650   3rd Qu.: 0.0000  
##  Max.   :228493   Max.   :12.0000

Viz. of the mention distribution

Parameters estimation

Let’s compute the overdispersion of mentions to check if a Negative Binomial is the most appropriate model

overdispersion <- var(reg_data$n_mentions) / mean(reg_data$n_mentions)

print(overdispersion)

## [1] 11.60813

Since \(\text{Var}(Y) >> \text{Mean}(Y)\), the Negative Binomial is the correct choice.

Now let’s estimate the parameters.

library(MASS)

m_nb <- glm.nb(n_mentions ~ n_awards + n_phil_sci_pubs + n_gov_roles + gender_dummy + english_affiliation + Tot_Publications + Citations + n_funded_articles, 
               data = reg_data)

summary(m_nb)

## 
## Call:
## glm.nb(formula = n_mentions ~ n_awards + n_phil_sci_pubs + n_gov_roles + 
##     gender_dummy + english_affiliation + Tot_Publications + Citations + 
##     n_funded_articles, data = reg_data, init.theta = 1.138175011, 
##     link = log)
## 
## Coefficients:
##                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)         -2.213e-01  3.995e-02  -5.540 3.02e-08 ***
## n_awards             8.899e-01  1.242e-01   7.164 7.85e-13 ***
## n_phil_sci_pubs      2.490e-01  1.063e-02  23.420  < 2e-16 ***
## n_gov_roles          2.098e-01  2.696e-02   7.781 7.19e-15 ***
## gender_dummy         1.596e-01  3.696e-02   4.316 1.59e-05 ***
## english_affiliation  6.494e-01  3.147e-02  20.636  < 2e-16 ***
## Tot_Publications     2.331e-03  3.357e-04   6.943 3.83e-12 ***
## Citations           -2.091e-05  4.081e-06  -5.123 3.01e-07 ***
## n_funded_articles   -3.125e-03  2.001e-02  -0.156    0.876    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for Negative Binomial(1.1382) family taken to be 1)
## 
##     Null deviance: 9491.1  on 6476  degrees of freedom
## Residual deviance: 6528.0  on 6468  degrees of freedom
## AIC: 24388
## 
## Number of Fisher Scoring iterations: 1
## 
## 
##               Theta:  1.1382 
##           Std. Err.:  0.0323 
## 
##  2 x log-likelihood:  -24368.3140

Let’s tidy a bit the results and exponentiate the estimates in order to interpret them as percentage change:

library(broom)

broom::tidy(m_nb) %>%
  mutate(
    exp_estimate = exp(estimate),             # multiplicative effect
    pct_change   = (exp(estimate) - 1) * 100  # percent change
  ) %>%
  dplyr::select(term, estimate, std.error, p.value, exp_estimate, pct_change) %>%
  mutate(across(c(estimate, std.error, exp_estimate, pct_change), ~round(., 3)),
         p.value = signif(p.value, 2)) %>%
  # arrange(desc(abs(pct_change))) %>% 
  reactable()

Interpretion of results

• Each additional award multiplies expected mentions by \(\approx 2.44\), meaning \(\approx 144\%\) increase per award. Very strong effect.
• Affiliation with an English-speaking country increases expected mentions by \(\approx 1.91\), meaning \(\approx 91\%\) increase. Strong effect.
• Each additional philosophy of science publication increases expected mentions by \(\approx 1.28\), meaning \(\approx 28\%\) increase per paper.
• Each government role multiplies expected mentions by \(\approx 1.23\), meaning \(\approx 23\%\) increase per role
• Being male increases expected mentions by \(\approx 1.17\), meaning \(\approx 17\%\) increase
• Each additional total publication increases expected mentions by \(\approx 0.23\%\)
• The effect of citations is negligible
• The effect of the number of funded articles is negative (\(\approx -0.3\%\)) but small and not statistically significant.

Focus on gender distribution

Since gender is an important variable that affects the number of mentions received significantly, we focus on gender distribution in the populations of authors and acknowledgees:

actor %>%
  mutate(is_author = ifelse(H_ID %in% authorship$H_ID, 1, 0),
         is_ackgee = ifelse(H_ID %in% mention$H_ID, 1, 0)) %>%
  group_by(Gender) %>%
  summarise(n_authors = sum(is_author),
            n_ackgees = sum(is_ackgee),
            n_actors = n_distinct(H_ID)) %>%
  mutate(perc_authors = round(n_authors/sum(n_authors)*100,1),
         perc_ackgees = round(n_ackgees/sum(n_ackgees)*100,1),
         perc_actors = round(n_actors/sum(n_actors)*100,1)) %>%
  dplyr::select(Gender,
    n_actors, perc_actors,
         n_authors, perc_authors,
         n_ackgees, perc_ackgees) %>%
  reactable()

actor %>%
  mutate(is_author = ifelse(H_ID %in% authorship$H_ID, 1, 0),
         is_ackgee = ifelse(H_ID %in% mention$H_ID, 1, 0),
         Gender = ifelse(Gender == "", "unknown", Gender)) %>%
  group_by(Gender) %>%
  summarise(n_authors = sum(is_author),
            n_ackgees = sum(is_ackgee)) %>%
  pivot_longer(cols = -Gender, names_to = "Population", values_to = "Frequency") %>%
  ggplot(aes(x = Population, y = Frequency, fill = Gender)) +
  geom_col(position = "fill") +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(y = "Proportion")+
  theme_classic()

Social map of philosophy of science

Co-authorship is rare in philosophy of science.

Average number of authors per paper and distribution of papers by number of co-authors:

authorship %>%
  group_by(UT) %>%
  summarise(n_authors = n_distinct(H_ID))%>%
  summarise(avg_n_authors = round(mean(n_authors),2),
            sd_n_authors = round(sd(n_authors),2),
            median_n_authors = median(n_authors)) %>%
  reactable()

authorship %>%
  group_by(UT) %>%
  summarise(n_authors = n_distinct(H_ID))%>%
  group_by(n_authors) %>%
  summarise(n_papers = n_distinct(UT)) %>%
  mutate(perc_papers = round(n_papers/sum(n_papers)*100,1)) %>%
  reactable()

Average number of co-authors per author:

authorship %>%
  inner_join(authorship, by = "UT") %>%
  group_by(H_ID.x) %>%
  summarise(n_coauthors = n_distinct(H_ID.y) - 1) %>%
  summarise(avg_co_authors = round(mean(n_coauthors),2),
            sd_co_authors = round(sd(n_coauthors),2),
            median_co_authors = median(n_coauthors),
            min_co_authors = min(n_coauthors),
            max_co_authors = max(n_coauthors)) %>%
  reactable()

## Warning in inner_join(., authorship, by = "UT"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 4 of `x` matches multiple rows in `y`.
## ℹ Row 4 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

authorship %>%
  inner_join(authorship, by = "UT") %>%
  group_by(H_ID.x) %>%
  summarise(n_coauthors = n_distinct(H_ID.y) - 1) %>% 
  group_by(n_coauthors) %>%
  summarise(n_authors = n_distinct(H_ID.x)) %>%
  mutate(perc_authors = round(n_authors/sum(n_authors)*100,2)) %>%
  reactable()

## Warning in inner_join(., authorship, by = "UT"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 4 of `x` matches multiple rows in `y`.
## ℹ Row 4 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

Co-acknowledgement map

Open interactive VOSviewer map

Each node represents an ackwnoweldgee mentioned at least 10 times in SOPHIS’ acknoweldgments collection (\(n = 447\), top \(5\%\) of all acknowledgees).

The distance between nodes represent the co-acknowledgment similarity: philosophers that are frequently mentioned together in the same acknowledgments are placed closer on the map, while philosophers that are seldom mentioned together are placed far apart.

The size of the node represents the number of mentions received.

The color of the node represents the cluster the node belongs to. Cluster labels are attributed based on the specialization of the acknowledgees belonging to the cluster.

If you hover over a node, a text box will appear with the following information:

• Gender
• Main affiliation
• Association(s)
• Award(s)
• Total mentions, and mentions broken down by articles they come from (resolution: intermediate)
• Total number of articles, and articles broken down by area (resolution: intermediate)
• Cosine similarity between the vectors of mentions by area and article by area
• Spearman similarity between the same two vectors
• Titles (links to articles via DOI)
• Keywords associated with articles in WoS
• Cluster: Human-assigned cluster label

NB: To recreate the map in the paper, change the resolution parameter to \(0.9\) and rotate the map