R/geneviewer.R

Defines functions GC_links get_links GC_normalize GC_align GC_cluster GC_tooltip GC_trackMouse GC_annotation GC_legend GC_color GC_transcript GC_genes GC_coordinates GC_labels GC_clusterFooter GC_clusterLabel GC_scaleBar GC_scale GC_grid GC_sequence GC_clusterTitle GC_title GC_chart

Documented in GC_align GC_annotation GC_chart GC_cluster GC_clusterFooter GC_clusterLabel GC_clusterTitle GC_color GC_coordinates GC_genes GC_grid GC_labels GC_legend GC_links GC_normalize GC_scale GC_scaleBar GC_sequence GC_title GC_tooltip GC_trackMouse GC_transcript

#' @importFrom magrittr %>%
#' @export
magrittr::`%>%`

#' Create a GC Chart Visualization
#'
#' Generates an interactive GC chart for genomic data.
#'
#' @param data Data frame containing genomic information or the file path to a
#'   folder containing `.gbk` files. When providing a file path, the data is
#'   loaded and processed into a data frame internally.
#' @param start Column name that indicates start positions. Default is "start".
#' @param end Column name that indicates end positions. Default is "end".
#' @param cluster Optional column name used for clustering purposes. Default is
#'   NULL.
#' @param group Column name used for gene grouping to influence color
#'   aesthetics.
#' @param strand Optional column name indicating strand orientation. Acceptable
#'   values include 1, 'forward', 'sense', or '+' to represent the forward
#'   strand, and -1, 0, 'reverse', 'antisense', "complement" or '-' to represent
#'   the reverse strand. Default is NULL, meaning strand information is not
#'   used.
#' @param width Width specification for the chart, such as '100\%' or 500.
#'   Default is unspecified.
#' @param height Height specification for the chart, such as '400px' or 300.
#'   Default is unspecified.
#' @param style A list of CSS styles to be applied to the chart container. Each
#'   element of the list should be a valid CSS property-value pair. For example,
#'   list(backgroundColor = "white", border = "2px solid black"). Default is an
#'   empty list.
#' @param elementId Optional identifier string for the widget. Default is NULL.
#' @param save_button Logical, whether to include a save button. Default is TRUE.
#'
#' @return A GC chart widget.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 50, 90, 130, 170, 210),
#'   end = c(40, 80, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 1, 2, 2, 2)
#' )
#' # Load from data.frame
#' GC_chart(genes_data, group = "group", cluster = "cluster", height = "200px") %>%
#' GC_labels("name")
#'
#' # Load from folder containing .gbk files
#' # file_path <- "~/path/to/folder/"
#' # GC_chart(file_path) %>%
#'
#' @import htmlwidgets
#' @import fontawesome
#' @export
GC_chart <- function(data, start = "start", end = "end", cluster = NULL, group = NULL, strand = NULL, width = "100%", height = "400px", style = list(), elementId = NULL, save_button = TRUE) {

  x <- list()
  # Capture all arguments with their current values
  x$params <- as.list(environment())
  x$params$data <- NULL
  x$params <- Filter(function(y) !is.null(y) && !(is.list(y) && length(y) == 0), x$params)


  # Load from .gbk files
  if (is.character(data)) {
    gbk <- geneviewer::read_gbk(data) # Adjust based on actual function call
    data <- geneviewer::gbk_features_to_df(gbk, feature = "CDS", keys = c("protein_id", "region", "translation"))
    data <- data[!is.na(data[[start]]) & !is.na(data[[end]]), ]
    cluster <- "cluster"
    strand <- "strand"
  }

  # ensure that data is a data frame
  stopifnot(is.data.frame(data))

  # Check if column names are in the data frame
  colnames_data <- colnames(data)

  if (!(start %in% colnames_data)) stop("start column not found in data")
  if (!(end %in% colnames_data)) stop("end column not found in data")

  if (!is.null(cluster) && !(cluster %in% colnames_data)) {
    stop("cluster column not found in data")
  }
  if (!is.null(group) && !(group %in% colnames_data)) {
    stop("group column not found in data")
  }
  if (!is.null(strand) && !(strand %in% colnames_data)) {
    stop("strand column not found in data")
  }

  show_legend <- if (!is.null(group)) TRUE else FALSE

  # Filter out rows with NA values in 'start' or 'end' columns
  original_nrow <- nrow(data)
  data <- data[!is.na(data[[start]]) & !is.na(data[[end]]), ]

  # Check if any rows were filtered out and issue a warning
  if (nrow(data) < original_nrow) {
    warning("Rows with NA values in 'start' or 'end' columns have been filtered out.")
  }

  # Add rowID to data
  data$rowID <- seq_len(nrow(data))

  # add start and end
  data_tmp <- data
  data$start <- data_tmp[[start]]
  data$end <- data_tmp[[end]]

  # Convert cluster to character
  if(!is.null(cluster)){
  data[[cluster]] <- as.character(data[[cluster]])
  }

  # Add strand if specified
  data <- add_strand(data, strand)

  x$data <- data
  x$links <- NULL
  x$group <- group
  x$cluster <- cluster
  x$graphContainer$direction <- "column"
  x$style <- style
  x$title$style <- list(width = "100%")
  x$legend <- list(
    group = group, show = show_legend, position = "bottom",
    width = width
  )
  x$legend$style <- list(width = "100%", backgroundColor = style$backgroundColor)
  x$saveButton <- save_button


  if (is.null(cluster)) {
    clusters <- "cluster"
  } else {
    clusters <- unique(as.character(data[[cluster]]))
  }

  for (clust in clusters) {
    # Subset data for the current cluster
    if (is.null(cluster)) {
      subset_data <- data
    } else {
      subset_data <- data[data[[cluster]] == clust, ]
    }

    # add cluster
    subset_data$cluster <- clust

    # Data
    x$series[[clust]]$clusterName <- clust
    x$series[[clust]]$data <- subset_data
    x$series[[clust]]$cluster <- list()
    x$series[[clust]]$container <- list(height = get_relative_height(height, height) / length(clusters), width = width)
    x$series[[clust]]$container$style <- list(width = "100%", backgroundColor = style$backgroundColor)
    x$series[[clust]]$genes <- list(group = group, show = TRUE)
    x$series[[clust]]$sequence <- list(show = TRUE)
    x$series[[clust]]$scale <- list(xMin = min(subset_data$start, subset_data$end), xMax = max(subset_data$start, subset_data$end))
    x$series[[clust]]$transcript <- list(group = group, show = FALSE)
    x$series[[clust]]$labels <- list(group = group, show = TRUE)
    x$series[[clust]]$coordinates <- list(show = FALSE)
    x$series[[clust]]$scaleBar <- list()
    x$series[[clust]]$footer <- list()
    x$series[[clust]]$clusterLabel <- list()
    x$series[[clust]]$clusterTitle <- list()
    x$series[[clust]]$annotations <- list()
    x$series[[clust]]$trackMouse <- list(show = FALSE)

    # Blast specific settings
    if(all(c("BlastP", "protein_id") %in% colnames_data)){
      formatter <-
        "<b>{protein_id}</b><br>
        <b>BlastP hit with:</b> {BlastP}<br>
        <b>Identity:</b> {identity}%<br>
        <b>Similarity:</b> {similarity}%<br>
        <b>Location:</b> {start} - {end}<br>"
    } else {
      formatter <-
        "<b>Start:</b> {start}<br><b>End:</b> {end}"
    }
    x$series[[clust]]$tooltip <-
      formatter <- list(
        show = TRUE,
        formatter = formatter
      )
  }

  # Determine dependencies
  dependencies <- if (save_button) {
    list(fontawesome::fa_html_dependency())
  } else {
    NULL
  }

  # create the widget
  htmlwidgets::createWidget(
    name = "geneviewer",
    x,
    width = width,
    height = height,
    package = "geneviewer",
    dependencies = dependencies,
    elementId = elementId
  )
}

#' Add Title to a GC_chart
#'
#' Modify the cluster title and subtitle of specified clusters within a GC chart and adjust
#' the display settings.
#'
#' @param GC_chart A GC chart object.
#' @param title Character vector. Titles to set for the clusters.
#' @param subtitle Character vector. Subtitles to set for the clusters.
#' @param show Logical. Whether to display the title. Default is TRUE.
#' @param height Character. Height for the title (e.g., "50px").
#' @param style A list of CSS styles to be applied to the chart container. Each
#'   element of the list should be a valid CSS property-value pair. For example,
#'   list(backgroundColor = "white", border = "2px solid black").
#'   Default is an empty list.
#' @param titleFont List. Settings for the title font.
#' @param subtitleFont List. Settings for the subtitle font.
#' @param ... Additional customization arguments for title and subtitle.
#'
#' @return Updated GC chart with new title settings.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 50, 90, 130, 170, 210),
#'   end = c(40, 80, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 1, 2, 2, 2)
#' )
#'
#' # Basic usage
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "400px") %>%
#' GC_labels("name") %>%
#' GC_title(
#'   title = "Cluster 1 Data",
#'   subtitle = "Detailed View",
#'   show = TRUE
#' )
#'
#' # Customizing title style
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "500px") %>%
#'   GC_labels("name") %>%
#'   GC_title(
#'     title = "Cluster 1 Data",
#'     subtitle = "Detailed View",
#'     show = TRUE,
#'     height = "50px",
#'     cluster = 1,
#'     x = 0,
#'     y = 25, # height / 2
#'     align = "center",
#'     spacing = 20,
#'     style = list(
#'       backgroundColor = "#0000"
#'       # Any other CSS styles
#'     ),
#'     titleFont = list(
#'       fontSize = "16px",
#'       fontStyle = "normal",
#'       fontWeight = "bold",
#'       textDecoration = "normal",
#'       fontFamily = "sans-serif",
#'       cursor = "default",
#'       fill = "black"
#'       # Any other CSS styles
#'     ),
#'     subtitleFont = list(
#'       fontSize = "14px",
#'       fontStyle = "normal",
#'       fontWeight = "bold",
#'       textDecoration = "normal",
#'       fontFamily = "sans-serif",
#'       cursor = "default",
#'       fill = "black"
#'       # Any other CSS styles
#'     )
#'   )
#'
#' @export
GC_title <- function(
    GC_chart,
    title = NULL,
    subtitle = NULL,
    style = list(),
    subtitleFont = list(),
    titleFont = list(),
    show = TRUE,
    height = NULL,
    ...
) {

  if (!show || is.null(title) && is.null(subtitle)) {
    return(GC_chart)
  }

  if (is.null(height)) {
    if (!is.null(title) && !is.null(subtitle)) {
      height <- 50
    } else if (!is.null(title) || !is.null(subtitle)) {
      height <- 30
    }
  }

  # Capture arguments and filter out NULL or empty values
  options <- Filter(function(x) !is.null(x) && length(x) > 0, list(
      title = title,
      subtitle = subtitle,
      subtitleFont = subtitleFont,
      titleFont = titleFont,
      style = style,
      height = height,
      show = show,
      ...
    ))

  # Merge new options with existing options
  if (is.null(GC_chart$x$title)) {
    GC_chart$x$title <- options
  } else {
    GC_chart$x$title <- modifyList(GC_chart$x$title, options)
  }

  return(GC_chart)
}

