# ========4.1.other_plot========

#

#' Transfer an igraph object to a ggig

#'

#' @param go igraph or meatnet

#' @param coors coordinates for nodes,columns: name, X, Y

#'

#' @return ggig object

#' @export

#' @family plot

#' @examples

#' as.ggig(co_net, coors = c_net_layout(co_net)) -> ggig

#' plot(ggig)

#' as.ggig(multi1, coors = c_net_layout(multi1)) -> ggig

#' plot(ggig, labels_num = 0.3)

as.ggig <- function(go, coors = NULL) {

  list(n_index = get_n(go), v_index = get_v(go), e_index = get_e(go)) -> net_par_res

  if (is.null(coors)) coors <- c_net_layout(go)

  coors <- get_coors(coors, go)

  # add coors

  coors <- coors[, 1:3] %>% na.omit()

  net_par_res$v_index %<>% dplyr::left_join(., coors, by = "name", suffix = c("", ".1"))

  net_par_res$e_index %<>% dplyr::left_join(., coors, by = c("from" = "name")) %>%

    dplyr::rename(X1 = "X", Y1 = "Y") %>%

    dplyr::left_join(., coors, by = c("to" = "name")) %>%

    dplyr::rename(X2 = "X", Y2 = "Y")

  class(net_par_res) <- c("ggig", "list")

  return(net_par_res)

}

#' Plot a ggig

#'

#' @param x ggig object

#' @inheritParams c_net_plot

#'

#' @family plot

#' @return ggplot

#' @exportS3Method

#' @method plot ggig

