IPBES_TCA_Ch3_clusters.qmd

---
title: "Transformative Change Assessment - Ch 3 - Clusters"
author: Rainer M Krug <Rainer.Krug@senckenberg.de> <Rainer@krugs.de>
format:
    html:
        toc: true
        toc-depth: 3
        embed-resources: true
        code-fold: true
        code-summary: "Show the code"
        grid:
            sidebar-width: 0px
            body-width: 4000px
            margin-width: 200px
            gutter-width: 1.5rem   
params:
    key_paper: "cX_key-paper.csv"
    gdm_path: !expr file.path('data', 'gdm')
---



```{r}
#| label: setup
#|
if (!exists("params")) {
    params <- rmarkdown::yaml_front_matter("IPBES_TCA_Ch3_clusters.qmd")$params
}

knitr::opts_chunk$set(message = NA)

library(IPBES.R)
library(openalexR)
library(dplyr)
library(readxl)
library(arrow)

library(tibble)
# library(dplyr)
# library(knitr)
library(networkD3)
library(webshot)

library(tictoc)

library(patchwork)

# devtools::install_github("mattflor/chorddiag")
library(chorddiag)

dir.create(params$gdm_path, showWarnings = FALSE)

fns <- sapply(
    1:6,
    function(i) {
        gsub(
            pattern = "X",
            replacement = i,
            x = file.path("input", "key_papers", params$key_paper)
        )
    }
)

###########
## Update `cX_key-paper.csv` from `TCA_Ch3_DOIs_Dataset_Theories_3_May_2024.xlsx`
## This needs to be run manually

if (FALSE) {
    all <- readxl::read_excel(file.path("input", "key_papers", "TCA_Ch3_DOIs_Dataset_Theories_3_May_2024.xlsx"))

    cluster <- names(all)[11:16]

    sapply(
        1:6,
        function(i) {
            all |>
                dplyr::filter(.data[[cluster[[i]]]] == 1) |>
                dplyr::select("DOI", "Authors", "Year", "Title") |>
                dplyr::filter(!is.na(DOI)) |>
                dplyr::mutate(
                    DOI = gsub(
                        pattern = "https://doi.org/",
                        replacement = "",
                        x = DOI
                    )
                ) |>
                write.csv(
                    file = fns[i],
                    row.names = FALSE
                )
        }
    ) |>
        invisible()

    rm(all, cluster)
}

##
###########

cluster <- lapply(
    fns,
    function(fn) {
        list(
            timestamp = Sys.time(),
            fn = fn,
            dois = read.csv(fn)$DOI
        )
    }
)

names(cluster) <- paste0("cluster_", 1:6)

approach_colors <- c(
    "#D46746",
    "#E69A6A",
    "#E6C540",
    "#B5C788",
    "#2DB3B0",
    "#A693B5"
)
```

# Verification of key papers

The key papers should describe only one cluster, and not multiple clusters. In other words,
a key paper should be in only one cluster. If a key-paper is in multiple clusters, this would lead to an overlap of the snowball corpus which is not caused by the cluster itself, but by the key paper which is in multiple clusters.

The papers are the following (the table will be empty if there are none):

```{r}
dupl_kp <- lapply(
    cluster,
    function(cl) {
        x <- cl$dois
        x[x != ""]
    }
) |>
    unlist()
dupl_kp <- dupl_kp[duplicated(dupl_kp)]

sprintf('<a href="https://doi.org/%s" target="_blank">%s</a>', dupl_kp, dupl_kp) |>
    knitr::kable()
```

These papers will be excluded from the analysis.

```{r}
for (i in grep("cluster", names(cluster), value = TRUE)) {
    cluster[[i]]$dois <- cluster[[i]]$dois[!cluster[[i]]$dois %in% dupl_kp]
}
```


# Do Searches

## Get Generell key-works and Snowball