#' Update cluster Title of a GC Chart Cluster
#'
#' Modify the cluster title and subtitle of specified clusters within a GC chart and adjust
#' the display settings.
#'
#' @param GC_chart A GC chart object.
#' @param title Character vector. Titles to set for the clusters.
#' @param subtitle Character vector. Subtitles to set for the clusters.
#' @param show Logical. Whether to display the title. Default is TRUE.
#' @param height Character. Height for the title (e.g., "40px").
#' @param cluster Numeric or character vector. Clusters in the GC chart to update.
#' @param titleFont List. Settings for the title font.
#' @param subtitleFont List. Settings for the subtitle font.
#' @param ... Additional customization arguments for title and subtitle.
#'
#' @return Updated GC chart with new title settings.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 50, 90, 130, 170, 210),
#'   end = c(40, 80, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 1, 2, 2, 2)
#' )
#'
#' # Basic usage
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "400px") %>%
#' GC_labels("name") %>%
#' GC_clusterTitle(
#'   title = "Cluster 1 Data",
#'   subtitle = "Detailed View",
#'   show = TRUE,
#'   cluster = 1
#' )
#'
#' # Customizing title style
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "400px") %>%
#'   GC_labels("name") %>%
#'   GC_clusterTitle(
#'     title = "Cluster 1 Data",
#'     subtitle = "Detailed View",
#'     show = TRUE,
#'     cluster = 1,
#'     x = 0,
#'     y = 5,
#'     align = "center",
#'     spacing = 20,
#'     titleFont = list(
#'       fontSize = "16px",
#'       fontStyle = "normal",
#'       fontWeight = "bold",
#'       textDecoration = "normal",
#'       fontFamily = "sans-serif",
#'       cursor = "default",
#'       fill = "black"
#'       # Any other CSS styles
#'     ),
#'     subtitleFont = list(
#'       fontSize = "14px",
#'       fontStyle = "normal",
#'       fontWeight = "bold",
#'       textDecoration = "normal",
#'       fontFamily = "sans-serif",
#'       cursor = "default",
#'       fill = "black"
#'       # Any other CSS styles
#'     )
#'   )
#' @export
GC_clusterTitle <- function(
    GC_chart,
    title = NULL,
    subtitle = NULL,
    subtitleFont = list(),
    titleFont = list(),
    show = TRUE,
    height = NULL,
    cluster = NULL,
    ...) {
  if (!show) {
    return(GC_chart)
  }

  # Capture ... arguments
  dots <- list(...)

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for (i in seq_along(clusters)) {
    # Default options
    options <- list(
      title = title[(i - 1) %% length(title) + 1],
      subtitle = subtitle[(i - 1) %% length(subtitle) + 1],
      subtitleFont = subtitleFont,
      titleFont = titleFont,
      show = show
    )

    # Add arguments to options
    for (name in names(dots)) {
      options[[name]] <- dots[[name]][(i - 1) %% length(dots[[name]]) + 1]
    }

    # Set height for each cluster
    GC_chart$x$series[[clusters[i]]]$grid$margin$top <- height[(i - 1) %% length(height) + 1]

    # Set title options for each cluster
    GC_chart$x$series[[clusters[i]]]$clusterTitle <- options
  }
  return(GC_chart)
}

#' Update Sequence Display of a GC Chart Cluster
#'
#' Modify the sequence display and break markers of specified clusters within a GC chart.
#'
#' This function allows customization of the sequence line and break markers in a GC chart.
#' It offers options to adjust the sequence line (`sequenceStyle`) and break markers (`markerStyle`).
#' The `y` parameter can be used to set the vertical position of the sequence.
#'
#' @param GC_chart A GC chart object.
#' @param show Logical, whether to display the sequence (default is TRUE).
#' @param cluster Numeric or character vector specifying clusters to update.
#' @param y Vertical position of the sequence line (default is 50).
#' @param sequenceStyle A list of styling options for the sequence line.
#' @param markerStyle A list of styling options for the sequence break markers.
#' @param ... Additional customization arguments for sequence display.
#'
#' @return An updated GC chart with modified sequence display settings.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 2, 2, 2)
#' )
#'
#' # Basic usage
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "200px") %>%
#' GC_labels("name") %>%
#' GC_sequence(show = TRUE, y = 50, cluster = NULL)
#'
#' # Customize sequence and marker styles
#' GC_chart(genes_data, cluster="cluster", group = "group", height = "200px") %>%
#'   GC_scale(hidden = TRUE, scale_breaks = TRUE) %>%
#'   GC_sequence(
#'     start = NULL,
#'     end = NULL,
#'     sequenceStyle = list(
#'       stroke = "blue",
#'       strokeWidth = 1
#'       # Any other CSS style
#'     ),
#'     markerStyle = list(
#'       stroke = "blue",
#'       strokeWidth = 1,
#'       gap = 3,
#'       tiltAmount = 5
#'       # Any other CSS style
#'     )
#'   ) %>%
#'   GC_legend(FALSE)
#'
#' @export
GC_sequence <- function(
    GC_chart,
    show = TRUE,
    cluster = NULL,
    y = 50,
    sequenceStyle = list(),
    markerStyle = list(),
    ...
) {

  # Capture ... arguments
  dots <- list(...)

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Default options
    options <- list(
      show = show[(i-1) %% length(show) + 1],
      y = y[(i-1) %% length(y) + 1],
      sequenceStyle = sequenceStyle,
      markerStyle = markerStyle
    )

    # Add ... arguments to options
    for(name in names(dots)) {
      options[[name]] <- dots[[name]][(i-1) %% length(dots[[name]]) + 1]
    }

    # Set sequence options for each cluster
    GC_chart$x$series[[clusters[i]]]$sequence <- options

  }

  return(GC_chart)
}

#' Update Grid Display of a GC Chart Cluster
#'
#' Modify the grid display of specified clusters within a GC chart. This
#' function allows users to adjust the margins, width, and height of the grid
#' for each cluster.
#'
#' @param GC_chart A GC chart object.
#' @param margin A list specifying top, right, bottom, and left margins.
#' @param width Numeric or character. Width of the grid. If numeric, will be
#' considered as percentage.
#' @param height Numeric. Height of the grid.
#' @param direction Character. Layout direction of the grid, either "column"
#' (default) for vertical or "row" for horizontal.
#' @param cluster Numeric or character vector. Clusters in the GC chart to update.
#'
#' @return Updated GC chart with new grid display settings.
#' @importFrom utils modifyList
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 2, 2, 2)
#' )
#'
#' # Set Margin of clusters
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "200px") %>%
#' GC_grid(margin = list(left = "50px", right = "0px"))
#'
#' # Set height of a specific cluster
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "200px") %>%
#' GC_grid(height = "120px", cluster = 2)
#'
#' @export
GC_grid <- function(
    GC_chart,
    margin = NULL,
    width = NULL,
    height = NULL,
    direction = "column",
    cluster = NULL
) {

  all_clusters <- names(GC_chart$x$series)
  update_clusters <- getUpdatedClusters(GC_chart, cluster)
  chart_height <- GC_chart$height

  if(!is.null(width) && is.null(cluster)){
    GC_chart$width <- get_relative_height(GC_chart$width, width)
  }

  if(direction == "row"){
    GC_chart$x$graphContainer$direction <- "row"
  }

  # Update margins
  if(!is.null(margin) && is.null(cluster)){

    paddingTop <- if (!is.null(margin[["top"]])) get_relative_height(chart_height, margin[["top"]]) else 0
    paddingBottom <- if (!is.null(margin[["bottom"]])) get_relative_height(chart_height, margin[["bottom"]]) else 0

    margin[["top"]] <- NULL
    margin[["bottom"]] <- NULL

    # Update left and right margins
    GC_chart$x$legend$margin <- if (is.null(GC_chart$x$legend$margin)) margin else utils::modifyList(GC_chart$x$legend$margin, margin)
    GC_chart$x$title$margin <- if (is.null(GC_chart$x$title$margin)) margin else utils::modifyList(GC_chart$x$title$margin, margin)

    # Update top and bottom margins
    if(paddingTop > 0){

      GC_chart$x$style[["paddingTop"]] <- paste0(as.character(paddingTop), "px")
      GC_chart$height <- "100%"
      for (i in seq_along(all_clusters)) {
        cluster_name <- update_clusters[i]
        current_height <- get_relative_height(GC_chart$x$series[[cluster_name]]$container$height, GC_chart$x$series[[cluster_name]]$container$height)
        GC_chart$x$series[[cluster_name]]$container$height <- current_height - (paddingTop / length(all_clusters))
      }
    }

    if(paddingBottom > 0){
      GC_chart$height <- "100%"
      GC_chart$x$style[["paddingBottom"]] <- paste0(as.character(paddingBottom), "px")
      for (i in seq_along(all_clusters)) {
        cluster_name <- update_clusters[i]
        current_height <- get_relative_height(GC_chart$x$series[[cluster_name]]$container$height, GC_chart$x$series[[cluster_name]]$container$height)
        GC_chart$x$series[[cluster_name]]$container$height <- GC_chart$x$series[[cluster_name]]$container$height - (paddingBottom / length(all_clusters))
      }
    }

  }

  # Udpate cluster dimensions
  for (i in seq_along(update_clusters)) {
    cluster_name <- update_clusters[i]

    # Update left and right margins if provided
    if (!is.null(margin)) {
        default_margin <- GC_chart$x$series[[cluster_name]]$container$margin
        GC_chart$x$series[[cluster_name]]$container$margin <- if (is.null(default_margin)) margin else utils::modifyList(default_margin, margin)
    }

    # Update width if provided
    if (!is.null(width) && !is.null(cluster)) {
      current_width <- width[(i-1) %% length(width) + 1]
      current_width <- get_relative_height(GC_chart$width, current_width)
      GC_chart$x$series[[cluster_name]]$container$style$width <- current_width
      GC_chart$x$series[[cluster_name]]$container$width <- current_width
    }

    # Update height if provided
    if (!is.null(height)) {
      if(!is.null(cluster)){
      current_height <- height[(i-1) %% length(height) + 1]
      current_height <- get_relative_height(chart_height, current_height)
      GC_chart$x$series[[cluster_name]]$container$height <- current_height
      } else {
        GC_chart$x$series[[cluster_name]]$container$height <- compute_size(height, length(all_clusters))
      }
    }
  }

  return(GC_chart)
}

