# scGPS introduction

#### Quan Nguyen and Michael Thompson

#### 2023-05-04

# 1. Installation instruction

    # To install scGPS from github (Depending on the configuration of the local
    # computer or HPC, possible custom C++ compilation may be required - see
    # installation trouble-shootings below)
    devtools::install_github("IMB-Computational-Genomics-Lab/scGPS")

    # for C++ compilation trouble-shooting, manual download and installation can be
    # done from github

    git clone https://github.com/IMB-Computational-Genomics-Lab/scGPS

    # then check in scGPS/src if any of the precompiled (e.g.  those with *.so and
    # *.o) files exist and delete them before recompiling

    # then with the scGPS as the R working directory, manually install and load
    # using devtools functionality
    # Install the package
    devtools::install()
    #load the package to the workspace
    library(scGPS)

# 2. A simple workflow of the scGPS:

The purpose of this workflow is to solve the following task:

- Given a mixed population with known subpopulations, estimate transition scores between these subpopulation.

## 2.1 Create scGPS objects

    # load mixed population 1 (loaded from day_2_cardio_cell_sample dataset,
    # named it as day2)
    library(scGPS)

    day2 <- day_2_cardio_cell_sample
    mixedpop1 <- new_scGPS_object(ExpressionMatrix = day2$dat2_counts,
        GeneMetadata = day2$dat2geneInfo, CellMetadata = day2$dat2_clusters)

    # load mixed population 2 (loaded from day_5_cardio_cell_sample dataset,
    # named it as day5)
    day5 <- day_5_cardio_cell_sample
    mixedpop2 <- new_scGPS_object(ExpressionMatrix = day5$dat5_counts,
        GeneMetadata = day5$dat5geneInfo, CellMetadata = day5$dat5_clusters)

## 2.2 Run prediction

    # select a subpopulation
    c_selectID <- 1
    # load gene list (this can be any lists of user selected genes)
    genes <- training_gene_sample
    genes <- genes$Merged_unique
    # load cluster information
    cluster_mixedpop1 <- colData(mixedpop1)[,1]
    cluster_mixedpop2 <- colData(mixedpop2)[,1]
    #run training (running nboots = 3 here, but recommend to use nboots = 50-100)
    LSOLDA_dat <- bootstrap_prediction(nboots = 3, mixedpop1 = mixedpop1,
        mixedpop2 = mixedpop2, genes = genes, c_selectID  = c_selectID,
        listData = list(), cluster_mixedpop1 = cluster_mixedpop1,
        cluster_mixedpop2 = cluster_mixedpop2, trainset_ratio = 0.7)
    names(LSOLDA_dat)
    #> [1] "Accuracy"          "ElasticNetGenes"   "Deviance"
    #> [4] "ElasticNetFit"     "LDAFit"            "predictor_S1"
    #> [7] "ElasticNetPredict" "LDAPredict"        "cell_results"

## 2.3 Summarise results

    # summary results LDA
    sum_pred_lda <- summary_prediction_lda(LSOLDA_dat = LSOLDA_dat, nPredSubpop = 4)
    # summary results Lasso to show the percent of cells
    # classified as cells belonging
    sum_pred_lasso <- summary_prediction_lasso(LSOLDA_dat = LSOLDA_dat,
        nPredSubpop = 4)
    # plot summary results
    plot_sum <-function(sum_dat){
        sum_dat_tf <- t(sum_dat)
        sum_dat_tf <- na.omit(sum_dat_tf)
        sum_dat_tf <- apply(sum_dat[, -ncol(sum_dat)],1,
            function(x){as.numeric(as.vector(x))})
        sum_dat$names <- gsub("ElasticNet for subpop","sp",  sum_dat$names )
        sum_dat$names <- gsub("in target mixedpop","in p",  sum_dat$names)
        sum_dat$names <- gsub("LDA for subpop","sp",  sum_dat$names )
        sum_dat$names <- gsub("in target mixedpop","in p",  sum_dat$names)
        colnames(sum_dat_tf) <- sum_dat$names
        boxplot(sum_dat_tf, las=2)
    }
    plot_sum(sum_pred_lasso)

    plot_sum(sum_pred_lda)

    # summary accuracy to check the model accuracy in the leave-out test set
    summary_accuracy(object = LSOLDA_dat)
    #> [1] 67.77251 62.32558 59.90783
    # summary maximum deviance explained by the model
    summary_deviance(object = LSOLDA_dat)
    #> $allDeviance
    #> [1] "7.08" "9.43" "9.51"
    #>
    #> $DeviMax
    #>          dat_DE$Dfd          Deviance           DEgenes
    #> 1                 0              9.51    genes_cluster1
    #> 2                 1              9.51    genes_cluster1
    #> 3                 2              9.51    genes_cluster1
    #> 4                 3              9.51    genes_cluster1
    #> 5                 4              9.51    genes_cluster1
    #> 6 remaining DEgenes remaining DEgenes remaining DEgenes
    #>
    #> $LassoGenesMax
    #> NULL

# 3. A complete workflow of the scGPS:

The purpose of this workflow is to solve the following task:

- Given an unknown mixed population, find clusters and estimate relationship between clusters

## 3.1 Identify clusters in a dataset using CORE

