#' Place nodes in a Hive Plot layout
#'
#' Hive plots were invented by Martin Krzywinski as a perceptually uniform and
#' scalable alternative to standard node-edge layouts. In hive plots nodes are
#' positioned on axes radiating out from a center based on their own information
#' e.g. membership of a class, size of neighborhood, etc. Edges are then drawn
#' between nodes as bezier curves. As the placement of nodes is not governed by
#' convoluted algorithms but directly reflects the qualities of the nodes itself
#' the resulting plot can be easier to interpret as well as compare to other
#' graphs.
#'
#' @details
#' In order to be able to draw all edges without edges crossing axes you should
#' not assign nodes to axes based on a variable with more than three levels.
#'
#' @param graph An `tbl_graph` object
#'
#' @param axis The node attribute to use for assigning nodes to axes
#'
#' @param axis.pos The relative distance to the prior axis. Default
#' (`NULL`) places axes equidistant.
#'
#' @param sort.by The node attribute to use for placing nodes along their axis.
#' Defaults (`NULL`) places nodes sequentially.
#'
#' @param divide.by An optional node attribute to subdivide each axis by.
#'
#' @param divide.order The order the axis subdivisions should appear in
#'
#' @param normalize Logical. Should axis lengths be equal or reflect the number
#' of nodes in each axis. Defaults to `TRUE`.
#'
#' @param center.size The size of the blank center, that is, the start position
#' of the axes.
#'
#' @param divide.size The distance between subdivided axis segments.
#'
#' @param use.numeric Logical, If the `sort.by` attribute is numeric,
#' should these values be used directly in positioning the nodes along the axes.
#' Defaults to `FALSE` which sorts the numeric values and positions them
#' equidistant from each other.
#'
#' @param offset Change the overall rotation of the hive plot by changing the
#' offset of the first axis.
#'
#' @param split.axes Should axes be split to show edges between nodes on the
#' same axis? One of:
#' \describe{
#'   \item{`'none'`}{Do not split axes and show in-between edges}
#'   \item{`'loops'`}{Only split axes that contain in-between edges}
#'   \item{`'all'`}{Split all axes}
#' }
#'
#' @param split.angle The angular distance between the two axes resulting from a
#' split.
#'
#' @param circular Ignored.
#'
#' @return A data.frame with the columns `x`, `y`, `r`,
#' `center_size`, `split`, `axis`, `section`, `angle`,
#' `circular` as well as any information stored as node variables in the
#' tbl_graph object.
#'
#' @references
#' Krzywinski, M., Birol, I., Jones, SJM., and Marra, MA. (2012). *Hive
#' plots-rational approach to visualizing networks*. Brief Bioinform 13 (5):
#' 627-644. https://doi.org/10.1093/bib/bbr069
#'
#' @family layout_tbl_graph_*
#'
#' @importFrom igraph gorder vertex_attr gsize induced_subgraph add_vertices E ends add_edges delete_edges %--% edge_attr
#' @importFrom utils tail
layout_tbl_graph_hive <- function(
  graph,
  axis,
  axis.pos = NULL,
  sort.by = NULL,
  divide.by = NULL,
  divide.order = NULL,
  normalize = TRUE,
  center.size = 0.1,
  divide.size = 0.05,
  use.numeric = FALSE,
  offset = pi / 2,
  split.axes = 'none',
  split.angle = pi / 6,
  circular = FALSE
) {
  axis <- enquo(axis)
  axis <- eval_tidy(axis, .N())
  sort.by <- enquo(sort.by)
  sort.by <- eval_tidy(sort.by, .N())
  divide.by <- enquo(divide.by)
  divide.by <- eval_tidy(divide.by, .N())

  axes <- split(seq_len(gorder(graph)), axis)
  if (is.null(axis.pos)) {
    axis.pos <- rep(1, length(axes))
  } else {
    if (length(axis.pos) != length(axes)) {
      cli::cli_warn(
        'Number of axes {.val {length(axes)}} not matching {.arg axis.pos} argument. Recycling as needed'
      )
      axis.pos <- rep(axis.pos, length.out = length(axes))
    }
  }
  axis.pos <- -cumsum(axis.pos)
  axis.pos <- c(0, axis.pos[-length(axis.pos)]) /
    -tail(axis.pos, 1) *
    2 *
    pi +
    offset
  if (use.numeric) {
    if (is.null(sort.by) || !is.numeric(sort.by)) {
      cli::cli_abort(
        '{.arg sort.by} must be a numeric vertex attribute when {.code use.numeric = TRUE}'
      )
    }
    numeric.range <- range(sort.by)
  }
  if (normalize) {
    normalize_to <- rep(1, length(axes))
  } else {
    normalize_to <- lengths(axes) / max(lengths(axes))
  }
  node.pos <- Map(
    function(nodes, axis_length, axis, angle) {
      if (length(nodes) == 0) {
        return(data_frame0())
      }
      split_axis <- switch(
        split.axes,
        all = TRUE,
        loops = gsize(induced_subgraph(graph, nodes)) > 0,
        none = FALSE,
        cli::cli_abort(
          'Unknown {.arg split} argument. Use {.val all}, {.val loops} or {.val none}'
        )
      )
      node_div <- axis_length / length(nodes)
      if (is.null(divide.by)) {
        node_split <- list(`1` = nodes)
      } else {
        if (use.numeric) {
          cli::cli_abort('Cannot divide axis when {.code use.numeric = TRUE}')
        }
        node_split <- split(nodes, divide.by[nodes])
        if (!is.null(divide.order)) {
          if (!all(divide.order %in% names(node_split))) {
            cli::cli_abort(
              'All {.arg divide.by} levels must be present in {.arg divide.order}'
            )
          }
          node_split <- node_split[order(match(
            names(node_split),
            divide.order
          ))]
        }
      }
      node_pos <- lapply(node_split, function(nodes) {
        if (length(nodes) == 0) {
          return(numeric())
        }
        if (is.null(sort.by)) {
          pos <- match(seq_along(nodes), order(nodes)) - 1
          pos <- pos * node_div
        } else {
          pos <- sort.by[nodes]
          if (use.numeric) {
            if (!is.numeric(pos)) {
              cli::cli_abort(
                '{.arg sort.by} must contain numeric data when {.code use.numeric = TRUE}'
              )
            }
            if (normalize) {
              if (diff(range(pos)) == 0) {
                pos <- rep(0.5, length.out = length(pos))
              } else {
                pos <- (pos - min(pos)) / diff(range(pos))
              }
            } else {
              pos <- (pos - numeric.range[1]) / diff(numeric.range)
            }
          } else {
            pos <- match(seq_along(pos), order(pos)) - 1
            pos <- pos * node_div
          }
        }
        pos
      })
      node_pos <- Reduce(
        function(l, r) {
          append(l, list(r + node_div + divide.size + max(l[[length(l)]])))
        },
        x = node_pos[-1],
        init = node_pos[1]
      )
      node_pos <- unlist(node_pos) + center.size

      data_frame0(
        node = nodes,
        r = node_pos[match(nodes, unlist(node_split))],
        center_size = center.size,
        split = split_axis,
        axis = axis,
        section = rep(names(node_split), lengths(node_split))[match(
          nodes,
          unlist(node_split)
        )],
        angle = angle,
        circular = FALSE
      )
    },
    nodes = axes,
    axis_length = normalize_to,
    axis = names(axes),
    angle = axis.pos
  )
  for (i in seq_along(node.pos)) {
    if (nrow(node.pos[[i]]) > 0 && node.pos[[i]]$split[1]) {
      n_new_nodes <- nrow(node.pos[[i]])
      new_node_start <- gorder(graph) + 1
      extra_nodes <- node.pos[[i]]
      extra_nodes$node <- seq(new_node_start, length.out = n_new_nodes)
      vattr <- lapply(vertex_attr(graph), `[`, i = node.pos[[i]]$node)
      graph <- add_vertices(graph, n_new_nodes, attr = vattr)

      loop_edges <- E(graph)[node.pos[[i]]$node %--% node.pos[[i]]$node]
      if (length(loop_edges) != 0) {
        loop_edges_ends <- ends(graph, loop_edges, names = FALSE)
        correct_order_ends <- node.pos[[i]]$r[match(
          loop_edges_ends[, 1],
          node.pos[[i]]$node
        )] <
          node.pos[[i]]$r[match(loop_edges_ends[, 2], node.pos[[i]]$node)]
        loop_edges_ends <- data_frame0(
          from = ifelse(
            correct_order_ends,
            loop_edges_ends[, 1],
            loop_edges_ends[, 2]
          ),
          to = ifelse(
            correct_order_ends,
            loop_edges_ends[, 2],
            loop_edges_ends[, 1]
          )
        )
        loop_edges_ends$to <- extra_nodes$node[match(
          loop_edges_ends$to,
          node.pos[[i]]$node
        )]
        loop_edges_ends <- matrix(
          c(
            ifelse(
              correct_order_ends,
              loop_edges_ends$from,
              loop_edges_ends$to
            ),
            ifelse(correct_order_ends, loop_edges_ends$to, loop_edges_ends$from)
          ),
          nrow = 2,
          byrow = TRUE
        )
        eattr <- lapply(edge_attr(graph), `[`, i = as.numeric(loop_edges))
        graph <- add_edges(graph, as.vector(loop_edges_ends), attr = eattr)
        graph <- delete_edges(graph, as.numeric(loop_edges))
      }

      node_correction <- unlist(lapply(node.pos[-i], function(ax) {
        correct <- if (ax$angle[1] < node.pos[[i]]$angle[1]) {
          ax$angle[1] - node.pos[[i]]$angle[1] < -pi
        } else {
          ax$angle[1] - node.pos[[i]]$angle[1] < pi
        }
        if (correct) ax$node
      }))
      if (length(node_correction) != 0) {
        correct_edges <- E(graph)[node.pos[[i]]$node %--% node_correction]
        correct_edges_ends <- ends(graph, correct_edges, names = FALSE)
        new_node_ind <- correct_edges_ends %in% node.pos[[i]]$node
        correct_edges_ends[new_node_ind] <- extra_nodes$node[match(
          correct_edges_ends[new_node_ind],
          node.pos[[i]]$node
        )]
        eattr <- lapply(edge_attr(graph), `[`, i = as.numeric(correct_edges))
        graph <- add_edges(
          graph,
          as.vector(t(correct_edges_ends)),
          attr = eattr
        )
        graph <- delete_edges(graph, as.numeric(correct_edges))
      }

      node.pos[[i]]$angle <- node.pos[[i]]$angle - split.angle / 2
      extra_nodes$angle <- extra_nodes$angle + split.angle / 2
      node.pos <- append(node.pos, list(extra_nodes))
    }
  }
  node.pos <- lapply(node.pos, function(nodes) {
    if (nrow(nodes) > 0) {
      nodes$x <- nodes$r * cos(nodes$angle)
      nodes$y <- nodes$r * sin(nodes$angle)
    }
    nodes
  })
  node.pos <- vec_rbind(!!!node.pos)
  node.pos <- node.pos[order(node.pos$node), names(node.pos) != 'node']
  extra_data <- as_tibble(as_tbl_graph(graph), active = 'nodes')
  node.pos <- cbind(
    node.pos,
    extra_data[, !names(extra_data) %in% names(node.pos), drop = FALSE]
  )
  attr(node.pos, 'graph') <- as_tbl_graph(graph)
  node.pos
}
