# ==========2.1 manipulate========

#' Set basic attributes from totu table

#'

#' @param go metanet an igraph object

#' @param ... some data.frames to annotate go

#' @param vertex_group choose which column to be vertex_group (map to vertex_shape)

#' @param vertex_class choose which column to be vertex_class (map to vertex_color)

#' @param vertex_size choose which column to be vertex_size (map to vertex_size)

#' @param edge_type choose which column to be edge_type (map to edge_color)

#' @param edge_class choose which column to be edge_class (map to edge_linetype)

#' @param edge_width choose which column to be edge_width (map to edge_width)

#' @param node_break node_break if v_class is numeric, default: 5

#' @param edge_break edge_break if e_type is numeric, default: 5

#' @param initialize initialize, default: TRUE

#'

#' @return a metanet object

#' @export

#' @family build

#' @examples

#' data("otutab", package = "pcutils")

#' t(otutab) -> totu

#' metadata[, 3:10] -> env

#'

#' data("c_net")

#' co_net <- c_net_set(co_net, taxonomy, data.frame("Abundance" = colSums(totu)),

#'   vertex_class = "Phylum", vertex_size = "Abundance"

#' )

#' co_net2 <- c_net_set(co_net2, taxonomy, data.frame(name = colnames(env), env = colnames(env)),

#'   vertex_class = c("Phylum", "env")

#' )

#' co_net2 <- c_net_set(co_net2, data.frame("Abundance" = colSums(totu)), vertex_size = "Abundance")

c_net_set <- function(go, ..., vertex_group = "v_group", vertex_class = "v_class", vertex_size = "size",

                      edge_type = "e_type", edge_class = "e_class", edge_width = "width",

                      node_break = 5, edge_break = 5, initialize = TRUE) {

  size <- e_class <- width <- NULL

  c_net_update(go, verbose = FALSE) -> go

  name <- v_group <- v_class <- e_type <- color <- NULL

  # annotation vertex

  anno_dfs <- list(...)

  if (length(anno_dfs) > 0) {

    anno_dfs2 <- list()

    for (i in seq_len(length(anno_dfs))) {

      x <- anno_dfs[[i]]

      if ("name" %in% colnames(x)) {

        rownames(x) <- x$name

        x <- dplyr::select(x, -name)

      }

      anno_dfs2[[i]] <- x

    }

    if (any(duplicated(lapply(anno_dfs2, names) %>% unlist()))) stop("Duplicated column names in your annotation tables, please check!")

    Reduce(\(x, y)merge(x, y, by = "row.names", all = TRUE) %>%

      tibble::column_to_rownames("Row.names"), anno_dfs2) -> all_anno

    anno_vertex(go, all_anno) -> go

  }

  get_v(go) -> v_index

  get_e(go) -> e_index

  # set something

  # ！！！这里的set要改成跟c_net_update一样的逻辑

  if (!setequal(vertex_group, "v_group")) dplyr::select(v_index, v_group, !!vertex_group) %>% condance() -> v_index$v_group

  if (!setequal(vertex_class, "v_class")) {

    old_color <- twocol2vector(v_index[, c("v_class", "color")])

    new_color_name <- c()

    # 给每一个v_group加上v_class调整颜色

    # 可能某一个group用numeric做v_class，所以要分开上色

    for (i in unique(v_index$v_group)) {

      tmp_index <- v_index[v_index$v_group == i, ]

      tmp_v_class <- dplyr::select(tmp_index, v_class, !!vertex_class) %>% condance()

      if (identical(tmp_v_class, tmp_index$v_class)) {

        new_color_name <- c(new_color_name, unique(tmp_index$v_class))

        next

      }

      if (is.numeric(tmp_v_class)) {

        tmp_v_color <- color_generate(tmp_v_class, n_break = node_break, mode = "v")

        tmp_v_class <- color_generate(tmp_v_class, n_break = node_break, mode = "label")

        v_index[v_index$v_group == i, "color"] <- tmp_v_color

      } else {

        new_color_name <- c(new_color_name, unique(tmp_index$v_class))

      }

      v_index[v_index$v_group == i, "v_class"] <- as.character(tmp_v_class)

    }

    # 总体分类颜色是否改变，没变的话就不该，变了的话全部重新赋

    new_color_name <- unique(new_color_name)

    if (!all(new_color_name %in% names(old_color))) {

      new_color <- setNames(pcutils::get_cols(length(new_color_name), pal = default_v_color), new_color_name)

      v_index$color <- condance(data.frame(

        v_index$color,

        pcutils::tidai(v_index$v_class, new_color)

      ))

    }

  }

  if (!setequal(vertex_size, "size")) dplyr::select(v_index, size, !!vertex_size) %>% condance() -> v_index$size

  if (!setequal(edge_type, "e_type")) {

    tmp_e_type <- dplyr::select(e_index, e_type, !!edge_type) %>% condance()

    if (!identical(tmp_e_type, e_index$e_type)) {

      tmp_e_color <- color_generate(tmp_e_type, edge_break, mode = "e")

      tmp_e_type <- color_generate(tmp_e_type, edge_break, mode = "label")

      e_index$e_type <- tmp_e_type

      e_index$color <- tmp_e_color

    }

  }

  if (!setequal(edge_class, "e_class")) dplyr::select(e_index, e_class, !!edge_class) %>% condance() -> e_index$e_class

  if (!setequal(edge_width, "width")) dplyr::select(e_index, width, !!edge_width) %>% condance() -> e_index$width

  as.list(v_index) -> igraph::vertex.attributes(go)

  as.list(e_index) -> igraph::edge.attributes(go)

  c_net_update(go, initialize = initialize, verbose = FALSE) -> go2

  return(go2)

}

