---
title: "Real experiments for Mercat"
date: "`r Sys.Date()`"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
source('../R/mercat.R', echo=F, chdir=T)
source('../R/mercat_exp_metrics.R', echo=F, chdir=T)

library(umap)
library(Rtsne)
library(densvis)
library(rtracklayer)
library(plyranges)
library(gridExtra)

library(reticulate)
ncvis <- reticulate::import('ncvis')
ncvis_obj <- ncvis$NCVis(d=as.integer(2), n_neighbors=as.integer(15))
```



## R Markdown

```{r mnist}
ds <- mnist_dataset(
  '../data/', 
  download = T, 
  transform = transform_to_tensor
)
ds$targets <- ds$targets - 1 ## BUG: the R version has off-by-one label errors in MNIST... number annotation is 1...10 instead of 0...9

imgs <- ds$data[ds$targets %in% c(2,4,6,8),,]
imgs <- do.call(rbind, lapply(1:(dim(imgs)[1]), function(i) as.numeric(imgs[i,,])))
labels <- ds$targets[ds$targets %in% c(2,4,6,8)]

iter <- 250
lr <- 0.01
stepsize <- c(100,250)
start.time <- Sys.time()
mercat_res <- mercat(imgs, iter=iter, lr=lr, stepsize = stepsize, batch_size = 64, angle_subsample = 64)
end.time <- Sys.time()
mercat_time <- end.time - start.time


dat_res <- data.frame(loss=mercat_res$loss,
                      iteration=1:iter)
gg <- ggplot(dat_res, aes(x=iteration)) + theme_minimal()
gg <- gg + geom_point(aes(y=loss), size=1, alpha=.7)
print(gg)

consideriter <- seq(1,length(mercat_res$Y), 5)
all_Y <- as.data.frame(do.call(rbind, lapply(consideriter, function(l){mercat_res$Y[[l]]})))
all_Y <- rbind(mercat_res$Y_init, all_Y)
colnames(all_Y) <- c("Y1", "Y2", "Y3")
all_Y$iteration <- rep(c(0, consideriter), each=nrow(mercat_res$Y[[1]]))
all_Y$cluster <- as.factor(rep(labels, length(consideriter)+1))


plot_ly(x=all_Y$Y1, y=all_Y$Y2, z=all_Y$Y3, mode="markers", color=all_Y$cluster, size=.1,
        frame=all_Y$iteration, colors="viridis")


Y_rot <- optimal_rot_vis(mercat_res$Y[[iter]])
print(plot_mercat_2D(YtoR_plain(Y_rot), labels, pointsize = .2))


start.time <- Sys.time()
mnist_umap <- umap::umap(imgs)$layout
end.time <- Sys.time()
umap_time <- end.time - start.time

gg <- ggplot(data.frame(umap1=mnist_umap[,1], umap2=mnist_umap[,2], digit=as.factor(labels)),
             aes(x=umap1, y=umap2, color=digit)) + theme_void()
gg <- gg + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)


start.time <- Sys.time()
mnist_tsne <- Rtsne(imgs)$Y
end.time <- Sys.time()
tsne_time <- end.time - start.time

gg <- ggplot(data.frame(tsne1=mnist_tsne[,1],
                        tsne2=mnist_tsne[,2],
                        digit=as.factor(labels)),
             aes(x=tsne1, y=tsne2, color=digit))
gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
mnist_ncvis <- ncvis_obj$fit_transform(imgs)
end.time <- Sys.time()
ncvis_time <- end.time - start.time

gg <- ggplot(data.frame(ncvis1=mnist_ncvis[,1],
                        ncvis2=mnist_ncvis[,2],
                        digit=as.factor(labels)),
             aes(x=ncvis1, y=ncvis2, color=digit))
gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)
  
start.time <- Sys.time()
mnist_densmap <- densmap(imgs, n_components=2L, init='spectral')
end.time <- Sys.time()
densmap_time <- end.time - start.time

gg <- ggplot(data.frame(densmap1=mnist_densmap[,1],
                        densmap2=mnist_densmap[,2],
                        digit=as.factor(labels)),
             aes(x=densmap1, y=densmap2, color=digit))
gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

ar_mercat <- angle_cor_eval(imgs, mercat_res$Y[[length(mercat_res$Y)]], geodesic=T)
dr_mercat <- sphere_dist_rank_eval(imgs, mercat_res$Y[[length(mercat_res$Y)]])
kn_mercat <- ngbh_eval(imgs, mercat_res$Y[[length(mercat_res$Y)]])
dp_mercat <- density_eval(imgs, mercat_res$Y[[length(mercat_res$Y)]])

ar_umap <- angle_cor_eval(imgs, mnist_umap)
dr_umap <- eucl_dist_rank_eval(imgs, mnist_umap)
kn_umap <- ngbh_eval(imgs, mnist_umap)
dp_umap <- density_eval(imgs, mnist_umap)

ar_tsne <- angle_cor_eval(imgs, mnist_tsne)
dr_tsne <- eucl_dist_rank_eval(imgs, mnist_tsne)
kn_tsne <- ngbh_eval(imgs, mnist_tsne)
dp_tsne <- density_eval(imgs, mnist_tsne)

ar_ncvis <- angle_cor_eval(imgs, mnist_ncvis)
dr_ncvis <- eucl_dist_rank_eval(imgs, mnist_ncvis)
kn_ncvis <- ngbh_eval(imgs, mnist_ncvis)
dp_ncvis <- density_eval(imgs, mnist_ncvis)

ar_densmap <- angle_cor_eval(imgs, mnist_densmap)
dr_densmap <- eucl_dist_rank_eval(imgs, mnist_densmap)
kn_densmap <- ngbh_eval(imgs, mnist_densmap)
dp_densmap <- density_eval(imgs, mnist_densmap)

metric_df <- data.frame(Mercat=round(c(ar_mercat, dr_mercat, kn_mercat, dp_mercat, mercat_time),3),
                          UMAP=round(c(ar_umap, dr_umap, kn_umap, dp_umap, umap_time),3),
                          tSNE=round(c(ar_tsne, dr_tsne, kn_tsne, dp_tsne, tsne_time),3),
                          NCVis=round(c(ar_ncvis, dr_ncvis, kn_ncvis, dp_ncvis, ncvis_time),3),
                          DensMAP=round(c(ar_densmap, dr_densmap, kn_densmap, dp_densmap, densmap_time),3)
)
rownames(metric_df) <- c("Angle", "Distance", "Neighborhood", "Density", "Runtime")
plot(tableGrob(metric_df))


```

```{r mnist investigation}
fin_res <- mercat_res$Y[[length(mercat_res)]]
slice_idcs <- which((fin_res[,2] < 0.4 & fin_res[,2] > 0.25) &
                      (fin_res[,1] < 0.55 & fin_res[,1] > 0.53) &
                      (fin_res[,3] < 0.80 & fin_res[,3] > 0.75))


img_stack <- array_reshape(imgs[slice_idcs,], c(length(slice_idcs),28,28))

img_vis <- lapply(1:dim(img_stack)[1], function(i)
{
  Matrix::image(img_stack[i,,], col=grey(seq(0, 1, length = 256)), asp=1, ylim=c(1,0))
})

```


## Single cell data of human blood

```{r singlecell blood}

ts_blood <- readRDS('../data/tabula_sapiens_blood_seurat.rds')
## get single platform to avoid strong batch effects
ts_blood <- ts_blood[,ts_blood@meta.data$assay == "10x 3' v3"]
ts_blood_exp <- as.matrix(GetAssayData(ts_blood))



## fix to protein-coding and nonzero genes
human_anno <- rtracklayer ::import('../data/gencode.v38.basic.annotation.gtf')
human_prot_genes <- human_anno %>%
  filter(seqnames != "chrM") %>%
  filter(gene_type == "protein_coding") %>%
  filter(type == "gene")
human_prot_genes <- mcols(human_prot_genes)$gene_id
human_prot_genes <- sapply(human_prot_genes, function(x){strsplit(x, '.', fixed=T)[[1]][1]})