plot.ggig <- function(x, coors = NULL, ..., labels_num = NULL,

                      vertex_size_range = NULL, edge_width_range = NULL,

                      plot_module = FALSE,

                      mark_module = FALSE, mark_color = NULL, mark_alpha = 0.3,

                      module_label = FALSE, module_label_cex = 2, module_label_color = "black",

                      module_label_just = c(0.5, 0.5),

                      legend_number = FALSE, legend = TRUE, legend_cex = 1,

                      legend_position = c(left_leg_x = -2, left_leg_y = 1, right_leg_x = 1.2, right_leg_y = 1),

                      group_legend_title = NULL, group_legend_order = NULL,

                      color_legend = TRUE, color_legend_order = NULL,

                      size_legend = FALSE, size_legend_title = "Node Size",

                      edge_legend = TRUE, edge_legend_title = "Edge type", edge_legend_order = NULL,

                      width_legend = FALSE, width_legend_title = "Edge width",

                      lty_legend = FALSE, lty_legend_title = "Edge class", lty_legend_order = NULL,

                      params_list = NULL,

                      seed = 1234) {

  if (!is.null(params_list)) {

    as.list(match.call()[-1]) -> set_params_list

    set_params_list[["params_list"]] <- NULL

    for (i in seq_along(params_list)) {

      if (names(params_list)[i] %in% names(set_params_list)) {

        message("The parameter `", names(params_list)[i], "` is duplicated, the format argument will be used.")

      }

    }

    pcutils::update_param(params_list, set_params_list) -> set_params_list

    do.call(c_net_plot, set_params_list)

    return(invisible())

  }

  rename <- size <- color <- e_type <- lty <- e_class <- v_class <- shape <- X1 <- Y1 <- X2 <- Y2 <- width <- X <- Y <- label <- NULL

  edge_width_text <- NULL

  ggig <- x

  ggig$v_index -> tmp_v

  ggig$e_index -> tmp_e

  set.seed(seed)

  # get coordinates

  if (!is.null(coors)) {

    tmp_v$X <- tmp_v$Y <- NULL

    tmp_e$X1 <- tmp_e$X2 <- tmp_e$Y1 <- tmp_e$Y2 <- NULL

    # add coors

    tmp_v %<>% dplyr::left_join(., coors, by = "name", suffix = c("", ".1"))

    tmp_e %<>% dplyr::left_join(., coors, by = c("from" = "name")) %>%

      rename(X1 = "X", Y1 = "Y") %>%

      dplyr::left_join(., coors, by = c("to" = "name")) %>%

      rename(X2 = "X", Y2 = "Y")

  }

  # get network type

  main <- get_net_main(ggig$n_index)

  # scale the size and width

  scale_size_width(tmp_v, tmp_e, vertex_size_range, edge_width_range)

  # new shapes

  tmp_v$shape <- tidai(tmp_v$v_group, 21:26)

  # some custom parameters

  some_custom_paras(tmp_v, tmp_e, ...)

  # show labels

  tmp_v <- get_show_labels(tmp_v, labels_num)

  if (TRUE) {

    tmp_e$e_type <- pcutils::change_fac_lev(tmp_e$e_type, edge_legend_order)

    edges <- levels(tmp_e$e_type)

    edge_cols <- dplyr::distinct(tmp_e, color, e_type)

    edge_cols <- setNames(edge_cols$color, edge_cols$e_type)

    if (legend_number) {

      eee <- table(tmp_e$e_type)

      edge_text <- paste(edges, eee[edges], sep = ": ")

    } else {

      edge_text <- edges

    }

  }

  if (TRUE) {

    edges1 <- levels(factor(tmp_e$e_class))

    edge_ltys <- dplyr::distinct(tmp_e, lty, e_class)

    edge_ltys <- setNames(edge_ltys$lty, edge_ltys$e_class)

    if (legend_number) {

      eee <- table(tmp_e$e_class)

      lty_text <- paste(edges1, eee[edges1], sep = ": ")

    } else {

      lty_text <- edges1

    }

  }

  if (TRUE) {

    vgroups <- pcutils::change_fac_lev(tmp_v$v_group, group_legend_order)

    node_size_text <- c(

      paste(lapply(node_size_text[levels(vgroups)], \(i)round(i[1], 3)), collapse = "/ "),

      paste(lapply(node_size_text[levels(vgroups)], \(i)round(i[2], 3)), collapse = "/ ")

    )

    new_f <- c()

    for (g_i in levels(vgroups)) {

      tmp_v1 <- tmp_v[tmp_v$v_group == g_i, c("v_class", "color", "shape")]

      tmp_f <- pcutils::change_fac_lev(tmp_v1$v_class, color_legend_order)

      new_f <- c(new_f, levels(tmp_f))

    }

    tmp_v$v_class <- pcutils::change_fac_lev(tmp_v$v_class, new_f)

    vclass <- levels(tmp_v$v_class)

    node_cols <- dplyr::distinct(tmp_v, color, v_class)

    node_cols <- setNames(node_cols$color, node_cols$v_class)

    node_shapes <- dplyr::distinct(tmp_v, shape, v_class)

    node_shapes <- setNames(node_shapes$shape, node_shapes$v_class)

    if (legend_number) {

      eee <- table(tmp_v$v_class)

      le_text <- paste(vclass, eee[vclass], sep = ": ")

    } else {

      le_text <- vclass

    }

  }

  p <- ggplot() +

    geom_segment(aes(

      x = X1, y = Y1, xend = X2, yend = Y2, color = e_type,

      linewidth = width, linetype = e_class

    ), data = tmp_e, alpha = 0.7) + # draw edges

    scale_color_manual(

      name = edge_legend_title, values = edge_cols,

      label = edge_text, guide = ifelse(edge_legend, "legend", "none")

    ) + # edge colors

    scale_linetype_manual(

      name = lty_legend_title, values = edge_ltys,

      label = lty_text, guide = ifelse(lty_legend, "legend", "none")

    ) + # edge linetype

    scale_linewidth(

      name = width_legend_title, breaks = c(min(tmp_e$width), max(tmp_e$width)), range = c(0.5, 1),

      labels = edge_width_text, guide = ifelse(width_legend, "legend", "none")

    )

  p1 <- p +

    geom_point(aes(X, Y, fill = v_class, size = size, shape = v_class), data = tmp_v) + # draw nodes

    # scale_shape_manual(values =setNames(default_v_shape[node_shapes],vclass))+#node shape

    scale_shape_manual(values = node_shapes) +

    scale_fill_manual(

      name = group_legend_title, values = node_cols[vclass],

      labels = le_text, guide = ifelse(color_legend, "legend", "none")

    ) + # node color

    scale_size(

      name = size_legend_title, breaks = c(min(tmp_v$size), max(tmp_v$size)),

      labels = node_size_text, guide = ifelse(size_legend, "legend", "none")

    ) + # node size

    ggnewscale::new_scale("size") +

    geom_text(aes(X, Y, size = size, label = label), col = "black", data = tmp_v, show.legend = FALSE) +

    scale_size(range = c(1, 3), guide = "none") +

    guides(

      fill = guide_legend(override.aes = list(shape = node_shapes[vclass])),

      shape = "none"

    )

  p2 <- p1 + labs(title = main) +

    scale_x_continuous(breaks = NULL) + scale_y_continuous(breaks = NULL) +

    coord_fixed(ratio = 1) +

    theme(panel.background = element_blank()) +

    theme(axis.title.x = element_blank(), axis.title.y = element_blank()) +

    theme(

      legend.background = element_rect(colour = NA),

      legend.box.background = element_rect(colour = NA),

      legend.key = element_rect(fill = NA)

    ) +

    theme(panel.background = element_rect(fill = "white", colour = NA)) +

    theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank())

  if (!legend) {

    return(p2 + theme(legend.position = "none"))

  }

  p2

}