#' Is this object a metanet object?

#'

#' @param go a test object

#'

#' @return logical

#' @export

#' @aliases is.metanet

#' @family manipulate

#' @examples

#' data(c_net)

#' is_metanet(co_net)

is_metanet <- function(go) {

  is.igraph(go) & inherits(go, "metanet")

}

#' Get vertex information

#'

#' @param go metanet object

#' @param index attribute name, default: NULL

#' @family manipulate

#' @return data.frame

#' @export

get_v <- function(go, index = NULL) {

  # 规定name只能为字符

  if (is.null(V(go)$name)) V(go)$name <- as.character(V(go))

  # df <- as.data.frame(igraph::vertex.attributes(go))

  igraph::as_data_frame(go, what = "vertices") -> df

  df <- dplyr::select(df, name, dplyr::everything())

  rownames(df) <- NULL

  if (!is.null(index)) {

    return(dplyr::select(df, !!index))

  } else {

    return(df)

  }

}

#' Get edge information

#' @param go metanet object

#' @param index attribute name, default: NULL

#' @return data.frame

#' @family manipulate

#' @export

get_e <- function(go, index = NULL) {

  id <- NULL

  tmp_e <- cbind_new(igraph::as_data_frame(go), data.frame(id = seq_len(igraph::ecount(go))))

  tmp_e <- dplyr::select(tmp_e, id, dplyr::everything())

  if (!is.null(index)) {

    return(dplyr::select(tmp_e, !!index))

  } else {

    return(tmp_e)

  }

}

#' Get network information

#'

#' @param go metanet object

#' @param index attribute name, default: NULL

#' @param simple logical, get simple index

#' @family manipulate

#' @return data.frame

#' @export