ts_blood_exp <- ts_blood_exp[(rowSums(ts_blood_exp) > 0) & (rownames(ts_blood_exp) %in% human_prot_genes),]
matched_cell_types <- ts_blood@meta.data$cell_type[match(colnames(ts_blood_exp), colnames(ts_blood))]

## get to standard form
ts_blood_exp <- t(ts_blood_exp)


## compute embedding
iter <- 50
lr <- 0.01
stepsize <- c(10,30)
start.time <- Sys.time()
mercat_res <- mercat(ts_blood_exp, iter=iter, lr=lr, stepsize = stepsize, batch_size = 64, angle_subsample = 64, report_progress = F)
end.time <- Sys.time()
mercat_time <- end.time - start.time

dat_res <- data.frame(loss=mercat_res$loss,
                      iteration=1:iter)
gg <- ggplot(dat_res, aes(x=iteration)) + theme_minimal()
gg <- gg + geom_point(aes(y=loss), size=1, alpha=.7)
print(gg)

consideriter <- seq(1,length(mercat_res$Y), 5)
all_Y <- as.data.frame(do.call(rbind, lapply(consideriter, function(l){mercat_res$Y[[l]]})))
all_Y <- rbind(mercat_res$Y_init, all_Y)
colnames(all_Y) <- c("Y1", "Y2", "Y3")
all_Y$iteration <- rep(c(0, consideriter), each=nrow(mercat_res$Y[[1]]))
all_Y$cell_type <- rep(matched_cell_types, length(consideriter)+1)

plot_ly(x=all_Y$Y1, y=all_Y$Y2, z=all_Y$Y3, mode="markers", color=all_Y$cell_type, size=.5,
        frame=all_Y$iteration)


Y_rot <- optimal_rot_vis(mercat_res$Y[[iter]])
print(plot_mercat_2D(YtoR_plain(Y_rot), matched_cell_types))

start.time <- Sys.time()
ts_blood_umap <- umap::umap(ts_blood_exp)$layout
end.time <- Sys.time()
umap_time <- end.time - start.time

gg <- ggplot(data.frame(umap1=ts_blood_umap[,1], umap2=ts_blood_umap[,2], cell_type=matched_cell_types),
             aes(x=umap1, y=umap2, color=cell_type)) + theme_void() + scale_color_viridis_d()
gg <- gg + geom_point(alpha=.7)
print(gg)

start.time <- Sys.time()
ts_blood_tsne <- Rtsne(ts_blood_exp)$Y
end.time <- Sys.time()
tsne_time <- end.time - start.time

gg <- ggplot(data.frame(tsne1=ts_blood_tsne[,1],
                        tsne2=ts_blood_tsne[,2],
                        cell_type=matched_cell_types),
             aes(x=tsne1, y=tsne2, color=cell_type))
gg <- gg + theme_minimal() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
ts_blood_ncvis <- ncvis_obj$fit_transform(ts_blood_exp)
end.time <- Sys.time()
ncvis_time <- end.time - start.time

gg <- ggplot(data.frame(ncvis1=ts_blood_ncvis[,1],
                        ncvis2=ts_blood_ncvis[,2],
                        cell_type=matched_cell_types),
             aes(x=ncvis1, y=ncvis2, color=cell_type))
gg <- gg + theme_minimal() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
ts_blood_densmap <- densmap(ts_blood_exp, n_components=2L, init='spectral')
end.time <- Sys.time()
densmap_time <- end.time - start.time

gg <- ggplot(data.frame(densmap1=ts_blood_densmap[,1],
                        densmap2=ts_blood_densmap[,2],
                        cell_type=matched_cell_types),
             aes(x=densmap1, y=densmap2, color=cell_type))
gg <- gg + theme_minimal() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

ar_mercat <- angle_cor_eval(ts_blood_exp, mercat_res$Y[[length(mercat_res$Y)]], geodesic=T)
dr_mercat <- sphere_dist_rank_eval(ts_blood_exp, mercat_res$Y[[length(mercat_res$Y)]])
kn_mercat <- ngbh_eval(ts_blood_exp, mercat_res$Y[[length(mercat_res$Y)]])
dp_mercat <- density_eval(ts_blood_exp, mercat_res$Y[[length(mercat_res$Y)]])


