## ----echo=FALSE, message=FALSE, warning = FALSE-------------------------------
knitr::opts_chunk$set(error=FALSE, message=FALSE, 
                      warning=FALSE, collapse = TRUE)
library(BiocStyle)

## ----eval=FALSE---------------------------------------------------------------
# if (!requireNamespace("BiocManager", quietly = TRUE))
#     install.packages("BiocManager")
# BiocManager::install("poem")

## ----message = FALSE,  warning = FALSE----------------------------------------
library(poem)
library(ggplot2)
library(dplyr)
library(tidyr)
library(ggnetwork)
library(igraph)
library(cowplot)

## -----------------------------------------------------------------------------
data(metric_info)
DT::datatable(metric_info)

## -----------------------------------------------------------------------------
data(toyExamples)
g1 <- toyExamples[toyExamples$graph=="graph1",]
g2 <- toyExamples[toyExamples$graph=="graph2",]
head(g1)

## ----fig.height = 3, fig.width = 7--------------------------------------------
ggplot(rbind(g1,g2), aes(x,y,color=class, shape=class)) + 
  geom_point() +
  facet_wrap(~graph) +
  theme_bw()

## -----------------------------------------------------------------------------
sw <- getEmbeddingMetrics(x=g1[,c("x","y")], labels=g1$class, metrics=c("SW"),
                          level="element")
head(sw)

## ----fig.height = 3, fig.width = 7--------------------------------------------
g1$sw <- getEmbeddingMetrics(x=g1[,c("x","y")], labels=g1$class,
                             metrics=c("SW"), level="element")$SW
g2$sw <- getEmbeddingMetrics(x=g2[,c("x","y")], labels=g2$class,
                             metrics=c("SW"), level="element")$SW
ggplot(rbind(g1,g2), aes(x, y, color=sw, shape=class)) + 
  geom_point() +
  facet_wrap(~graph) +
  theme_bw()

## -----------------------------------------------------------------------------
cl <- getEmbeddingMetrics(x=g1[,c("x","y")], labels=g1$class,
                          metrics=c("dbcv", "meanSW"), level="class")
head(cl)

## ----fig.height = 3, fig.width = 7--------------------------------------------
res1 <- getEmbeddingMetrics(x=g1[,c("x","y")], labels=g1$class,
                            metrics=c("dbcv", "meanSW"), level="class")
res2 <- getEmbeddingMetrics(x=g2[,c("x","y")], labels=g2$class,
                            metrics=c("dbcv", "meanSW"), level="class")

bind_rows(list(graph1=res1, graph2=res2), .id="graph") %>% 
  pivot_longer(cols=c("meanSW","dbcv"), names_to="metric",values_to="value") %>%
ggplot(aes(class, value, fill=graph, group=graph)) + 
  geom_bar(position = "dodge", stat = "identity") +
  facet_wrap(~metric) +
  theme_bw()

## -----------------------------------------------------------------------------
getEmbeddingMetrics(x=g1[,c("x","y")], labels=g1$class, level="dataset",
                    metrics=c("meanSW", "meanClassSW", "pnSW", "minClassSW",
                              "cdbw", "cohesion", "compactness", "sep", "dbcv"))

## ----fold=TRUE----------------------------------------------------------------
# Some functions for plotting
plotGraphs <- function(d, k=7){
  gn <- dplyr::bind_rows(lapply(split(d[,-1],d$graph), FUN=function(d1){
    nn <- emb2knn(as.matrix(d1[,c("x","y")]), k=k)
    g <- poem:::.nn2graph(nn, labels=d1$class)
    ggnetwork(g, layout=as.matrix(d1[,seq_len(2)]), scale=FALSE)
  }), .id="graph")
  ggplot(gn, aes(x = x, y = y, xend = xend, yend = yend)) + theme_blank() + 
    theme(legend.position = "right") + geom_edges(alpha=0.5, colour="grey") + 
    geom_nodes(aes(colour=class, shape=class), size=2) + 
    facet_wrap(~graph, nrow=1)
}

## ----fig.height = 3, fig.width = 7--------------------------------------------
plotGraphs(bind_rows(list(g1,g2), .id="graph"))

## -----------------------------------------------------------------------------
getGraphMetrics(x=g1[,c("x","y")], labels=g1$class, metrics=c("PWC","ISI"),
                level="class", directed=FALSE, k=7, shared=FALSE)