get_n <- function(go, index = NULL, simple = FALSE) {

  gls <- igraph::graph.attributes(go)

  if (simple) {

    gls <- lapply(gls, \(x){

      if (inherits(x, "data.frame")) {

        return(NULL)

      }

      if (is.array(x)) {

        return(NULL)

      }

      if (is.list(x)) {

        return(NULL)

      }

      if (length(x) > 1) {

        return(NULL)

      }

      return(x)

    })

  } else {

    gls <- lapply(gls, \(x){

      if (inherits(x, "data.frame")) {

        return(paste0(ncol(x), "-columns df"))

      }

      if (is.array(x)) {

        return(paste0(length(x), "-elements ", class(x)))

      }

      if (is.list(x)) {

        return(paste0(length(x), "-elements ", class(x)))

      }

      if (length(x) > 1) {

        return(paste0(length(x), "-elements vector"))

      }

      return(x)

    })

  }

  df <- as.data.frame(do.call(cbind, gls))

  if (!is.null(index)) {

    return(dplyr::select(df, !!index))

  } else {

    return(df)

  }

}

#' Filter a network according to some attributes

#'

#' @param go metanet object

#' @param ... some attributes of vertex and edge

#' @param mode "v" or "e"

#'

#' @return metanet

#' @export

#' @family manipulate

#' @examples

#' data("multi_net")

#' c_net_filter(multi1, v_group %in% c("omic1", "omic2"))

c_net_filter <- function(go, ..., mode = "v") {

  if (mode == "v") {

    go1 <- filter_v(go, ...)

  } else if (mode == "e") {

    go1 <- filter_e(go, ...)

  } else {

    stop("mode should be 'v' or 'e'")

  }

  if (length(V(go1)) == 0) {

    message("The network is empty.")

  }

  go1

}

filter_v <- function(go, ...) {

  get_v(go) -> tmp_v

  tmp_v <- dplyr::filter(tmp_v, ...)

  tmp_v$name -> vid

  igraph::subgraph(go, vid) -> go1

  class(go1) <- c("metanet", "igraph")

  go1

}

filter_e <- function(go, ...) {

  get_e(go) -> tmp_e

  tmp_e <- dplyr::filter(tmp_e, ...)

  tmp_e$id -> eid

  igraph::subgraph.edges(go, eid) -> go1

  class(go1) <- c("metanet", "igraph")

  go1

}

#' Union two networks

#'

#' @param go1 metanet object

#' @param go2 metanet object

#'

#' @return metanet

#' @export

#' @family manipulate

#' @examples

#' data("c_net")

#' co_net_union <- c_net_union(co_net, co_net2)

#' c_net_plot(co_net_union)

c_net_union <- function(go1, go2) {

  tmp_v1 <- get_v(go1)

  tmp_v2 <- get_v(go2)

  cols <- c("name", "label", "size", "v_group", "shape", "v_class", "color")

  tmp_v <- rbind(tmp_v1[cols], tmp_v2[cols])

  message("Duplicated vertexes: ", sum(duplicated(tmp_v$name)), "\nUse the attributes of the first network.")

  tmp_v <- tmp_v[!duplicated(tmp_v$name), ]

  tmp_e1 <- get_e(go1)

  tmp_e2 <- get_e(go2)

  cols <- c("from", "to", "e_type", "color", "e_class", "lty", "width")

  tmp_e <- rbind(tmp_e1[cols], tmp_e2[cols])

  message("Duplicated edges: ", sum(duplicated(tmp_e[, c("from", "to")])), "\nUse the attributes of the first network.")

  tmp_e <- tmp_e[!duplicated(tmp_e[, c("from", "to")]), ]

  go <- igraph::union(go1, go2)

  go <- clean_igraph(go, direct = FALSE)

  go <- c_net_annotate(go, tmp_v, mode = "v")

  go <- c_net_annotate(go, tmp_e, mode = "e")

  go <- c_net_annotate(go, list(n_type = "combine_net"), mode = "n")

  go <- c_net_update(go, initialize = TRUE)

  go

}

#' Annotate a metanet

#'

#' @param go metanet object

#' @param anno_tab a dataframe using to annotate (mode v, e), or a list (mode n)

#' @param mode "v" for vertex, "e" for edge, "n" for network

#' @param verbose logical

#'

#' @return a annotated metanet object

#' @export

#' @family manipulate