(skip this step if clusters are known)

    # find clustering information in an expresion data using CORE
    day5 <- day_5_cardio_cell_sample
    cellnames <- colnames(day5$dat5_counts)
    cluster <-day5$dat5_clusters
    cellnames <-data.frame("Cluster"=cluster, "cellBarcodes" = cellnames)
    mixedpop2 <-new_scGPS_object(ExpressionMatrix = day5$dat5_counts,
                        GeneMetadata = day5$dat5geneInfo, CellMetadata = cellnames)

    CORE_cluster <- CORE_clustering(mixedpop2, remove_outlier = c(0), PCA=FALSE)

    # to update the clustering information, users can ...
    key_height <- CORE_cluster$optimalClust$KeyStats$Height
    optimal_res <- CORE_cluster$optimalClust$OptimalRes
    optimal_index = which(key_height == optimal_res)

    clustering_after_outlier_removal <- unname(unlist(
     CORE_cluster$Cluster[[optimal_index]]))
    corresponding_cells_after_outlier_removal <- CORE_cluster$cellsForClustering
    original_cells_before_removal <- colData(mixedpop2)[,2]
    corresponding_index <- match(corresponding_cells_after_outlier_removal,
                                original_cells_before_removal )
    # check the matching
    identical(as.character(original_cells_before_removal[corresponding_index]),
             corresponding_cells_after_outlier_removal)
    #> [1] TRUE
    # create new object with the new clustering after removing outliers
    mixedpop2_post_clustering <- mixedpop2[,corresponding_index]
    colData(mixedpop2_post_clustering)[,1] <- clustering_after_outlier_removal

## 3.2 Identify clusters in a dataset using SCORE (Stable Clustering at Optimal REsolution)

(skip this step if clusters are known)

(SCORE aims to get stable subpopulation results by introducing bagging aggregation and bootstrapping to the CORE algorithm)

    # find clustering information in an expresion data using SCORE
    day5 <- day_5_cardio_cell_sample
    cellnames <- colnames(day5$dat5_counts)
    cluster <-day5$dat5_clusters
    cellnames <-data.frame("Cluster"=cluster, "cellBarcodes" = cellnames)
    mixedpop2 <-new_scGPS_object(ExpressionMatrix = day5$dat5_counts,
                        GeneMetadata = day5$dat5geneInfo, CellMetadata = cellnames )

    SCORE_test <- CORE_bagging(mixedpop2, remove_outlier = c(0), PCA=FALSE,
                                    bagging_run = 20, subsample_proportion = .8)

## 3.3 Visualise all cluster results in all iterations

    dev.off()
    #> null device
    #>           1
    ##3.2.1 plot CORE clustering
    p1 <- plot_CORE(CORE_cluster$tree, CORE_cluster$Cluster,
        color_branch = c("#208eb7", "#6ce9d3", "#1c5e39", "#8fca40", "#154975",
            "#b1c8eb"))
    p1
    #> $mar
    #> [1] 1 5 0 1
    #extract optimal index identified by CORE
    key_height <- CORE_cluster$optimalClust$KeyStats$Height
    optimal_res <- CORE_cluster$optimalClust$OptimalRes
    optimal_index = which(key_height == optimal_res)
    #plot one optimal clustering bar
    plot_optimal_CORE(original_tree= CORE_cluster$tree,
                     optimal_cluster = unlist(CORE_cluster$Cluster[optimal_index]),
                     shift = -2000)
    #> Ordering and assigning labels...
    #> 2
    #> 162335NA
    #> 3
    #> 162335423
    #> Plotting the colored dendrogram now....
    #> Plotting the bar underneath now....

    ##3.2.2 plot SCORE clustering
    #plot all clustering bars
    plot_CORE(SCORE_test$tree, list_clusters = SCORE_test$Cluster)
    #plot one stable optimal clustering bar
    plot_optimal_CORE(original_tree= SCORE_test$tree,
                     optimal_cluster = unlist(SCORE_test$Cluster[
                        SCORE_test$optimal_index]),
                     shift = -100)
    #> Ordering and assigning labels...
    #> 2
    #> 88250NANANANA
    #> 3
    #> 88250335NANANA
    #> 4
    #> 88250335367NANA
    #> 5
    #> 88250335367414NA
    #> 6
    #> 88250335367414470
    #> Plotting the colored dendrogram now....
    #> Plotting the bar underneath now....

## 3.4 Compare clustering results with other dimensional reduction methods (e.g., tSNE)

    t <- tSNE(expression.mat=assay(mixedpop2))
    #> Preparing PCA inputs using the top 1500 genes ...
    #> Computing PCA values...
    #> Running tSNE ...
    p2 <-plot_reduced(t, color_fac = factor(colData(mixedpop2)[,1]),
                          palletes =1:length(unique(colData(mixedpop2)[,1])))
    #> Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
    #> ℹ Please use `after_stat(count)` instead.
    #> ℹ The deprecated feature was likely used in the cowplot package.
    #>   Please report the issue at <https://github.com/wilkelab/cowplot/issues>.
    #> This warning is displayed once every 8 hours.
    #> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
    #> generated.
    #> Warning: Use of `reduced_dat_toPlot$Dim1` is discouraged.
    #> ℹ Use `Dim1` instead.
    #> Warning: Use of `reduced_dat_toPlot$Dim2` is discouraged.
    #> ℹ Use `Dim2` instead.
    p2