#' Update Scale of a GC Chart Cluster
#'
#' Modify the scale settings for specified clusters within a GC chart.
#'
#' @param GC_chart A GC chart object.
#' @param cluster Numeric or character vector specifying clusters in the GC
#' chart to update.
#' @param start Numeric vector indicating the starting point for the scale.
#' Default is NULL.
#' @param end Numeric vector indicating the end point for the scale.
#' Default is NULL.
#' @param padding Numeric value or percentage string indicating the padding on
#' either side of the scale. The value can be a number or a string in the
#' format of '2\%'. Default is 2.
#' @param hidden Logical flag indicating whether the axis is hidden. Default is
#' FALSE.
#' @param breaks List specifying settings for the scale breaks. Default is an
#' empty list ().
#' @param axis_position Character string indicating the type of the axis ('top' or
#' bottom'). Default is 'bottom'.
#' @param axis_type Character string indicating the type of the axis ('position' or
#' 'range'). Default is 'position'.
#' @param tickValues Numeric vector or NULL, custom tick values to be used at
#' the top of the cluster. If NULL, the default tick values are used.
#' @param reverse Logical flag indicating whether to reverse the scale for the
#' corresponding cluster. Default is FALSE.
#' @param scale_breaks Logical flag indicating if scale breaks should be
#' employed. Default is FALSE.
#' @param scale_break_threshold Numeric value indicating the threshold
#' percentage for determining scale breaks. Default is 20.
#' @param scale_break_padding Numeric value indicating the padding on either
#' side of a scale break. Default is 1.
#' @param ticksCount Numeric value indicating the number of ticks on the scale.
#' Default is 10.
#' @param ticksFormat Format for tick labels; depends on axis_type, defaulting
#' to ",.0f" for 'position' or ".2s" for 'range' when NULL.
#' @param y Numeric value from 1 to 100 indicating the y-position of the x-axis.
#' Default is NULL.
#' @param tickStyle List specifying the style for the ticks.
#' @param textStyle List specifying the style for the tick text.
#' @param lineStyle List specifying the style for the axis line.
#' @param ... Additional arguments for scale settings.
#'
#' @return Updated GC chart with new scale settings.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(100, 1000, 2000),
#'   end = c(150, 1500, 2500),
#'   name = c('Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('B', 'A', 'C'),
#'   cluster = c(2, 2, 2)
#' )
#' #Example usage with all custom options
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "200px") %>%
#'   GC_scale(
#'     start = 1,
#'     end = 2600,
#'     padding = 2,
#'     hidden = FALSE,
#'     reverse = FALSE,
#'     axis_position = "bottom",
#'     # breaks = list(
#'     #  list(start = 160, end = 900),
#'     #  list(start = 1600, end = 1900)
#'     # ),
#'     # tickValues = c(1, 2600),
#'     scale_breaks = TRUE,
#'     scale_break_threshold = 20,
#'     scale_break_padding = 1,
#'     ticksCount = 10,
#'     ticksFormat = ",.0f",
#'     y = NULL,
#'     tickStyle =
#'       list(
#'         stroke = "grey",
#'         strokeWidth = 1,
#'         lineLength = 6
#'         # Any other CSS styles
#'       ),
#'     textStyle =
#'       list(
#'         fill = "black",
#'         fontSize = "10px",
#'         fontFamily = "Arial",
#'         cursor = "default"
#'         # Any other CSS styles
#'       ),
#'     lineStyle = list(
#'       stroke = "grey",
#'       strokeWidth = 1
#'       # Any other CSS styles
#'     )
#'   ) %>%
#'   GC_legend(FALSE)
#' @export
GC_scale <- function(GC_chart,
                     cluster = NULL,
                     start = NULL,
                     end = NULL,
                     padding = 2,
                     hidden = FALSE,
                     breaks = list(),
                     tickValues = NULL,
                     reverse = FALSE,
                     axis_position = "bottom",
                     axis_type = "position", # range
                     y = NULL,
                     scale_breaks = FALSE,
                     scale_break_threshold = 20,
                     scale_break_padding = 1,
                     ticksCount = 10,
                     ticksFormat = NULL,
                     tickStyle = list(),
                     textStyle = list(),
                     lineStyle = list(),
                     ...) {
  # Capture ... arguments
  dots <- list(...)

  xMin <- NULL
  xMax <- NULL

  if(axis_type == "range"){
    if(is.null(ticksFormat)){
      ticksFormat <- ".2s"
    }
  data <-  adjust_to_range(GC_chart$x$data, cluster = GC_chart$x$cluster)
  GC_chart$x$data <- data
  xMin <- 1
  xMax <- max(data$start, data$end)
  }

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for (i in seq_along(clusters)) {

    subset_data <- GC_chart$x$series[[clusters[i]]]$data
    start_idx <- (i - 1) %% length(start) + 1
    stop_idx <- (i - 1) %% length(end) + 1
    reverse_idx <- (i - 1) %% length(reverse) + 1

    if (axis_type == "range" && !hidden) {
      if(length(clusters) > 1){
      subset_data <- data[data[[GC_chart$x$cluster]] == clusters[i], ]
      GC_chart$x$series[[clusters[i]]]$data <- subset_data
      } else {
        GC_chart$x$series[[clusters[i]]]$data <- data
      }

      # Set hidden to TRUE for all but the last cluster
      if (i < length(clusters)) {
        hidden_current <- TRUE
      } else {
        hidden_current <- hidden
      }
    } else {
      hidden_current <- hidden
    }

    # Compute scale breaks if required
    if (scale_breaks) {
      breaks_data <-
        get_scale_breaks(subset_data,
                         threshold_percentage = scale_break_threshold,
                         padding = scale_break_padding)
    } else {
      breaks_data <- breaks
    }

    # Default options
    options <- list(
      start = start[start_idx],
      end = end[stop_idx],
      xMin = xMin,
      xMax = xMax,
      padding = padding,
      hidden = hidden_current,
      breaks = breaks_data,
      tickValues = tickValues,
      reverse = reverse[reverse_idx],
      axisPosition = axis_position,
      axisType = axis_type,
      scale_breaks = scale_breaks,
      scale_break_threshold = scale_break_threshold,
      scale_break_padding = scale_break_padding,
      ticksCount = ticksCount,
      ticksFormat = ticksFormat,
      y = y,
      tickStyle = tickStyle,
      textStyle = textStyle,
      lineStyle = lineStyle
    )

    # Set scale options for each cluster
    GC_chart$x$series[[clusters[i]]]$scale <- options

  }

  return(GC_chart)
}

#' Update Scale Bar of a GC Chart Cluster
#'
#' Modify the scale bar settings for specified clusters within a GC chart.
#'
#' @param GC_chart A GC chart object.
#' @param show Logical. Whether to show the scale bar.
#' @param cluster Numeric or character vector. Clusters in the GC chart to update.
#' @param scaleBarLineStyle List of style options for the scale bar line.
#' @param scaleBarTickStyle List of style options for the scale bar ticks.
#' @param labelStyle List of style options for the scale bar label.
#' @param ... Additional arguments for scale bar settings.
#'
#' @return Updated GC chart with new scale bar settings.
#'
#' @examples
#' genes_data <- data.frame(
#'  start = c(1000, 9000, 13000, 17000, 21000),
#'  end = c(4000, 12000, 16000, 20000, 24000),
#'  name = c('Gene 1', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'  group = c('A', 'B', 'B', 'A', 'C'),
#'  cluster = c(1, 1, 2, 2, 2)
#' )
#'
#' # Set scale bar for individual clusters
#' GC_chart(genes_data, cluster ="cluster", group = "group") %>%
#' GC_scaleBar(cluster = 1, title = "1 kb", scaleBarUnit = 1000) %>%
#' GC_scaleBar(cluster = 2, title = "2 kb", scaleBarUnit = 2000)
#'
#' # Style scale bar
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "400px") %>%
#'   GC_scaleBar(
#'     title = "1kb",
#'     scaleBarUnit = 1000,
#'     cluster = NULL,
#'     x = 0,
#'     y = 50,
#'     labelStyle = list(
#'       labelPosition =  "left",
#'       fontSize = "10px",
#'       fontFamily = "sans-serif",
#'       fill = "red", # Text color
#'       cursor = "default"
#'       # Any other CSS style for the label
#'     ),
#'     textPadding = -2,
#'     scaleBarLineStyle = list(
#'       stroke = "black",
#'       strokeWidth = 1
#'       # Any other CSS style for the line
#'     ),
#'     scaleBarTickStyle = list(
#'       stroke = "black",
#'       strokeWidth = 1
#'       # Any other CSS style for the tick
#'     )
#'   )
#'
#' @export
GC_scaleBar <- function(
    GC_chart,
    show = TRUE,
    cluster = NULL,
    scaleBarLineStyle = list(),
    scaleBarTickStyle = list(),
    labelStyle = list(),
    ...
) {

  if (!show) {
    return(GC_chart)
  }

  # Capture ... arguments
  dots <- list(...)

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Default options
    options <- list(
      show = show[(i-1) %% length(show) + 1],
      scaleBarLineStyle = scaleBarLineStyle,
      scaleBarTickStyle = scaleBarTickStyle,
      labelStyle = labelStyle
    )

    # Add ... arguments to options
    for(name in names(dots)) {
      options[[name]] <- dots[[name]][(i-1) %% length(dots[[name]]) + 1]
    }

    # Set scaleBar options for each cluster
    GC_chart$x$series[[clusters[i]]]$scaleBar <- options

  }

  return(GC_chart)
}

#' Set or Update Cluster Labels for a GC Chart
#'
#' This function allows you to set or update the labels for specified clusters
#' within a GC chart. It provides flexibility in terms of the title, visibility,
#' width, position, and other additional customization options.
#'
#' @param GC_chart A GC chart object.
#' @param title Character vector. The title for the cluster label. Default is NULL.
#' @param show Logical. Whether to show the cluster label. Default is TRUE.
#' @param width Character. The width of the cluster label. Default is "100px".
#' @param cluster Numeric or character vector. Clusters in the GC chart to update.
#' Default is NULL.
#' @param position Character. Position of the label, either "left" or "right".
#' Default is "left".
#' @param wrapLabel Logical. Indicates whether the label should be wrapped.
#' Default is TRUE.
#' @param wrapOptions List. Specifies the wrapping options.
#' Default is an empty List.
#' @param ... Additional customization arguments for the cluster label,
#' such as 'fontSize', 'fontStyle', 'fontWeight', 'fontFamily', 'cursor', etc.
#'
#'
#' @return Updated GC chart with new or modified cluster labels.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 2, 2, 2)
#' )
#'
#' # Set cluster labels
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "200px") %>%
#' GC_clusterLabel(title = unique(genes_data$cluster))
#'
#' # Set label for a specific cluster
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "200px") %>%
#' GC_clusterLabel(title = "Cluster 1", cluster = 1)
#'
#' # Style labels
#' GC_chart(genes_data, cluster ="cluster", group = "group", height = "200px") %>%
#'   GC_clusterLabel(
#'     title = c("Cluster 1", "Cluster 2"),
#'     width = "100px",
#'     x = 0,
#'     y = 0,
#'     position = "left",
#'     wrapLabel = TRUE,
#'     wrapOptions = list(
#'       dyAdjust = 0,
#'       lineHeightEms = 1.05,
#'       lineHeightSquishFactor =  1,
#'       splitOnHyphen =  TRUE,
#'       centreVertically = TRUE
#'      ),
#'     fontSize = "12px",
#'     fontStyle = "normal",
#'     fontWeight = "bold",
#'     fontFamily = "sans-serif",
#'     cursor = "default"
#'   )
#'
#' @export
GC_clusterLabel <- function(
    GC_chart,
    title = NULL,
    show = TRUE,
    width = "100px",
    cluster = NULL,
    position = "left",
    wrapLabel = TRUE,
    wrapOptions = list(),
    ...
) {

  if (!show) {
    return(GC_chart)
  }

  cluster_column <- GC_chart$x$cluster

  if(!is.null(cluster_column) && is.null(title)){
    title <- unique(GC_chart$x$data[[GC_chart$x$cluster]])
  }

  # Capture ... arguments
  dots <- list(...)

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Get the current position for this cluster
    currentPosition <- position[(i-1) %% length(position) + 1]

    # Default options
    options <- list(
      title = title[(i-1) %% length(title) + 1],
      show = show[(i-1) %% length(show) + 1],
      wrapLabel = wrapLabel,
      wrapOptions = wrapOptions,
      position = currentPosition
    )

    # Add ... arguments to options
    for(name in names(dots)) {
      options[[name]] <- dots[[name]][(i-1) %% length(dots[[name]]) + 1]
    }

    # Set clusterLabel options for each cluster
    GC_chart$x$series[[clusters[i]]]$clusterLabel <- options

    # Set width for each cluster based on position
    if (currentPosition == "left") {
      GC_chart <- GC_grid(
        GC_chart,
        margin = list(left = width[(i-1) %% length(width) + 1]),
        cluster = clusters[i]
      )
      #GC_chart$x$series[[clusters[i]]]$grid$margin$left <- width[(i-1) %% length(width) + 1]
    } else if (currentPosition == "right") {
      GC_chart <- GC_grid(
        GC_chart,
        margin = list(right = width[(i-1) %% length(width) + 1]),
        cluster = clusters[i]
      )
    }

  }
  return(GC_chart)
}

