---
title: "Présentation de l'application de colSBM sur Doré et al. 2020"
output:
    html_document:
        toc: true
        theme: united
    pdf_document:
      keep_tex: true
---

```{r, setup, include=FALSE, warning=FALSE}
knitr::opts_chunk$set(echo = FALSE)
options(knitr.table.format = function() {
  if (knitr::is_latex_output()) "latex" else "pandoc"
})
```

```{r require_lib, echo = FALSE, include=FALSE, warning=FALSE}
require("tidyverse")
require("knitr")
devtools::load_all("R/")
source("real_data/temporary_plot.R")
```

```{r pretty_matrix_print, echo = FALSE, warning=FALSE}
# Define a generic method that transforms an object x in a LaTeX string
as_latex <- function(x, ...) {
  UseMethod("as_latex", x)
}

# Define a class latex for LaTeX expressions
as_latex.character <- function(x) {
  structure(
    paste(x, collapse = " "),
    class = c("latex", "character")
  )
}

# A character string of class latex is rendered in display mode
# Define a knit_print() method for the latex class
knit_print.latex <- function(x, ...) {
  knitr::asis_output(
    paste0("$$", x, "$$")
  )
}

# Now, define a method as_latex for matrix
as_latex.matrix <- function(x, ...) {
  as_latex(c(
    "\\begin{bmatrix}",
    paste(
      t(x),
      rep(c(rep("&", nrow(x) - 1), "\\\\"), ncol(x)),
      collapse = ""
    ),
    "\\end{bmatrix}"
  ))
}

# Indicate to knitr that matrix are rendered as latex
knit_print.matrix <- function(x, ...) {
  knitr::knit_print(as_latex(round(x, 2)))
}
```

```{r better_collection_extraction, echo = FALSE, warning=FALSE}
extract_unlist_reorder <- function(clustering_data_path) {
  clustering <- readRDS(clustering_data_path)
  if (!is.list(clustering)) {
    clustering <- list(clustering)
  }
  best_partition <- extract_best_bipartite_partition(clustering)
  best_partition_unlist <- unlist(best_partition)
  if (!is.list(best_partition_unlist)) {
    best_partition_unlist <- list(best_partition_unlist)
  }
  size <- length(best_partition_unlist)
  return(setNames(lapply(best_partition_unlist, function(collection) {
    reorder_parameters(collection)
  }), paste(rep("Collection", size), seq_len(size))))
}

meso_print <- function(unlisted_partition) {
  for (idx in seq_along(unlisted_partition)) {
    cat(paste("\n\n\n\nPour la collection", idx, "\n\n"))
    print(plot(unlisted_partition[[idx]], type = "meso", mixture = TRUE))
    cat("\n\n")
    print(knitr::kable(unlisted_partition[[idx]]$net_id, col.names = "Networks"))
  }
}

alpha_print <- function(unlisted_partition) {
  for (idx in seq_along(unlisted_partition)) {
    cat(paste("\nPour la collection ", idx, ":\n"))
    cat(knitr::knit_print(unlisted_partition[[idx]]$alpha))
  }
}
```