ar_umap <- angle_cor_eval(ts_blood_exp, ts_blood_umap)
dr_umap <- eucl_dist_rank_eval(ts_blood_exp, ts_blood_umap)
kn_umap <- ngbh_eval(ts_blood_exp, ts_blood_umap)
dp_umap <- density_eval(ts_blood_exp, ts_blood_umap)


ar_tsne <- angle_cor_eval(ts_blood_exp, ts_blood_tsne)
dr_tsne <- eucl_dist_rank_eval(ts_blood_exp, ts_blood_tsne)
kn_tsne <- ngbh_eval(ts_blood_exp, ts_blood_tsne)
dp_tsne <- density_eval(ts_blood_exp, ts_blood_tsne)

ar_ncvis <- angle_cor_eval(ts_blood_exp, ts_blood_ncvis)
dr_ncvis <- eucl_dist_rank_eval(ts_blood_exp, ts_blood_ncvis)
kn_ncvis <- ngbh_eval(ts_blood_exp, ts_blood_ncvis)
dp_ncvis <- density_eval(ts_blood_exp, ts_blood_ncvis)
  
ar_densmap <- angle_cor_eval(ts_blood_exp, ts_blood_densmap)
dr_densmap <- eucl_dist_rank_eval(ts_blood_exp, ts_blood_densmap)
kn_densmap <- ngbh_eval(ts_blood_exp, ts_blood_densmap)
dp_densmap <- density_eval(ts_blood_exp, ts_blood_densmap)

metric_df <- data.frame(Mercat=c(ar_mercat, dr_mercat, kn_mercat, dp_mercat, mercat_time),
                          UMAP=c(ar_umap, dr_umap, kn_umap, dp_umap, umap_time),
                          tSNE=c(ar_tsne, dr_tsne, kn_tsne, dp_tsne, tsne_time),
                          NCVis=c(ar_ncvis, dr_ncvis, kn_ncvis, dp_ncvis, ncvis_time),
                          DensMAP=c(ar_densmap, dr_densmap, kn_densmap, dp_densmap, densmap_time)
)
rownames(metric_df) <- c("Angle", "Distance", "Neighborhood", "Density", "Runtime")
plot(tableGrob(metric_df))

```



## Single cell data of pancreatic development in mice

https://www.nature.com/articles/s41467-018-06176-3#data-availability
murine pancreatic development
see Fig. 3g for expected lineage model

```{r singlecell murine pancreas}
exp_data <- anndata::read_h5ad('../data/GSE132188_adata.h5ad.h5')


## fix to protein-coding and nonzero genes
mm10_anno <- rtracklayer::import('../data/Mus_musculus.GRCm39.110.chr.gtf.gz')
mouse_prot_genes <- mm10_anno %>%
  filter(seqnames != "chrM") %>%
  filter(gene_biotype == "protein_coding") %>%
  filter(type == "gene")
mouse_prot_genes <- mcols(mouse_prot_genes)$gene_name

exp <- as.matrix(exp_data$X[,rownames(exp_data$var) %in% mouse_prot_genes])
exp <- exp[, colSums(exp) > 0]

cell_anno <- exp_data$obs$clusters_fig3_final


## compute embedding
iter <- 50
lr <- 0.01
stepsize <- c(10,30)
start.time <- Sys.time()
mercat_res <- mercat(exp, iter=iter, lr=lr, stepsize = stepsize, batch_size = 64, angle_subsample = 64)
end.time <- Sys.time()
mercat_time <- end.time - start.time

dat_res <- data.frame(loss=mercat_res$loss,
                      iteration=1:iter)
gg <- ggplot(dat_res, aes(x=iteration)) + theme_minimal()
gg <- gg + geom_point(aes(y=loss), size=1, alpha=.7)
print(gg)