#' Add a Footer to Each Cluster in a GC Chart
#'
#' This function allows you to add a footer to all or specific clusters within a GC chart.
#' You can specify titles, subtitles, and control the display and styling.
#'
#' @param GC_chart A GC chart object that the footers will be added to.
#' @param title Character vector or NULL. The title to be displayed in the footer.
#'        Multiple titles can be provided for different clusters, and they will be recycled
#'        if there are more clusters than titles. Default is NULL.
#' @param subtitle Character vector or NULL. Subtitles to accompany the main titles.
#'        Default is NULL.
#' @param show Logical vector. Controls the visibility of each footer.
#'        Default is TRUE for all clusters.
#' @param cluster Numeric or character vector specifying which clusters should have footers added or updated.
#'        If NULL, all clusters will be updated. Default is NULL.
#' @param subtitleFont List, styling options for the subtitle.
#' @param titleFont List, styling options for the title.
#' @param ... Additional arguments for further customization of the footers.
#'
#' @return A GC chart object with updated footer settings for each specified cluster.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 2, 2, 2)
#' )
#'
#' # Add a simple footer with subtitle to all clusters
#' GC_chart(genes_data, cluster = "cluster", group = "group") %>%
#'   GC_clusterFooter(
#'     title = "Cluster Footer",
#'     subtitle = "Cluster subtitle"
#'   )
#' # Add styling to the title and subtitle
#' GC_chart(genes_data, cluster = "cluster", group = "group") %>%
#'   GC_clusterFooter(
#'     title = "This is a footer",
#'     subtitle = "Subtitle for the footer",
#'     spacing = 15,
#'     show = TRUE,
#'     cluster = 1,
#'     x = 6,
#'     y = -20,
#'     align = "center", # left / right
#'     spacing = 12,
#'     titleFont = list(
#'       fontSize = "12px",
#'       fontWeight = "bold",
#'       fontFamily = "sans-serif",
#'       fill = "black",
#'       cursor = "default"
#'     ),
#'     subtitleFont = list(
#'       fill = "grey",
#'       fontSize = "10px",
#'       fontStyle = "normal",
#'       fontFamily = "sans-serif",
#'       cursor = "default"
#'     )
#'   )
#'
#' @export
GC_clusterFooter <- function(
    GC_chart,
    title = NULL,
    subtitle = NULL,
    show = TRUE,
    cluster = NULL,
    subtitleFont = list(),
    titleFont = list(),
    ...
) {

  if (!show) {
    return(GC_chart)
  }

  # Capture ... arguments
  dots <- list(...)

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Default options
    options <- list(
      title = title[(i-1) %% length(title) + 1],
      subtitle = subtitle[(i-1) %% length(subtitle) + 1],
      show = show[(i-1) %% length(show) + 1],
      subtitleFont = subtitleFont,
      titleFont = titleFont
    )

    # Add ... arguments to options
    for(name in names(dots)) {
      options[[name]] <- dots[[name]][(i-1) %% length(dots[[name]]) + 1]
    }

    # Set footer options for each cluster
    GC_chart$x$series[[clusters[i]]]$footer <- options
  }

  return(GC_chart)
}


#' Add Labels to Each Cluster in a GC Chart
#'
#' This function adds labels to each cluster within a GC chart. It provides the
#' option to show or hide the labels and supports customization of label properties.
#' It can automatically pick up group names as labels from the `GC_chart` object if not provided.
#'
#' @param GC_chart A `GC chart` object to which labels will be added.
#' @param label Character vector, logical, or NULL. Specific labels for the clusters.
#'        If NULL and `GC_chart` has group names, those will be used as labels.
#' @param show Logical; controls the visibility of labels. Default is `TRUE`.
#' @param cluster Numeric or character vector or NULL; specifies which clusters should be labeled.
#'        If NULL, labels will be applied to all clusters. Default is NULL.
#' @param itemStyle List, a list of styles to apply to individual items in the chart.
#' @param ... Additional arguments for further customization of the labels.
#'
#' @return A `GC chart` object with updated label settings for each specified cluster.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 2, 2, 2)
#' )
#'
#' # Add labels to all clusters
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "200px") %>%
#' GC_labels()
#'
#' # Add labels and styling
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "200px") %>%
#' GC_labels(
#'  label = "group",
#'  show = TRUE,
#'  x = 0,
#'  y = 50,
#'  dy = "-1.2em",
#'  dx = "0em",
#'  rotate = 0,
#'  adjustLabels = TRUE, # Rotate labels to prevent overlap
#'  fontSize = "12px",
#'  fontStyle = "italic",
#'  fill = "black",
#'  fontFamily = "sans-serif",
#'  textAnchor = "middle",
#'  cursor = "default",
#' )
#'
#' # Alter style of a specific label
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "200px") %>%
#' GC_labels(label = "group") %>%
#' GC_labels(
#'   cluster = 1,
#'   itemStyle = list(
#'     list(index = 0, fill = "red", fontSize = "14px", fontWeight = "bold")
#'   )
#' )
#'
#' @export
GC_labels <- function(
    GC_chart,
    label = NULL,
    show = TRUE,
    cluster = NULL,
    itemStyle = list(),
    ...
) {

  if (!show) {
    return(GC_chart)
  }

  if (is.logical(label) && length(label) == 1) {
    show <- label
    label <- NULL
  }

  if (is.null(label) && is.null(GC_chart$x$group)){
    stop("Please define labels")
  }

  if (is.null(label) && !is.null(GC_chart$x$group)) {
    label <- GC_chart$x$group
  }

  if (!(label %in% names(GC_chart$x$data))) {
    stop("label column not found in data")
  }

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Default options
    options <- Filter(function(x) !is.null(x) && length(x) > 0, list(
      label = label[(i-1) %% length(label) + 1],
      show = show[(i-1) %% length(show) + 1],
      itemStyle = itemStyle,
      ...
    ))

    # Merge new options with existing options
    if (is.null(GC_chart$x$series[[clusters[i]]]$labels)) {
      GC_chart$x$series[[clusters[i]]]$labels <- options
    } else {
      GC_chart$x$series[[clusters[i]]]$labels <- modifyList(GC_chart$x$series[[clusters[i]]]$labels, options)
    }
  }

  return(GC_chart)
}

#' Modify Coordinates in a GC Chart
#'
#' This function updates a GC chart by modifying the coordinates settings. It
#' allows for showing or hiding tick values, applying custom tick values for the
#' top and bottom axes, and supports several other customizations for specific
#' or all clusters in the chart.
#'
#' @param GC_chart The GC chart object to be modified.
#' @param show Logical, whether to show the tick values or not. Can be a single
#'   value or a vector.
#' @param tickValuesTop Numeric vector or NULL, custom tick values to be used at
#'   the top of the cluster. If NULL, the default tick values are used.
#' @param tickValuesBottom Numeric vector or NULL, custom tick values to be used
#'   at the bottom of the cluster. If NULL, the default tick values are used.
#' @param ticksFormat Format for tick labels. Default is ",.0f".
#' @param cluster Numeric or character vector or NULL; specifies which clusters
#' to generate coordinates for.
#'        If NULL, labels will be applied to all clusters. Default is NULL.
#' @param tickStyle List, styling options for the ticks.
#' @param textStyle List, styling options for the text.
#'   the coordinate modifications. If NULL, applies to all clusters.
#' @param ... Additional arguments to be passed to the coordinate options.
#'
#' @return Returns the GC chart object with updated coordinates.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5'),
#'   cluster = c(1, 1, 2, 2, 2)
#' )
#'
#' # Add coordinates to all clusters
#' GC_chart(genes_data, cluster = "cluster", group = "name", height = "200px") %>%
#' GC_coordinates()
#'
#' # Modify coordinates of a specific cluster
#' GC_chart(genes_data, cluster = "cluster", group = "name", height = "200px") %>%
#' GC_coordinates() %>%
#' GC_coordinates(
#'   cluster = 2,
#'   show = TRUE,
#'   tickValuesTop = c(130, 170, 210, 240),
#'   tickValuesBottom = c(160, 200),
#'   ticksFormat = ",.0f", # ".2s",
#'   rotate = -45,
#'   yPositionTop = 55,
#'   yPositionBottom = 45,
#'   overlapThreshold = 20,
#'   tickStyle = list(
#'   stroke = "black",
#'   strokeWidth = 1,
#'   lineLength = 6
#'   ),
#'   textStyle = list(
#'   fill = "black",
#'   fontSize = "12px",
#'   fontFamily = "Arial",
#'   cursor = "default"
#'   )
#' )
#'
#' @export
GC_coordinates <- function(
    GC_chart,
    show = TRUE,
    tickValuesTop = NULL,
    tickValuesBottom = NULL,
    ticksFormat = NULL,
    tickStyle = list(),
    textStyle = list(),
    cluster = NULL,
    ...
) {

  if (!show) {
    return(GC_chart)
  }

  # Capture ... arguments
  dots <- list(...)

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Default options
    options <- list(
      show = show[(i-1) %% length(show) + 1],
      ticksFormat = ticksFormat,
      tickStyle = tickStyle,
      textStyle = textStyle
    )

    # Add ... arguments to options
    for(name in names(dots)) {
      options[[name]] <- dots[[name]][(i-1) %% length(dots[[name]]) + 1]
    }

    # Set coordinates options for each cluster
    GC_chart$x$series[[clusters[i]]]$coordinates <- options

    # Add tickvalues for each cluster
    GC_chart$x$series[[clusters[i]]]$coordinates$tickValuesTop <- tickValuesTop
    GC_chart$x$series[[clusters[i]]]$coordinates$tickValuesBottom <- tickValuesBottom

  }

  # Check if prevent_gene_overlap is called last
  if (!is.null(GC_chart$x$prevent_gene_overlap_called) && GC_chart$x$prevent_gene_overlap_called) {
    warning("Separating strands must be called after setting genes, labels or coordinates for proper effect.")
  }

  return(GC_chart)
}