#' Input a graphml file exported by Gephi

#'

#' @param file graphml file exported by Gephi

#' @family plot

#' @return list contains the igraph object and coordinates

#'

#' @export

input_gephi <- function(file) {

  X <- Y <- code <- NULL

  igraph::read.graph(file, format = "graphml") -> gephi

  get_v(gephi) -> tmp_v

  # extract coors

  if (!all(c("x", "y", "r", "g", "b", "id") %in% colnames(tmp_v))) {

    stop("This file is not exported by Gephi, please use igraph::read.graph()")

  }

  coors <- tmp_v[, c("x", "y")]

  coors <- data.frame(name = tmp_v$label, X = coors[, 1], Y = coors[, 2])

  class(coors) <- "coors"

  coors <- rescale_coors(coors)

  # transform color

  pcutils::rgb2code(tmp_v[, c("r", "g", "b")]) %>% dplyr::pull(code) -> tmp_v$color

  if ("cor" %in% edge.attributes(gephi)) {

    E(gephi)$color <- ifelse(E(gephi)$cor > 0, "#48A4F0", "#E85D5D")

  } else {

    E(gephi)$color <- "#48A4F0"

  }

  # scale size

  tmp_v$size <- pcutils::mmscale(tmp_v$size, 1, 5)

  E(gephi)$width <- pcutils::mmscale(E(gephi)$width, 0.05, 0.2)

  # delete

  tmp_v %>%

    dplyr::select(-c("label", "x", "y", "r", "g", "b", "id")) %>%

    as.list() -> vertex.attributes(gephi)

  edge.attributes(gephi)["Edge Label"] <- edge.attributes(gephi)["id"] <- NULL

  gephi <- c_net_update(gephi, initialize = TRUE)

  igraph::graph_attr(gephi, "coors") <- coors

  return(list(go = gephi, coors = coors))

}

#' Input a cyjs file exported by Cytoscape

#'

#' @param file cyjs file exported by Cytoscape

#' @family plot

#' @return list contains the igraph object and coordinates

#'

#' @export