consideriter <- seq(1,length(mercat_res$Y), 5)
all_Y <- as.data.frame(do.call(rbind, lapply(consideriter, function(l){mercat_res$Y[[l]]})))
all_Y <- rbind(mercat_res$Y_init, all_Y)
colnames(all_Y) <- c("Y1", "Y2", "Y3")
all_Y$iteration <- rep(c(0, consideriter), each=nrow(mercat_res$Y[[1]]))
all_Y$cell_anno <- rep(cell_anno, length(consideriter)+1)

plot_ly(x=all_Y$Y1, y=all_Y$Y2, z=all_Y$Y3, mode="markers", color=all_Y$cell_anno, size=.5,
        frame=all_Y$iteration)


Y_rot <- optimal_rot_vis(mercat_res$Y[[iter]])
print(plot_mercat_2D(YtoR_plain(Y_rot), cell_anno))

start.time <- Sys.time()
panc_umap <- umap::umap(exp)$layout
end.time <- Sys.time()
umap_time <- end.time - start.time

gg <- ggplot(data.frame(umap1=panc_umap[,1], umap2=panc_umap[,2], cell_type=cell_anno),
             aes(x=umap1, y=umap2, color=cell_type)) + scale_color_viridis_d()  + theme_void()
gg <- gg + geom_point(alpha=.7)
print(gg)

start.time <- Sys.time()
panc_tsne <- Rtsne(exp)$Y
end.time <- Sys.time()
tsne_time <- end.time - start.time

gg <- ggplot(data.frame(tsne1=panc_tsne[,1],
                        tsne2=panc_tsne[,2],
                        cell_type=cell_anno),
             aes(x=tsne1, y=tsne2, color=cell_type))
gg <- gg + theme_minimal() + geom_point(alpha=.7) + scale_color_viridis_d()  + theme_void()
print(gg)

start.time <- Sys.time()
panc_ncvis <- ncvis_obj$fit_transform(exp)
end.time <- Sys.time()
ncvis_time <- end.time - start.time

gg <- ggplot(data.frame(ncvis1=panc_ncvis[,1],
                        ncvis2=panc_ncvis[,2],
                        cell_type=cell_anno),
             aes(x=ncvis1, y=ncvis2, color=cell_type))
gg <- gg + theme_minimal() + geom_point(alpha=.7) + scale_color_viridis_d() + theme_void()
print(gg)

start.time <- Sys.time()
panc_densmap <- densmap(exp, n_components=2L, init='spectral')
end.time <- Sys.time()
densmap_time <- end.time - start.time

gg <- ggplot(data.frame(densmap1=panc_densmap[,1],
                        densmap2=panc_densmap[,2],
                        cell_type=cell_anno),
             aes(x=densmap1, y=densmap2, color=cell_type))
gg <- gg + theme_minimal() + geom_point(alpha=.7) + scale_color_viridis_d() + theme_void()
print(gg)

ar_mercat <- angle_cor_eval(exp, mercat_res$Y[[length(mercat_res$Y)]], geodesic=T)
dr_mercat <- sphere_dist_rank_eval(exp, mercat_res$Y[[length(mercat_res$Y)]])
kn_mercat <- ngbh_eval(exp, mercat_res$Y[[length(mercat_res$Y)]])
dp_mercat <- density_eval(exp, mercat_res$Y[[length(mercat_res$Y)]])

ar_umap <- angle_cor_eval(exp, panc_umap)
dr_umap <- eucl_dist_rank_eval(exp, panc_umap)
kn_umap <- ngbh_eval(exp, panc_umap)
dp_umap <- density_eval(exp, panc_umap)

ar_tsne <- angle_cor_eval(exp, panc_tsne)
dr_tsne <- eucl_dist_rank_eval(exp, panc_tsne)
kn_tsne <- ngbh_eval(exp, panc_tsne)
dp_tsne <- density_eval(exp, panc_tsne)

ar_ncvis <- angle_cor_eval(exp, panc_ncvis)
dr_ncvis <- eucl_dist_rank_eval(exp, panc_ncvis)
kn_ncvis <- ngbh_eval(exp, panc_ncvis)
dp_ncvis <- density_eval(exp, panc_ncvis)
  
ar_densmap <- angle_cor_eval(exp, panc_densmap)
dr_densmap <- eucl_dist_rank_eval(exp, panc_densmap)
kn_densmap <- ngbh_eval(exp, panc_densmap)
dp_densmap <- density_eval(exp, panc_densmap)