#' Modify Gene Characteristics within a Chart
#'
#' This function updates a gene chart with specific characteristics for genes
#' based on the given parameters. It can show/hide genes, apply a color scheme,
#' assign custom colors, filter by cluster, and accept additional options.
#'
#' @param GC_chart The gene chart object to be modified.
#' @param group Column name used for gene grouping to influence color
#'   aesthetics.
#' @param marker Character or NULL, type of marker to represent genes on the chart.
#' Allowed values are 'arrow', 'boxarrow', 'box', 'cbox', and 'rbox'.
#' @param marker_size Character or NULL, size category of the marker
#' ('small', 'medium', 'large').
#' @param show Logical, whether to show the genes or not.
#' @param colorScheme Character or NULL, the name of the color scheme to use.
#' @param customColors List or NULL, custom colors to apply to the genes.
#' @param cluster Numeric or character, the specific cluster to filter genes by.
#' @param itemStyle List, a list of styles to apply to individual items in the
#'   chart.
#' @param ... Additional arguments to be passed to the gene options.
#'
#' @return Returns the modified gene chart object.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 2, 2, 2)
#' )
#'
#' # Change the appearance of a specific gene cluster
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "200px") %>%
#'   GC_genes(
#'     group = "group",
#'     show = TRUE,
#'     marker = "arrow",
#'     marker_size = "medium",
#'     colorScheme = NULL, # One of D3.js build in colorSchemes
#'                         # (eg. "schemeCategory10",
#'                         # "schemeAccent", "schemeTableau10")
#'     customColors = NULL, # A vector of color names
#'     prevent_overlap = FALSE,
#'     gene_overlap_spacing = 40,
#'     cluster = 1, # Specify a specific cluster
#'     x = 1,
#'     y = 50,
#'     stroke = "black",
#'     strokeWidth = 1,
#'     arrowheadWidth = NULL,
#'     arrowheadHeight = NULL,
#'     arrowHeight = NULL,
#'     markerHeight = NULL # overwrites marker_size
#'    )
#'
#' # Change the appearance of a specific gene
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "200px") %>%
#' GC_genes(
#'   cluster = 2,
#'   itemStyle = list(list(index = 2, fill = "red", stroke = "blue")
#'   )
#'  )
#'
#' @export
GC_genes <- function(
    GC_chart,
    group = NULL,
    marker = NULL,
    marker_size = NULL,
    show = TRUE,
    colorScheme = NULL,
    customColors = NULL,
    cluster = NULL,
    itemStyle = list(),
    ...
) {

  if (is.logical(group) && length(group) == 1) {
    show <- group
    group <- NULL
  }

  # if (is.null(group) && is.null(GC_chart$x$group) && is.null(marker)){
  #   stop("Please define a group")
  # }

  if (is.null(group) && !is.null(GC_chart$x$group)){
    group <- GC_chart$x$group
  }

  if (!is.null(group) && !(group %in% names(GC_chart$x$data))) {
    stop("group column not found in data")
  }

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Default options
    options <- Filter(function(x) !is.null(x) && length(x) > 0, list(
      group = group[(i-1) %% length(group) + 1],
      marker = marker[(i-1) %% length(marker) + 1],
      markerSize = marker_size,
      show = show[(i-1) %% length(show) + 1],
      colorScheme = colorScheme,
      customColors = customColors,
      itemStyle = itemStyle,
      ...
    ))

    GC_chart$x$series[[clusters[i]]]$genes <- options

  }

  # Check if prevent_gene_overlap is called last
  if (!is.null(GC_chart$x$prevent_gene_overlap_called) && GC_chart$x$prevent_gene_overlap_called) {
    warning("Preventing gene overlap must be called after setting genes, labels or coordinates for proper effect.")
  }

  return(GC_chart)
}

#'Modify Transcript Characteristics within a Chart
#'
#'This function updates the chart with specific characteristics for transcripts
#'based on the given parameters. It can show/hide transcripts, apply a color
#'scheme, assign custom colors, filter by cluster, and accept additional
#'options.
#'
#'@param GC_chart The chart object to be modified.
#'@param transcript Optional column name used for clustering transcript data.
#' Default is NULL.
#'@param type Column name identifying the feature type ("UTR",
#' "exon"). Default is NULL.
#' @param strand Optional column name indicating strand orientation. Acceptable
#'   values include 1, 'forward', 'sense', or '+' to represent the forward
#'   strand, and -1, 0, 'reverse', 'antisense', "complement" or '-' to represent
#'   the reverse strand. Default is NULL, meaning strand information is not
#'   used.
#'@param group Optional column name used for transcript grouping to influence
#'color aesthetics.
#'@param selection Numeric or character, the specific transcript to filter
#'  transcripts by.
#'@param show Logical, whether to show the transcripts or not.
#'@param colorScheme Character or NULL, the name of the color scheme to use.
#'@param customColors List or NULL, custom colors to apply to the genes.

#'@param styleExons List, styles to apply to exons in the chart.
#'@param styleIntrons List, styles to apply to introns in the chart.
#'@param styleUTRs List, styles to apply to UTRs in the chart.
#'@param itemStyleExons List, a list of styles to apply to individual exons in
#'  the chart.
#'@param itemStyleIntrons List, a list of styles to apply to individual introns
#'  in the chart.
#'@param itemStyleUTRs List, a list of styles to apply to individual UTRs in the
#'  chart.
#' @param labelOptions List, options for styling labels such as font size, color,
#'  and position.
#'@param ... Additional arguments to be passed to the gene options.
#'
#'@return Returns the modified gene chart object.
#'
#' @examples
#' transcript_data <- data.frame(
#'   transcript = c("transcript1", "transcript1", "transcript1", "transcript1",
#'                  "transcript2", "transcript2", "transcript2"),
#'   type = c("5_utr", "exon", "exon", "3_utr",
#'            "5_utr", "exon", "3_utr"),
#'   start = c(1, 101, 201, 301,
#'             1, 101, 301),
#'   end = c(50, 150, 250, 350,
#'           50, 150, 350),
#'   strand = rep("forward", 7)
#' )
#'
#' # All default transcript settings
#' GC_chart(
#'   transcript_data,
#'   start = "start",
#'   end = "end",
#'   height = "200px"
#' ) %>%
#'   GC_transcript(
#'     transcript = "transcript",
#'     strand = "strand",
#'     type = "type",
#'     group = NULL,
#'     show = TRUE,
#'     selection = NULL,
#'     colorScheme = NULL,
#'     customColors = NULL,
#'     styleExons = list(
#'       show = TRUE,
#'       strokeWidth = 0,
#'       cursor = "default",
#'       marker = "box",
#'       markerSize = "medium",
#'       arrowheadWidth = NULL,
#'       arrowheadHeight = NULL,
#'       markerHeight = NULL,
#'       cornerRadius = NULL
#'       # Any other CSS style
#'     ),
#'     styleIntrons = list(
#'       show = TRUE,
#'       strokeWidth = 1,
#'       fill = "none",
#'       cursor = "default",
#'       marker = "intron",
#'       markerSize = "medium",
#'       arrowheadWidth = NULL,
#'       arrowheadHeight = NULL,
#'       markerHeight = NULL,
#'       cornerRadius = NULL
#'       # Any other CSS style
#'     ),
#'     styleUTRs = list(
#'       show = TRUE,
#'       fontSize = "10px",
#'       fontStyle = "normal",
#'       fontFamily = "sans-serif",
#'       cursor = "default",
#'       color = "black",
#'       fill = "#FFF",
#'       strokeWidth = 1,
#'       marker = "box",
#'       markerSize = "medium",
#'       arrowheadWidth = NULL,
#'       arrowheadHeight = NULL,
#'       markerHeight = NULL,
#'       cornerRadius = NULL
#'       # Any other CSS style
#'     ),
#'     labelOptions = list(
#'       show = TRUE,
#'       xOffset = 2,
#'       yOffset = 0,
#'       fontSize = "12px",
#'       fontStyle = "normal",
#'       fontWeight = "normal",
#'       fontFamily = "sans-serif",
#'       cursor = "default",
#'       color = "black"
#'     ),
#'     itemStyleExons = list(),
#'     itemStyleIntrons = list(),
#'     itemStyleUTRs = list()
#'   )
#' # Change the appearance of a specific intron
#' GC_chart(transcript_data,
#'          start = "start",
#'          end = "end",
#'          height = "200px"
#' ) %>%
#'   GC_transcript(
#'     transcript = "transcript",
#'     type = "type",
#'     selection = 2,
#'     itemStyleExons = list(list(index = 0, fill = "red")
#'     )
#'   )
#' @export
GC_transcript <- function(GC_chart,
                          transcript = NULL,
                          type = NULL,
                          strand = NULL,
                          group = NULL,
                          selection = NULL,
                          show = TRUE,
                          colorScheme = NULL,
                          customColors = NULL,
                          styleExons = list(),
                          styleIntrons = list(),
                          styleUTRs = list(),
                          itemStyleExons = list(),
                          itemStyleIntrons = list(),
                          itemStyleUTRs = list(),
                          labelOptions = list(),
                          ...) {

  transcript_called <- GC_chart$x$transcript_called

  # Update GC_chart object with new data
  if (is.null(transcript_called)) {

    data <- GC_chart$x$data
    data_tmp <- GC_chart$x$data
    colnames_data <- colnames(data)

    if (!is.null(type) && !(type %in% colnames_data)) {
      stop("type column not found in data")
    }

    if (!is.null(type)) {
      data$type <- data_tmp[[type]]
    }

    if (!is.null(transcript) && !(transcript %in% colnames_data)) {
      stop("transcript column not found in data")
    }

    if (!is.null(transcript)) {
      data$transcript <- as.character(data_tmp[[transcript]])
    }
    data <- get_introns(data)
    transcripts <- unique(as.character(data$transcript))

    # Update chart object
    new_params <- GC_chart$x$params
    new_params$data <- data

    if (is.null(transcript)) {
      new_params$cluster <- "transcript"
    } else {
      new_params$cluster <- transcript
    }
    new_params$strand <- strand

    GC_chart <- do.call(geneviewer::GC_chart, new_params)

    for (trans in transcripts) {
        GC_chart$x$series[[trans]]$genes <- list(group = NULL, show = FALSE)
        GC_chart$x$series[[trans]]$sequence <- list(show = FALSE)
        GC_chart$x$series[[trans]]$transcript <- list(group = NULL, show = TRUE)
    }
  }

  if (is.logical(group) && length(group) == 1) {
    show <- group
    group <- NULL
  }

  if (is.null(group) && !is.null(GC_chart$x$group)) {
    group <- GC_chart$x$group
  }

  if (!is.null(group) && !(group %in% names(GC_chart$x$data))) {
    stop("group column not found in data")
  }

  clusters <- getUpdatedClusters(GC_chart, selection)

  for (i in seq_along(clusters)) {
    # Default options
    options <- Filter(
      function(x)
        ! is.null(x) && length(x) > 0,
      list(
        group = group[(i - 1) %% length(group) + 1],
        show = show[(i - 1) %% length(show) + 1],
        colorScheme = colorScheme,
        customColors = customColors,
        styleExons = styleExons,
        styleIntrons = styleIntrons,
        styleUTRs = styleUTRs,
        itemStyleExons = itemStyleExons,
        itemStyleIntrons = itemStyleIntrons,
        itemStyleUTRs = itemStyleUTRs,
        labelOptions = labelOptions,
        ...
      )
    )

    GC_chart$x$series[[clusters[i]]]$transcript <- options

  }

  GC_chart$x$transcript_called <- TRUE

  return(GC_chart)
}

