add build for data object + add nodes names to data object

.Rbuildignore

@@ -14,3 +14,4 @@ $run_dev.*
 todo.md
 .gitlab-ci.yml
 docker*
+build_data/build_FungusTreeNetwork.R

R/FungusTreeNetwork.R

@@ -14,6 +14,8 @@
 #' \describe{
 #'  \item{networks}{
 #'    \itemize{
+#'      \item{tree_names : (character) tree names}
+#'      \item{fungus_names : (character) fungus names}
 #'      \item{tree_tree}{
 #'        \enumerate{
 #'          \item{nodes : data.frame describing nodes of tree_tree network}

R/fct_adjacency_to_edges.R

@@ -138,7 +138,7 @@ get_graph.matrix <- function(x,
                                col = colnames(x)
                              ),
                              type = "unipartite", directed = F, ...) {
-  . <-
+  . <- NULL
     ## Tests
     if (dim(x)[[1]] != length(node_names[["row"]]) | dim(x)[[2]] != length(node_names[["col"]])) {
       stop("x has different dimension than node_names")

R/fct_get_Blocks.R

@@ -26,8 +26,8 @@
 #' my_sbm_bi <- FungusTreeNetwork$sbmResults$fungus_tree
 #'
 #' node_names_bi <- list(
-#'   row = sbm::fungusTreeNetwork$fungus_names,
-#'   col = sbm::fungusTreeNetwork$tree_names
+#'   row = FungusTreeNetwork$networks$fungus_names,
+#'   col = FungusTreeNetwork$networks$tree_names
 #' )
 #'
 #'my_blocks_bi <- get_block(my_sbm_bi,
@@ -40,7 +40,7 @@
 #' #                                      model = "poisson")
 #' my_sbm_uni <- FungusTreeNetwork$sbmResults$tree_tree
 #'
-#' node_names_uni <- list(sbm::fungusTreeNetwork$tree_names)
+#' node_names_uni <- list(FungusTreeNetwork$networks$tree_names)
 #'
 #'my_blocks_uni <- get_block(my_sbm_uni,
 #'                          labels = c('Tree'),
@@ -72,7 +72,7 @@ get_block <- function(x, labels = "default", node_names = NULL,
 #' #                                      model = "poisson")
 #' my_sbm_uni <- FungusTreeNetwork$sbmResults$tree_tree
 #'
-#' node_names_uni <- list(sbm::fungusTreeNetwork$tree_names)
+#' node_names_uni <- list(FungusTreeNetwork$networks$tree_names)
 #'
 #'my_blocks_uni <- get_block(my_sbm_uni,
 #'                          labels = c('Tree'),
@@ -148,8 +148,8 @@ get_block.SimpleSBM_fit <- function(x,
 #' my_sbm_bi <- FungusTreeNetwork$sbmResults$fungus_tree
 #'
 #' node_names_bi <- list(
-#'   row = sbm::fungusTreeNetwork$fungus_names,
-#'   col = sbm::fungusTreeNetwork$tree_names
+#'   row = FungusTreeNetwork$networks$fungus_names,
+#'   col = FungusTreeNetwork$networks$tree_names
 #' )
 #'
 #'my_blocks_bi <- get_block(my_sbm_bi,

R/fct_visSbm.R

@@ -149,8 +149,8 @@ prePlotNet <- function(matrix,
 #' my_sbm_bi <- FungusTreeNetwork$sbmResults$fungus_tree
 #'
 #' node_names_bi <- list(
-#'   row = sbm::fungusTreeNetwork$fungus_names,
-#'   col = sbm::fungusTreeNetwork$tree_names
+#'   row = FungusTreeNetwork$networks$fungus_names,
+#'   col = FungusTreeNetwork$networks$tree_names
 #' )
 #'
 #' visSbm(my_sbm_bi,
@@ -169,7 +169,7 @@ prePlotNet <- function(matrix,
 #' #                                      model = "poisson")
 #' my_sbm_uni <- FungusTreeNetwork$sbmResults$tree_tree
 #'
-#' node_names_uni <- list(sbm::fungusTreeNetwork$tree_names)
+#' node_names_uni <- list(FungusTreeNetwork$networks$tree_names)
 #'
 #' visSbm(my_sbm_uni,
 #'   labels = c("Tree"),
@@ -273,8 +273,8 @@ visSbm.default <- function(x,
 #' my_sbm_bi <- FungusTreeNetwork$sbmResults$fungus_tree
 #'
 #' node_names_bi <- list(
-#'   row = sbm::fungusTreeNetwork$fungus_names,
-#'   col = sbm::fungusTreeNetwork$tree_names
+#'   row = FungusTreeNetwork$networks$fungus_names,
+#'   col = FungusTreeNetwork$networks$tree_names
 #' )
 #'
 #' visSbm(my_sbm_bi,
@@ -401,7 +401,7 @@ visSbm.BipartiteSBM_fit <- function(x,
 #' #                                      model = "poisson")
 #' my_sbm_uni <- FungusTreeNetwork$sbmResults$tree_tree
 #'
-#' node_names_uni <- list(sbm::fungusTreeNetwork$tree_names)
+#' node_names_uni <- list(FungusTreeNetwork$networks$tree_names)
 #'
 #' visSbm(my_sbm_uni,
 #'   labels = c("Tree"),

build_data/build_FungusTreeNetwork.R

+### --------- Packages ---------------------------------------------------------
+require(sbm)
+require(magrittr)
+require(shinySbm)
+
+### --------- Renv -------------------------------------------------------------
+
+
+### --------- Nodes Names ------------------------------------------------------
+
+fungus_names <- as.character(sbm::fungusTreeNetwork$fungus_names)
+tree_names <- as.character(sbm::fungusTreeNetwork$tree_names)
+
+### --------- Applying SBM -----------------------------------------------------
+
+sbm_tree <- sbm::estimateSimpleSBM(sbm::fungusTreeNetwork$tree_tree,
+  model = "poisson",
+  dimLabels = c("Tree")
+)
+
+sbm_fungus <- sbm::estimateBipartiteSBM(sbm::fungusTreeNetwork$fungus_tree,
+  model = "bernoulli",
+  dimLabels = c(
+    row = "Fungus",
+    col = "Tree"
+  )
+)
+
+### --------- Building Graphs (edges list) -------------------------------------
+
+get_graph_tree <- function(x = sbm::fungusTreeNetwork$tree_tree,
+                           labels = "tree",
+                           node_names = as.character(sbm::fungusTreeNetwork$tree_names)) {
+  nodes <- data.frame(
+    id = 1:length(node_names),
+    label = node_names
+  )
+
+  # Edges table
+  edges <- data.frame(
+    # edges start from
+    from = sapply(nodes$id, function(i) { # for each block nb
+      rep(i, each = length(node_names) - i + 1) # connection with the ones it is not yet connected
+    }) %>% unlist(),
+    # edges end to
+    to = sapply(nodes$id, function(i) { # for each block nb
+      i:length(node_names) # connection with the ones it is not yet connected
+    }) %>% unlist()
+  ) %>%
+    dplyr::mutate(value = apply(., 1, function(i) {
+      x[i[1], i[2]] # get connection values
+    }) %>% unlist())
+
+  ## Add labels
+  nodes$id <- paste0(labels, "_", nodes$id)
+  edges$from <- paste0(labels, "_", edges$from)
+  edges$to <- paste0(labels, "_", edges$to)
+
+  return(list(nodes = nodes, edges = edges, type = "unipartite"))
+}
+
+get_graph_fungus <- function(x = sbm::fungusTreeNetwork$fungus_tree,
+                             labels = c(row = "fungi", col = "tree"),
+                             node_names = list(
+                               row = as.character(sbm::fungusTreeNetwork$fungus_names),
+                               col = as.character(sbm::fungusTreeNetwork$tree_names)
+                             )) {
+  margins <- c(nrow, ncol)
+  nodes <- purrr::map_dfr(c(1, 2), function(i) {
+    data.frame(
+      id = paste0(labels[[i]], "_", 1:margins[[i]](x)),
+      type = labels[[i]],
+      label = node_names[[i]]
+    )
+  })
+  edges <- data.frame(
+    from = rep(nodes$id[nodes$type == "fungi"], ncol(x)),
+    to = rep(nodes$id[nodes$type == "tree"], each = nrow(x)),
+    value = as.vector(x)
+  )
+  return(list(nodes = nodes, edges = edges, type = "bipartite"))
+}
+
+## Check if same
+tree_tree_net <- get_graph_tree()
+identical(tree_tree_net, shinySbm::FungusTreeNetwork$networks$tree_tree)
+fungus_tree_net <- get_graph_fungus()
+identical(fungus_tree_net, shinySbm::FungusTreeNetwork$networks$fungus_tree)
+
+
+### --------- Gathering Objects ------------------------------------------------
+
+FungusTreeNetwork <- list(
+  networks = list(
+    fungus_names = fungus_names,
+    tree_names = tree_names,
+    tree_tree = tree_tree_net,
+    fungus_tree = fungus_tree_net
+  ),
+  sbmResults = list(
+    tree_tree = sbm_tree,
+    fungus_tree = sbm_fungus
+  )
+)
+
+save(FungusTreeNetwork,file = "data/FungusTreeNetwork.rda")

man/FungusTreeNetwork.Rd

@@ -8,8 +8,14 @@
 A list of the following entries :
 
 \describe{
+ \item{node_names}{
+   \itemize{
+   }
+ }
  \item{networks}{
    \itemize{
+     \item{tree_names : (character) tree names}
+     \item{fungus_names : (character) fungus names}
      \item{tree_tree}{
        \enumerate{
          \item{nodes : data.frame describing nodes of tree_tree network}

shinySbm.Rproj

@@ -19,4 +19,5 @@ LineEndingConversion: Posix
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageBuildArgs: --resave-data
 PackageCheckArgs: --as-cran