## 3.5 Find gene markers and annotate clusters

    #load gene list (this can be any lists of user-selected genes)
    genes <-training_gene_sample
    genes <-genes$Merged_unique

    #the gene list can also be objectively identified by differential expression
    #analysis cluster information is requied for find_markers. Here, we use
    #CORE results.

    #colData(mixedpop2)[,1] <- unlist(SCORE_test$Cluster[SCORE_test$optimal_index])

    suppressMessages(library(locfit))

    DEgenes <- find_markers(expression_matrix=assay(mixedpop2),
                                cluster = colData(mixedpop2)[,1],
                                selected_cluster=unique(colData(mixedpop2)[,1]))

    #the output contains dataframes for each cluster.
    #the data frame contains all genes, sorted by p-values
    names(DEgenes)
    #> [1] "baseMean"       "log2FoldChange" "lfcSE"          "stat"
    #> [5] "pvalue"         "padj"           "id"

    #you can annotate the identified clusters
    DEgeneList_1vsOthers <- DEgenes$DE_Subpop1vsRemaining$id

    #users need to check the format of the gene input to make sure they are
    #consistent to the gene names in the expression matrix

    #the following command saves the file "PathwayEnrichment.xlsx" to the
    #working dir
    #use 500 top DE genes
    suppressMessages(library(DOSE))
    suppressMessages(library(ReactomePA))
    suppressMessages(library(clusterProfiler))
    genes500 <- as.factor(DEgeneList_1vsOthers[seq_len(500)])
    enrichment_test <- annotate_clusters(genes, pvalueCutoff=0.05, gene_symbol=TRUE)

    #the enrichment outputs can be displayed by running
    clusterProfiler::dotplot(enrichment_test, showCategory=10, font.size = 6)

# 4. Relationship between clusters within one sample or between two samples

The purpose of this workflow is to solve the following task:

- Given one or two unknown mixed population(s) and clusters in each mixed population, estimate
- Visualise relationship between clusters*

## 4.1 Start the scGPS prediction to find relationship between clusters

    #select a subpopulation, and input gene list
    c_selectID <- 1
    #note make sure the format for genes input here is the same to the format
    #for genes in the mixedpop1 and mixedpop2
    genes = DEgenes$id[1:500]

    #run the test bootstrap with nboots = 2 runs

    cluster_mixedpop1 <- colData(mixedpop1)[,1]
    cluster_mixedpop2 <- colData(mixedpop2)[,1]

    LSOLDA_dat <- bootstrap_prediction(nboots = 2, mixedpop1 = mixedpop1,
                                 mixedpop2 = mixedpop2, genes = genes,
                                 c_selectID  = c_selectID,
                                 listData = list(),
                                 cluster_mixedpop1 = cluster_mixedpop1,
                                 cluster_mixedpop2 = cluster_mixedpop2)

## 4.2 Display summary results for the prediction

    #get the number of rows for the summary matrix
    row_cluster <-length(unique(colData(mixedpop2)[,1]))

    #summary results LDA to to show the percent of cells classified as cells
    #belonging by LDA classifier
    summary_prediction_lda(LSOLDA_dat=LSOLDA_dat, nPredSubpop = row_cluster )
    #>                 V1               V2                                names
    #> 1 10.1604278074866 87.1657754010695 LDA for subpop 1 in target mixedpop2
    #> 2 10.7142857142857 97.1428571428571 LDA for subpop 2 in target mixedpop2
    #> 3 9.77443609022556 86.4661654135338 LDA for subpop 3 in target mixedpop2
    #> 4             12.5               85 LDA for subpop 4 in target mixedpop2

    #summary results Lasso to show the percent of cells classified as cells
    #belonging by Lasso classifier
    summary_prediction_lasso(LSOLDA_dat=LSOLDA_dat, nPredSubpop = row_cluster)
    #>                 V1               V2                                      names
    #> 1 36.3636363636364 45.9893048128342 ElasticNet for subpop1 in target mixedpop2
    #> 2               85 89.2857142857143 ElasticNet for subpop2 in target mixedpop2
    #> 3 9.77443609022556 28.5714285714286 ElasticNet for subpop3 in target mixedpop2
    #> 4             32.5             52.5 ElasticNet for subpop4 in target mixedpop2

    # summary maximum deviance explained by the model during the model training
    summary_deviance(object = LSOLDA_dat)
    #> $allDeviance
    #> [1] "87.97" "52.53"
    #>
    #> $DeviMax
    #>           dat_DE$Dfd          Deviance           DEgenes
    #> 1                  0             87.97    genes_cluster1
    #> 2                  1             87.97    genes_cluster1
    #> 3                  2             87.97    genes_cluster1
    #> 4                  4             87.97    genes_cluster1
    #> 5                  7             87.97    genes_cluster1
    #> 6                  8             87.97    genes_cluster1
    #> 7                 10             87.97    genes_cluster1
    #> 8                 12             87.97    genes_cluster1
    #> 9                 15             87.97    genes_cluster1
    #> 10                18             87.97    genes_cluster1
    #> 11                19             87.97    genes_cluster1
    #> 12                24             87.97    genes_cluster1
    #> 13                26             87.97    genes_cluster1
    #> 14                28             87.97    genes_cluster1
    #> 15                33             87.97    genes_cluster1
    #> 16                34             87.97    genes_cluster1
    #> 17                36             87.97    genes_cluster1
    #> 18                37             87.97    genes_cluster1
    #> 19                39             87.97    genes_cluster1
    #> 20                45             87.97    genes_cluster1
    #> 21                46             87.97    genes_cluster1
    #> 22                48             87.97    genes_cluster1
    #> 23                53             87.97    genes_cluster1
    #> 24                55             87.97    genes_cluster1
    #> 25                56             87.97    genes_cluster1
    #> 26                57             87.97    genes_cluster1
    #> 27                58             87.97    genes_cluster1
    #> 28                59             87.97    genes_cluster1
    #> 29                60             87.97    genes_cluster1
    #> 30                63             87.97    genes_cluster1
    #> 31                65             87.97    genes_cluster1
    #> 32                67             87.97    genes_cluster1
    #> 33 remaining DEgenes remaining DEgenes remaining DEgenes
    #>
    #> $LassoGenesMax
    #> NULL

    # summary accuracy to check the model accuracy in the leave-out test set
    summary_accuracy(object = LSOLDA_dat)
    #> [1] 64.73214 68.75000