```{r}
#| label: get_key_works_snowball
#|

fn <- file.path("data", "key_works.rds")
if (exists(fn)) {
    key_works <- readRDS(fn)
} else {
    dois <- read.csv(file.path("input", "key_papers", "key-paper.csv"))$DOI
    key_works <- oa_fetch(
        entity = "works",
        doi = dois,
        verbose = FALSE
    )
    saveRDS(key_works, fn)
}

ids <- openalexR:::shorten_oaid(key_works$id)

fn <- file.path("data", "snowball.rds")
if (file.exists(fn)) {
    snowball <- readRDS(fn)
} else {
    snowball <- oa_snowball(
        identifier = ids,
        verbose = FALSE
    )
    saveRDS(snowball, fn)
}

flat_snow <- snowball2df(snowball) |>
    tibble::as_tibble()
```

## Get Cluster key-works and  Snowballs

```{r}
#| label: get_clusters_works_snowball
#|
tic()
fn <- file.path("data", "cluster.rds")
if (file.exists(fn)) {
    cluster <- readRDS(fn)
} else {
    cluster <- lapply(
        cluster,
        function(cl) {
            message("Processing ", cl$fn, " ...")
            message("|- Fetching works ...")
            cl$key_works <- oa_fetch(
                entity = "works",
                doi = cl$dois,
                verbose = FALSE
            )
            cl$key_works$id <- gsub(
                pattern = "https://openalex.org/",
                replacement = "",
                cl$key_works$id
            )
            message("|- Snowballing works ...")
            cl$snowball_1 <- oa_snowball(
                identifier = openalexR:::shorten_oaid(cl$key_works$id),
                verbose = FALSE
            )
            message("|- Converting to tibble ...")
            cl$snowball_1_df <- snowball2df(cl$snowball_1) |>
                as_tibble()
            message("\n")
            return(cl)
        }
    )

    ## Detemine linkages between Clusters

    nodes <- data.frame(
        id = names(cluster),
        n = sapply(
            cluster,
            function(cl) {
                nrow(cl$snowball_1$nodes)
            }
        ),
        n_kp = sapply(
            cluster,
            function(cl) {
                nrow(cl$key_works)
            }
        ),
        stringsAsFactors = FALSE
    )

    all_kps <- lapply(
        cluster,
        function(cl) {
            cl$key_works$id
        }
    )

    all_ids <- lapply(
        cluster,
        function(cl) {
            cl$snowball_1$nodes$id
        }
    )

    nodes$only_l1 <- sapply(
        1:nrow(nodes),
        function(i) {
            id_from <- cluster[[nodes$id[i]]]$key_works$id
            nms <- grep(nodes$id[i], names(all_ids), value = TRUE, invert = TRUE)
            id_to <- all_kps[nms] |>
                unlist() |>
                unique()
            sum(!(id_from %in% id_to))
        }
    )

    nodes$only_l2 <- sapply(
        1:nrow(nodes),
        function(i) {
            id_from <- cluster[[nodes$id[i]]]$key_works$id
            nms <- grep(nodes$id[i], names(all_ids), value = TRUE, invert = TRUE)
            id_to <- all_ids[nms] |>
                unlist() |>
                unique()
            sum(!(id_from %in% id_to))
        }
    )

    nodes$only_l3 <- sapply(
        1:nrow(nodes),
        function(i) {
            id_from <- cluster[[nodes$id[i]]]$snowball_1$nodes$id
            nms <- grep(nodes$id[i], names(all_ids), value = TRUE, invert = TRUE)
            id_to <- all_ids[nms] |>
                unlist() |>
                unique()
            sum(!(id_from %in% id_to))
        }
    )

    edges <- expand.grid(
        names(cluster),
        names(cluster),
        stringsAsFactors = FALSE
    )
    names(edges) <- c("from", "to")
    edges <- edges[edges$from != edges$to, ]
    rownames(edges) <- NULL


    ## in_l1: keypaper c1 %in% keypaper c2
    edges$in_l1 <- sapply(
        1:nrow(edges),
        function(i) {
            cluster[[edges$from[i]]]$key_works$id %in% cluster[[edges$to[i]]]$key_works$id |>
                sum()
        }
    )


    ## in_l2: keypaper c1 %in% nodes c2
    edges$in_l2 <- sapply(
        1:nrow(edges),
        function(i) {
            cluster[[edges$from[i]]]$key_works$id %in% cluster[[edges$to[i]]]$snowball_1$nodes$id |>
                sum()
        }
    )

    ## in_l3: nodes c1 %in% nodes c2
    edges$in_l3 <- sapply(
        1:nrow(edges),
        function(i) {
            cluster[[edges$from[i]]]$snowball_1$nodes$id %in% cluster[[edges$to[i]]]$snowball_1$nodes$id |>
                sum()
        }
    )


    cluster$links <- list(
        nodes = nodes,
        edges = edges
    )

    saveRDS(cluster, fn)
}


key_works_cluster <- lapply(
    1:(length(cluster) - 1),
    function(i) {
        cluster[[i]]$key_works
    }
) |>
    do.call(what = rbind) |>
    dplyr::distinct(id, .keep_all = TRUE)

snowball_cluster <- list(
    nodes = lapply(
        1:(length(cluster) - 1),
        function(i) {
            cluster[[i]]$snowball_1$nodes
        }
    ) |>
        do.call(what = rbind) |>
        dplyr::distinct(id, .keep_all = TRUE),
    edges = lapply(
        1:(length(cluster) - 1),
        function(i) {
            cluster[[i]]$snowball_1$edges
        }
    ) |>
        do.call(what = rbind) |>
        dplyr::distinct()
)

toc()
```


