---
title: "Experiments for hyperparameter tuning"
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(rjson)

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

```{r synth and mammoth hyperparam}


umap_neigh <- c(15,30,50,100,200)
tsne_perp <- c(15,30,50,100,200)
ncvis_neigh <- umap_neigh
densmap_neigh <- umap_neigh


## k is number of clusters
## n is number of samples per cluster (single number) or vectors of cluster sizes
## d is number of dimensions to embed the clusters in
## S_var is vector of cluster-specific variances (so, has k entries) (default: NULL)
gen_clusters_mvrnorm <- function(k, n, d, S_var=NULL)
{
  if (length(n) == 1)
  {
    n <- rep(n, k)
  }
  dat <- do.call(rbind,lapply(1:k, function(i)
  {
    mu <- runif(d, min=-10, max=10)
    if (is.null(S_var))
    {
      S <- diag(runif(d, min=.5, max=2))
    } else {
      S <- diag(rep(S_var[i], d))
    }
    mvrnorm(n[i], mu, Sigma = S)
  }))
  return(dat)
}
# Same arguments as above, generate uniform data in a hypercube (S_var is used as scaling factor for edge length)
gen_clusters_unif <- function(k, n, d, S_var=NULL)
{
  if (length(n) == 1)
  {
    n <- rep(n, k)
  }
  if (is.null(S_var))
  {
    S <- rep(1, k)
  }
  dat <- do.call(rbind,lapply(1:k, function(i)
  {
    mu <- runif(d, min=-10, max=10)
    sweep(do.call(cbind, lapply(1:d, function(dim_idx)
    {
      runif(n[i], 0, S[i])
    })), 2, mu)
  }))
  return(dat)
}


seed <- 1
  
## Example 0:5 clusters of equal (uniform) distribution with different center
XU <- gen_clusters_unif(5, 200, 50)
clusterlabels <- rep(1:5, each=200)
shuffle <- sample(nrow(XU), nrow(XU))
XU <- XU[shuffle,]
clusterlabels <- clusterlabels[shuffle]
  

umap_XU_res <- do.call(rbind, setNames(lapply(umap_neigh, function(neigh)
{
  custom.config <- umap.defaults
  custom.config$n_neighbors <- neigh
  start.time <- Sys.time()
  umap_XU <- umap::umap(XU, config=custom.config)$layout
  end.time <- Sys.time()
  umap_time <- end.time - start.time
  
  gg <- ggplot(data.frame(umap1=umap_XU[,1],
                          umap2=umap_XU[,2],
                          cluster=clusterlabels),
               aes(x=umap1, y=umap2, color=cluster))
  gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis() + theme(legend.position = "none")
  print(gg)
  
  ar_umap <- angle_cor_eval(XU, umap_XU)
  dr_umap <- eucl_dist_rank_eval(XU, umap_XU)
  kn_umap <- ngbh_eval(XU, umap_XU)
  dp_umap <- density_eval(XU, umap_XU)
  return(data.frame(time=umap_time, ar=ar_umap, dr=dr_umap, kn=kn_umap, dp=dp_umap))
}),umap_neigh))


tsne_XU_res <- do.call(rbind, setNames(lapply(tsne_perp, function(perp)
{
  start.time <- Sys.time()
  tsne_XU <- Rtsne(XU, perplexity=perp)$Y
  end.time <- Sys.time()
  tsne_time <- end.time - start.time
  
  gg <- ggplot(data.frame(tsne1=tsne_XU[,1],
                          tsne2=tsne_XU[,2],
                          cluster=clusterlabels),
               aes(x=tsne1, y=tsne2, color=cluster))
  gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis() + theme(legend.position = "none")
  print(gg)
  
  ar_tsne <- angle_cor_eval(XU, tsne_XU)
  dr_tsne <- eucl_dist_rank_eval(XU, tsne_XU)
  kn_tsne <- ngbh_eval(XU, tsne_XU)
  dp_tsne <- density_eval(XU, tsne_XU)
  
  return(data.frame(time=tsne_time, ar=ar_tsne, dr=dr_tsne, kn=kn_tsne, dp=dp_tsne))
}),tsne_perp))
  

ncvis_XU_res <- do.call(rbind, setNames(lapply(ncvis_neigh, function(neigh)
{
  ncvis_obj <- ncvis$NCVis(d=as.integer(2), n_neighbors=as.integer(neigh))
  start.time <- Sys.time()
  ncvis_XU <- ncvis_obj$fit_transform(XU)
  end.time <- Sys.time()
  ncvis_time <- end.time - start.time
  
  gg <- ggplot(data.frame(ncvis1=ncvis_XU[,1],
                          ncvis2=ncvis_XU[,2],
                          cluster=clusterlabels),
               aes(x=ncvis1, y=ncvis2, color=cluster))
  gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis() + theme(legend.position = "none")
  print(gg)
  
  ar_ncvis <- angle_cor_eval(XU, ncvis_XU)
  dr_ncvis <- eucl_dist_rank_eval(XU, ncvis_XU)
  kn_ncvis <- ngbh_eval(XU, ncvis_XU)
  dp_ncvis <- density_eval(XU, ncvis_XU)
  
  return(data.frame(time=ncvis_time, ar=ar_ncvis, dr=dr_ncvis, kn=kn_ncvis, dp=dp_ncvis))
}),ncvis_neigh))
  

densmap_XU_res <- do.call(rbind, setNames(lapply(densmap_neigh, function(neigh)
{
  start.time <- Sys.time()
  densmap_XU <- densmap(XU, n_components=2L, n_neighbors=as.integer(neigh), init='spectral', random_state=as.integer(seed))
  end.time <- Sys.time()
  densmap_time <- end.time - start.time
  
  gg <- ggplot(data.frame(densmap1=densmap_XU[,1],
                          densmap2=densmap_XU[,2],
                          cluster=clusterlabels),
               aes(x=densmap1, y=densmap2, color=cluster))
  gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis() + theme(legend.position = "none")
  print(gg)
  
  
  ar_densmap <- angle_cor_eval(XU, densmap_XU)
  dr_densmap <- eucl_dist_rank_eval(XU, densmap_XU)
  kn_densmap <- ngbh_eval(XU, densmap_XU)
  dp_densmap <- density_eval(XU, densmap_XU)
  
  return(data.frame(time=densmap_time, ar=ar_densmap, dr=dr_densmap, kn=kn_densmap, dp=dp_densmap))
}),densmap_neigh))

plot(tableGrob(as.data.frame(umap_XU_res)))
plot(tableGrob(as.data.frame(tsne_XU_res)))
plot(tableGrob(as.data.frame(ncvis_XU_res)))
plot(tableGrob(as.data.frame(densmap_XU_res)))



## mammoth data
X_mammoth <- fromJSON(file = "../data/mammoth_3d.json")
X_mammoth <- matrix(unlist(X_mammoth), ncol=3, byrow=T)
XC <- X_mammoth/sd(X_mammoth[,1])

umap_XC_res <- do.call(rbind, setNames(lapply(umap_neigh, function(neigh)
{
  custom.config <- umap.defaults
  custom.config$n_neighbors <- neigh
  start.time <- Sys.time()
  umap_XC <- umap::umap(XC, config=custom.config)$layout
  end.time <- Sys.time()
  umap_time <- end.time - start.time
  
  gg <- ggplot(data.frame(umap1=umap_XC[,1],
                          umap2=umap_XC[,2]),
               aes(x=umap1, y=umap2))
  gg <- gg + theme_void() + geom_point(alpha=.7, color="black")
  print(gg)
  
  ar_umap <- angle_cor_eval(XC, umap_XC)
  dr_umap <- eucl_dist_rank_eval(XC, umap_XC)
  kn_umap <- ngbh_eval(XC, umap_XC)
  dp_umap <- density_eval(XC, umap_XC)
  return(data.frame(time=umap_time, ar=ar_umap, dr=dr_umap, kn=kn_umap, dp=dp_umap))
}),umap_neigh))


tsne_XC_res <- do.call(rbind, setNames(lapply(tsne_perp, function(perp)
{
  start.time <- Sys.time()
  tsne_XC <- Rtsne(XC, perplexity=perp)$Y
  end.time <- Sys.time()
  tsne_time <- end.time - start.time
  
  gg <- ggplot(data.frame(tsne1=tsne_XC[,1],
                          tsne2=tsne_XC[,2]),
               aes(x=tsne1, y=tsne2))
  gg <- gg + theme_void() + geom_point(alpha=.7, color="black")
  print(gg)
  
  ar_tsne <- angle_cor_eval(XC, tsne_XC)
  dr_tsne <- eucl_dist_rank_eval(XC, tsne_XC)
  kn_tsne <- ngbh_eval(XC, tsne_XC)
  dp_tsne <- density_eval(XC, tsne_XC)
  
  return(data.frame(time=tsne_time, ar=ar_tsne, dr=dr_tsne, kn=kn_tsne, dp=dp_tsne))
}),tsne_perp))
  

ncvis_XC_res <- do.call(rbind, setNames(lapply(ncvis_neigh, function(neigh)
{
  ncvis_obj <- ncvis$NCVis(d=as.integer(2), n_neighbors=as.integer(neigh))
  start.time <- Sys.time()
  ncvis_XC <- ncvis_obj$fit_transform(XC)
  end.time <- Sys.time()
  ncvis_time <- end.time - start.time
  
  gg <- ggplot(data.frame(ncvis1=ncvis_XC[,1],
                          ncvis2=ncvis_XC[,2]),
               aes(x=ncvis1, y=ncvis2))
  gg <- gg + theme_void() + geom_point(alpha=.7, color="black")
  print(gg)
  
  ar_ncvis <- angle_cor_eval(XC, ncvis_XC)
  dr_ncvis <- eucl_dist_rank_eval(XC, ncvis_XC)
  kn_ncvis <- ngbh_eval(XC, ncvis_XC)
  dp_ncvis <- density_eval(XC, ncvis_XC)
  
  return(data.frame(time=ncvis_time, ar=ar_ncvis, dr=dr_ncvis, kn=kn_ncvis, dp=dp_ncvis))
}),ncvis_neigh))
  

densmap_XC_res <- do.call(rbind, setNames(lapply(densmap_neigh, function(neigh)
{
  start.time <- Sys.time()
  densmap_XC <- densmap(XC, n_components=2L, n_neighbors=as.integer(neigh), init='spectral', random_state=as.integer(seed))
  end.time <- Sys.time()
  densmap_time <- end.time - start.time
  
  gg <- ggplot(data.frame(densmap1=densmap_XC[,1],
                          densmap2=densmap_XC[,2]),
               aes(x=densmap1, y=densmap2))
  gg <- gg + theme_void() + geom_point(alpha=.7, color="black")
  print(gg)
  
  
  ar_densmap <- angle_cor_eval(XC, densmap_XC)
  dr_densmap <- eucl_dist_rank_eval(XC, densmap_XC)
  kn_densmap <- ngbh_eval(XC, densmap_XC)
  dp_densmap <- density_eval(XC, densmap_XC)
  
  return(data.frame(time=densmap_time, ar=ar_densmap, dr=dr_densmap, kn=kn_densmap, dp=dp_densmap))
}),densmap_neigh))

plot(tableGrob(as.data.frame(umap_XC_res)))
plot(tableGrob(as.data.frame(tsne_XC_res)))
plot(tableGrob(as.data.frame(ncvis_XC_res)))
plot(tableGrob(as.data.frame(densmap_XC_res)))

```



