Last updated: 2023-12-20

Checks: 7 0

Knit directory: workflowr-policy-landscape/

This reproducible R Markdown analysis was created with workflowr (version 1.7.1). The Checks tab describes the reproducibility checks that were applied when the results were created. The Past versions tab lists the development history.

R Markdown file: up-to-date

Great! Since the R Markdown file has been committed to the Git repository, you know the exact version of the code that produced these results.

Environment: empty

Great job! The global environment was empty. Objects defined in the global environment can affect the analysis in your R Markdown file in unknown ways. For reproduciblity it’s best to always run the code in an empty environment.

Seed: set.seed(20220505)

The command set.seed(20220505) was run prior to running the code in the R Markdown file. Setting a seed ensures that any results that rely on randomness, e.g. subsampling or permutations, are reproducible.

Session information: recorded

Great job! Recording the operating system, R version, and package versions is critical for reproducibility.

Cache: none

Nice! There were no cached chunks for this analysis, so you can be confident that you successfully produced the results during this run.

File paths: relative

Great job! Using relative paths to the files within your workflowr project makes it easier to run your code on other machines.

Repository version: a30bb03

Great! You are using Git for version control. Tracking code development and connecting the code version to the results is critical for reproducibility.

The results in this page were generated with repository version a30bb03. See the Past versions tab to see a history of the changes made to the R Markdown and HTML files.

Note that you need to be careful to ensure that all relevant files for the analysis have been committed to Git prior to generating the results (you can use wflow_publish or wflow_git_commit). workflowr only checks the R Markdown file, but you know if there are other scripts or data files that it depends on. Below is the status of the Git repository when the results were generated: 


Ignored files:
    Ignored:    .DS_Store
    Ignored:    .RData
    Ignored:    .Rhistory
    Ignored:    .Rproj.user/
    Ignored:    data/.DS_Store
    Ignored:    data/original_dataset_reproducibility_check/.DS_Store
    Ignored:    output/.DS_Store
    Ignored:    output/Figure_3B/.DS_Store
    Ignored:    output/created_datasets/.DS_Store

Untracked files:
    Untracked:  gutenbergr_0.2.3.tar.gz

Unstaged changes:
    Modified:   Policy_landscape_workflowr.R
    Modified:   data/original_dataset_reproducibility_check/original_cleaned_data.csv
    Modified:   data/original_dataset_reproducibility_check/original_dataset_words_stm_5topics.csv
    Modified:   output/Figure_3A/Figure_3A.png
    Modified:   output/created_datasets/cleaned_data.csv

Note that any generated files, e.g. HTML, png, CSS, etc., are not included in this status report because it is ok for generated content to have uncommitted changes.

These are the previous versions of the repository in which changes were made to the R Markdown (analysis/3_Text_similarities_Figure_2B.Rmd) and HTML (docs/3_Text_similarities_Figure_2B.html) files. If you’ve configured a remote Git repository (see ?wflow_git_remote), click on the hyperlinks in the table below to view the files as they were in that past version.

File Version Author Date Message
html 5c836ab zuzannazagrodzka 2023-12-07 Build site.
html c494066 zuzannazagrodzka 2023-12-02 Build site.
html 8b3a598 zuzannazagrodzka 2023-11-10 Build site.
Rmd 3015fd2 zuzannazagrodzka 2023-11-10 adding arrow to the library and changing the reading command
html 729fc52 zuzannazagrodzka 2023-11-10 Build site.
html 120f965 zuzannazagrodzka 2023-11-09 Build site.
Rmd 44c3f87 zuzannazagrodzka 2023-11-09 wflow_publish(c("./analysis/3_Text_similarities_Figure_2B.Rmd"))
Rmd 41dd1ca Thomas Frederick Johnson 2022-11-25 Revisions to the text, and pushing the write thing this time…
html 5bdfc2a Andrew Beckerman 2022-11-24 Build site.
html 34ddc80 Andrew Beckerman 2022-11-24 Build site.
html 693000e Andrew Beckerman 2022-11-24 Build site.
html 60a6c61 Andrew Beckerman 2022-11-24 Build site.
html fb90a00 Andrew Beckerman 2022-11-24 Build site.
Rmd e08d7ac Andrew Beckerman 2022-11-24 more organising and editing of workflowR mappings
html e08d7ac Andrew Beckerman 2022-11-24 more organising and editing of workflowR mappings
Rmd 31239cd Andrew Beckerman 2022-11-24 more organising and editing of workflowR mappings
html 0a21152 zuzannazagrodzka 2022-09-21 Build site.
html 796aa8e zuzannazagrodzka 2022-09-21 Build site.
Rmd efb1202 zuzannazagrodzka 2022-09-21 Publish other files