# Create Graphs

## Create Static Citation Network Graph of the General Corpus

```{r}
#| label: openalex_graph
## | |

no <- list.files("figures", pattern = "snowball_cited", full.names = TRUE) |>
    length()

if (no < 4) {
    snowball <- file.path("data", "snowball.rds") |>
        readRDS()

    key_works_au <- file.path("data", "key_works.rds") |>
        readRDS() |>
        IPBES.R::abbreviate_authors()

    key_works_id <- names(key_works_au)

    key_works_cit <- Map(function(au, id) c(cit = au, id = id), key_works_au, key_works_id)
    names(key_works_cit) <- NULL

    snowball$nodes$cited_by_count_by_year <- snowball$nodes$cited_by_count / (2024 - snowball$nodes$publication_year)

    snowball_p <- snowball

    for  (i in seq_along(key_works_cit)) {
        snowball_p$nodes$id[snowball_p$nodes$id %in% key_works_cit[[i]]["id"]] <- key_works_cit[[i]]["cit"]
        snowball_p$edges$from[snowball_p$edges$from %in% key_works_cit[[i]]["id"]] <- key_works_cit[[i]]["cit"]
        snowball_p$edges$to[snowball_p$edges$to %in% key_works_cit[[i]]["id"]] <- key_works_cit[[i]]["cit"]
    }

    IPBES.R::plot_snowball(snowball_p, name = "snowball", path = "figures")
    rm(snowball_p)
}
```

## Create Static Citation Network Graph of the S1 Corpus

Only S1 corpus of S1 can be graphed due to the size of the S2 corpus.

```{r}
#| label: openalex_graph_S1
#| eval: false
#|

tic()

lapply(
    names(cluster),
    function(name) {
        plot_name <- paste0(name, "_S1")
        if (length(list.files("figures", pattern = paste0(plot_name, ".*(pdf|png)"))) < 4) {
            message("Plotting ", name, " ...")
            try(
                plot_snowball(
                    cluster[[name]]$snowball_1,
                    name = plot_name
                ),
                silent = FALSE
            )
        }
    }
)

toc()
```

## Create Interactive Citation Network Graph of the S1 Corpus

```{r}
#| label: openalex_graph_S1_interactive
#| eval: false
#|

tic()

lapply(
    names(cluster),
    function(name) {
        plot_name <- paste0(name, paste0(name, "_S1_interactive_network.html"))
        if (!file.exists(file.path("figures", plot_name))) {
            message("Plotting Interactive", name, " ...")
            nwg <- IPBES.R::plot_snowball_interactive(
                snowball = cluster[[name]]$snowball_1,
                key_works = cluster[[name]]$key_works,
                file = file.path("figures", plot_name)
            )
        }
    }
)

toc()
```

## Create Maps of the S1 Corpus

Create Maps of the first author only