#' @examples

#' data("c_net")

#' anno <- data.frame("name" = "s__Pelomonas_puraquae", new_atr = "new")

#' co_net_new <- c_net_annotate(co_net, anno, mode = "v")

#' get_v(co_net_new, c("name", "new_atr"))

#'

#' anno <- data.frame("from" = "s__Pelomonas_puraquae", "to" = "s__un_g__Rhizobium", new_atr = "new")

#' co_net_new <- c_net_annotate(co_net, anno, mode = "e")

#' get_e(co_net_new, c("from", "to", "new_atr"))

#'

#' co_net_new <- c_net_annotate(co_net, list(new_atr = "new"), mode = "n")

#' get_n(co_net_new)

c_net_annotate <- function(go, anno_tab, mode = "v", verbose = TRUE) {

  mode <- match.arg(mode, c("v", "e", "n"))

  if (mode == "v") {

    anno_vertex(go, anno_tab, verbose = verbose) -> go

  } else if (mode == "e") {

    anno_edge(go, anno_tab, verbose = verbose) -> go

  } else if (mode == "n") {

    igraph::graph.attributes(go) <-

      pcutils::update_param(igraph::graph.attributes(go), anno_tab)

  }

  go

}

#' Use data.frame to annotate vertexes of metanet

#'

#' @param go metanet object

#' @param verbose logical

#' @param anno_tab a dataframe using to annotate (with rowname or a "name" column)

#'

#' @return a annotated metanet object

#' @aliases anno_node

#' @export

#' @family manipulate

#' @examples

#' data("c_net")

#' data("otutab", package = "pcutils")

#' anno_vertex(co_net, taxonomy)

anno_vertex <- function(go, anno_tab, verbose = TRUE) {

  if (is.null(anno_tab)) {

    return(go)

  }

  get_v(go) -> v_atr

  if (!"name" %in% colnames(anno_tab)) rownames(anno_tab) -> anno_tab$name

  if (any(duplicated(anno_tab$name))) {

    stop(

      "Duplicated name in annotation tables: ",

      paste0(anno_tab$name[duplicated(anno_tab$name)], collapse = ", ")

    )

  }

  v_atr <- dplyr::left_join(v_atr, anno_tab, by = "name", suffix = c(".x", ""))

  grep(".x", colnames(v_atr), value = TRUE) %>% gsub(".x", "", .) -> du

  if (length(du) > 0) message(length(du), (" attributes will be overwrited:\n"), paste0(du, collapse = ", "), "\n")

  v_atr %>% dplyr::select(!dplyr::ends_with(".x")) -> v_atr

  as.list(v_atr) -> igraph::vertex.attributes(go)

  return(go)

}

#' Use dataframe to annotate edges of an igraph

#'

#' @param go metanet an igraph object

#' @param verbose logical

#' @param anno_tab a dataframe using to annotate (with rowname or a name column)

#'

#' @return a annotated igraph object

#' @export

#' @family manipulate

#' @examples

#' data("c_net")

#' anno <- data.frame("from" = "s__Pelomonas_puraquae", "to" = "s__un_g__Rhizobium", new_atr = "new")

#' anno_edge(co_net, anno) -> anno_net