```{r taxonomy_functions, echo = FALSE, warning=FALSE}
interaction_data <- read.table(file = "real_data/data/interaction-data.txt", sep = "\t", header = TRUE)

insect_orders <- unique(interaction_data$insectorder)
plant_family <- unique(interaction_data$plantorder)

insect_orders[is.na(insect_orders)] <- "NA"
plant_family[is.na(plant_family)] <- "NA"
### Matching taxonomy
taxonomy_in_clusters <- function(unlisted_model) {
  if (is.list(unlisted_model)) {
    lapply(seq_len(length(unlisted_model)), function(col_idx) {
      # Per collection
      # Empty init
      insect_count <- t(sapply(insect_orders, function(order) {
        out_count <- rep(0, unlisted_model[[col_idx]]$Q[2])
        out_count
      }))

      plant_count <- t(sapply(plant_family, function(order) {
        out_count <- rep(0, unlisted_model[[col_idx]]$Q[1])
        out_count
      }))

      for (m in seq.int(unlisted_model[[col_idx]]$M)) {
        #### Insect
        insect_names <- names(unlisted_model[[col_idx]]$Z[[1]][[2]])

        insect_count <- insect_count + t(sapply(insect_orders, function(order) {
          out_count <- rep(0, unlisted_model[[col_idx]]$Q[2])
          names(out_count) <- seq.int(unlisted_model[[col_idx]]$Q[2])
          insect_count <- table(unlisted_model[[col_idx]]$Z[[m]][[2]][grep(order, insect_names)])
          out_count[names(insect_count)] <- insect_count
          out_count
        }))
        #### Plants
        plant_names <- names(unlisted_model[[col_idx]]$Z[[1]][[1]])

        plant_count <- t(sapply(plant_family, function(order) {
          out_count <- rep(0, unlisted_model[[col_idx]]$Q[1])
          names(out_count) <- seq.int(unlisted_model[[col_idx]]$Q[1])
          plant_count <- table(unlisted_model[[col_idx]]$Z[[m]][[1]][grep(order, plant_names)])
          out_count[names(plant_count)] <- plant_count
          out_count
        }))
      }
      return(list(insects = insect_count, plants = plant_count))
    })
  } else {
    # Per collection
    # Empty init
    insect_count <- t(sapply(insect_orders, function(order) {
      out_count <- rep(0, unlisted_model$Q[2])
      out_count
    }))

    plant_count <- t(sapply(plant_family, function(order) {
      out_count <- rep(0, unlisted_model$Q[1])
      out_count
    }))

    for (m in seq.int(unlisted_model$M)) {
      #### Insect
      insect_names <- names(unlisted_model$Z[[1]][[2]])

      insect_count <- insect_count + t(sapply(insect_orders, function(order) {
        out_count <- rep(0, unlisted_model$Q[2])
        names(out_count) <- seq.int(unlisted_model$Q[2])
        insect_count <- table(unlisted_model$Z[[m]][[2]][grep(order, insect_names)])
        out_count[names(insect_count)] <- insect_count
        out_count
      }))
      #### Plants
      plant_names <- names(unlisted_model$Z[[1]][[1]])

      plant_count <- t(sapply(plant_family, function(order) {
        out_count <- rep(0, unlisted_model$Q[1])
        names(out_count) <- seq.int(unlisted_model$Q[1])
        plant_count <- table(unlisted_model$Z[[m]][[1]][grep(order, plant_names)])
        out_count[names(plant_count)] <- plant_count
        out_count
      }))
    }
    return(list(list(insects = insect_count, plants = plant_count)))
  }
}

taxonomy_remove_empty <- function(taxonomy_collections_list) {
  lapply(taxonomy_collections_list, function(collection) {
    list(
      insects = collection$insects[which(rowSums(collection$insects != 0) > 0), ],
      plants = collection$plants[which(rowSums(collection$plants != 0) > 0), ]
    )
  })
}

get_formatted_data <- function(collection, group, max_rank = 6) {
  collection[[group]] %>%
    as.data.frame() %>% # Transformation en data frame
    mutate(
      Total = rowSums(.),
      Rang = rank(-Total, ties.method = "min")
    ) %>% # Creation d'une colonne Total
    rownames_to_column(var = "TaxonBrut") %>%
    mutate(Taxon = ifelse(Rang <= max_rank & Total > 0, TaxonBrut, "Other")) %>%
    arrange(Rang) %>%
    mutate(Taxon = factor(Taxon, levels = unique(Taxon))) %>%
    select(-Total, -TaxonBrut, -Rang) %>%
    pivot_longer(
      cols = -c("Taxon"),
      names_to = "Bloc",
      values_to = "Nombre",
      names_prefix = "V"
    ) %>%
    group_by(Taxon, Bloc) %>%
    summarise_all(sum) %>%
    ungroup() %>%
    group_by(Bloc) %>%
    mutate(Proportion = Nombre / sum(Nombre)) %>%
    ungroup() %>%
    mutate(Group = group)
}

taxonomy_plot <- function(data, insects_or_plants, model, stack_or_fill) {
  plots <- filter(data, Group == insects_or_plants) %>%
    ggplot(aes(x = Bloc, y = Nombre, fill = Taxon)) +
    geom_bar(stat = "identity", position = stack_or_fill) +
    labs(x = "Block", y = "Number of Nodes", fill = "Taxonomy") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
    ggtitle(paste(
      ifelse(insects_or_plants == "insects",
        "Pollinators", "Plants"
      ), "repartition (",
      ifelse(stack_or_fill == "stack", "absolute", "proportion"),
      ") in the", model, "clustering"
    )) +
    facet_wrap(~Collection, ncol = 3, scales = "free_x")

  # Arrange the plots in a grid layout
  gridExtra::grid.arrange(plots, newpage = TRUE)
}
```