## 4.3 Plot the relationship between clusters in one sample

Here we look at one example use case to find relationship between clusters within one sample or between two sample

    #run prediction for 3 clusters
    cluster_mixedpop1 <- colData(mixedpop1)[,1]
    cluster_mixedpop2 <- colData(mixedpop2)[,1]
    #cluster_mixedpop2 <- as.numeric(as.vector(colData(mixedpop2)[,1]))

    c_selectID <- 1
    #top 200 gene markers distinguishing cluster 1
    genes = DEgenes$id[1:200]

    LSOLDA_dat1 <- bootstrap_prediction(nboots = 2, mixedpop1 = mixedpop2,
                            mixedpop2 = mixedpop2, genes=genes, c_selectID,
                            listData =list(),
                            cluster_mixedpop1 = cluster_mixedpop2,
                            cluster_mixedpop2 = cluster_mixedpop2)

    c_selectID <- 2
    genes = DEgenes$id[1:200]

    LSOLDA_dat2 <- bootstrap_prediction(nboots = 2,mixedpop1 = mixedpop2,
                            mixedpop2 = mixedpop2, genes=genes, c_selectID,
                            listData =list(),
                            cluster_mixedpop1 = cluster_mixedpop2,
                            cluster_mixedpop2 = cluster_mixedpop2)

    c_selectID <- 3
    genes = DEgenes$id[1:200]
    LSOLDA_dat3 <- bootstrap_prediction(nboots = 2,mixedpop1 = mixedpop2,
                            mixedpop2 = mixedpop2, genes=genes, c_selectID,
                            listData =list(),
                            cluster_mixedpop1 = cluster_mixedpop2,
                            cluster_mixedpop2 = cluster_mixedpop2)

    c_selectID <- 4
    genes = DEgenes$id[1:200]
    LSOLDA_dat4 <- bootstrap_prediction(nboots = 2,mixedpop1 = mixedpop2,
                            mixedpop2 = mixedpop2, genes=genes, c_selectID,
                            listData =list(),
                            cluster_mixedpop1 = cluster_mixedpop2,
                            cluster_mixedpop2 = cluster_mixedpop2)

    #prepare table input for sankey plot

    LASSO_C1S2  <- reformat_LASSO(c_selectID=1, mp_selectID = 2,
                                 LSOLDA_dat=LSOLDA_dat1,
                                 nPredSubpop = length(unique(colData(mixedpop2)
                                    [,1])),
                                 Nodes_group ="#7570b3")

    LASSO_C2S2  <- reformat_LASSO(c_selectID=2, mp_selectID =2,
                                 LSOLDA_dat=LSOLDA_dat2,
                                 nPredSubpop = length(unique(colData(mixedpop2)
                                    [,1])),
                                 Nodes_group ="#1b9e77")

    LASSO_C3S2  <- reformat_LASSO(c_selectID=3, mp_selectID =2,
                                 LSOLDA_dat=LSOLDA_dat3,
                                 nPredSubpop = length(unique(colData(mixedpop2)
                                    [,1])),
                                 Nodes_group ="#e7298a")

    LASSO_C4S2  <- reformat_LASSO(c_selectID=4, mp_selectID =2,
                                 LSOLDA_dat=LSOLDA_dat4,
                                 nPredSubpop = length(unique(colData(mixedpop2)
                                    [,1])),
                                 Nodes_group ="#00FFFF")

    combined <- rbind(LASSO_C1S2,LASSO_C2S2,LASSO_C3S2, LASSO_C4S2 )
    combined <- combined[is.na(combined$Value) != TRUE,]

    nboots = 2
    #links: source, target, value
    #source: node, nodegroup
    combined_D3obj <-list(Nodes=combined[,(nboots+3):(nboots+4)],
                         Links=combined[,c((nboots+2):(nboots+1),ncol(combined))])

    library(networkD3)

    Node_source <- as.vector(sort(unique(combined_D3obj$Links$Source)))
    Node_target <- as.vector(sort(unique(combined_D3obj$Links$Target)))
    Node_all <-unique(c(Node_source, Node_target))

    #assign IDs for Source (start from 0)
    Source <-combined_D3obj$Links$Source
    Target <- combined_D3obj$Links$Target

    for(i in 1:length(Node_all)){
       Source[Source==Node_all[i]] <-i-1
       Target[Target==Node_all[i]] <-i-1
    }
    #
    combined_D3obj$Links$Source <- as.numeric(Source)
    combined_D3obj$Links$Target <- as.numeric(Target)
    combined_D3obj$Links$LinkColor <- combined$NodeGroup

    #prepare node info
    node_df <-data.frame(Node=Node_all)
    node_df$id <-as.numeric(c(0, 1:(length(Node_all)-1)))

    suppressMessages(library(dplyr))
    Color <- combined %>% count(Node, color=NodeGroup) %>% select(2)
    node_df$color <- Color$color

    suppressMessages(library(networkD3))
    p1<-sankeyNetwork(Links =combined_D3obj$Links, Nodes = node_df,
                     Value = "Value", NodeGroup ="color", LinkGroup = "LinkColor",
                     NodeID="Node", Source="Source", Target="Target", fontSize = 22)
    p1

#saveNetwork(p1, file = paste0(path,'Subpopulation_Net.html'))

## 4.3 Plot the relationship between clusters in two samples