anno_edge <- function(go, anno_tab, verbose = TRUE) {

  name <- NULL

  if (is.null(anno_tab)) {

    return(go)

  }

  get_e(go) -> e_atr

  if (all(c("from", "to") %in% colnames(anno_tab))) {

    e_atr <- dplyr::left_join(e_atr, anno_tab, by = c("from", "to"), suffix = c(".x", ""))

    grep(".x", colnames(e_atr), value = TRUE) %>% gsub(".x", "", .) -> du

    if (length(du) > 0) {

      if (verbose) message(length(du), (" attributes will be overwrited:\n"), paste0(du, collapse = ","), "\n")

    }

    e_atr %>% dplyr::select(!dplyr::ends_with(".x")) -> e_atr

  } else {

    if (verbose) message("No 'from' and 'to' columns in annotation table, will use 'name_from' and 'name_to' instead.")

    if (!"name" %in% colnames(anno_tab)) rownames(anno_tab) -> anno_tab$name

    anno_tab %>% dplyr::select(name, dplyr::everything()) -> anno_tab

    # from

    tmp <- anno_tab

    colnames(tmp) <- paste0(colnames(anno_tab), "_from")

    e_atr <- dplyr::left_join(e_atr, tmp, by = c("from" = "name_from"), suffix = c(".x", ""))

    grep(".x", colnames(e_atr), value = TRUE) %>% gsub(".x", "", .) -> du

    if (length(du) > 0) {

      if (verbose) message(length(du), (" attributes will be overwrited:\n"), paste0(du, collapse = ","), "\n")

    }

    e_atr %>% dplyr::select(!dplyr::ends_with(".x")) -> e_atr

    # to

    tmp <- anno_tab

    colnames(tmp) <- paste0(colnames(anno_tab), "_to")

    e_atr <- dplyr::left_join(e_atr, tmp, by = c("to" = "name_to"), suffix = c(".x", ""))

    grep(".x", colnames(e_atr), value = TRUE) %>% gsub(".x", "", .) -> du

    if (length(du) > 0) {

      if (verbose) message(length(du), (" attributes will be overwrited:\n"), paste0(du, collapse = ","), "\n")

    }

    e_atr %>% dplyr::select(!dplyr::ends_with(".x")) -> e_atr

  }

  as.list(e_atr) -> igraph::edge.attributes(go)

  return(go)

}

#' Save network file

#'

#' @param go metanet network

#' @param filename filename

#' @param format "data.frame","graphml"

#' @return No value

#' @family manipulate

#' @export

c_net_save <- function(go, filename = "net", format = "data.frame") {

  if (format == "data.frame") {

    get_v(go) %>% write.csv(., paste0(filename, "_nodes.csv"), row.names = FALSE)

    get_e(go) %>%

      dplyr::select(-1) %>%

      write.csv(., paste0(filename, "_edges.csv"), row.names = FALSE)

  } else if (format == "graphml") {

    if ("id" %in% edge.attributes(go)) go <- igraph::delete_edge_attr(go, "id")

    if (!grepl("\\.graphml$", filename)) filename <- paste0(filename, ".graphml")

    igraph::write_graph(go, filename, format = "graphml")

  } else {

    if (!grepl(paste0("\\.", format), filename)) filename <- paste0(filename, ".", format)

    igraph::write_graph(go, filename, format = format)

  }

  message(paste0(filename, " saved sucessfully!"))

}

#' Load network file

#'

#' @inheritParams c_net_save

#'

#' @return metanet

#' @export

#' @family manipulate

c_net_load <- function(filename, format = "data.frame") {

  if (format == "data.frame") {

    nodes <- read.csv(paste0(filename, "_nodes.csv"), stringsAsFactors = FALSE)

    edges <- read.csv(paste0(filename, "_edges.csv"), stringsAsFactors = FALSE)

    c_net_from_edgelist(edges, vertex_df = nodes) -> go

  } else if (format == "cyjs") {

    lib_ps("jsonify", library = FALSE)

    if (!grepl("\\.cyjs$", filename)) filename <- paste0(filename, ".cyjs")

    jsonify::from_json(filename) -> G

    if (!is.data.frame(G$elements$nodes$data)) {

      names <- lapply(G$elements$nodes$data, names)

      comm_name <- Reduce(intersect, names)

      lapply(G$elements$nodes$data, \(i)i[comm_name]) -> G$elements$nodes$data

      G$elements$nodes$data <- list_to_dataframe(G$elements$nodes$data)

    }

    node <- cbind_new(G$elements$nodes$data, G$elements$nodes$position)

    node$y <- -node$y

    node <- node[, colnames(node) != "name"]

    colnames(node)[1] <- "name"

    edge <- G$elements$edges$data

    edge <- edge[, !colnames(edge) %in% c("from", "to")]

    colnames(edge)[1:3] <- c("id", "from", "to")

    c_net_from_edgelist(edge, node) -> go

  } else if (format == "graphml") {

    if (!grepl("\\.graphml$", filename)) filename <- paste0(filename, ".graphml")

    igraph::read_graph(filename, format = "graphml") -> go

    go <- c_net_update(go, initialize = TRUE)

  } else {

    if (!grepl(paste0("\\.", format), filename)) filename <- paste0(filename, ".", format)

    igraph::read_graph(filename, format = format) -> go

    go <- c_net_update(go, initialize = TRUE)

  }

  go

}