#' Update Color Scheme in Gene Chart
#'
#' This function updates the color scheme of the legend and genes in a gene chart.
#'
#' @param GC_chart The gene chart object to be modified.
#' @param colorScheme Optional; character or NULL, the name of a predefined
#' color scheme to apply to the genes.Acceptable values include D3.js's built-in
#' color schemes like "schemeCategory10", "schemeAccent", "schemeTableau10".
#' @param customColors Either NULL, a list of color values, or a named list of
#' color values.
#'
#' @return Returns the gene chart object with updated color settings for the genes.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 50, 90, 130, 170, 210),
#'   end = c(40, 80, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 1, 2, 2, 2)
#' )
#'
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "100px") %>%
#'   GC_color(colorScheme = "schemeCategory10")
#'
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "100px") %>%
#'   GC_color(customColors = c("red", "orange", "green"))
#'
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "100px") %>%
#'   GC_color(customColors = list(A = "yellow", B = "pink", C =  "purple"))
#'
#'
#' @export
GC_color <- function(
    GC_chart,
    colorScheme = NULL,
    customColors = NULL
) {

  # Warning if both colorScheme and customColors are selected
  if (!is.null(colorScheme) && !is.null(customColors)) {
    warning("Both colorScheme and customColors are selected. Please choose only one.")
    return(GC_chart)
  }

  series <- GC_chart$x

  # Update legend
  GC_chart$x$legend$legendOptions$colorScheme <- colorScheme
  GC_chart$x$legend$legendOptions$customColors <- customColors

  # Capture clusters to update
  clusters <- names(GC_chart$x$series)

  # Update gene and transcript colors
  for(cluster_name in clusters){
    GC_chart$x$series[[cluster_name]]$genes$colorScheme <- colorScheme
    GC_chart$x$series[[cluster_name]]$genes$customColors <- customColors
    GC_chart$x$series[[cluster_name]]$transcript$colorScheme <- colorScheme
    GC_chart$x$series[[cluster_name]]$transcript$customColors <- customColors
  }

  return(GC_chart)
}

#' Set Legend for a Gene Chart
#'
#' This function configures the legend for a gene chart. It allows toggling the
#' legend's visibility, setting a background color, and assigning custom labels
#' for the legend entries. The function can also handle additional
#' customizations through various options.
#'
#' @param GC_chart The gene chart object to be modified.
#' @param group Optional; character or NULL, specifies the groups to include in
#'   the legend. If NULL, groups are taken from the 'group' attribute of the
#'   'GC_chart' object.
#' @param show Logical, specifies whether to display the legend.
#' @param backgroundColor String, the background color of the legend.
#' @param order Optional; list, specifies the order of the legend labels.
#' @param position Character. Position of the legend, either "top" or "bottom".
#'   Default is "bottom".
#' @param style A list of CSS styles to be applied to the chart container. Each
#'   element of the list should be a valid CSS property-value pair. For example,
#'   list(backgroundColor = "white", border = "2px solid black"). Default is an
#'   empty list.
#' @param legendOptions List, additional options for the legend.
#' @param legendTextOptions List, additional text options for the legend.
#' @param ... Additional arguments to be passed to the legend configuration.
#'
#' @return Returns the modified gene chart object with the legend configured.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'B', 'B', 'A', 'C'),
#'   cluster = c('A', 'A', 'A', 'B', 'B')
#' )
#'
#' # Customize legend
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "200px") %>%
#'   GC_legend(
#'     position = "top", #bottom
#'     orientation = "horizontal", #vertical
#'     x = 0,
#'     y = 0,
#'     adjustHeight = TRUE,
#'     backgroundColor = "#0000",
#'     order = list(),
#'     positions = "bottom",
#'     style = list(
#'       backgroundColor = "#0000"
#'       # Any other CSS styles
#'     ),
#'     legendOptions = list(
#'       cursor = "pointer",
#'       colorScheme = NULL,
#'       customColors = NULL # c("red", "green", "orange")
#'       # Additional styles
#'     ),
#'     legendTextOptions = list(
#'       cursor = "pointer",
#'       textAnchor = "start",
#'       dy = ".35em",
#'       fontSize = "12px",
#'       fontFamily = "sans-serif",
#'       fill = "black"
#'       # Additional styles
#'     )
#'   )
#'
#' @export
GC_legend <- function(
    GC_chart,
    group = NULL,
    show = TRUE,
    backgroundColor = "#0000",
    order = list(),
    position = "bottom",
    style = list(),
    legendOptions = list(),
    legendTextOptions = list(),
    ...
) {

  if (!show) {
    return(GC_chart)
  }

  if (is.logical(group) && length(group) == 1) {
    show <- group
    group <- NULL
  }

  if (is.null(group) && is.null(GC_chart$x$group) && is.null(labels)){
    stop("Please define a group")
  }

  if (is.null(group) && !is.null(GC_chart$x$group)){
    group <- GC_chart$x$group
  }

  if (is.null(labels) && !(group %in% names(GC_chart$x$data))) {
    stop("group column not found in data")
  }

  # Capture arguments and filter out NULL or empty values
  options <- Filter(function(x) !is.null(x) && length(x) > 0, list(
    group = group,
    show = show,
    backgroundColor = backgroundColor,
    order = order,
    position = position,
    style = style,
    legendOptions = legendOptions,
    legendTextOptions = legendTextOptions,
    ...
  ))

  # Merge new options with existing options
  if (is.null(GC_chart$x$legend)) {
    GC_chart$x$legend <- options
  } else {
    GC_chart$x$legend <- modifyList(GC_chart$x$legend, options)
  }

  return(GC_chart)
}

#' Add Annotations to a GC_chart
#'
#' This function adds annotations to specified clusters within a GC chart.
#' Annotations can be of various types and are positioned based on provided
#' coordinates. The types of annotations available are: text, textMarker, line,
#' arrow, symbol, rectangle, promoter, and terminator.
#'
#' @param GC_chart A GC chart object to which the annotations will be added.
#' @param cluster Numeric or character vector specifying the clusters to which
#'   annotations should be added.
#' @param type Character vector specifying the type of annotations to add. The
#'   default is "text".
#' @param ... Additional parameters for customization of annotations, depending
#'   on the type.
#'
#' @return Updated GC chart object with added annotations.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 50, 90, 130, 170, 210),
#'   end = c(40, 80, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 1, 2, 2, 2)
#' )
#'
#' # Adding annotations to a GC chart
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "220px") %>%
#'   GC_annotation(
#'     type = "textMarker",
#'     cluster = 1,
#'     position = 24,
#'     text = "Gene 1",
#'     arrowSize = 8
#'   ) %>%
#'   GC_annotation(
#'     type = "text",
#'     text = "feature 1",
#'     x = 91,
#'     y = 71
#'   ) %>%
#'   GC_annotation(
#'     type = "symbol",
#'     symbol = "triangle",
#'     x = 95,
#'     y = 64,
#'     size = 10,
#'     rotation = 180
#'   ) %>%
#'   GC_annotation(
#'     type = "terminator",
#'     x = 81
#'   ) %>%
#'   GC_annotation(
#'     type = "promoter",
#'     x = 49
#'   ) %>%
#'   # Convenience function to track mouse position on hoover
#'   GC_trackMouse()
#'
#' @seealso \code{\link{GC_trackMouse}}
#'
#' @export
GC_annotation <- function(
    GC_chart,
    type = "textAnnotation",
    cluster = NULL,
    ...
) {

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Capture arguments and filter out NULL or empty values
    options <- Filter(function(x) !is.null(x) && length(x) > 0, list(
      type = type,
      ...
    ))

    currentAnnotations <- GC_chart$x$series[[clusters[i]]]$annotations

    if(is.null(currentAnnotations) || length(currentAnnotations) == 0){
      GC_chart$x$series[[clusters[i]]]$annotations <- list(options)
    } else {
      GC_chart$x$series[[clusters[i]]]$annotations <- c(currentAnnotations, list(options))
    }

  }

  return(GC_chart)
}

#' Track Mouse Movement in a GC_chart
#'
#' This function enables or disables mouse tracking on specified clusters within
#' a GC chart. When enabled, the x and y coordinates of the mouse are displayed
#' which can be used to place annotations.
#'
#' @param GC_chart A GC chart object to which the annotations will be added.
#' @param show Logical, specifies whether to track the mouse or not.
#' @param cluster Numeric or character vector specifying the clusters to which
#' annotations should be added.
#' @return Updated GC chart object with mouse tracking settings.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 50, 90, 130, 170, 210),
#'   end = c(40, 80, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5', 'Gene 6'),
#'   group = c('A', 'A', 'B', 'B', 'A', 'C'),
#'   cluster = c(1, 1, 1, 2, 2, 2)
#' )
#'
#' # Enable mouse tracking
#' GC_chart(genes_data, cluster = "cluster", group = "group", height = "220px") %>%
#' GC_trackMouse()
#'
#' @seealso \code{\link{GC_annotation}}
#'
#' @export
GC_trackMouse <- function(
    GC_chart,
    show = TRUE,
    cluster = NULL
) {

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

      GC_chart$x$series[[clusters[i]]]$trackMouse$show <- show

  }

  return(GC_chart)
}


#' Set Tooltip for a Gene Chart
#'
#' This function configures the tooltip for a gene chart.
#'
#' @param GC_chart The gene chart object to be modified.
#' @param formatter A character string defining the HTML content of the tooltip. It can
#'   include placeholders like \code{\{start\}} and \code{\{end\}} which will be replaced by actual
#'   data values. The default value shows start and end data.
#' @param show Logical, whether to display the tooltip or not.
#' @param cluster Optional; used to specify which clusters in the chart should have tooltips.
#' @param ... Additional arguments that can be used to further customize the tooltip.
#'
#' @return Returns the gene chart object with the tooltip configured.
#'
#' @examples
#' # Set tooltip
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5'),
#'   group = c('A', 'B', 'B', 'A', 'C')
#' )
#'
#' # Add tooltips to the gene chart
#' GC_chart(genes_data, group = "group", height = "200px") %>%
#' GC_tooltip(formatter = " <b>Start:</b> {start}<br><b>end:</b> {end}")
#'
#' @export
GC_tooltip <- function(
    GC_chart,
    formatter = "<b>Start:</b> {start}<br><b>End:</b> {end}",
    show = TRUE,
    cluster = NULL,
    ...
) {

  if (!show) {
    return(GC_chart)
  }

  if (is.logical(formatter) && length(formatter) == 1) {
    show <- formatter
  }

  # Capture ... arguments
  dots <- list(...)

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)

  for(i in seq_along(clusters)){

    # Default options
    options <- list(
      formatter = formatter,
      show = show
    )

    # Add arguments to options
    for(name in names(dots)) {
      options[[name]] <- dots[[name]][(i-1) %% length(dots[[name]]) + 1]
    }

    # Set title options for each cluster
    GC_chart$x$series[[clusters[i]]]$tooltip <- options

  }
  return(GC_chart)
}