input_cytoscape <- function(file) {

  c_net_load(file, format = "cyjs") -> cyto

  get_v(cyto) -> tmp_v

  coors <- tmp_v[, c("x", "y")]

  coors <- data.frame(name = tmp_v$name, X = coors[, 1], Y = coors[, 2])

  class(coors) <- "coors"

  coors <- rescale_coors(coors)

  cyto <- c_net_update(cyto, initialize = TRUE)

  igraph::graph_attr(cyto, "coors") <- coors

  return(list(go = cyto, coors = coors))

}

#' plot use networkD3

#'

#' @param go metanet

#' @param v_class which attributes use to be v_class

#' @param ... see \code{\link[networkD3]{forceNetwork}}

#' @return D3 plot

#' @export

#' @family plot

#' @examples

#' data("c_net")

#' plot(co_net2)

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

#'   netD3plot(co_net2)

#' }

netD3plot <- function(go, v_class = "v_class", ...) {

  flag <- "y"

  if (length(V(go)) > 200) {

    message("Too big network, recommend using Gephi to layout,still use networkD3?")

    flag <- readline("yes/no(y/n):")

  }

  if (tolower(flag) %in% c("yes", "y")) {

    lib_ps("networkD3", library = FALSE)

    go <- c_net_set(go, vertex_class = v_class)

    get_v(go) -> tmp_v

    nodes <- tmp_v[, c("name", "v_class", "size", "color")]

    colnames(nodes) <- c("name", "group", "size", "color")

    nodes$size <- pcutils::mmscale(nodes$size, 2, 40)

    colors <- unique(nodes$color)

    get_e(go) -> tmp_e

    links <- tmp_e[, c("from", "to", "width", "color")]

    links$width <- pcutils::mmscale(links$width, 0.5, 1.5)

    # give ids

    links$IDsource <- match(links$from, nodes$name) - 1

    links$IDtarget <- match(links$to, nodes$name) - 1

    # Create force directed network plot

    networkD3::forceNetwork(

      Links = links, Nodes = nodes,

      Source = "IDsource", Target = "IDtarget", linkColour = links$color, linkDistance = 20,

      linkWidth = networkD3::JS("function(d) { return (d.width); }"), charge = -5,

      NodeID = "name", Group = "group", Nodesize = "size",

      colourScale = networkD3::JS(paste0("d3.scaleOrdinal([`", paste(colors, collapse = "`,`"), "`])")), legend = TRUE, ...

    )

  }

}

MetaNet_theme <- {

  ggplot2::theme_classic(base_size = 13) + ggplot2::theme(

    axis.text = element_text(color = "black"),

    plot.margin = grid::unit(rep(0.5, 4), "lines"),

    strip.background = ggplot2::element_rect(fill = NA)

  )

}

#' Venn network

#'

#' @param tab data.frame (row is elements, column is group), or a list (names is group, value is elements)

#'

#' @return plot

#' @export

#' @family plot

#' @examples

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

#' tab <- otutab[400:485, 1:3]

#' venn_net(tab) -> v_net

#' plot(v_net)

venn_net <- function(tab) {

  # pcutils:::venn_cal(tab)->vennlist

  tab[is.na(tab)] <- 0

  edgelist <- data.frame()

  if (is.data.frame(tab)) {

    groupss <- colnames(tab)

    for (i in groupss) {

      if (sum(tab[, i] > 0) > 0) edgelist <- rbind(edgelist, data.frame(Group = i, elements = rownames(tab)[tab[, i] > 0]))

    }

  } else if (all(class(tab) == "list")) {

    vennlist <- tab

    groupss <- names(vennlist)

    for (i in groupss) {

      if (length(vennlist[[i]] > 0)) edgelist <- rbind(edgelist, data.frame(Group = i, elements = vennlist[[i]]))

    }

  } else {

    stop("wrong input tab")

  }

  nodelist <- rbind(

    data.frame(name = groupss, v_group = "Group", v_class = paste0("Group: ", groupss)),

    data.frame(name = unique(edgelist$elements), v_group = "elements", v_class = "elements")

  )

  venn_net <- c_net_from_edgelist(edgelist, vertex_df = nodelist)

  graph.attributes(venn_net)$n_type <- "venn"

  all_group <- get_e(venn_net)[, c("from", "to")] %>%

    pcutils::squash("from") %>%

    dplyr::rename(name = "to", all_group = "from")

  venn_net <- c_net_set(venn_net, all_group, vertex_class = "all_group", edge_type = "from")

  venn_net

}