Here we look at one example use case to find relationship between clusters within one sample or between two sample

    #run prediction for 3 clusters
    cluster_mixedpop1 <- colData(mixedpop1)[,1]
    cluster_mixedpop2 <- colData(mixedpop2)[,1]
    row_cluster <-length(unique(colData(mixedpop2)[,1]))

    c_selectID <- 1
    #top 200 gene markers distinguishing cluster 1
    genes = DEgenes$id[1:200]
    LSOLDA_dat1 <- bootstrap_prediction(nboots = 2, mixedpop1 = mixedpop1,
                            mixedpop2 = mixedpop2, genes=genes, c_selectID,
                            listData =list(),
                            cluster_mixedpop1 = cluster_mixedpop1,
                            cluster_mixedpop2 = cluster_mixedpop2)

    c_selectID <- 2
    genes = DEgenes$id[1:200]
    LSOLDA_dat2 <- bootstrap_prediction(nboots = 2,mixedpop1 = mixedpop1,
                            mixedpop2 = mixedpop2, genes=genes, c_selectID,
                            listData =list(),
                            cluster_mixedpop1 = cluster_mixedpop1,
                            cluster_mixedpop2 = cluster_mixedpop2)

    c_selectID <- 3
    genes = DEgenes$id[1:200]
    LSOLDA_dat3 <- bootstrap_prediction(nboots = 2,mixedpop1 = mixedpop1,
                            mixedpop2 = mixedpop2, genes=genes, c_selectID,
                            listData =list(),
                            cluster_mixedpop1 = cluster_mixedpop1,
                            cluster_mixedpop2 = cluster_mixedpop2)

    #prepare table input for sankey plot

    LASSO_C1S1  <- reformat_LASSO(c_selectID=1, mp_selectID = 1,
                                 LSOLDA_dat=LSOLDA_dat1, nPredSubpop = row_cluster,
                                 Nodes_group = "#7570b3")

    LASSO_C2S1  <- reformat_LASSO(c_selectID=2, mp_selectID = 1,
                                 LSOLDA_dat=LSOLDA_dat2, nPredSubpop = row_cluster,
                                 Nodes_group = "#1b9e77")

    LASSO_C3S1  <- reformat_LASSO(c_selectID=3, mp_selectID = 1,
                                 LSOLDA_dat=LSOLDA_dat3, nPredSubpop = row_cluster,
                                 Nodes_group = "#e7298a")

    combined <- rbind(LASSO_C1S1,LASSO_C2S1,LASSO_C3S1)

    nboots = 2
    #links: source, target, value
    #source: node, nodegroup
    combined_D3obj <-list(Nodes=combined[,(nboots+3):(nboots+4)],
                         Links=combined[,c((nboots+2):(nboots+1),ncol(combined))])
    combined <- combined[is.na(combined$Value) != TRUE,]

    library(networkD3)

    Node_source <- as.vector(sort(unique(combined_D3obj$Links$Source)))
    Node_target <- as.vector(sort(unique(combined_D3obj$Links$Target)))
    Node_all <-unique(c(Node_source, Node_target))

    #assign IDs for Source (start from 0)
    Source <-combined_D3obj$Links$Source
    Target <- combined_D3obj$Links$Target

    for(i in 1:length(Node_all)){
       Source[Source==Node_all[i]] <-i-1
       Target[Target==Node_all[i]] <-i-1
    }

    combined_D3obj$Links$Source <- as.numeric(Source)
    combined_D3obj$Links$Target <- as.numeric(Target)
    combined_D3obj$Links$LinkColor <- combined$NodeGroup

    #prepare node info
    node_df <-data.frame(Node=Node_all)
    node_df$id <-as.numeric(c(0, 1:(length(Node_all)-1)))

    suppressMessages(library(dplyr))
    n <- length(unique(node_df$Node))
    getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "Set1"))
    Color = getPalette(n)
    node_df$color <- Color
    suppressMessages(library(networkD3))
    p1<-sankeyNetwork(Links =combined_D3obj$Links, Nodes = node_df,
                     Value = "Value", NodeGroup ="color", LinkGroup = "LinkColor",
                     NodeID="Node", Source="Source", Target="Target", fontSize = 22)
    p1