Visualising Text Similarities (Fig 2b)

Source of the functions: https://www.markhw.com/blog/word-similarity-graphs

We combined two methods - word similarity graphs and stm modelling) to be able visually explore topics and words’ connections in the aims and missions documents.

We used the word similarity method (https://www.markhw.com/blog/word-similarity-graphs) to calculate similarities between words and later to be able to plot them with topic modeling score values (package stm)

The three primary steps are:

  1. Calculating the similarities between words (Cosine matrix).

  2. Formatting these similarity scores into a symmetric matrix, where the diagonal contains 0s and the off-diagonal cells are similarities between words.

  3. Clustering nodes using a community detection algorithm (here: Walktrap algorithm) and plotting the data into circular hierarchical dendrograms for each of the stakeholder group separately (Figure 2B).

rm(list=ls())

Libraries

Loading packages

# remotes::install_github('talgalili/dendextend')
library(dendextend)
library(igraph)
library(ggraph)
library(reshape2)
library(dplyr)
library(tidyverse)
library(tidytext)
library(arrow)

Word similarity

Functions to create words similarities matrix.

  • cosine_matrix
  • Walktrap_topics

Source of the code: https://www.markhw.com/blog/word-similarity-graphs

# Cosine matrix
cosine_matrix <- function(tokenized_data, lower = 0, upper = 1, filt = 0) {
  
  if (!all(c("word", "id") %in% names(tokenized_data))) {
    stop("tokenized_data must contain variables named word and id")
  }
  
  if (lower < 0 | lower > 1 | upper < 0 | upper > 1 | filt < 0 | filt > 1) {
    stop("lower, upper, and filt must be 0 <= x <= 1")
  }
  docs <- length(unique(tokenized_data$id))
  
  out <- tokenized_data %>%
    count(id, word) %>%
    group_by(word) %>%
    mutate(n_docs = n()) %>%
    ungroup() %>%
    filter(n_docs <= (docs * upper) & n_docs > (docs * lower)) %>%
    select(-n_docs) %>%
    mutate(n = 1) %>%
    spread(word, n, fill = 0) %>%
    select(-id) %>%
    as.matrix() %>%
    lsa::cosine()
  
  filt <- quantile(out[lower.tri(out)], filt)
  out[out < filt] <- diag(out) <- 0
  out <- out[rowSums(out) != 0, colSums(out) != 0]
  
  return(out)
}


# Walktrap_topics

walktrap_topics <- function(g, ...) {
  wt <- igraph::cluster_walktrap(g, ...)
  
  membership <- igraph::cluster_walktrap(g, ...) %>% 
      igraph::membership() %>% 
      as.matrix() %>% 
      as.data.frame() %>% 
      rownames_to_column("word") %>% 
      arrange(V1) %>% 
      rename(group = V1)
  
  dendrogram <- stats::as.dendrogram(wt)
  
  return(list(membership = membership, dendrogram = dendrogram))
}

Data

Importing data (created in 2_topic_modeling)

# Importing dataset that we originally created and used in our analysis
corpus_df <- read_feather(file = "./data/original_dataset_reproducibility_check/original_dataset_words_stm_5topics.arrow")


# Importing dataset created in 2_topic_modeling.Rmd
# corpus_df <- read.csv("./output/created_datasets/dataset_words_stm_5topics.csv")

Running above functions for each stakeholder

colnames(corpus_df)
 [1] "txt"                "filename"           "name"              
 [4] "doc_type"           "stakeholder"        "sentence_doc"      
 [7] "orig_word"          "word_mix"           "word"              
[10] "org_subgroups"      "mean_beta_t1"       "mean_beta_t2"      
[13] "mean_beta_t3"       "mean_beta_t4"       "mean_beta_t5"      
[16] "mean_score_t1"      "mean_score_t2"      "mean_score_t3"     
[19] "mean_score_t4"      "mean_score_t5"      "sum_beta_t1"       
[22] "sum_beta_t2"        "sum_beta_t3"        "sum_beta_t4"       
[25] "sum_beta_t5"        "topic"              "highest_mean_score"
[28] "highest_mean_beta" 
stake_names <- unique(corpus_df$stakeholder)
count <- 1
figure_list <- vector()

for (stake in stake_names) {
  n <- count # number of the stakeholder in the list
  stakeholder_name <- stake_names[n] # stakeholder's name
  
  # selecting data with the right name of the stakeholder
  dat <- corpus_df %>%
  select(stakeholder, sentence_doc, word) %>%
  rename(id = sentence_doc) %>% 
  filter(stakeholder %in% stakeholder_name) %>% 
  select(-stakeholder)
  ##################### 
  
  # Calculating similarity matrix
  cos_mat <- cosine_matrix(dat, lower = 0.050, upper = 1, filt = 0.9)
  
  # Getting words used in the network
  word_list_net <- rownames(cos_mat)
  grep("workflow", word_list_net)

  print(dim(cos_mat))
  
  # Creating a graph
  g <- graph_from_adjacency_matrix(cos_mat, mode = "undirected", weighted = TRUE)
  topics = walktrap_topics(g)
  print(stakeholder_name)
  plot(topics$dendrogram)

  subtrees <- partition_leaves(topics$dendrogram)
  leaves <- subtrees[[1]]  


  pathRoutes <- function(leaf) {
    which(sapply(subtrees, function(x) leaf %in% x))
  }

  paths <- lapply(leaves, pathRoutes)

  edges = NULL
  for(a in 1:length(paths)){
    # print(a)
    for(b in c(1:(length(paths[[a]])-1))){
     if(b == (length(paths[[a]])-1)){
        tmp_df = data.frame(
         from = paths[[a]][b],
         to = leaves[a]
       )
     } else {
        tmp_df = data.frame(
          from = paths[[a]][b],
          to = paths[[a]][b+1]
       )
     }
     edges = rbind(edges, tmp_df)
   }
  }


  connect = melt(cos_mat) # library reshape required
  colnames(connect) = c("from", "to", "value")
  connect = subset(connect, value != 0)

  # create a vertices data.frame. One line per object of our hierarchy
  vertices  <-  data.frame(
    name = unique(c(as.character(edges$from), as.character(edges$to))) 
  ) 
  # Let's add a column with the group of each name. It will be useful later to color points
  vertices$group  <-  edges$from[ match( vertices$name, edges$to ) ]


  #Let's add information concerning the label we are going to add: angle, horizontal adjustement and potential flip
  #calculate the ANGLE of the labels
  #vertices$id <- NA
  #myleaves <- which(is.na( match(vertices$name, edges$from) ))
  #nleaves <- length(myleaves)
  #vertices$id[ myleaves ] <- seq(1:nleaves)
  #vertices$angle <- 90 - 360 * vertices$id / nleaves

  # calculate the alignment of labels: right or left
  # If I am on the left part of the plot, my labels have currently an angle < -90
  #vertices$hjust <- ifelse( vertices$angle < -90, 1, 0)

  # flip angle BY to make them readable
  #vertices$angle <- ifelse(vertices$angle < -90, vertices$angle+180, vertices$angle)
  
  # replacing "group" value with the topic numer from the STM
  
  # Colour words by topic modelling topics (STM)
  # I have to change the group numbers in topics

  stm_top <- corpus_df %>%
    select(stakeholder, word, topic = topic) %>% 
    filter(stakeholder %in% stakeholder_name) %>%
    select(-stakeholder)
  

  stm_top$topic <- as.factor(stm_top$topic)
  stm_top <- unique(stm_top)


  # Removing group column and creating a new one based on the stm info
  vertices <- vertices

  vertices <- vertices %>% 
    left_join(stm_top, by = c("name" = "word")) %>% 
    select(-group) %>% 
    rename(group = topic)

  # Adding a beta value so I can use it in the graph
  stm_beta <- corpus_df %>% 
    select(stakeholder, word, beta = highest_mean_beta) %>% 
    filter(stakeholder %in% stakeholder_name) %>%
    select(-stakeholder)
  
  
  stm_beta <- unique(stm_beta)
  dim(stm_beta)

  vertices <- vertices %>% 
   left_join(stm_beta, by = c("name" = "word")) 


  vertices$beta_size = vertices$beta
  
  ##############################################################

  # Create a graph object
  mygraph <- igraph::graph_from_data_frame(edges, vertices=vertices)

  # The connection object must refer to the ids of the leaves:
  from  <-  match( connect$from, vertices$name)
  to  <-  match( connect$to, vertices$name)

  # Basic usual argument
  tmp_plt = ggraph(mygraph, layout = 'dendrogram', circular = T) + 
    geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05, alpha=0.2), size =0, colour = "white") +
    #colour=group, size=value
          scale_colour_manual(values= c("dark green", "dark red", "darkgoldenrod", "dark blue", "black"), na.value = "black") +   
    geom_conn_bundle(data = get_con(from = from, to = to, col = connect$value), tension = 0.9, aes(colour = col, alpha = col+0.5), width = 1.1) +
    scale_edge_color_continuous(low="white", high="black") +
    # geom_node_text(aes(x = x*1.1, y=y*1.1, filter = leaf, label=name, angle = angle, hjust=hjust), size=5, alpha=1) +
    geom_node_text(aes(x = x*1.1, y=y*1.1, filter = leaf, label=name, colour = group, angle = 0, hjust = 0.5, size = beta_size),  alpha=1) +
    
     theme_void() +
    theme(
      legend.position="none",
      plot.margin=unit(c(0,0,0,0),"cm"),
    ) +
    expand_limits(x = c(-1.5, 1.5), y = c(-1.5, 1.5)) 

  g <- ggplot_build(tmp_plt)
  tmp_dat = g[[3]]$data
  tmp_dat$position = NA
  tmp_dat_a = subset(tmp_dat, x >= 0)
  tmp_dat_a = tmp_dat_a[order(-tmp_dat_a$y),]
  tmp_dat_a = subset(tmp_dat_a, !is.na(beta))
  tmp_dat_a$order = 1:nrow(tmp_dat_a)
  
  tmp_dat_b = subset(tmp_dat, x < 0)
  tmp_dat_b = tmp_dat_b[order(-tmp_dat_b$y),]
  tmp_dat_b = subset(tmp_dat_b, !is.na(beta))
  tmp_dat_b$order = (nrow(tmp_dat_a) +nrow(tmp_dat_b)) : (nrow(tmp_dat_a) +1)
  
  tmp_dat = rbind(tmp_dat_a, tmp_dat_b)
  
  vertices = left_join(vertices, tmp_dat[,c("name", "order")], by = c("name"))
  vert_save = vertices
  vertices = vert_save
  
  vertices$id <- NA
  vertices = vertices[order(vertices$order),]
  myleaves <- which(is.na( match(vertices$name, edges$from) ))
  nleaves <- length(myleaves)
  vertices$id[ myleaves ] <- seq(1:nleaves)
  vertices$angle <- 90 - 360 * vertices$id / nleaves
  
  # calculate the alignment of labels: right or left
  # If I am on the left part of the plot, my labels have currently an angle < -90
  vertices$hjust <- ifelse( vertices$angle < -90, 1, 0)
  
  # flip angle BY to make them readable
  vertices$angle <- ifelse(vertices$angle < -90, vertices$angle+180, vertices$angle)
  vertices = vertices[order(as.numeric(rownames(vertices))),]
  
  mygraph <- igraph::graph_from_data_frame(edges, vertices=vertices)
  
  figure_to_save <- ggraph(mygraph, layout = 'dendrogram', circular = T) + 
    geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05, alpha=0.2, colour = group, size = beta_size)) +
    #colour=group, size=value
          scale_colour_manual(values= c("dark green", "dark red", "darkgoldenrod", "dark blue", "black"), na.value = "black") +   
    geom_conn_bundle(data = get_con(from = from, to = to, col = connect$value), tension = 0.99, aes(colour = col, alpha = col+0.5), width = 1.1) +
    scale_edge_color_continuous(low="grey90", high="black") +
    geom_node_text(aes(x = x*1.1, y=y*1.1, filter = leaf, label=name, colour = group, angle = angle, hjust = hjust, size = beta_size)) +
    
    theme_void() +
    theme(
      legend.position="none",
      plot.margin=unit(c(0,0,0,0),"cm"),
    ) +
    expand_limits(x = c(-1.5, 1.5), y = c(-1.5, 1.5))

  assign(paste0(stake_names[n], "_figure2B"), figure_to_save)
  # name_temp <- assign(paste0(stake_names[n], "_figure2b"), figure_to_save)
  figure_list <- append(figure_list, paste0(stake_names[n], "_figure2B"))
  
  print(figure_to_save)

  #####################
  count <-  count + 1 

}
[1] 47 47
[1] "advocates"
Warning: Using the `size` aesthetic in this geom was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` in the `default_aes` field and elsewhere instead.
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10 
[1] 32 32
[1] "funders"

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10 
[1] 39 39
[1] "journals"

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10 
[1] 48 48
[1] "publishers"

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10 
[1] 35 35
[1] "repositories"

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10 
[1] 34 34
[1] "societies"

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10

Figure production

# Saving figures individually 

figure_list

figure_name <- paste0("./output/Figure_2B/advocates_5topics_figure2B.png")
png(file=figure_name,
  width= 3000, height= 3000, res=400)
  advocates_figure2B
  dev.off()


figure_name <- paste0("./output/Figure_2B/funders_5topics_figure2B.png")
png(file=figure_name,
  width= 3000, height= 3000, res=400)
  funders_figure2B
  dev.off()
  
figure_name <- paste0("./output/Figure_2B/journals_5topics_figure2B.png")
png(file=figure_name,
  width= 3000, height= 3000, res=400)
  journals_figure2B
  dev.off()
  
figure_name <- paste0("./output/Figure_2B/publishers_5topics_figure2B.png")
png(file=figure_name,
  width= 3000, height= 3000, res=400)
  publishers_figure2B
  dev.off()
  
figure_name <- paste0("./output/Figure_2B/repositories_5topics_figure2B.png")
png(file=figure_name,
  width= 3000, height= 3000, res=400)
  repositories_figure2B
  dev.off()
  
figure_name <- paste0("./output/Figure_2B/societies_5topics_figure2B.png")
png(file=figure_name,
  width= 3000, height= 3000, res=400)
  societies_figure2B
  dev.off()

Additional analysis

Circular graph created on all documents (all stakeholders)

# selecting data with the right name of the stakeholder
dat <- corpus_df %>%
  select(sentence_doc, word) %>%
  rename(id = sentence_doc) 

  # Calculating similarity matrix
  cos_mat <- cosine_matrix(dat, lower = 0.035, upper = 1, filt = 0.9)
  
# Getting words used in the network
word_list_net <- rownames(cos_mat)
grep("workflow", word_list_net)
integer(0)
# Creating a graph
g <- graph_from_adjacency_matrix(cos_mat, mode = "undirected", weighted = TRUE)
topics = walktrap_topics(g)
plot(topics$dendrogram)

Version Author Date
8b3a598 zuzannazagrodzka 2023-11-10 
subtrees <- partition_leaves(topics$dendrogram)
leaves <- subtrees[[1]]  

pathRoutes <- function(leaf) {
  which(sapply(subtrees, function(x) leaf %in% x))
}

paths <- lapply(leaves, pathRoutes)

edges = NULL
for(a in 1:length(paths)){
  # print(a)
  for(b in c(1:(length(paths[[a]])-1))){
    if(b == (length(paths[[a]])-1)){
      tmp_df = data.frame(
        from = paths[[a]][b],
        to = leaves[a]
      )
    } else {
      tmp_df = data.frame(
        from = paths[[a]][b],
        to = paths[[a]][b+1]
      )
    }
    edges = rbind(edges, tmp_df)
  }
}
connect = melt(cos_mat)
colnames(connect) = c("from", "to", "value")
connect = subset(connect, value != 0)


# create a vertices data.frame. One line per object of our hierarchy
vertices  <-  data.frame(
  name = unique(c(as.character(edges$from), as.character(edges$to))) 
) 
# Let's add a column with the group of each name. It will be useful later to color points
vertices$group  <-  edges$from[ match( vertices$name, edges$to ) ]


#Let's add information concerning the label we are going to add: angle, horizontal adjustement and potential flip
#calculate the ANGLE of the labels
#vertices$id <- NA
#myleaves <- which(is.na( match(vertices$name, edges$from) ))
#nleaves <- length(myleaves)
#vertices$id[ myleaves ] <- seq(1:nleaves)
#vertices$angle <- 90 - 360 * vertices$id / nleaves

# calculate the alignment of labels: right or left
# If I am on the left part of the plot, my labels have currently an angle < -90
#vertices$hjust <- ifelse( vertices$angle < -90, 1, 0)

# flip angle BY to make them readable
#vertices$angle <- ifelse(vertices$angle < -90, vertices$angle+180, vertices$angle)

# replacing "group" value with the topic numer from the STM

# Colour words by topic modelling topics (STM)
# I have to change the group numbers in topics

stm_top <- corpus_df %>%
  select(word, topic = topic)

stm_top$topic <- as.factor(stm_top$topic)
stm_top <- unique(stm_top)

# Removing group column and creating a new one based on the stm info
vertices <- vertices

vertices <- vertices %>% 
  left_join(stm_top, by = c("name" = "word")) %>% 
  select(-group) %>% 
  rename(group = topic)

# Adding a beta value so I can use it in the graph
stm_beta <- corpus_df %>% 
  select(word, beta = highest_mean_beta)
stm_beta <- unique(stm_beta)
dim(stm_beta)
[1] 2832    2
vertices <- vertices %>% 
  left_join(stm_beta, by = c("name" = "word")) 

vertices$beta_size = vertices$beta
##########################################################

# Create a graph object
mygraph <- igraph::graph_from_data_frame(edges, vertices=vertices)

# The connection object must refer to the ids of the leaves:
from  <-  match( connect$from, vertices$name)
to  <-  match( connect$to, vertices$name)

# Basic usual argument
tmp_plt = ggraph(mygraph, layout = 'dendrogram', circular = T) + 
  geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05, alpha=0.2), size =0, colour = "white") +
  #colour=group, size=value
        scale_colour_manual(values= c("dark green", "dark red", "darkgoldenrod", "dark blue", "black"), na.value = "black") +   
  geom_conn_bundle(data = get_con(from = from, to = to, col = connect$value), tension = 0.9, aes(colour = col, alpha = col+0.5), width = 1.1) +
  scale_edge_color_continuous(low="white", high="black") +
  # geom_node_text(aes(x = x*1.1, y=y*1.1, filter = leaf, label=name, angle = angle, hjust=hjust), size=5, alpha=1) +
  geom_node_text(aes(x = x*1.1, y=y*1.1, filter = leaf, label=name, colour = group, angle = 0, hjust = 0.5, size = beta_size),  alpha=1) +
  
   theme_void() +
  theme(
    legend.position="none",
    plot.margin=unit(c(0,0,0,0),"cm"),
  ) +
  expand_limits(x = c(-1.5, 1.5), y = c(-1.5, 1.5)) 

g <- ggplot_build(tmp_plt)
tmp_dat = g[[3]]$data
tmp_dat$position = NA
tmp_dat_a = subset(tmp_dat, x >= 0)
tmp_dat_a = tmp_dat_a[order(-tmp_dat_a$y),]
tmp_dat_a = subset(tmp_dat_a, !is.na(beta))
tmp_dat_a$order = 1:nrow(tmp_dat_a)

tmp_dat_b = subset(tmp_dat, x < 0)
tmp_dat_b = tmp_dat_b[order(-tmp_dat_b$y),]
tmp_dat_b = subset(tmp_dat_b, !is.na(beta))
tmp_dat_b$order = (nrow(tmp_dat_a) +nrow(tmp_dat_b)) : (nrow(tmp_dat_a) +1)

tmp_dat = rbind(tmp_dat_a, tmp_dat_b)

vertices = left_join(vertices, tmp_dat[,c("name", "order")], by = c("name"))
vert_save = vertices
vertices = vert_save

vertices$id <- NA
vertices = vertices[order(vertices$order),]
myleaves <- which(is.na( match(vertices$name, edges$from) ))
nleaves <- length(myleaves)
vertices$id[ myleaves ] <- seq(1:nleaves)
vertices$angle <- 90 - 360 * vertices$id / nleaves

# calculate the alignment of labels: right or left
# If I am on the left part of the plot, my labels have currently an angle < -90
vertices$hjust <- ifelse( vertices$angle < -90, 1, 0)

# flip angle BY to make them readable
vertices$angle <- ifelse(vertices$angle < -90, vertices$angle+180, vertices$angle)
vertices = vertices[order(as.numeric(rownames(vertices))),]

mygraph <- igraph::graph_from_data_frame(edges, vertices=vertices)

figure_tosave <- ggraph(mygraph, layout = 'dendrogram', circular = T) + 
  geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05, alpha=0.2, colour = group, size = beta_size)) +
  #colour=group, size=value
        scale_colour_manual(values= c("dark green", "dark red", "darkgoldenrod", "dark blue", "black"), na.value = "black") +   
  geom_conn_bundle(data = get_con(from = from, to = to, col = connect$value), tension = 0.99, aes(colour = col, alpha = col+0.5), width = 1.1) +
  scale_edge_color_continuous(low="grey90", high="black") +
  geom_node_text(aes(x = x*1.1, y=y*1.1, filter = leaf, label=name, colour = group, angle = angle, hjust = hjust, size = beta_size)) +
  
  theme_void() +
  theme(
    legend.position="none",
    plot.margin=unit(c(0,0,0,0),"cm"),
  ) +
  expand_limits(x = c(-1.6, 1.6), y = c(-1.6, 1.6))

figure_name <- paste0("./output/Other_figures/All_stakeholders_5topics_figure.png")

# uncomment to generate file

# png(file=figure_name,
#   width=3000, height=3000, res = 500)
#   figure_tosave
#   dev.off()
  
# figure_tosave

Session information

sessionInfo()
R version 4.3.1 (2023-06-16)
Platform: x86_64-apple-darwin20 (64-bit)
Running under: macOS Monterey 12.6

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: Europe/London
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] arrow_13.0.0.1    tidytext_0.4.1    lubridate_1.9.3   forcats_1.0.0    
 [5] stringr_1.5.0     purrr_1.0.2       readr_2.1.4       tidyr_1.3.0      
 [9] tibble_3.2.1      tidyverse_2.0.0   dplyr_1.1.3       reshape2_1.4.4   
[13] ggraph_2.1.0      ggplot2_3.4.3     igraph_1.5.1      dendextend_1.17.1
[17] workflowr_1.7.1  

loaded via a namespace (and not attached):
 [1] gtable_0.3.4       xfun_0.40          bslib_0.5.1        processx_3.8.2    
 [5] ggrepel_0.9.4      lattice_0.21-8     tzdb_0.4.0         callr_3.7.3       
 [9] vctrs_0.6.3        tools_4.3.1        ps_1.7.5           generics_0.1.3    
[13] fansi_1.0.4        janeaustenr_1.0.0  tokenizers_0.3.0   pkgconfig_2.0.3   
[17] Matrix_1.5-4.1     assertthat_0.2.1   lifecycle_1.0.3    compiler_4.3.1    
[21] farver_2.1.1       git2r_0.32.0       munsell_0.5.0      lsa_0.73.3        
[25] ggforce_0.4.1      getPass_0.2-2      graphlayouts_1.0.2 httpuv_1.6.11     
[29] SnowballC_0.7.1    htmltools_0.5.6    sass_0.4.7         yaml_2.3.7        
[33] crayon_1.5.2       later_1.3.1        pillar_1.9.0       jquerylib_0.1.4   
[37] whisker_0.4.1      MASS_7.3-60        cachem_1.0.8       viridis_0.6.4     
[41] tidyselect_1.2.0   digest_0.6.33      stringi_1.7.12     labeling_0.4.3    
[45] polyclip_1.10-6    rprojroot_2.0.3    fastmap_1.1.1      grid_4.3.1        
[49] colorspace_2.1-0   cli_3.6.1          magrittr_2.0.3     tidygraph_1.2.3   
[53] utf8_1.2.3         withr_2.5.1        scales_1.2.1       promises_1.2.1    
[57] bit64_4.0.5        timechange_0.2.0   rmarkdown_2.25     httr_1.4.7        
[61] bit_4.0.5          gridExtra_2.3      hms_1.1.3          evaluate_0.21     
[65] knitr_1.44         viridisLite_0.4.2  rlang_1.1.1        Rcpp_1.0.11       
[69] glue_1.6.2         tweenr_2.0.2       rstudioapi_0.15.0  jsonlite_1.8.7    
[73] R6_2.5.1           plyr_1.8.9         fs_1.6.3          

sessionInfo()
R version 4.3.1 (2023-06-16)
Platform: x86_64-apple-darwin20 (64-bit)
Running under: macOS Monterey 12.6

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: Europe/London
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] arrow_13.0.0.1    tidytext_0.4.1    lubridate_1.9.3   forcats_1.0.0    
 [5] stringr_1.5.0     purrr_1.0.2       readr_2.1.4       tidyr_1.3.0      
 [9] tibble_3.2.1      tidyverse_2.0.0   dplyr_1.1.3       reshape2_1.4.4   
[13] ggraph_2.1.0      ggplot2_3.4.3     igraph_1.5.1      dendextend_1.17.1
[17] workflowr_1.7.1  

loaded via a namespace (and not attached):
 [1] gtable_0.3.4       xfun_0.40          bslib_0.5.1        processx_3.8.2    
 [5] ggrepel_0.9.4      lattice_0.21-8     tzdb_0.4.0         callr_3.7.3       
 [9] vctrs_0.6.3        tools_4.3.1        ps_1.7.5           generics_0.1.3    
[13] fansi_1.0.4        janeaustenr_1.0.0  tokenizers_0.3.0   pkgconfig_2.0.3   
[17] Matrix_1.5-4.1     assertthat_0.2.1   lifecycle_1.0.3    compiler_4.3.1    
[21] farver_2.1.1       git2r_0.32.0       munsell_0.5.0      lsa_0.73.3        
[25] ggforce_0.4.1      getPass_0.2-2      graphlayouts_1.0.2 httpuv_1.6.11     
[29] SnowballC_0.7.1    htmltools_0.5.6    sass_0.4.7         yaml_2.3.7        
[33] crayon_1.5.2       later_1.3.1        pillar_1.9.0       jquerylib_0.1.4   
[37] whisker_0.4.1      MASS_7.3-60        cachem_1.0.8       viridis_0.6.4     
[41] tidyselect_1.2.0   digest_0.6.33      stringi_1.7.12     labeling_0.4.3    
[45] polyclip_1.10-6    rprojroot_2.0.3    fastmap_1.1.1      grid_4.3.1        
[49] colorspace_2.1-0   cli_3.6.1          magrittr_2.0.3     tidygraph_1.2.3   
[53] utf8_1.2.3         withr_2.5.1        scales_1.2.1       promises_1.2.1    
[57] bit64_4.0.5        timechange_0.2.0   rmarkdown_2.25     httr_1.4.7        
[61] bit_4.0.5          gridExtra_2.3      hms_1.1.3          evaluate_0.21     
[65] knitr_1.44         viridisLite_0.4.2  rlang_1.1.1        Rcpp_1.0.11       
[69] glue_1.6.2         tweenr_2.0.2       rstudioapi_0.15.0  jsonlite_1.8.7    
[73] R6_2.5.1           plyr_1.8.9         fs_1.6.3