#' Summaries two columns information

#' @param df data.frame

#' @param from first column name or index

#' @param to second column name or index

#' @param count (optional) weight column, if no, each equal to 1

#' @param direct consider direct? default: FALSE

#'

#' @return data.frame

#' @export

#' @examples

#' test <- data.frame(

#'   a = sample(letters[1:4], 10, replace = TRUE),

#'   b = sample(letters[1:4], 10, replace = TRUE)

#' )

#' summ_2col(test, direct = TRUE)

#' summ_2col(test, direct = FALSE)

#' if (requireNamespace("circlize")) {

#'   summ_2col(test, direct = TRUE) %>% pcutils::my_circo()

#' }

summ_2col <- function(df, from = 1, to = 2, count = 3, direct = FALSE) {

  if (ncol(df) < 2) stop("need at least two columns")

  if (ncol(df) == 2) {

    tmp <- cbind(df, count = 1)

  } else {

    tmp <- dplyr::select(df, !!from, !!to, !!count)

  }

  cols <- colnames(tmp)

  colnames(tmp) <- c("from", "to", "count")

  if (direct) {

    tmp <- (dplyr::group_by(tmp, from, to) %>% dplyr::summarise(count = sum(count)))

    colnames(tmp) <- cols

    return(as.data.frame(tmp))

  }

  com <- \(group1, group2, levels){

    factor(c(group1, group2), levels = levels) %>% sort()

  }

  group <- factor(c(tmp[, 1], tmp[, 2]))

  tmp1 <- apply(tmp, 1, function(x) com(x[1], x[2], levels(group))) %>%

    t() %>%

    as.data.frame()

  tmp1 <- cbind(tmp1, tmp$count)

  colnames(tmp1) <- c("from", "to", "count")

  tmp1 <- dplyr::group_by(tmp1, from, to) %>% dplyr::summarise(count = sum(count))

  colnames(tmp1) <- cols

  return(as.data.frame(tmp1))

}

#' Get skeleton network according to a group

#'

#' @param go network

#' @param Group vertex column name

#' @param count take which column count, default: NULL

#' @param top_N top_N

#'

#' @return skeleton network

#' @export

#' @family topological

#' @examples

#' get_group_skeleton(co_net) -> ske_net

#' skeleton_plot(ske_net)