metric_df <- data.frame(Mercat=round(c(ar_mercat, dr_mercat, kn_mercat, dp_mercat, mercat_time),3),
                          UMAP=round(c(ar_umap, dr_umap, kn_umap, dp_umap, umap_time),3),
                          tSNE=round(c(ar_tsne, dr_tsne, kn_tsne, dp_tsne, tsne_time),3),
                          NCVis=round(c(ar_ncvis, dr_ncvis, kn_ncvis, dp_ncvis, ncvis_time),3),
                          DensMAP=round(c(ar_densmap, dr_densmap, kn_densmap, dp_densmap, densmap_time),3)
)
rownames(metric_df) <- c("Angle", "Distance", "Neighborhood", "Density", "Runtime")
plot(tableGrob(metric_df))

```


## Dataset of hematopoiesis

Paul et al. 2015 hematopoiesis data from bone marrow

```{r singlecell paul}
exp_data <- anndata::read_h5ad('../data/mousehema.h5ad')
exp <- as.matrix(exp_data$X)
cell_anno <- exp_data$obs$paul15_clusters

## compute embedding
iter <- 200
lr <- 0.01
stepsize <- c(50,150)
start.time <- Sys.time()
mercat_res <- mercat(exp, iter=iter, lr=lr, stepsize = stepsize, batch_size = 64, angle_subsample = 64, report_progress = T)
end.time <- Sys.time()
mercat_time <- end.time - start.time

dat_res <- data.frame(loss=mercat_res$loss,
                      iteration=1:iter)
gg <- ggplot(dat_res, aes(x=iteration)) + theme_minimal()
gg <- gg + geom_point(aes(y=loss), size=1, alpha=.7)
print(gg)

consideriter <- seq(1,length(mercat_res$Y), 5)
all_Y <- as.data.frame(do.call(rbind, lapply(consideriter, function(l){mercat_res$Y[[l]]})))
all_Y <- rbind(mercat_res$Y_init, all_Y)
colnames(all_Y) <- c("Y1", "Y2", "Y3")
all_Y$iteration <- rep(c(0, consideriter), each=nrow(mercat_res$Y[[1]]))
all_Y$cell_anno <- rep(cell_anno, length(consideriter)+1)

plot_ly(x=all_Y$Y1, y=all_Y$Y2, z=all_Y$Y3, mode="markers", color=all_Y$cell_anno, size=.5,
        frame=all_Y$iteration, colors="viridis")


Y_rot <- optimal_rot_vis(mercat_res$Y[[iter]])
print(plot_mercat_2D(YtoR_plain(Y_rot), cell_anno, pointsize=.2, long0 = pi))


start.time <- Sys.time()
hema_umap <- umap::umap(exp)$layout
end.time <- Sys.time()
umap_time <- end.time - start.time

gg <- ggplot(data.frame(umap1=hema_umap[,1], umap2=hema_umap[,2], cell_type=cell_anno),
             aes(x=umap1, y=umap2, color=cell_type)) + theme_void()
gg <- gg + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
hema_tsne <- Rtsne(exp)$Y
end.time <- Sys.time()
tsne_time <- end.time - start.time

gg <- ggplot(data.frame(tsne1=hema_tsne[,1],
                        tsne2=hema_tsne[,2],
                        cell_type=cell_anno),
             aes(x=tsne1, y=tsne2, color=cell_type))
gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
hema_ncvis <- ncvis_obj$fit_transform(exp)
end.time <- Sys.time()
ncvis_time <- end.time - start.time

gg <- ggplot(data.frame(ncvis1=hema_ncvis[,1],
                        ncvis2=hema_ncvis[,2],
                        cell_type=cell_anno),
             aes(x=ncvis1, y=ncvis2, color=cell_type))
gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
hema_densmap <- densmap(exp, n_components=2L, init='spectral')
end.time <- Sys.time()
densmap_time <- end.time - start.time