```{r}
#| label: openalex_maps_fa_S1
#| eval: true
#|

tic()

maps <- lapply(
    grep("cluster_", names(cluster), value = TRUE),
    function(name) {
        plot_name <- paste0("map_first_author_", name, "__S1")
        message("Plotting map ", name, " ...")
        map <- sapply(
            cluster[[name]]$snowball_1$nodes$author,
            function(authors) {
                if (is.null(names(authors))) {
                    return(NULL)
                } else {
                    authors[["institution_country_code"]][[1]]
                }
            }
        ) |>
            unlist() |>
            table(useNA = "no") |>
            as.data.frame() |>
            dplyr::rename(
                iso2c = Var1,
                n = Freq
            ) |>
            dplyr::mutate(
                log_n_1 = log(n) + 1
            ) |>
            IPBES.R::map_country_codes(
                values = "log_n_1",
                geodata_path = params$gdm_path
            ) +
            ggplot2::ggtitle(paste(name, "First Author Only"))

        if (length(list.files("maps", pattern = paste0(plot_name, ".*(pdf|png)"))) < 2) {
            ggplot2::ggsave(
                file.path("maps", paste0(plot_name, ".pdf")),
                map,
                width = 5,
                height = 2.5
            )
            ggplot2::ggsave(
                file.path("maps", paste0(plot_name, ".png")),
                map,
                width = 5,
                height = 2.5
            )
        }
        return(map)
    }
)

plot_name <- "map_first_author__S1"
if (length(list.files("maps", pattern = paste0("^", plot_name, ".*(pdf|png)"))) < 2) {
    map <- patchwork::wrap_plots(
        plots = maps,
        ncol = 3
    )
    ggplot2::ggsave(
        file.path("maps", paste0(plot_name, ".pdf")),
        map,
        width = 15,
        height = 5
    )
    ggplot2::ggsave(
        file.path("maps", paste0(plot_name, ".png")),
        map,
        width = 15,
        height = 5
    )
}
rm(map, maps)

toc()
```

Create Maps of the all authors. All authors are weighted equal for now.

```{r}
#| label: openalex_maps_aa_S1
#| eval: true
#|

tic()

maps <- lapply(
    grep("cluster_", names(cluster), value = TRUE),
    function(name) {
        plot_name <- paste0("map_all_authors_", name, "__S1")
        message("Plotting map ", name, " ...")
        map <- sapply(
            cluster[[name]]$snowball_1$nodes$author,
            function(authors) {
                if (is.null(names(authors))) {
                    return(NULL)
                } else {
                    authors[["institution_country_code"]]
                }
            }
        ) |>
            unlist() |>
            table(useNA = "no") |>
            as.data.frame() |>
            dplyr::rename(
                iso2c = Var1,
                n = Freq
            ) |>
            dplyr::mutate(
                log_n_1 = log(n) + 1
            ) |>
            IPBES.R::map_country_codes(
                values = "log_n_1",
                geodata_path = params$gdm_path
            ) +
            ggplot2::ggtitle(paste(name, "All Authors"))

        if (length(list.files("maps", pattern = paste0(plot_name, ".*(pdf|png)"))) < 2) {
            ggplot2::ggsave(
                file.path("maps", paste0(plot_name, ".pdf")),
                map,
                width = 5,
                height = 2.5
            )
            ggplot2::ggsave(
                file.path("maps", paste0(plot_name, ".png")),
                map,
                width = 5,
                height = 2.5
            )
        }
        return(map)
    }
)
plot_name <- "map_all_authors__S1"
if (length(list.files("maps", pattern = paste0("^", plot_name, ".*(pdf|png)"))) < 2) {
    map <- patchwork::wrap_plots(
        plots = maps,
        ncol = 3
    )
    ggplot2::ggsave(
        file.path("maps", paste0(plot_name, ".pdf")),
        map,
        width = 15,
        height = 5
    )
    ggplot2::ggsave(
        file.path("maps", paste0(plot_name, ".png")),
        map,
        width = 15,
        height = 5
    )
}
rm(map, maps)
toc()
```


# Results

## Network Graph of General Snowball Search