```{r load data, echo = FALSE, include = FALSE, warning=FALSE}
# All results
iid_unlist <- extract_unlist_reorder("real_data/data/dore_collection_clustering_nb_run1_iid_123networks_24-05-23-21:40:42.Rds")

rho_unlist <- extract_unlist_reorder("real_data/data/dore_collection_clustering_nb_run1_rho_123networks_25-05-23-13:58:30.Rds")

pi_unlist <- extract_unlist_reorder("real_data/data/dore_collection_clustering_nb_run1_pi_123networks_25-05-23-17:31:25.Rds")

pirho_unlist <- extract_unlist_reorder("real_data/data/dore_collection_clustering_nb_run1_pirho_123networks_26-05-23-19:22:55.Rds")
```

## Clustering avec le modèle iid
Avec le modèle *iid* nous obtenons les `r length(iid_unlist)` collections et
les structures suivantes:

```{r iid_meso_plot, echo = FALSE, message=FALSE, results="asis", fig.cap=paste(names(iid_unlist), rep("- iid",length(iid_unlist))), warning=FALSE}
meso_print(iid_unlist)
```

Et voici donc les valeurs numériques pour les $\alpha$ (paramètres de connectivité).

```{r iid_alpha, echo = FALSE, results="asis", warning=FALSE}
alpha_print(iid_unlist)
```
### Comparaison avec des infos supplémentaires
```{r supinfo, echo = FALSE}
supinfo <- readxl::read_xlsx("real_data/data/supinfo.xlsx", sheet = 2)
interaction_data <- read.table(file = "real_data/data/interaction-data.txt", sep = "\t", header = TRUE)

seq_ids_network_aggreg <- unique(interaction_data$id_network_aggreg)
incidence_matrices <- readRDS(file = "real_data/data/dore-matrices.Rds")
names_aggreg_networks <- names(incidence_matrices)
vectorClusteringNet <- numeric(nrow(supinfo))
for (k in 1:length(iid_unlist)) {
  idclust <- match(iid_unlist[[k]]$net_id, names_aggreg_networks)
  supinfoclust <- match(seq_ids_network_aggreg[idclust], supinfo$Idweb)
  vectorClusteringNet[supinfoclust] <- k
}
```

```{r Annual_timespan_plot, echo = FALSE}
ggplot(supinfo) +
  aes(
    y = Annual_time_span,
    x = vectorClusteringNet, group = vectorClusteringNet, fill = as.factor(vectorClusteringNet)
  ) +
  xlab("Numéro de collection") +
  ylab("Annual time span") +
  guides(fill = guide_legend(title = "Numéro\nde collection")) +
  geom_boxplot()
```

### Répartition dans les clusters selon la taxonomie
```{r iid_taxonomy, echo = FALSE, warning=FALSE}
iid_taxonomy <- taxonomy_in_clusters(iid_unlist)

iid_taxonomy_long <- map_dfr(iid_taxonomy,
  function(collection) {
    map_dfr(
      c("insects", "plants"),
      function(group) {
        get_formatted_data(collection, group)
      }
    )
  },
  .id = "Collection"
)
```