gg <- ggplot(data.frame(densmap1=hema_densmap[,1],
                        densmap2=hema_densmap[,2],
                        cell_type=cell_anno),
             aes(x=densmap1, y=densmap2, color=cell_type))
gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

ar_mercat <- angle_cor_eval(exp, mercat_res$Y[[length(mercat_res$Y)]], geodesic=T)
dr_mercat <- sphere_dist_rank_eval(exp, mercat_res$Y[[length(mercat_res$Y)]])
kn_mercat <- ngbh_eval(exp, mercat_res$Y[[length(mercat_res$Y)]])
dp_mercat <- density_eval(exp, mercat_res$Y[[length(mercat_res$Y)]])

ar_umap <- angle_cor_eval(exp, hema_umap)
dr_umap <- eucl_dist_rank_eval(exp, hema_umap)
kn_umap <- ngbh_eval(exp, hema_umap)
dp_umap <- density_eval(exp, hema_umap)

ar_tsne <- angle_cor_eval(exp, hema_tsne)
dr_tsne <- eucl_dist_rank_eval(exp, hema_tsne)
kn_tsne <- ngbh_eval(exp, hema_tsne)
dp_tsne <- density_eval(exp, hema_tsne)

ar_ncvis <- angle_cor_eval(exp, hema_ncvis)
dr_ncvis <- eucl_dist_rank_eval(exp, hema_ncvis)
kn_ncvis <- ngbh_eval(exp, hema_ncvis)
dp_ncvis <- density_eval(exp, hema_ncvis)
  
ar_densmap <- angle_cor_eval(exp, hema_densmap)
dr_densmap <- eucl_dist_rank_eval(exp, hema_densmap)
kn_densmap <- ngbh_eval(exp, hema_densmap)
dp_densmap <- density_eval(exp, hema_densmap)

metric_df <- data.frame(Mercat=round(c(ar_mercat, dr_mercat, kn_mercat, dp_mercat, mercat_time),3),
                          UMAP=round(c(ar_umap, dr_umap, kn_umap, dp_umap, umap_time),3),
                          tSNE=round(c(ar_tsne, dr_tsne, kn_tsne, dp_tsne, tsne_time),3),
                          NCVis=round(c(ar_ncvis, dr_ncvis, kn_ncvis, dp_ncvis, ncvis_time),3),
                          DensMAP=round(c(ar_densmap, dr_densmap, kn_densmap, dp_densmap, densmap_time),3)
)
rownames(metric_df) <- c("Angle", "Distance", "Neighborhood", "Density", "Runtime")
plot(tableGrob(metric_df))

```


HeLa cell cycle data from Rong (originally from https://github.com/danielschw188/Revelio)

```{r HeLa cell cycle}
load('../data/HeLaS3.RData')

data <- t(data)
cell_anno <- phase

## compute embedding
iter <- 200
lr <- 0.01
stepsize <- c(50,150)
start.time <- Sys.time()
mercat_res <- mercat(data, iter=iter, lr=lr, stepsize = stepsize, batch_size = 64, angle_subsample = 64, report_progress = F)
end.time <- Sys.time()
mercat_time <- end.time - start.time

dat_res <- data.frame(loss=mercat_res$loss,
                      iteration=1:iter)
gg <- ggplot(dat_res, aes(x=iteration, y=loss)) + theme_minimal()
gg <- gg + geom_point(size=1, alpha=.7)
print(gg)

consideriter <- seq(1,length(mercat_res$Y), 5)
all_Y <- as.data.frame(do.call(rbind, lapply(consideriter, function(l){mercat_res$Y[[l]]})))
all_Y <- rbind(mercat_res$Y_init, all_Y)
colnames(all_Y) <- c("Y1", "Y2", "Y3")
all_Y$iteration <- rep(c(0, consideriter), each=nrow(mercat_res$Y[[1]]))
all_Y$cell_anno <- rep(cell_anno, length(consideriter)+1)

plot_ly(x=all_Y$Y1, y=all_Y$Y2, z=all_Y$Y3, mode="markers", color=all_Y$cell_anno, size=.5,
        frame=all_Y$iteration, colors="viridis")