#saveNetwork(p1, file = paste0(path,'Subpopulation_Net.html'))

    devtools::session_info()
    #> ─ Session info ───────────────────────────────────────────────────────────────
    #>  setting  value
    #>  version  R version 4.3.0 RC (2023-04-18 r84287 ucrt)
    #>  os       Windows Server 2022 x64 (build 20348)
    #>  system   x86_64, mingw32
    #>  ui       RTerm
    #>  language (EN)
    #>  collate  C
    #>  ctype    English_United States.utf8
    #>  tz       America/New_York
    #>  date     2023-05-04
    #>  pandoc   2.7.3 @ C:/PROGRA~1/Pandoc/ (via rmarkdown)
    #>
    #> ─ Packages ───────────────────────────────────────────────────────────────────
    #>  ! package              * version    date (UTC) lib source
    #>    AnnotationDbi        * 1.63.1     2023-05-04 [2] Bioconductor
    #>    ape                    5.7-1      2023-03-13 [2] CRAN (R 4.3.0)
    #>    aplot                  0.1.10     2023-03-08 [2] CRAN (R 4.3.0)
    #>    Biobase              * 2.61.0     2023-05-04 [2] Bioconductor
    #>    BiocGenerics         * 0.47.0     2023-05-04 [2] Bioconductor
    #>    BiocParallel           1.35.0     2023-05-04 [2] Bioconductor
    #>    Biostrings             2.69.0     2023-05-04 [2] Bioconductor
    #>    bit                    4.0.5      2022-11-15 [2] CRAN (R 4.3.0)
    #>    bit64                  4.0.5      2020-08-30 [2] CRAN (R 4.3.0)
    #>    bitops                 1.0-7      2021-04-24 [2] CRAN (R 4.3.0)
    #>    blob                   1.2.4      2023-03-17 [2] CRAN (R 4.3.0)
    #>    bslib                  0.4.2      2022-12-16 [2] CRAN (R 4.3.0)
    #>    cachem                 1.0.8      2023-05-01 [2] CRAN (R 4.3.0)
    #>    callr                  3.7.3      2022-11-02 [2] CRAN (R 4.3.0)
    #>    caret                * 6.0-94     2023-03-21 [2] CRAN (R 4.3.0)
    #>    class                  7.3-22     2023-05-03 [2] CRAN (R 4.3.0)
    #>    cli                    3.6.1      2023-03-23 [2] CRAN (R 4.3.0)
    #>    clusterProfiler      * 4.9.0      2023-05-04 [2] Bioconductor
    #>    codetools              0.2-19     2023-02-01 [2] CRAN (R 4.3.0)
    #>    colorspace             2.1-0      2023-01-23 [2] CRAN (R 4.3.0)
    #>    cowplot                1.1.1      2020-12-30 [2] CRAN (R 4.3.0)
    #>    crayon                 1.5.2      2022-09-29 [2] CRAN (R 4.3.0)
    #>    data.table             1.14.8     2023-02-17 [2] CRAN (R 4.3.0)
    #>    DBI                    1.1.3      2022-06-18 [2] CRAN (R 4.3.0)
    #>    DelayedArray           0.27.2     2023-05-04 [2] Bioconductor
    #>    dendextend             1.17.1     2023-03-25 [2] CRAN (R 4.3.0)
    #>    DESeq2                 1.41.0     2023-05-04 [2] Bioconductor
    #>    devtools               2.4.5      2022-10-11 [2] CRAN (R 4.3.0)
    #>    digest                 0.6.31     2022-12-11 [2] CRAN (R 4.3.0)
    #>    DOSE                 * 3.27.1     2023-05-04 [2] Bioconductor
    #>    downloader             0.4        2015-07-09 [2] CRAN (R 4.3.0)
    #>    dplyr                * 1.1.2      2023-04-20 [2] CRAN (R 4.3.0)
    #>    dynamicTreeCut       * 1.63-1     2016-03-11 [2] CRAN (R 4.3.0)
    #>    e1071                  1.7-13     2023-02-01 [2] CRAN (R 4.3.0)
    #>    ellipsis               0.3.2      2021-04-29 [2] CRAN (R 4.3.0)
    #>    enrichplot             1.21.0     2023-05-04 [2] Bioconductor
    #>    evaluate               0.20       2023-01-17 [2] CRAN (R 4.3.0)
    #>    fansi                  1.0.4      2023-01-22 [2] CRAN (R 4.3.0)
    #>    farver                 2.1.1      2022-07-06 [2] CRAN (R 4.3.0)
    #>    fastcluster            1.2.3      2021-05-24 [2] CRAN (R 4.3.0)
    #>    fastmap                1.1.1      2023-02-24 [2] CRAN (R 4.3.0)
    #>    fastmatch              1.1-3      2021-07-23 [2] CRAN (R 4.3.0)
    #>    fgsea                  1.27.0     2023-05-04 [2] Bioconductor
    #>    foreach                1.5.2      2022-02-02 [2] CRAN (R 4.3.0)
    #>    fs                     1.6.2      2023-04-25 [2] CRAN (R 4.3.0)
    #>    future                 1.32.0     2023-03-07 [2] CRAN (R 4.3.0)
    #>    future.apply           1.10.0     2022-11-05 [2] CRAN (R 4.3.0)
    #>    generics               0.1.3      2022-07-05 [2] CRAN (R 4.3.0)
    #>    GenomeInfoDb         * 1.37.1     2023-05-04 [2] Bioconductor
    #>    GenomeInfoDbData       1.2.10     2023-04-21 [2] Bioconductor
    #>    GenomicRanges        * 1.53.1     2023-05-04 [2] Bioconductor
    #>    ggforce                0.4.1      2022-10-04 [2] CRAN (R 4.3.0)
    #>    ggfun                  0.0.9      2022-11-21 [2] CRAN (R 4.3.0)
    #>    ggplot2              * 3.4.2      2023-04-03 [2] CRAN (R 4.3.0)
    #>    ggplotify              0.1.0      2021-09-02 [2] CRAN (R 4.3.0)
    #>    ggraph                 2.1.0      2022-10-09 [2] CRAN (R 4.3.0)
    #>    ggrepel                0.9.3      2023-02-03 [2] CRAN (R 4.3.0)
    #>    ggtree                 3.9.0      2023-05-04 [2] Bioconductor
    #>    glmnet                 4.1-7      2023-03-23 [2] CRAN (R 4.3.0)
    #>    globals                0.16.2     2022-11-21 [2] CRAN (R 4.3.0)
    #>    glue                   1.6.2      2022-02-24 [2] CRAN (R 4.3.0)
    #>    GO.db                  3.17.0     2023-04-21 [2] Bioconductor
    #>    GOSemSim               2.27.0     2023-05-04 [2] Bioconductor
    #>    gower                  1.0.1      2022-12-22 [2] CRAN (R 4.3.0)
    #>    graph                  1.79.0     2023-05-04 [2] Bioconductor
    #>    graphite               1.47.0     2023-05-04 [2] Bioconductor
    #>    graphlayouts           1.0.0      2023-05-01 [2] CRAN (R 4.3.0)
    #>    gridExtra              2.3        2017-09-09 [2] CRAN (R 4.3.0)
    #>    gridGraphics           0.5-1      2020-12-13 [2] CRAN (R 4.3.0)
    #>    gson                   0.1.0      2023-03-07 [2] CRAN (R 4.3.0)
    #>    gtable                 0.3.3      2023-03-21 [2] CRAN (R 4.3.0)
    #>    hardhat                1.3.0      2023-03-30 [2] CRAN (R 4.3.0)
    #>    HDO.db                 0.99.1     2023-04-21 [2] Bioconductor
    #>    highr                  0.10       2022-12-22 [2] CRAN (R 4.3.0)
    #>    htmltools              0.5.5      2023-03-23 [2] CRAN (R 4.3.0)
    #>    htmlwidgets            1.6.2      2023-03-17 [2] CRAN (R 4.3.0)
    #>    httpuv                 1.6.9      2023-02-14 [2] CRAN (R 4.3.0)
    #>    httr                   1.4.5      2023-02-24 [2] CRAN (R 4.3.0)
    #>    igraph                 1.4.2      2023-04-07 [2] CRAN (R 4.3.0)
    #>    ipred                  0.9-14     2023-03-09 [2] CRAN (R 4.3.0)
    #>    IRanges              * 2.35.1     2023-05-04 [2] Bioconductor
    #>    iterators              1.0.14     2022-02-05 [2] CRAN (R 4.3.0)
    #>    jquerylib              0.1.4      2021-04-26 [2] CRAN (R 4.3.0)
    #>    jsonlite               1.8.4      2022-12-06 [2] CRAN (R 4.3.0)
    #>    KEGGREST               1.41.0     2023-05-04 [2] Bioconductor
    #>    knitr                  1.42       2023-01-25 [2] CRAN (R 4.3.0)
    #>    labeling               0.4.2      2020-10-20 [2] CRAN (R 4.3.0)
    #>    later                  1.3.1      2023-05-02 [2] CRAN (R 4.3.0)
    #>    lattice              * 0.21-8     2023-04-05 [2] CRAN (R 4.3.0)
    #>    lava                   1.7.2.1    2023-02-27 [2] CRAN (R 4.3.0)
    #>    lazyeval               0.2.2      2019-03-15 [2] CRAN (R 4.3.0)
    #>    lifecycle              1.0.3      2022-10-07 [2] CRAN (R 4.3.0)
    #>    listenv                0.9.0      2022-12-16 [2] CRAN (R 4.3.0)
    #>    locfit               * 1.5-9.7    2023-01-02 [2] CRAN (R 4.3.0)
    #>    lubridate              1.9.2      2023-02-10 [2] CRAN (R 4.3.0)
    #>    magrittr               2.0.3      2022-03-30 [2] CRAN (R 4.3.0)
    #>    MASS                   7.3-60     2023-05-04 [2] CRAN (R 4.3.0)
    #>    Matrix                 1.5-4      2023-04-04 [2] CRAN (R 4.3.0)
    #>    MatrixGenerics       * 1.13.0     2023-05-04 [2] Bioconductor
    #>    matrixStats          * 0.63.0     2022-11-18 [2] CRAN (R 4.3.0)
    #>    memoise                2.0.1      2021-11-26 [2] CRAN (R 4.3.0)
    #>    mime                   0.12       2021-09-28 [2] CRAN (R 4.3.0)
    #>    miniUI                 0.1.1.1    2018-05-18 [2] CRAN (R 4.3.0)
    #>    ModelMetrics           1.2.2.2    2020-03-17 [2] CRAN (R 4.3.0)
    #>    munsell                0.5.0      2018-06-12 [2] CRAN (R 4.3.0)
    #>    networkD3            * 0.4        2017-03-18 [2] CRAN (R 4.3.0)
    #>    nlme                   3.1-162    2023-01-31 [2] CRAN (R 4.3.0)
    #>    nnet                   7.3-19     2023-05-03 [2] CRAN (R 4.3.0)
    #>    org.Hs.eg.db         * 3.17.0     2023-04-21 [2] Bioconductor
    #>    parallelly             1.35.0     2023-03-23 [2] CRAN (R 4.3.0)
    #>    patchwork              1.1.2      2022-08-19 [2] CRAN (R 4.3.0)
    #>    pillar                 1.9.0      2023-03-22 [2] CRAN (R 4.3.0)
    #>    pkgbuild               1.4.0      2022-11-27 [2] CRAN (R 4.3.0)
    #>    pkgconfig              2.0.3      2019-09-22 [2] CRAN (R 4.3.0)
    #>    pkgload                1.3.2      2022-11-16 [2] CRAN (R 4.3.0)
    #>    plyr                   1.8.8      2022-11-11 [2] CRAN (R 4.3.0)
    #>    png                    0.1-8      2022-11-29 [2] CRAN (R 4.3.0)
    #>    polyclip               1.10-4     2022-10-20 [2] CRAN (R 4.3.0)
    #>    prettyunits            1.1.1      2020-01-24 [2] CRAN (R 4.3.0)
    #>    pROC                   1.18.0     2021-09-03 [2] CRAN (R 4.3.0)
    #>    processx               3.8.1      2023-04-18 [2] CRAN (R 4.3.0)
    #>    prodlim                2023.03.31 2023-04-02 [2] CRAN (R 4.3.0)
    #>    profvis                0.3.8      2023-05-02 [2] CRAN (R 4.3.0)
    #>    promises               1.2.0.1    2021-02-11 [2] CRAN (R 4.3.0)
    #>    proxy                  0.4-27     2022-06-09 [2] CRAN (R 4.3.0)
    #>    ps                     1.7.5      2023-04-18 [2] CRAN (R 4.3.0)
    #>    purrr                  1.0.1      2023-01-10 [2] CRAN (R 4.3.0)
    #>    qvalue                 2.33.0     2023-05-04 [2] Bioconductor
    #>    R6                     2.5.1      2021-08-19 [2] CRAN (R 4.3.0)
    #>    rappdirs               0.3.3      2021-01-31 [2] CRAN (R 4.3.0)
    #>    RColorBrewer           1.1-3      2022-04-03 [2] CRAN (R 4.3.0)
    #>    Rcpp                   1.0.10     2023-01-22 [2] CRAN (R 4.3.0)
    #>    RcppArmadillo          0.12.2.0.0 2023-04-05 [2] CRAN (R 4.3.0)
    #>  D RcppParallel           5.1.7      2023-02-27 [2] CRAN (R 4.3.0)
    #>    RCurl                  1.98-1.12  2023-03-27 [2] CRAN (R 4.3.0)
    #>    reactome.db            1.84.0     2023-04-21 [2] Bioconductor
    #>    ReactomePA           * 1.45.0     2023-05-04 [2] Bioconductor
    #>    recipes                1.0.6      2023-04-25 [2] CRAN (R 4.3.0)
    #>    remotes                2.4.2      2021-11-30 [2] CRAN (R 4.3.0)
    #>    reshape2               1.4.4      2020-04-09 [2] CRAN (R 4.3.0)
    #>    rlang                  1.1.1      2023-04-28 [2] CRAN (R 4.3.0)
    #>    rmarkdown              2.21       2023-03-26 [2] CRAN (R 4.3.0)
    #>    rpart                  4.1.19     2022-10-21 [2] CRAN (R 4.3.0)
    #>    RSQLite                2.3.1      2023-04-03 [2] CRAN (R 4.3.0)
    #>    Rtsne                  0.16       2022-04-17 [2] CRAN (R 4.3.0)
    #>    S4Arrays               1.1.2      2023-05-04 [2] Bioconductor
    #>    S4Vectors            * 0.39.1     2023-05-04 [2] Bioconductor
    #>    sass                   0.4.6      2023-05-03 [2] CRAN (R 4.3.0)
    #>    scales                 1.2.1      2022-08-20 [2] CRAN (R 4.3.0)
    #>    scatterpie             0.1.9      2023-04-22 [2] CRAN (R 4.3.0)
    #>    scGPS                * 1.15.0     2023-05-04 [1] Bioconductor
    #>    sessioninfo            1.2.2      2021-12-06 [2] CRAN (R 4.3.0)
    #>    shadowtext             0.1.2      2022-04-22 [2] CRAN (R 4.3.0)
    #>    shape                  1.4.6      2021-05-19 [2] CRAN (R 4.3.0)
    #>    shiny                  1.7.4      2022-12-15 [2] CRAN (R 4.3.0)
    #>    SingleCellExperiment * 1.23.0     2023-05-04 [2] Bioconductor
    #>    SparseArray            1.1.2      2023-05-04 [2] Bioconductor
    #>    stringi                1.7.12     2023-01-11 [2] CRAN (R 4.3.0)
    #>    stringr                1.5.0      2022-12-02 [2] CRAN (R 4.3.0)
    #>    SummarizedExperiment * 1.31.1     2023-05-04 [2] Bioconductor
    #>    survival               3.5-5      2023-03-12 [2] CRAN (R 4.3.0)
    #>    tibble                 3.2.1      2023-03-20 [2] CRAN (R 4.3.0)
    #>    tidygraph              1.2.3      2023-02-01 [2] CRAN (R 4.3.0)
    #>    tidyr                  1.3.0      2023-01-24 [2] CRAN (R 4.3.0)
    #>    tidyselect             1.2.0      2022-10-10 [2] CRAN (R 4.3.0)
    #>    tidytree               0.4.2      2022-12-18 [2] CRAN (R 4.3.0)
    #>    timechange             0.2.0      2023-01-11 [2] CRAN (R 4.3.0)
    #>    timeDate               4022.108   2023-01-07 [2] CRAN (R 4.3.0)
    #>    treeio                 1.25.0     2023-05-04 [2] Bioconductor
    #>    tweenr                 2.0.2      2022-09-06 [2] CRAN (R 4.3.0)
    #>    urlchecker             1.0.1      2021-11-30 [2] CRAN (R 4.3.0)
    #>    usethis                2.1.6      2022-05-25 [2] CRAN (R 4.3.0)
    #>    utf8                   1.2.3      2023-01-31 [2] CRAN (R 4.3.0)
    #>    vctrs                  0.6.2      2023-04-19 [2] CRAN (R 4.3.0)
    #>    viridis                0.6.3      2023-05-03 [2] CRAN (R 4.3.0)
    #>    viridisLite            0.4.2      2023-05-02 [2] CRAN (R 4.3.0)
    #>    withr                  2.5.0      2022-03-03 [2] CRAN (R 4.3.0)
    #>    xfun                   0.39       2023-04-20 [2] CRAN (R 4.3.0)
    #>    xtable                 1.8-4      2019-04-21 [2] CRAN (R 4.3.0)
    #>    XVector                0.41.1     2023-05-04 [2] Bioconductor
    #>    yaml                   2.3.7      2023-01-23 [2] CRAN (R 4.3.0)
    #>    yulab.utils            0.0.6      2022-12-20 [2] CRAN (R 4.3.0)
    #>    zlibbioc               1.47.0     2023-05-04 [2] Bioconductor
    #>
    #>  [1] F:/biocbuild/bbs-3.18-bioc/tmpdir/RtmpWuxXwZ/Rinst6dc65e93c68
    #>  [2] F:/biocbuild/bbs-3.18-bioc/R/library
    #>
    #>  D ── DLL MD5 mismatch, broken installation.
    #>
    #> ──────────────────────────────────────────────────────────────────────────────