get_group_skeleton <- function(go, Group = "v_class", count = NULL, top_N = 8) {

  name <- v_group <- n <- NULL

  stopifnot(is_igraph(go))

  direct <- igraph::is_directed(go)

  if (!Group %in% vertex_attr_names(go)) stop("no Group named ", Group, " !")

  get_v(go) -> tmp_v

  tmp_v %>% dplyr::select(name, !!Group) -> nodeGroup

  colnames(nodeGroup) <- c("name", "Group")

  nodeGroup$Group <- as.factor(nodeGroup$Group)

  # summary edges counts in each e_type

  suppressMessages(anno_edge(go, nodeGroup) %>% get_e() -> edge)

  {

    if (is.null(count)) {

      edge$count <- 1

    } else {

      edge$count <- edge[, count]

    }

  }

  bb <- data.frame()

  for (i in unique(edge$e_type)) {

    tmp <- edge[edge$e_type == i, c("Group_from", "Group_to", "count")]

    tmp <- dplyr::mutate_if(tmp, is.factor, as.character)

    # tmp=pcutils:::gettop(tmp,top_N)

    bb <- rbind(bb, data.frame(summ_2col(tmp,

      direct = direct

    ), e_type = i))

  }

  tmp_go <- igraph::graph_from_data_frame(bb, directed = direct)

  nodeGroup <- cbind_new(nodeGroup, data.frame(v_group = tmp_v$v_group))

  # nodeGroup=mutate_all(nodeGroup,as.character)

  # nodeGroup=rbind(nodeGroup,c("others","others","others"))

  dplyr::distinct(nodeGroup, Group, v_group) %>% tibble::column_to_rownames("Group") -> v_group_tab

  V(tmp_go)$v_group <- v_group_tab[V(tmp_go)$name, "v_group"]

  V(tmp_go)$v_class <- V(tmp_go)$name

  V(tmp_go)$size <- stats::aggregate(tmp_v$size, by = list(tmp_v[, Group]), sum) %>%

    tibble::column_to_rownames("Group.1") %>%

    .[V(tmp_go)$name, "x"]

  suppressWarnings({

    V(tmp_go)$count <- tmp_v %>%

      dplyr::group_by_(Group) %>%

      dplyr::count() %>%

      tibble::column_to_rownames(Group) %>%

      .[V(tmp_go)$name, "n"]

  })

  tmp_go <- c_net_update(tmp_go, initialize = TRUE)

  get_e(tmp_go) -> tmp_e

  E(tmp_go)$width <- E(tmp_go)$label <- tmp_e$count

  graph.attributes(tmp_go)$n_type <- "skeleton"

  graph.attributes(tmp_go)$skeleton <- Group

  tmp_go

}

#' Skeleton plot

#'

#' @param ske_net skeleton

#' @param split_e_type split by e_type? default: TRUE

#' @param ... additional parameters for \code{\link[igraph]{igraph.plotting}}

#'

#' @export

#' @rdname get_group_skeleton

skeleton_plot <- function(ske_net, split_e_type = TRUE, ...) {

  e_type <- NULL

  params <- list(...)

  tmp_go <- ske_net

  if (get_n(tmp_go)$n_type != "skeleton") stop("Not a skeleton network")

  get_e(tmp_go) -> tmp_e

  if (split_e_type) {

    for (i in unique(tmp_e$e_type)) {

      # main plot

      tmp_go1 <- c_net_filter(tmp_go, e_type == i, mode = "e")

      do.call(c_net_plot, pcutils::update_param(

        list(go = tmp_go1, legend_number = TRUE, edge_width_range = c(1, 5)), params

      ))

    }

  } else {

    tmp_go <- clean_multi_edge_metanet(tmp_go)

    do.call(c_net_plot, pcutils::update_param(

      list(go = tmp_go, legend_number = TRUE, edge_width_range = c(1, 5)), params

    ))

  }

}

# 整理skeleton网络的边，使其尽量不重叠。

# 1.from-to都是自己时，添加edge.loop.angle

# 2.from-to一致时，添加edge.curved

# 3.from-to刚好相反时，添加edge.curved

#' Clean multi edge metanet to plot

#' @param go metanet object

#'

#' @return metanet object

#' @export

#'

#' @examples

#' g <- igraph::make_ring(2)

#' g <- igraph::add.edges(g, c(1, 1, 1, 1, 2, 1))

#' plot(g)

#' plot(clean_multi_edge_metanet(g))