Y_rot <- optimal_rot_vis(mercat_res$Y[[iter]])
print(plot_mercat_2D(YtoR_plain(Y_rot), cell_anno))
#print(plot_moll_2D(YtoR_plain(Y_rot), cell_anno))

start.time <- Sys.time()
cc_umap <- umap::umap(data)$layout
end.time <- Sys.time()
umap_time <- end.time - start.time

gg <- ggplot(data.frame(umap1=cc_umap[,1], umap2=cc_umap[,2], cell_type=cell_anno),
             aes(x=umap1, y=umap2, color=cell_type)) + theme_void()
gg <- gg + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
cc_tsne <- Rtsne(data)$Y
end.time <- Sys.time()
tsne_time <- end.time - start.time

gg <- ggplot(data.frame(tsne1=cc_tsne[,1],
                        tsne2=cc_tsne[,2],
                        cell_type=cell_anno),
             aes(x=tsne1, y=tsne2, color=cell_type))
gg <- gg  + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
cc_ncvis <- ncvis_obj$fit_transform(data)
end.time <- Sys.time()
ncvis_time <- end.time - start.time

gg <- ggplot(data.frame(ncvis1=cc_ncvis[,1],
                        ncvis2=cc_ncvis[,2],
                        cell_type=cell_anno),
             aes(x=ncvis1, y=ncvis2, color=cell_type))
gg <- gg  + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

start.time <- Sys.time()
cc_densmap <- densmap(data, n_components=2L, init='spectral')
end.time <- Sys.time()
densmap_time <- end.time - start.time

gg <- ggplot(data.frame(densmap1=cc_densmap[,1],
                        densmap2=cc_densmap[,2],
                        cell_type=cell_anno),
             aes(x=densmap1, y=densmap2, color=cell_type))
gg <- gg  + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d()
print(gg)

ar_mercat <- angle_cor_eval(data, mercat_res$Y[[length(mercat_res$Y)]], geodesic=T)
dr_mercat <- sphere_dist_rank_eval(data, mercat_res$Y[[length(mercat_res$Y)]])
kn_mercat <- ngbh_eval(data, mercat_res$Y[[length(mercat_res$Y)]])
dp_mercat <- density_eval(data, mercat_res$Y[[length(mercat_res$Y)]])

ar_umap <- angle_cor_eval(data, cc_umap)
dr_umap <- eucl_dist_rank_eval(data, cc_umap)
kn_umap <- ngbh_eval(data, cc_umap)
dp_umap <- density_eval(data, cc_umap)

ar_tsne <- angle_cor_eval(data, cc_tsne)
dr_tsne <- eucl_dist_rank_eval(data, cc_tsne)
kn_tsne <- ngbh_eval(data, cc_tsne)
dp_tsne <- density_eval(data, cc_tsne)

ar_ncvis <- angle_cor_eval(data, cc_ncvis)
dr_ncvis <- eucl_dist_rank_eval(data, cc_ncvis)
kn_ncvis <- ngbh_eval(data, cc_ncvis)
dp_ncvis <- density_eval(data, cc_ncvis)
  
ar_densmap <- angle_cor_eval(data, cc_densmap)
dr_densmap <- eucl_dist_rank_eval(data, cc_densmap)
kn_densmap <- ngbh_eval(data, cc_densmap)
dp_densmap <- density_eval(data, cc_densmap)

metric_df <- data.frame(Mercat=round(c(ar_mercat, dr_mercat, kn_mercat, dp_mercat, mercat_time), 3),
                          UMAP=round(c(ar_umap, dr_umap, kn_umap, dp_umap, umap_time), 3),
                          tSNE=round(c(ar_tsne, dr_tsne, kn_tsne, dp_tsne, tsne_time), 3),
                          NCVis=round(c(ar_ncvis, dr_ncvis, kn_ncvis, dp_ncvis, ncvis_time), 3),
                          DensMAP=round(c(ar_densmap, dr_densmap, kn_densmap, dp_densmap, densmap_time), 3)
)
rownames(metric_df) <- c("Angle", "Distance", "Neighborhood", "Density", "Runtime")
plot(tableGrob(metric_df))


```