## ----fig.height = 3, fig.width = 7--------------------------------------------
res1 <- getGraphMetrics(x=g1[,c("x","y")], 
                        labels=g1$class,metrics=c("PWC","ISI"), 
                        level="class", directed=FALSE, k=7, shared=FALSE)
res2 <- getGraphMetrics(x=g2[,c("x","y")], labels=g2$class, 
                        metrics=c("PWC","ISI"), level="class", 
                        directed=FALSE, k=7, shared=FALSE)

bind_rows(list(graph1=res1, graph2=res2), .id="graph") %>% 
  pivot_longer(cols=c("PWC","ISI"), names_to="metric",values_to="value") %>%
ggplot(aes(class, value, fill=graph, group=graph)) + 
  geom_bar(position = "dodge", stat = "identity") +
  facet_wrap(~metric) +
  theme_bw()

## ----fig.height = 3, fig.width = 7--------------------------------------------
k <- 7
r <- 0.5
snn1 <- emb2snn(as.matrix(g1[,c("x","y")]), k=k)
snn2 <- emb2snn(as.matrix(g2[,c("x","y")]), k=k)
g1$cluster <- factor(igraph::cluster_louvain(snn1, resolution = r)$membership)
g2$cluster <- factor(igraph::cluster_louvain(snn2, resolution = r)$membership)

ggplot(rbind(g1,g2), aes(x,y,color=cluster, shape=class)) + 
  geom_point() +
  facet_wrap(~graph) +
  theme_bw()

## -----------------------------------------------------------------------------
# for g1
getPartitionMetrics(true=g1$class, pred=g1$cluster, level="dataset",
                    metrics = c("RI", "WC", "WH", "ARI", "AWC", "AWH",
                                "FM", "AMI"))

# for g2
getPartitionMetrics(true=g2$class, pred=g2$cluster, level="dataset",
                    metrics = c("RI", "WC", "WH", "ARI", "AWC", "AWH",
                                "FM", "AMI"))

## -----------------------------------------------------------------------------
getPartitionMetrics(true=g1$class, pred=g2$cluster, level="class")

## -----------------------------------------------------------------------------
fuzzyTrue <- matrix(c(
  0.95, 0.025, 0.025, 
  0.98, 0.01, 0.01, 
  0.96, 0.02, 0.02, 
  0.95, 0.04, 0.01, 
  0.95, 0.01, 0.04, 
  0.99, 0.005, 0.005, 
  0.025, 0.95, 0.025, 
  0.97, 0.02, 0.01, 
  0.025, 0.025, 0.95), 
  ncol = 3, byrow=TRUE)

## -----------------------------------------------------------------------------
# a hard truth:
hardTrue <- apply(fuzzyTrue,1,FUN=which.max)
# some predicted labels:
hardPred <- c(1,1,1,1,1,1,2,2,2)
getFuzzyPartitionMetrics(hardPred=hardPred, hardTrue=hardTrue, 
                         fuzzyTrue=fuzzyTrue, nperms=3, level="class")

## ----fig.height = 3, fig.width = 8.5------------------------------------------
data(sp_toys)
s <- 3
st <- 1
p1 <- ggplot(sp_toys, aes(x, y, 
               color=label)) + 
  geom_point(size=s, alpha=0.5) + scale_y_reverse() + theme_bw() +
  geom_point(shape = 1, size = s, stroke = st, aes(color=p1)) + 
  labs(x="",y="", title="P1") 

p0 <- ggplot(sp_toys, aes(x, y, 
               color=label)) + 
  geom_point(size=s, alpha=0.5) + scale_y_reverse() + theme_bw() +
  geom_point(shape = 1, size = s, stroke = st, aes(color=label)) + 
  labs(x="",y="", title="C") 
p2 <- ggplot(sp_toys, aes(x, y, 
               color=label)) + 
  geom_point(size=s, alpha=0.5) + scale_y_reverse() + theme_bw() +
  geom_point(shape = 1, size = s, stroke = st, aes(color=p2)) + 
  labs(x="",y="", title="P2") 

plot_grid(p0 + theme(legend.position = "none",
                     plot.title = element_text(hjust = 0.5)),
          p1 + theme(legend.position = "none",
                     plot.title = element_text(hjust = 0.5)),
          p2 + theme(legend.position = "none",
                     plot.title = element_text(hjust = 0.5)), ncol = 3)