#' Modify Cluster Settings
#'
#' This function can switch prevention of gene overlap on, adjust the spacing
#' between tracks and alter the styling of specified clusters.
#'
#' @param GC_chart The gene chart object to be modified.
#' @param separate_strands Logical, indicating whether to vertically separate
#' forward and reverse genes.
#' @param strand_spacing Numeric, specifies the spacing between genes on
#' different strands. Used only if `separate_strands` is TRUE.
#' @param prevent_gene_overlap Logical, indicating whether to vertically separate
#' overlapping genes.
#' @param overlap_spacing Numeric, specifies the spacing between overlapping genes
#' Used only if `prevent_gene_overlap` is TRUE.
#' @param cluster Optional; used to specify which clusters in the chart should have tooltips.
#' @param style A list of CSS styles to be applied to the gene track.
#'              Each element of the list should be a valid CSS property-value
#'              pair. For example, list(backgroundColor = "red", color = "white").
#' @param ... Additional arguments to be passed to the underlying functions.
#'
#' @return Returns the modified gene chart object.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(1, 10, 200, 220, 600),
#'   end = c(10, 150, 180, 400, 400),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5'),
#'   group = c('A', 'A', 'A', 'A', 'A')
#' )
#'
#'
#' GC_chart(genes_data, group = "group", height = "150px") %>%
#'   GC_cluster(separate_strands=TRUE, strand_spacing = 0) %>%
#'   GC_legend(FALSE)
#'
#' @export
GC_cluster <- function(
    GC_chart,
    separate_strands = NULL,
    strand_spacing = NULL,
    prevent_gene_overlap = NULL,
    overlap_spacing=NULL,
    cluster = NULL,
    style = list(),
    ...
) {

  if (!is.null(separate_strands) && !is.null(prevent_gene_overlap) &&
      separate_strands == TRUE && prevent_gene_overlap == TRUE) {
    warning("Setting both 'separate_strands' and 'prevent_gene_overlap' to TRUE is not supported. Resetting to NULL.")
    separate_strands <- NULL
    prevent_gene_overlap <- NULL
  }

  # Update the GC_chart object with title and options for each cluster
  clusters <- getUpdatedClusters(GC_chart, cluster)


  for(i in seq_along(clusters)){

  # Add gene track
  if(!is.null(prevent_gene_overlap) && prevent_gene_overlap){
    subset_data <- GC_chart$x$series[[i]]$data
    subset_data <- subset_data[with(subset_data, order(-pmax(start, end), abs(end - start))), ]
    GC_chart$x$series[[i]]$data <- add_gene_track(subset_data)
  }

  # Update style options
  if (is.null(GC_chart$x$series[[clusters[i]]]$container$style)) {
    GC_chart$x$series[[clusters[i]]]$container$style <- style
  } else {
    GC_chart$x$series[[clusters[i]]]$container$style <-
      modifyList(GC_chart$x$series[[clusters[i]]]$container$style, style)
  }

  # Update cluster options
  clusterOptions <- Filter(function(x) !is.null(x) && length(x) > 0, list(
    separateStrands = separate_strands,
    strandSpacing = strand_spacing,
    subset_data = prevent_gene_overlap,
    overlapSpacing = overlap_spacing,
    ...
  ))

  if (is.null(GC_chart$x$series[[clusters[i]]]$cluster)) {
    GC_chart$x$series[[clusters[i]]]$cluster <- clusterOptions
  } else {
    GC_chart$x$series[[clusters[i]]]$cluster <-
      modifyList(GC_chart$x$series[[clusters[i]]]$cluster, clusterOptions)
  }

  # Update container options
  containerOptions <- Filter(function(x) !is.null(x) && length(x) > 0, list(
    ...
  ))

  if (is.null(GC_chart$x$series[[clusters[i]]]$container)) {
    GC_chart$x$series[[clusters[i]]]$container <- containerOptions
  } else {
    GC_chart$x$series[[clusters[i]]]$container <-
      modifyList(GC_chart$x$series[[clusters[i]]]$container, containerOptions)
  }

  }

  return(GC_chart)
}

#' Align gene clusters
#'
#' This function aligns clusters based on a specified gene id.
#'
#' @param GC_chart A chart object containing genomic data along with clustering
#' information.
#' @param id_column The name of the column that contains the gene identifiers.
#' @param id The specific identifier of the gene to be aligned.
#' @param align The alignment method for the gene. Valid values are
#' "left", "right", or "center". Defaults to "left".
#'
#' @return The modified `GC_chart` object with updated genomic coordinates.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 210),
#'   end = c(40, 120, 160, 200, 240),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5'),
#'   group = c('A', 'B', 'C', 'C', 'A'),
#'   cluster =  c(1, 1, 1, 2, 2)
#' )
#'
#'
#' GC_chart(genes_data, group = "group", cluster = "cluster", height = "150px") %>%
#'   GC_align("group", "A", align = "left") %>%
#'   GC_legend(FALSE)
#'
#' @export
GC_align <- function(
    GC_chart,
    id_column,
    id,
    align = "left") {
  if (is.null(GC_chart$x$cluster)) {
    warning("Could not align selected gene. Please define cluster in the GC_chart function.")
    return(GC_chart)
  }

  if (!(id_column %in% colnames(GC_chart$x$data))) {
    warning(paste("Column", id_column, "not found in the data."))
    return(GC_chart)
  }

  if (!(id %in% GC_chart$x$data[[id_column]])) {
    warning(paste("ID", id, "not found in the", id_column, "column."))
    return(GC_chart)
  }

  # Swap start and stop for reverse genes
  data <- GC_chart$x$data
  cluster_column <- GC_chart$x$cluster

  # Get reversed clusters
  clusters <- unique(data[[cluster_column]])
  reversed_clusters <- clusters[sapply(clusters, function(cl) {
    if (!is.null(GC_chart$x$series[[cl]]$scale) && !is.null(GC_chart$x$series[[cl]]$scale$reverse)) {
      return(GC_chart$x$series[[cl]]$scale$reverse == TRUE)
    } else {
      return(FALSE)
    }
  })]

  swapped_indices <- data$start > data$end
  data[swapped_indices, c("start", "end")] <- data[swapped_indices, c("end", "start")]

  adjusted_range <- adjust_range(data, cluster_column, id_column, id, align = align, reversed_clusters)
  update_clusters <- adjusted_range[[cluster_column]]

  for (cluster in update_clusters) {
    cluster_data <- adjusted_range[adjusted_range[[cluster_column]] == cluster, ]
    # Set scale options for each cluster
    GC_chart$x$series[[cluster]]$scale$start <- cluster_data$start
    GC_chart$x$series[[cluster]]$scale$end <- cluster_data$end
  }

  return(GC_chart)
}

#' Normalize Gene Clusters in a Genomic Chart
#'
#' This function normalizes the genomic coordinates of a set of genes within a
#' cluster, ensuring that the genes are evenly spaced along the entire range of
#' the cluster. The function allows for the option to preserve the original gene
#' lengths and to introduce customized gaps between the genes.
#'
#' @param GC_chart A chart object containing genomic data and clustering
#'   information. The chart object must include a `series` component with data
#'   for each cluster.
#' @param group Column name containing gene names to apply custom gaps to.
#' @param cluster A vector of cluster names to be normalized. If `NULL`, all
#'   clusters in the `GC_chart` will be normalized.
#' @param normalize A logical value indicating whether to normalize the gene
#'   positions within each cluster. Default is `TRUE`.
#' @param preserve_gene_length A logical vector indicating whether to preserve
#'   the original gene lengths for each cluster. If a single value is provided,
#'   it is recycled for all clusters.
#' @param gap A numeric vector specifying the proportion of the total length to
#'   be used as the gap between genes in each cluster. The value must be between
#'   0 and 1. If a single value is provided, it is recycled for all clusters. If
#'   `NULL`, the gaps are calculated based on the actual spacing between the
#'   genes in the original data.
#' @param custom_gaps A named list where each name corresponds to a gene name and
#'   each value is a numeric factor by which to adjust the gap after that gene.
#'
#' @return The modified `GC_chart` object with normalized gene coordinates for
#'   the specified clusters.
#'
#' @examples
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 10, 90, 130),
#'   end = c(40, 120, 160, 40, 120, 160),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3','Gene 1', 'Gene 2', 'Gene 3'),
#'   group = c('A', 'B', 'C', 'A', 'B', 'C'),
#'   cluster =  c(1, 1, 1, 2, 2, 2)
#' )
#'
#' GC_chart(genes_data, group = "group", cluster = "cluster", height = "150px") %>%
#'   GC_normalize(
#'     cluster = 2,
#'     preserve_gene_length = TRUE,
#'     gap = NULL
#'  )
#'
#' @export
GC_normalize <-
  function(
    GC_chart,
    group = NULL,
    cluster = NULL,
    normalize = TRUE,
    preserve_gene_length = TRUE,
    gap = NULL,
    custom_gaps = list()
    ) {

  # Check if 'cluster' column exists if the cluster parameter is provided
  if (is.null(GC_chart$x$cluster) && !is.null(cluster)) {
    warning("Could not normalize selected genes. Please define cluster in the GC_chart function.")
    return(GC_chart)
  }

  if (is.null(group) && !is.null(GC_chart$x$group)){
    group <- GC_chart$x$group
  }

  if (!is.null(group) && !(group %in% names(GC_chart$x$data))) {
    stop("group column not found in data")
  }

  clusters <- getUpdatedClusters(GC_chart, cluster)

  for (i in seq_along(clusters)) {

    cluster_name <- clusters[i]
    cluster_data <- GC_chart$x$series[[cluster_name]]$data

    # Normalize genes
    if(normalize){
    cluster_data <- normalize_gc_positions(
      cluster_data,
      preserve_gene_length = preserve_gene_length[(i - 1) %% length(preserve_gene_length) + 1],
      gap = gap[(i - 1) %% length(gap) + 1])
    }

    if (length(custom_gaps) > 0) {
      if (is.null(group)) {
        warning("Group is NULL. Custom gaps will not be applied because the group column is not specified.")
      } else {
        for (gene_name in names(custom_gaps)) {
          factor <- custom_gaps[[gene_name]]
          cluster_data <- custom_gaps(
            cluster_data,
            group = group,
            gene_name = gene_name,
            factor = factor
          )
        }
      }
    }

    # Update chart and cluster data
    GC_chart$x$series[[cluster_name]]$data <- cluster_data
    GC_chart[["x"]][["series"]][[cluster_name]][["scale"]][["xMin"]] <-
      min(cluster_data$start, cluster_data$end)
    GC_chart[["x"]][["series"]][[cluster_name]][["scale"]][["xMax"]] <-
      max(cluster_data$start, cluster_data$end)

    GC_chart$x$data <- update_cluster_data(GC_chart$x$data, cluster_data)

  }

  return(GC_chart)
}