```{r paul hema hyper}

umap_neigh <- c(15,30,100,200,500)
tsne_perp <- c(15,30,100,200,500)
ncvis_neigh <- umap_neigh
densmap_neigh <- umap_neigh


exp_data <- anndata::read_h5ad('../data/mousehema.h5ad')
exp <- as.matrix(exp_data$X)
cell_anno <- exp_data$obs$paul15_clusters



umap_paul_res <- do.call(rbind, setNames(lapply(umap_neigh, function(neigh)
{
  custom.config <- umap.defaults
  custom.config$n_neighbors <- neigh
  start.time <- Sys.time()
  umap_paul <- umap::umap(exp, config=custom.config)$layout
  end.time <- Sys.time()
  umap_time <- end.time - start.time
  
  gg <- ggplot(data.frame(umap1=umap_paul[,1],
                          umap2=umap_paul[,2],
                          cell_type=cell_anno),
               aes(x=umap1, y=umap2, color=cell_type))
  gg <- gg + theme_void() + geom_point(alpha=.7) + scale_color_viridis_d() + theme(legend.position = "none")
  print(gg)
  
  ar_umap <- angle_cor_eval(exp, umap_paul)
  dr_umap <- eucl_dist_rank_eval(exp, umap_paul)
  kn_umap <- ngbh_eval(exp, umap_paul)
  dp_umap <- density_eval(exp, umap_paul)
  
  rm(umap_paul)
  gc()
  return(data.frame(time=umap_time, ar=ar_umap, dr=dr_umap, kn=kn_umap, dp=dp_umap))
}),umap_neigh))


tsne_paul_res <- do.call(rbind, setNames(lapply(tsne_perp, function(perp)
{
  start.time <- Sys.time()
  tsne_paul <- Rtsne(exp, perplexity=perp)$Y
  end.time <- Sys.time()
  tsne_time <- end.time - start.time
  
  gg <- ggplot(data.frame(tsne1=tsne_paul[,1],
                          tsne2=tsne_paul[,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() + theme(legend.position = "none")
  print(gg)
  
  ar_tsne <- angle_cor_eval(exp, tsne_paul)
  dr_tsne <- eucl_dist_rank_eval(exp, tsne_paul)
  kn_tsne <- ngbh_eval(exp, tsne_paul)
  dp_tsne <- density_eval(exp, tsne_paul)
  
  rm(tsne_paul)
  gc()
  
  return(data.frame(time=tsne_time, ar=ar_tsne, dr=dr_tsne, kn=kn_tsne, dp=dp_tsne))
}),tsne_perp))
gc()
  

ncvis_paul_res <- do.call(rbind, setNames(lapply(ncvis_neigh, function(neigh)
{
  ncvis_obj <- ncvis$NCVis(d=as.integer(2), n_neighbors=as.integer(neigh))
  start.time <- Sys.time()
  ncvis_paul <- ncvis_obj$fit_transform(exp)
  end.time <- Sys.time()
  ncvis_time <- end.time - start.time
  
  gg <- ggplot(data.frame(ncvis1=ncvis_paul[,1],
                          ncvis2=ncvis_paul[,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() + theme(legend.position = "none")
  print(gg)
  
  ar_ncvis <- angle_cor_eval(exp, ncvis_paul)
  dr_ncvis <- eucl_dist_rank_eval(exp, ncvis_paul)
  kn_ncvis <- ngbh_eval(exp, ncvis_paul)
  dp_ncvis <- density_eval(exp, ncvis_paul)
  
  rm(ncvis_paul)
  gc()
  
  return(data.frame(time=ncvis_time, ar=ar_ncvis, dr=dr_ncvis, kn=kn_ncvis, dp=dp_ncvis))
}),ncvis_neigh))
gc()

densmap_paul_res <- do.call(rbind, setNames(lapply(densmap_neigh, function(neigh)
{
  start.time <- Sys.time()
  densmap_paul <- densmap(exp, n_components=2L, n_neighbors=as.integer(neigh), init='spectral')
  end.time <- Sys.time()
  densmap_time <- end.time - start.time
  
  gg <- ggplot(data.frame(densmap1=densmap_paul[,1],
                          densmap2=densmap_paul[,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() + theme(legend.position = "none")
  print(gg)
  
  
  ar_densmap <- angle_cor_eval(exp, densmap_paul)
  dr_densmap <- eucl_dist_rank_eval(exp, densmap_paul)
  kn_densmap <- ngbh_eval(exp, densmap_paul)
  dp_densmap <- density_eval(exp, densmap_paul)
  
  rm(densmap_paul)
  gc()
  
  return(data.frame(time=densmap_time, ar=ar_densmap, dr=dr_densmap, kn=kn_densmap, dp=dp_densmap))
}),densmap_neigh))

plot(tableGrob(as.data.frame(umap_paul_res)))
plot(tableGrob(as.data.frame(tsne_paul_res)))
plot(tableGrob(as.data.frame(ncvis_paul_res)))
plot(tableGrob(as.data.frame(densmap_paul_res)))

```