![Cited by count](figures/snowball_cited_by_count.png)

To download the high resolution graph, please [click here](figures/snowball_cited_by_count.pdf).

```{r}
#| label: general_snowball_nodes_data
#|

data <- readRDS(file.path("data", "snowball.rds"))[["nodes"]]

data$author_abbr <- IPBES.R::abbreviate_authors(data)

data$doi <- paste0("<a href=\'", data$doi, "\' target='_blank'>", gsub("https://doi.org/", "", data$doi), "</a>")

data |>
    dplyr::select(
        id,
        doi,
        author_abbr,
        title,
        cited_by_count,
        ab
    ) |>
    IPBES.R::table_dt()
```

## Graphs and Maps

The following interactions are possible in the interactive graphs:

- when moving your mouse over a node, the title author and year of the paper is shown.
- clicking on a node will open the paper in a new tab.
- scrolling up and down with your scroll wheel zooms in and out
- clicking on the canvas and move the mouse will move the network
- clicking on a node and dragging it moves the node

### Overview Maps

#### First Author Only

![](maps/map_first_author__S1.png)

#### All Authors no weighting

![](maps/map_all_authors__S1.png)

### Cluster 1

![](maps/map_first_author_cluster_1__S1.png)
Ach so. 
![](figures/cluster_1_S1_cited_by_count_by_year.png)

- [Better quality map](maps/map_first_author_cluster_1__S1.pdf){target=_blank}
- [Better quality cluster](figures/cluster_1_S1_cited_by_count_by_year.pdf){target=_blank}
- [Interactive](figures/cluster_1_S1_interactive_network.html){target=_blank}.

### Cluster 2

![](maps/map_first_author_cluster_2__S1.png)

![](figures/cluster_2_S1_cited_by_count_by_year.png)

- [Better quality map](maps/map_first_author_cluster_2__S1.pdf){target=_blank}
- [Better quality cluster](figures/cluster_2_S1_cited_by_count_by_year.pdf){target=_blank}
- [Interactive](figures/cluster_2_S1_interactive_network.html){target=_blank}.

### Cluster 3

![](maps/map_first_author_cluster_3__S1.png)

![](figures/cluster_3_S1_cited_by_count_by_year.png)

- [Better quality map](maps/map_first_author_cluster_3__S1.pdf){target=_blank}
- [Better quality cluster](figures/cluster_3_S1_cited_by_count_by_year.pdf){target=_blank}
- [Interactive](figures/cluster_3_S1_interactive_network.html){target=_blank}.

### Cluster 4

![](maps/map_first_author_cluster_4__S1.png)

![](figures/cluster_4_S1_cited_by_count_by_year.png)

- [Better quality map](maps/map_first_author_cluster_4__S1.pdf){target=_blank}
- [Better quality cluster](figures/cluster_4_S1_cited_by_count_by_year.pdf){target=_blank}
- [Interactive](figures/cluster_4_S1_interactive_network.html){target=_blank}.

### Cluster 5

!![](maps/map_first_author_cluster_5__S1.png)

[](figures/cluster_5_S1_cited_by_count_by_year.png)

- [Better quality map](maps/map_first_author_cluster_5__S1.pdf){target=_blank}
- [Better quality cluster](figures/cluster_5_S1_cited_by_count_by_year.pdf){target=_blank}
- [Interactive](figures/cluster_5_S1_interactive_network.html){target=_blank}.

### Cluster 6

![](maps/map_first_author_cluster_6__S1.png)

![](figures/cluster_6_S1_cited_by_count_by_year.png)

- [Better quality map](maps/map_first_author_cluster_6__S1.pdf){target=_blank}
- [Better quality cluster](figures/cluster_6_S1_cited_by_count_by_year.pdf){target=_blank}
- [Interactive](figures/cluster_6_S1_interactive_network.html){target=_blank}.


## Common works between clusters

This section looks at common works between the keypapers of each cluster as well as the whole corpus as obtained through a first generation snowball search using the provided keyworks.

The links are classifiad using three levels:

- **in_l1**: (keypaper in `from`) in (keypaper in `to`)
- **in_l2**: (keypaper in `from`) in (snowball in `to`)
- **in_l3**: (snowball in `from`) in (snowball in `to`)

### Cluster properties

- **n**: number of papers in the snowball corpus
- **n_kp**: number of keypapers

```{r}
IPBES.R::table_dt(data = cluster$links$nodes[, -1])
```


### Links between clusters

- **from**: cluster which is the cluster in which the papers are
- **to**: cluster to which the `from` cluster is compared to
- **in_l1**: (keypaper in `from`) in (keypaper in `to`)
- **in_l2**: (keypaper in `from`) in (snowball in `to`)
- **in_l3**: (snowball in `from`) in (snowball in `to`)

```{r}
IPBES.R::table_dt(data = cluster$links$edges)
```

The column `in_l1` shgould be all zeros as the keypapers should only be linked to one cluster and not to multiple clusters.



### Links between Clusters

```{r}
#| label: get_linkages
#| eval: true


# cluster <- readRDS(file.path("data", "cluster.rds"))


linkages <- rbind(
    cluster$links$edges,
    data.frame(
        from = cluster$links$nodes$id,
        to = cluster$links$nodes$id,
        in_l1 = cluster$links$nodes$only_l1,
        in_l2 = cluster$links$nodes$only_l2,
        in_l3 = cluster$links$nodes$only_l3
    )
) |>
    dplyr::arrange(from, to)



# linkages <- n_clust |>
#     merge(
#         x = cluster$links$edges,
#         by = "from"
#     ) |>
#     group_by(
#         from
#     ) |>
#     summarize(
#         in_l1 = unique(n_l1) - sum(in_l1),
#         in_l2 = unique(n_l2) - sum(in_l2),
#         in_l3 = unique(n_l3) - sum(in_l3)
#     ) |>
#     ungroup() |>
#     mutate(to = from) |>
#     relocate(to, .after = "from") |>
#     rbind(cluster$links$edges)

linkages_p <- linkages |>
    dplyr::group_by(
        from
    ) |>
    mutate(
        n_l1 = sum(in_l1),
        n_l2 = sum(in_l2),
        n_l3 = sum(in_l3)
    ) |>
    mutate(
        in_l1 = in_l1 / n_l1,
        in_l2 = in_l2 / n_l2,
        in_l3 = in_l3 / n_l3,
        n_l1 = NULL,
        n_l2 = NULL,
        n_l3 = NULL
    )

# linkages_p <- merge(
#     linkages,
#     n_clust,
#     by = "from"
# ) |>
#     mutate(
#         in_l1 = in_l1 / n_l1,
#         in_l2 = in_l2 / n_l2,
#         in_l3 = in_l3 / n_l3,
#         n_l1 = NULL,
#         n_l2 = NULL,
#         n_l3 = NULL
#     ) |>
#     as_tibble()

####

plot_chord <- function(
    linkages,
    level,
    equal_angles = FALSE,
    showTicks =
        TRUE,
    groupnamePadding = 50,
    margin = 150,
    ...) {
    m <- linkages |>
        select(
            from,
            to,
            contains(level)
        ) |>
        dplyr::arrange(from, to) |>
        tidyr::pivot_wider(
            names_from = to,
            values_from = contains(level)
        )
    rown <- m$from
    m <- m[, -1]
    m <- m[, sort(names(m))]
    m <- as.matrix(m)
    m[] <- as.numeric(m[])
    dimnames(m)[[1]] <- rown

    if (equal_angles) {
        m <- m / rowSums(m)
    }

    rownames(m) <- dplyr::case_match(
        rownames(m),
        "cluster_1" ~ "Science and Technology",
        "cluster_2" ~ "Knowledge co-creation",
        "cluster_3" ~ "Systems",
        "cluster_4" ~ "Inner Transformation",
        "cluster_5" ~ "Empowerment",
        "cluster_6" ~ "Structural"
    )
    colnames(m) <- dplyr::case_match(
        colnames(m),
        "cluster_1" ~ "Science and Technology",
        "cluster_2" ~ "Knowledge co-creation",
        "cluster_3" ~ "Systems",
        "cluster_4" ~ "Inner Transformation",
        "cluster_5" ~ "Empowerment",
        "cluster_6" ~ "Structural"
    )

    # groupColors <- c(
    #     "#D46746",
    #     "#E69A6A",
    #     "#E6C540",
    #     "#B5C788",
    #     "#2DB3B0",
    #     "#A693B5"
    # )

    # groupColors <- c(
    #     grDevices::rgb(red = .87, green = 0.45, blue = 0.33),
    #     grDevices::rgb(red = .86, green = 0.64, blue = 0.48),
    #     grDevices::rgb(red = .90, green = 0.80, blue = 0.39),
    #     grDevices::rgb(red = .74, green = 0.78, blue = 0.59),
    #     grDevices::rgb(red = .41, green = 0.70, blue = 0.69),
    #     grDevices::rgb(red = .64, green = 0.60, blue = 0.69)
    # )

    cd <- chorddiag::chorddiag(
        m,
        groupnamePadding = groupnamePadding,
        showTicks = showTicks,
        type = "directional", ,
        margin = margin,
        groupColors = approach_colors,
        ...
    )
    return(cd)
}
```