#' Quick build a metanet from two columns table

#'

#' @param edgelist two columns table (no elements exist in two columns at same time)

#'

#' @return metanet

#' @export

#' @family plot

#' @examples

#' twocol <- data.frame(

#'   "col1" = sample(letters, 30, replace = TRUE),

#'   "col2" = sample(c("A", "B"), 30, replace = TRUE)

#' )

#' twocol_net <- twocol_edgelist(twocol)

#' plot(twocol_net)

#' c_net_plot(twocol_net, g_layout_polygon(twocol_net))

twocol_edgelist <- function(edgelist) {

  if (any(edgelist[, 1] %in% edgelist[, 2])) stop("Must no elements exist in two columns at same time")

  nodelist <- rbind(

    data.frame(name = unique(edgelist[, 1]), v_group = names(edgelist)[1], v_class = names(edgelist)[1]),

    data.frame(name = unique(edgelist[, 2]), v_group = names(edgelist)[2], v_class = names(edgelist)[2])

  )

  venn_net <- c_net_from_edgelist(edgelist, vertex_df = nodelist)

  graph.attributes(venn_net)$n_type <- "twocol"

  # venn_net=c_net_set(venn_net,edge_type = "from")

  venn_net

}

#' Transform a dataframe to a network edgelist.

#'

#' @param test df

#' @param fun default: sum

#'

#' @return metanet

#' @export

#'

#' @examples

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

#' cbind(taxonomy, num = rowSums(otutab))[1:20, ] -> test

#' df2net_tree(test) -> ttt

#' plot(ttt)

#' if (requireNamespace("ggraph")) plot(ttt, coors = as_circle_tree())

df2net_tree <- function(test, fun = sum) {

  flag <- FALSE

  if (!is.numeric(test[, ncol(test)])) {

    test$num <- 1

  } else {

    flag <- TRUE

    name <- colnames(test)[ncol(test)]

  }

  nc <- ncol(test)

  if (nc < 3) stop("as least 3-columns dataframe")

  link <- pcutils::df2link(test, fun = fun)

  nodes <- link$nodes

  links <- link$links

  if (flag) {

    colnames(links)[3] <- colnames(nodes)[3] <- name

  } else {

    name <- "weight"

  }

  # c_net_from_edgelist(as.data.frame(links),vertex = nodes)

  net <- igraph::graph_from_data_frame(as.data.frame(links), vertices = nodes)

  net <- c_net_set(net, vertex_class = "level", vertex_size = name, edge_width = name)

  net <- c_net_update(net, initialize = TRUE, verbose = FALSE)

  graph_attr(net, "coors") <- c_net_layout(net, as_tree())

  net

}

#' Plot olympic rings using network

#'

#' @return network plot

#' @export

#' @family plot

#' @examples

#' olympic_rings_net()

olympic_rings_net <- function() {

  r <- 1

  pensize <- r / 6

  rings_data <- data.frame(

    x = c(-2 * (r + pensize), -(r + pensize), 0, (r + pensize), 2 * (r + pensize)),

    y = c(r, 0, r, 0, r),

    color = c("#0081C8", "#FCB131", "#000000", "#00A651", "#EE334E")

  )

  g1 <- module_net(module_number = 5, n_node_in_module = 30)

  plot(g1,

    coors = g_layout(g1, layout1 = rings_data[, 1:2], zoom1 = 1.2, zoom2 = 0.5),

    rescale = FALSE, legend = FALSE, main = "Olympic Rings", vertex.frame.color = NA,

    edge.width = 0, vertex.color = setNames(rings_data$color, 1:5), vertex.size = 7

  )

}