## -----------------------------------------------------------------------------
getSpatialExternalMetrics(true=sp_toys$label, pred=sp_toys$p1,
                      location=sp_toys[,c("x","y")], level="dataset",
                      metrics=c("SpatialARI","SpatialAccuracy"),
                      fuzzy_true = TRUE, fuzzy_pred = FALSE)

## -----------------------------------------------------------------------------
getSpatialExternalMetrics(true=sp_toys$label, pred=sp_toys$p1,
                      location=sp_toys[,c("x","y")], level="class")

## -----------------------------------------------------------------------------
res1.1 <- getSpatialExternalMetrics(true=sp_toys$label, pred=sp_toys$p1,
                      location=sp_toys[,c("x","y")], level="dataset",
                      metrics=c("SpatialARI","SpatialAccuracy"),
                      fuzzy_true = TRUE, fuzzy_pred = FALSE)
res2.1 <- getSpatialExternalMetrics(true=sp_toys$label, pred=sp_toys$p2,
                      location=sp_toys[,c("x","y")], level="dataset",
                      metrics=c("SpatialARI","SpatialAccuracy"),
                      fuzzy_true = TRUE, fuzzy_pred = FALSE)
res1.2 <- getPartitionMetrics(true=sp_toys$label, pred=sp_toys$p1,
                      level="dataset", metrics=c("ARI"))
res2.2 <- getPartitionMetrics(true=sp_toys$label, pred=sp_toys$p2,
                      level="dataset", metrics=c("ARI"))

## ----fig.height = 2, fig.width = 5--------------------------------------------
cbind(bind_rows(list(res1.1, res2.1), .id="P"),
      bind_rows(list(res1.2, res2.2), .id="P")) %>% 
  pivot_longer(cols=c("SpatialARI", "SpatialAccuracy", "ARI"), 
               names_to="metric", values_to="value") %>%
  ggplot(aes(x=P, y=value, group=metric)) +
  geom_point(size=3, aes(color=P)) +
  facet_wrap(~metric) +
  theme_bw() + labs(x="Prediction")

## -----------------------------------------------------------------------------
sp_toys$c_elsa <- getSpatialInternalMetrics(label=sp_toys$label, 
                      location=sp_toys[,c("x","y")], level="element",
                      metrics=c("ELSA"))$ELSA
sp_toys$p1_elsa <- getSpatialInternalMetrics(label=sp_toys$p1, 
                      location=sp_toys[,c("x","y")], level="element",
                      metrics=c("ELSA"))$ELSA
sp_toys$p2_elsa <- getSpatialInternalMetrics(label=sp_toys$p2, 
                      location=sp_toys[,c("x","y")], level="element",
                      metrics=c("ELSA"))$ELSA

## ----fig.height = 3, fig.width = 14-------------------------------------------
s <- 3
st <- 1
p1 <- ggplot(sp_toys, aes(x, y, 
               color=p1_elsa)) + 
  geom_point(size=s, alpha=0.5) + scale_y_reverse() + theme_bw() +
  labs(x="",y="", title="P1", color="ELSA") +
  scico::scale_color_scico(palette = "roma", limits = c(0, 1), direction=-1)

p0 <- ggplot(sp_toys, aes(x, y, 
               color=c_elsa)) + 
  geom_point(size=s, alpha=0.5) + scale_y_reverse() + theme_bw() +
  labs(x="",y="", title="C", color="ELSA") +
  scico::scale_color_scico(palette = "roma", limits = c(0, 1), direction=-1)
p2 <- ggplot(sp_toys, aes(x, y, 
               color=p2_elsa)) + 
  geom_point(size=s, alpha=0.5) + scale_y_reverse() + theme_bw() +
  labs(x="",y="", title="P2", color="ELSA") +
  scico::scale_color_scico(palette = "roma", limits = c(0, 1), direction=-1)

plot_grid(p0 + theme(plot.title = element_text(hjust = 0.5)),
          p1 + theme(plot.title = element_text(hjust = 0.5)),
          p2 + theme(plot.title = element_text(hjust = 0.5)), 
          nrow=1, rel_width=c(1,1,1))

## -----------------------------------------------------------------------------
sessionInfo()