clean_multi_edge_metanet <- function(go) {

  tmp_e <- get_e(go)

  tmp_e$loop.angle <- 0

  # tmp_e$curved=0

  summ_2col(tmp_e[, c("from", "to")], direct = FALSE) -> e_count

  filter(e_count, count > 1) -> multi_e_count

  for (i in seq_len(nrow(multi_e_count))) {

    from <- multi_e_count$from[i]

    to <- multi_e_count$to[i]

    count <- multi_e_count$count[i]

    if (from == to) {

      tmp_e[tmp_e$from == from & tmp_e$to == to, "loop.angle"] <- seq(0, 2 * pi, length = count + 1)[-(count + 1)]

    }

    # else {

    #   tmp_e[tmp_e$from%in%c(from,to) & tmp_e$to%in%c(from,to),"curved"] <- 0.2 # seq(0,1,length=count)

    # }

  }

  #   summ_2col(tmp_e[,c("from","to")],direct = TRUE) -> e_count

  #   filter(e_count,count>1) -> multi_e_count

  #   for (i in seq_len(nrow(multi_e_count))) {

  #     from=multi_e_count$from[i]

  #     to=multi_e_count$to[i]

  #     count=multi_e_count$count[i]

  #     if(from!=to){

  #       tmp_e[tmp_e$from==from & tmp_e$to==to,"curved"] <- seq(0.2,1,length=count)

  #     }

  #   }

  igraph::edge.attributes(go) <- as.list(tmp_e)

  go

}

#' Link summary of the network

#'

#' @param go igraph or metanet

#' @param group summary which group of vertex attribution in names(vertex_attr(go))

#' @param e_type "positive", "negative", "all"

#' @param topN topN of group, default: 10

#' @param mode 1~2

#' @param colors colors

#' @param plot_param plot parameters

#'

#' @return plot

#' @export

#' @family topological

#' @examples

#' if (requireNamespace("circlize")) {

#'   links_stat(co_net, topN = 10)

#'   module_detect(co_net) -> co_net_modu

#'   links_stat(co_net_modu, group = "module")

#' }

#' if (requireNamespace("corrplot")) {

#'   links_stat(co_net, topN = 10, mode = 2)

#' }

links_stat <- function(go, group = "v_class", e_type = "all",

                       topN = 10, colors = NULL, mode = 1, plot_param = list()) {

  color <- v_class <- shape <- left_leg_x <- from <- to <- n <- NULL

  direct <- is_directed(go)

  go <- c_net_set(go, vertex_class = group)

  get_v(go) -> v_index

  v_index %>% dplyr::select("name", "v_class") -> map

  suppressMessages(anno_edge(go, map) %>% get_e() -> edge)

  # statistics

  if (e_type != "all") edge %>% dplyr::filter(e_type == !!e_type) -> edge

  summ_2col(edge[, paste0("v_class", c("_from", "_to"))], direct = direct) -> bb

  colnames(bb) <- c("from", "to", "count")

  dplyr::group_by(bb, from) %>%

    dplyr::summarise(n = sum(count)) %>%

    dplyr::arrange(-n) %>%

    dplyr::top_n(topN, n) %>%

    dplyr::pull(from) -> nnn

  # plot

  bb2 <- mutate(bb,

    from = ifelse(from %in% nnn, from, "Others"),

    to = ifelse(to %in% nnn, to, "Others")

  ) %>% summ_2col(direct = direct)

  if (mode == 1) {

    do.call(pcutils::my_circo, pcutils::update_param(

      list(

        df = bb2,

        reorder = FALSE,

        pal = colors

      ), plot_param

    ))

  }

  if (mode == 2) {

    tab <- pcutils::df2distance(bb2)

    tab2 <- tab

    tab2[tab2 > 0] <- 1

    tab2[tab2 != 1] <- 0

    # tab2 <- trans(tab, "pa") %>% as.matrix()

    do.call(corrplot::corrplot, pcutils::update_param(

      list(

        corr = tab2,

        type = "lower",

        method = "color",

        col = c("white", "white", "red"),

        addgrid.col = "black",

        cl.pos = "n",

        tl.col = "black"

      ),

      plot_param

    ))

  }

}

# 每个分组可以构建一个网络，每个网络都可以用link_stat得到一些互作的数量（互作强度），可以再看这些数量和分组间某些指标的相关性。