#' Get Links from GC Chart
#'
#' Processes a `GC_chart` object to create links between clusters. It creates
#' links for all values in the group column or between value1 and value2 when
#' specified.
#'
#' @param GC_chart Gene chart object.
#' @param group The name of the column in the data to create value pairs from.
#' @param value1 Optional vector of group values to generate links for.
#' @param value2 Optional vector of group values to generate links for.
#' @param cluster Numeric or character vector or NULL; specifies which clusters
#' to generate links between.
#' @return A data frame of links between clusters based on the group column.
#' @examples
#' # See examples for the `GC_links` function for usage.
#' @seealso
#' * [GC_links()]
#' @noRd
get_links <-
  function(GC_chart,
           group,
           value1 = NULL,
           value2 = NULL,
           cluster = NULL) {

    data <- GC_chart$x$data

    # Check if group column exists in the data
    if (!(group %in% names(data))) {
      stop(paste("Column", group, "not found in chart data."))
      return(NULL)
    }

    # Remove rows with NA in the specified group column
    data <- data[!is.na(data[[group]]), ]
    data <- data[data[[group]] != "No Hit", ]

    # Check if all values in value1 and value2 are present in the group column
    if (!is.null(value1) && !all(value1 %in% data[[group]])) {
      stop("Some values in 'value1' are not present in the group column.")
      return(NULL)
    }
    if (!is.null(value2) && !all(value2 %in% data[[group]])) {
      stop("Some values in 'value2' are not present in the group column.")
      return(NULL)
    }

    if (!is.null(cluster) && length(cluster) < 2) {
      stop("At least two clusters need to be provided.")
      return(NULL)
    }
    clusters <- getUpdatedClusters(GC_chart, cluster)

    cluster_column <- GC_chart$x$cluster
    if (is.null(cluster_column)) {
      stop("Please define cluster in the GC_chart function.")
      return(NULL)
    }

    # Rename cluster column
    colnames(data)[colnames(data) == cluster_column] <- "cluster"

    cluster_pairs <-
      mapply(c, clusters[-length(clusters)], clusters[-1], SIMPLIFY = FALSE)
    data <- subset(data, data$cluster %in% clusters)

    all_merged_links <- NULL

    # Process each cluster pair
    for (pair in cluster_pairs) {
      cluster1 <- data[data$cluster == pair[1], ]
      cluster2 <- data[data$cluster == pair[2], ]

      if (is.null(value1) || is.null(value2)) {
        # Filter for common group IDs
        common_genes <- intersect(cluster1[[group]], cluster2[[group]])
        cluster1 <- cluster1[cluster1[[group]] %in% common_genes, ]
        cluster2 <- cluster2[cluster2[[group]] %in% common_genes, ]

        names(cluster1) <- paste0(names(cluster1), "1")
        names(cluster2) <- paste0(names(cluster2), "2")

        merged_links <- merge(cluster1, cluster2, by.x = paste0(group, "1"), by.y = paste0(group, "2"))

        all_merged_links <- rbind(all_merged_links, merged_links)
      } else {
        # Process each value pair
        if (!is.null(value1) &&
          !is.null(value2) &&
          length(value1) == length(value2)) {
          for (i in seq_along(value1)) {
            if (!(value1[i] %in% cluster1[[group]])) {
              temp <- value1[i]
              value1[i] <- value2[i]
              value2[i] <- temp
            }

            filtered_cluster1 <-
              cluster1[cluster1[[group]] == value1[i], ]
            filtered_cluster2 <-
              cluster2[cluster2[[group]] == value2[i], ]

            if (nrow(filtered_cluster1) == 0 ||
              nrow(filtered_cluster2) == 0) {
              next
            }

            names(filtered_cluster1) <- paste0(names(filtered_cluster1), "1")
            names(filtered_cluster2) <- paste0(names(filtered_cluster2), "2")
            filtered_cluster1$temp_key <- 1
            filtered_cluster2$temp_key <- 1

            merged_links <- merge(filtered_cluster1, filtered_cluster2, by.x = "temp_key", by.y = "temp_key")
            merged_links$temp_key <- NULL


            all_merged_links <-
              rbind(all_merged_links, merged_links)
          }
        }
      }
    }

    if (is.null(all_merged_links) || nrow(all_merged_links) == 0) {
      stop("No links found with the specified parameters.")
      return(NULL)
    }

    return(all_merged_links)
  }

#' Add Links to GC Chart
#'
#' Add links generated by `get_links` to a `GC_chart` object. Links are added
#' to the graph by their respective rowIDs.
#'
#' @param GC_chart Gene chart object.
#' @param group The name of the column in the data to create value pairs from.
#' @param data data.frame containing linking data.
#' @param value1 Optional vector of group values to generate links for.
#' @param value2 Optional vector of group values to generate links for.
#' @param cluster Numeric or character vector or NULL; specifies which clusters.
#' @param curve Logical; if `TRUE`, links are curved, otherwise straight.
#' @param measure Character; specifies which measure to use for link color intensity. Should be "identity", "similarity", or "none".
#' @param show_links Logical; if `TRUE`, links are shown, otherwise hidden.
#' @param label Logical; if `TRUE`, shows measure labels on the links, otherwise hidden.
#' @param normal_color Color for the links in their normal state.
#' @param inverted_color Color for inverted links.
#' @param use_group_colors Logical; if `TRUE`, color links by group.
#' @param color_bar Logical; if `TRUE`, the color bar is displayed.
#' @param colorBarOptions List of options to customize the color bar appearance.
#' @param linkWidth Numeric; specifies the width of the links. A value of `1`
#' represents full width, and `0` represents no width.
#' @param linkStyle A list of CSS styles to apply to the links.
#' @param labelStyle A list of CSS styles specifically for the labels.
#' @param ... Additional arguments passed to the links.
#' @return Modified `GC_chart` object with added links.
#' @examples
#' # Add links between all groups in each cluster
#' genes_data <- data.frame(
#'   start = c(10, 90, 130, 170, 240, 250, 300, 340, 380, 420),
#'   end = c(40, 120, 160, 200, 210, 270, 330, 370, 410, 450),
#'   name = c('Gene 1', 'Gene 2', 'Gene 3', 'Gene 4', 'Gene 5',
#'            'Gene 6', 'Gene 7', 'Gene 8', 'Gene 9', 'Gene 10'),
#'   group = c('A', 'B', 'C', 'A', 'B', 'C', 'A', 'B', 'C', 'D'),
#'   identity = c(NA, NA, NA, 50, 40, 100, 60, 65, 20, NA),
#'   similarity = c(NA, NA, NA, 40, 30, 90, 50, 55, 10, NA),
#'   cluster = c(1, 1, 1, 2, 2, 2, 3, 3, 3, 3)
#' )
#' GC_chart(genes_data,
#'          cluster = "cluster",
#'          height = "200px") %>%
#'   GC_links(
#'     group = "group",
#'     value1 = "A",
#'     value2 = "B",
#'     measure = "identity",
#'     label = FALSE) %>%
#'   GC_labels(label = "group")
#'
#' # Add links between group A of cluster 1 and A and B of cluster 2
#' GC_chart(genes_data,
#'          cluster = "cluster",
#'          height = "200px") %>%
#'          GC_labels(label = "group") %>%
#'          GC_links(group = "group",
#'                    value1 = c("A", "A"),
#'                    value2 = c("B", "A"),
#'                    label = FALSE,
#'                    cluster = c(1,2))
#'
#' # Style links and color bar
#' GC_chart(genes_data,
#'          cluster = "cluster",
#'          height = "200px"
#' ) %>%
#'   GC_links(
#'     group = "group",
#'     data = NULL,
#'     curve = TRUE,
#'     measure = "identity",
#'     show_links = TRUE,
#'     label = TRUE,
#'     normal_color = "#1f77b4",
#'     inverted_color = "#d62728",
#'     use_group_colors = FALSE,
#'     color_bar = TRUE,
#'     colorBarOptions = list(
#'       x = 0,
#'       y = 24,
#'       width = 10,
#'       height = 60,
#'       labelOptions = list(
#'         fontSize = 8,
#'         xOffset = 2,
#'         yOffset = 0
#'         # Any other CSS style
#'       ),
#'       titleOptions = list(
#'         fontSize = 10,
#'         xOffset = 2,
#'         yOffset = 0
#'         # Any other CSS style
#'       ),
#'       barOptions = list(
#'         stroke = "#000",
#'         strokeWidth = 0.5,
#'         opacity = 1
#'         # Any other CSS style
#'       )
#'     ),
#'     linkWidth = 1,
#'     linkStyle = list(
#'       stroke = "black",
#'       strokeWidth = 0.5,
#'       fillOpacity = 0.4
#'       # Any other CSS style
#'     ),
#'     labelStyle = list(
#'       fontSize = "8px"
#'       # Any other CSS style
#'     )
#'   ) %>%
#'   GC_labels(label = "group", cluster = 1) %>%
#'   GC_clusterLabel()
#' @seealso
#' * [get_links()]
#' @export
GC_links <- function(
    GC_chart,
    group = NULL,
    data = NULL,
    value1 = NULL,
    value2 = NULL,
    cluster = NULL,
    curve = TRUE,
    measure = "identity",
    show_links = TRUE,
    label = TRUE,
    normal_color = "#969696",
    inverted_color = "#d62728",
    use_group_colors = FALSE,
    color_bar = TRUE,
    colorBarOptions = list(),
    linkWidth = NULL,
    linkStyle = list(),
    labelStyle = list(),
    ...
) {

  # Validate measure
  if (!measure %in% c("identity", "similarity", "none")) {
    stop("Invalid measure specified. Choose 'identity', 'similarity', or 'none'.")
  }

  # Check for required data
  if (is.null(data) && is.null(GC_chart)) {
    stop("Error: Either 'group' or 'data' must be provided.")
  }

  # Retrieve links data or use the provided data
  if (!is.null(data)) {
    links_data <- data
    group <- NULL
    label <- FALSE
  } else {
    links_data <- get_links(GC_chart, group, value1 = value1, value2 = value2, cluster = cluster)
  }

  # Rename relevant columns
  if ("identity2" %in% names(links_data)) {
    names(links_data)[names(links_data) == "identity2"] <- "identity"
  }
  if ("similarity2" %in% names(links_data)) {
    names(links_data)[names(links_data) == "similarity2"] <- "similarity"
  }
  names(links_data)[names(links_data) == paste0(group, "1")] <- "group1"
  names(links_data)[names(links_data) == paste0(group, "2")] <- "group2"

  # Define relevant columns based on the measure
  link_columns <- c("cluster1", "group1", "start1", "end1",
                    "cluster2", "group2", "start2", "end2")
  if (measure != "none") {
    link_columns <- c(link_columns, measure)
  }

  if (use_group_colors) {
    group_color <- if (!is.null(GC_chart$x$group)) GC_chart$x$group else group
    links_data$groupColor <- links_data[[paste0(group_color, "2")]]
    link_columns <- c(link_columns, "groupColor")
    color_bar <- FALSE
  }

  links_data <- links_data[, link_columns[link_columns %in% names(links_data)], drop = FALSE]
  links_data <- links_data[order(links_data$start2), ]

  # Construct the links options with the new measure-related parameters
  links_options <- Filter(function(x) !is.null(x) && length(x) > 0, list(
    group = group,
    curve = curve,
    measure = measure,
    showLinks = show_links,
    label = label,
    normalColor = normal_color,
    invertedColor = inverted_color,
    useGroupColors = use_group_colors,
    value1 = value1,
    value2 = value2,
    colorBar = color_bar,
    colorBarOptions = colorBarOptions,
    linkWidth = linkWidth,
    linkStyle = linkStyle,
    labelStyle = labelStyle,
    ...
  ))

  # Integrate the new links into the GC_chart object
  currentLinks <- GC_chart$x$links

  if (is.null(currentLinks) || length(currentLinks) == 0) {
    links_data$linkID <- paste0("0-", (1:nrow(links_data)))

    links <- list(
      data = links_data,
      options = links_options
    )

    GC_chart$x$links <- list(links)
  } else {
    links_data$linkID <- paste0(length(currentLinks), "-", (1:nrow(links_data)))

    links <- list(
      data = links_data,
      options = links_options
    )

    GC_chart$x$links <- c(currentLinks, list(links))
  }

  return(GC_chart)
}

Try the geneviewer package in your browser

Any scripts or data that you put into this service are public.

geneviewer documentation built on April 12, 2025, 9:12 a.m.