#### Level 1

Number of keypapers in one cluster in the keypapers of another cluster.

```{r}
#| label: plot_chord_l1
#|

plot_chord(linkages, "l1")
plot_chord(linkages_p, "l1")
```

#### Level 2

Number of keypapers in one cluster in the snowball corpus of another cluster.

```{r}
#| label: plot_chord_l2
#|

plot_chord(linkages, "l2")
plot_chord(linkages_p, "l2")
```

#### Level 3

Number of papers in the snowball corpus in one cluster in the snowball corpus of another cluster.

```{r}
#| label: plot_chord_l3
#|

p <- plot_chord(linkages, "l3", margin = 250)
htmlwidgets::saveWidget(p, file = file.path("figures", "common_l3.html"), selfcontained = TRUE)
unlink(file.path("figures", "common_l3_files"), recursive = TRUE)
p

p <- plot_chord(linkages, "l3", equal_angles = TRUE, showTicks = FALSE, groupnamePadding = 5)
htmlwidgets::saveWidget(p, file = file.path("figures", "common_l3_equal.html"), selfcontained = TRUE)
unlink(file.path("figures", "common_l3_equal_files"), recursive = TRUE)
p

```

## Common works between Cluster and General corpus

### Overlab between Cluster and General key-papers and corpi

Here I will show the overlap between the combined cluster corpi and the General corpus based on the six key papers.

|                                | Cluster                               | General                           | overlap                                                                                      |
|--------------------------------|---------------------------------------|-----------------------------------|----------------------------------------------------------------------------------------------| 
| <nobr>(keypaper <-> keypaper)  | `r length(key_works_cluster$id)`      |    `r length(key_works$id)`       |    `r sum(key_works_cluster$id       %in% gsub("^https://openalex.org/", "", key_works$id))` |
| <nobr>(keypaper <-> paper)     | `r length(key_works_cluster$id)`      |    `r length(snowball$nodes$id)`  |    `r sum(key_works_cluster$id       %in% snowball$nodes$id)`                                |
| <nobr>(paper <-> keypaper)     | `r length(snowball_cluster$nodes$id)` |    `r length(key_works$id)`       |    `r sum(snowball_cluster$nodes$id %in% gsub("^https://openalex.org/", "", key_works$id))`  |
| <nobr>(paper <-> paper)        | `r length(snowball_cluster$nodes$id)` |    `r length(snowball$node$id)`   |    `r sum(snowball_cluster$nodes$id %in% snowball$nodes$id)`                                 |


#### (keypaper <-> keypaper)

```{r}
key_works_cluster[key_works_cluster$id %in% gsub("^https://openalex.org/", "", key_works$id), ] |>
    IPBES.R::table_dt(fixedColumns = NULL)
```

#### (keypaper <-> paper)
```{r}
key_works_cluster[key_works_cluster$id %in% snowball$nodes$id, ] |>
    IPBES.R::table_dt(fixedColumns = NULL)
```