```{r iid_plot_taxonomy_pollinators, echo = FALSE, message = FALSE,fig.cap = 'Pollinators repartition for the iid model regarding taxonomy', warning=FALSE}
# Pollinators
taxonomy_plot(
  data = iid_taxonomy_long,
  insects_or_plants = "insects",
  stack_or_fill = "stack", model = "iid"
)
taxonomy_plot(
  data = iid_taxonomy_long,
  insects_or_plants = "insects",
  stack_or_fill = "fill", model = "iid"
)
```

```{r iid_plot_taxonomy_plants, echo = FALSE, message = FALSE,fig.cap = 'Plants repartition for the iid model regarding taxonomy', warning=FALSE}
taxonomy_plot(
  data = iid_taxonomy_long,
  insects_or_plants = "plants",
  stack_or_fill = "stack", model = "iid"
)
taxonomy_plot(
  data = iid_taxonomy_long,
  insects_or_plants = "plants",
  stack_or_fill = "fill", model = "iid"
)
```

#### Tables
```{r iid_taxo_tables, echo = FALSE}
iid_taxonomy_long %>%
  filter(Group == "insects") %>%
  group_by(Taxon) %>%
  mutate(row_id = row_number()) %>%
  pivot_wider(names_from = c(Collection, Bloc), values_from = Nombre, names_glue = "Collection_{Collection}_Bloc_{Bloc}") %>%
  ungroup() %>%
  select(-row_id) %>%
  group_by(Taxon) %>%
  summarize(across(starts_with("Collection"), ~ na.omit(.)[1])) %>%
  ungroup()
```


## Clustering avec le modèle pi
Avec le modèle *pi* nous obtenons les `r length(pi_unlist)` collections et
les structures suivantes:

```{r pi_meso_plot, echo = FALSE, message=FALSE, fig.cap=paste(names(pi_unlist), rep("- pi",length(pi_unlist))), results="asis", warning=FALSE}
meso_print(pi_unlist)
```

Et voici donc les valeurs numériques pour les $\alpha$ (paramètres de connectivité).

```{r pi_alpha, echo = FALSE, results="asis", warning=FALSE}
alpha_print(pi_unlist)
```

### Répartition dans les clusters selon la taxonomie
```{r pi_taxonomy, echo = FALSE, warning=FALSE}
pi_taxonomy <- taxonomy_in_clusters(pi_unlist)

pi_taxonomy_long <- map_dfr(pi_taxonomy,
  function(collection) {
    map_dfr(
      c("insects", "plants"),
      function(group) {
        get_formatted_data(collection, group)
      }
    )
  },
  .id = "Collection"
)
```

```{r pi_plot_taxonomy_pollinators, echo = FALSE, message = FALSE,fig.cap = 'Pollinators repartition for the pi model regarding taxonomy', warning=FALSE}
# Pollinators
taxonomy_plot(
  data = pi_taxonomy_long,
  insects_or_plants = "insects",
  stack_or_fill = "stack", model = "pi"
)
taxonomy_plot(
  data = pi_taxonomy_long,
  insects_or_plants = "insects",
  stack_or_fill = "fill", model = "pi"
)
```

```{r pi_plot_taxonomy_plants, echo = FALSE, message = FALSE,fig.cap = 'Plants repartition for the pi model regarding taxonomy', warning=FALSE}
taxonomy_plot(
  data = pi_taxonomy_long,
  insects_or_plants = "plants",
  stack_or_fill = "stack", model = "pi"
)
taxonomy_plot(
  data = pi_taxonomy_long,
  insects_or_plants = "plants",
  stack_or_fill = "fill", model = "pi"
)
```

## Clustering avec le modèle rho
Avec le modèle *rho* nous obtenons les `r length(rho_unlist)` collections et
les structures suivantes:

```{r rho_meso_plot, echo = FALSE, message=FALSE, fig.cap=paste(names(rho_unlist), rep("- rho",length(rho_unlist))), results="asis", warning=FALSE}
meso_print(rho_unlist)
```

Et voici donc les valeurs numériques pour les $\alpha$ (paramètres de connectivité).

```{r rho_alpha, echo = FALSE, results="asis", warning=FALSE}
alpha_print(rho_unlist)
```

### Répartition dans les clusters selon la taxonomie
```{r rho_taxonomy, echo = FALSE, warning=FALSE}
rho_taxonomy <- taxonomy_in_clusters(rho_unlist)

rho_taxonomy_long <- map_dfr(rho_taxonomy,
  function(collection) {
    map_dfr(
      c("insects", "plants"),
      function(group) {
        get_formatted_data(collection, group)
      }
    )
  },
  .id = "Collection"
)
```

```{r rho_plot_taxonomy_pollinators, echo = FALSE, message = FALSE,fig.cap = 'Pollinators repartition for the rho model regarding taxonomy', warning=FALSE}
# Pollinators
taxonomy_plot(
  data = rho_taxonomy_long,
  insects_or_plants = "insects",
  stack_or_fill = "stack", model = "rho"
)
taxonomy_plot(
  data = rho_taxonomy_long,
  insects_or_plants = "insects",
  stack_or_fill = "fill", model = "rho"
)
```

```{r rho_plot_taxonomy_plants, echo = FALSE, message = FALSE,fig.cap = 'Plants repartition for the rho model regarding taxonomy', warning=FALSE}
taxonomy_plot(
  data = rho_taxonomy_long,
  insects_or_plants = "plants",
  stack_or_fill = "stack", model = "rho"
)
taxonomy_plot(
  data = rho_taxonomy_long,
  insects_or_plants = "plants",
  stack_or_fill = "fill", model = "rho"
)
```

## Clustering avec le modèle pirho
Avec le modèle *pirho* nous obtenons les `r length(pirho_unlist)` collections et
les structures suivantes:

```{r pirho_meso_plot, echo = FALSE, message=FALSE, fig.cap=paste(names(pirho_unlist), rep("- pirho",length(pirho_unlist))), results="asis", warning=FALSE}
meso_print(pirho_unlist)
```

Et voici donc les valeurs numériques pour les $\alpha$ (paramètres de connectivité).

```{r pirho_alpha, echo = FALSE, results="asis", warning=FALSE}
alpha_print(pirho_unlist)
```

### Répartition dans les clusters selon la taxonomie
```{r pirho_taxonomy, echo = FALSE, warning=FALSE}
pirho_taxonomy <- taxonomy_in_clusters(pirho_unlist)

pirho_taxonomy_long <- map_dfr(pirho_taxonomy,
  function(collection) {
    map_dfr(
      c("insects", "plants"),
      function(group) {
        get_formatted_data(collection, group)
      }
    )
  },
  .id = "Collection"
)
```

```{r pirho_plot_taxonomy_pollinators, echo = FALSE, message = FALSE, fig.cap = 'Pollinators repartition for the pirho model regarding taxonomy', warning=FALSE}
# Pollinators
taxonomy_plot(
  data = pirho_taxonomy_long,
  insects_or_plants = "insects",
  stack_or_fill = "stack", model = "pirho"
)
taxonomy_plot(
  data = pirho_taxonomy_long,
  insects_or_plants = "insects",
  stack_or_fill = "fill", model = "pirho"
)
```

```{r pirho_plot_taxonomy_plants, echo = FALSE, message = FALSE,fig.cap = 'Plants repartition for the pirho model regarding taxonomy', warning=FALSE}
taxonomy_plot(
  data = pirho_taxonomy_long,
  insects_or_plants = "plants",
  stack_or_fill = "stack", model = "pirho"
)
taxonomy_plot(
  data = pirho_taxonomy_long,
  insects_or_plants = "plants",
  stack_or_fill = "fill", model = "pirho"
)
```