#### (paper <-> keypaper)
```{r}
snowball_cluster$nodes[snowball_cluster$nodes$id %in% gsub("^https://openalex.org/", "", key_works$id), ] |>
    IPBES.R::table_dt(fixedColumns = NULL)
```

#### (paper <-> paper)
```{r}
snowball_cluster$nodes[snowball_cluster$nodes$id %in% snowball$nodes$id, ] |>
    IPBES.R::table_dt(fixedColumns = NULL)
```

## Approaches -> Theories graph

```{r}
data <- read.csv(file.path("input", "T&F of TC from CA - chapter 3 - All theories from CA coded.csv"))[c(6, 11:16)]
names(data) <- c(
    "Theory",
    "1 Science and Technology",
    "2. Knowledge co-creation",
    "3. Systems",
    "4. Inner Transformation",
    "5. Empowerment",
    "6. Structural"
)

nodes <- data.frame(
    name = c(
        names(data)[2:7],
        data$Theory |> unique()
    )
)
nodes$group <- c(
    paste0(1:6, "."),
    rep(
        "theory",
        nrow(nodes) - length(approach_colors)
    )
)


links <- lapply(
    2:7,
    function(i) {
        data |>
            dplyr::mutate(
                source = names(data)[i],
            ) |>
            dplyr::select(
                source = source,
                target = Theory,
                level = names(data)[i],
            )
    }
) |>
    do.call(what = rbind) |>
    dplyr::mutate(
        source = factor(
            source,
            levels = nodes$name
        ) |>
            as.numeric(),
        source = as.numeric(source) - 1,
        target = factor(
            target,
            levels = nodes$name
        ) |>
            as.numeric(),
        target = as.numeric(target) - 1,
        value = 1
    ) |>
    dplyr::filter(
        !is.na(level)
    )

links$level <- as.character(links$level)

my_color <- 'd3.scaleOrdinal() .domain(["1", "2", "1.", "2.", "3.", "4.", "5.", "6.", "theory"]) .range(["red", "blue", "#D46746", "#E69A6A", "#E6C540", "#B5C788", "#2DB3B0", "#A693B5", "lightgrey"])'

##########

bn <- file.path("figures", "approaches_theories_1")
sankeyNetwork(
    Links = links |> dplyr::filter(level == 1),
    LinkGroup = "level",
    Nodes = nodes,
    NodeGroup = "group",
    Source = "target",
    Target = "source",
    Value = "value",
    NodeID = "name",
    colourScale = my_color,
    sinksRight = FALSE
) |>
    saveNetwork(
        file = paste0(bn, ".html"),
        selfcontained = TRUE
    )
webshot::webshot(
    url = paste0(bn, ".html"),
    file = paste0(bn, ".pdf")
)
unlink(paste0(bn, "_files"), recursive = TRUE)

##########

bn <- file.path("figures", "approaches_theories_2")
sankeyNetwork(
    Links = links |> dplyr::filter(level == 2),
    LinkGroup = "level",
    Nodes = nodes,
    NodeGroup = "group",
    Source = "target",
    Target = "source",
    Value = "value",
    NodeID = "name",
    colourScale = my_color,
    sinksRight = FALSE
) |>
    saveNetwork(
        file = paste0(bn, ".html"),
        selfcontained = TRUE
    )
webshot::webshot(
    url = paste0(bn, ".html"),
    file = paste0(bn, ".pdf")
)
unlink(paste0(bn, "_files"), recursive = TRUE)


bn <- file.path("figures", "approaches_theories_1_2")
sankeyNetwork(
    Links = links |> dplyr::filter(!is.na(level)),
    LinkGroup = "level",
    Nodes = nodes,
    NodeGroup = "group",
    Source = "target",
    Target = "source",
    Value = "value",
    NodeID = "name",
    colourScale = my_color,
    sinksRight = FALSE
) |>
    saveNetwork(
        file = paste0(bn, ".html"),
        selfcontained = TRUE
    )
unlink(paste0(bn, "_files"), recursive = TRUE)

webshot::webshot(
    url = paste0(bn, ".html"),
    file = paste0(bn, ".pdf")
)

```